diff --git a/src/stdlib_io_filesystem.F90 b/src/stdlib_io_filesystem.F90 index a9f5b52d0..1aa4d0711 100644 --- a/src/stdlib_io_filesystem.F90 +++ b/src/stdlib_io_filesystem.F90 @@ -6,13 +6,34 @@ module stdlib_io_filesystem implicit none private - public :: exists, list_dir, run, temp_dir + public :: temp_dir, is_windows, exists, list_dir, run character(*), parameter :: temp_dir = 'temp' character(*), parameter :: listed_contents = temp_dir//'/listed_contents.txt' contains + !> Version: experimental + !> + !> Whether the operating system is Windows. + !> [Specification](../page/specs/stdlib_io.html#is_windows) + logical function is_windows() + character(len=255) :: value + integer :: length, stat + + call get_environment_variable('OSTYPE', value, length, stat) + if (stat == 0 .and. length > 0 .and. (index(value, 'win') > 0 .or. index(value, 'msys') > 0)) then + is_windows = .true.; return + end if + + call get_environment_variable('OS', value, length, stat) + if (stat == 0 .and. length > 0 .and. index(value, 'Windows_NT') > 0) then + is_windows = .true.; return + end if + + is_windows = .false. + end + !> Version: experimental !> !> Whether a file or directory exists at the given path. diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index bfcad3556..4b2323fbe 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -17,6 +17,7 @@ subroutine collect_filesystem(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & + new_unittest("fs_file_is_windows", fs_is_windows), & new_unittest("fs_file_not_exists", fs_file_not_exists, should_fail=.true.), & new_unittest("fs_file_exists", fs_file_exists), & new_unittest("fs_current_dir_exists", fs_current_dir_exists), & @@ -30,6 +31,20 @@ subroutine collect_filesystem(testsuite) ] end + subroutine fs_is_windows(error) + type(error_type), allocatable, intent(out) :: error + + character(len=255) :: value + integer :: length, stat + + call get_environment_variable('HOMEDRIVE', value, length, stat) + if (is_windows()) then + call check(error, stat == 0 .and. length > 0, "Windows should be detected.") + else + call check(error, stat /= 0 .and. length == 0, "Windows should not be detected.") + end if + end + subroutine fs_file_not_exists(error) type(error_type), allocatable, intent(out) :: error