system: is_directory

doc/specs/stdlib_system.md

@@ -417,3 +417,38 @@ Returns one of the `integer` `OS_*` parameters representing the OS type, from th
 ```fortran
 {!example/system/example_os_type.f90!}
 ```
+
+## `is_directory` - Test if a path is a directory
+
+### Status
+
+Experimental
+
+### Description
+
+This function checks if a specified file system path is a directory. 
+It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted.
+
+### Syntax
+
+`result = [[stdlib_io(module):is_directory(function)]] (path)`
+
+### Class
+Function
+
+### Arguments
+
+`path`: Shall be a character string containing the file system path to evaluate. It is an `intent(in)` argument.
+
+### Return values
+
+The function returns a `logical` value:
+
+- `.true.` if the path matches an existing directory.
+- `.false.` otherwise, or if the operating system is unsupported.
+
+### Example
+
+```fortran
+{!example/system/example_is_directory.f90!}
+```

example/system/CMakeLists.txt

@@ -1,4 +1,5 @@
 ADD_EXAMPLE(get_runtime_os)
+ADD_EXAMPLE(is_directory)
 ADD_EXAMPLE(os_type)
 ADD_EXAMPLE(process_1)
 ADD_EXAMPLE(process_2)

example/system/example_is_directory.f90

@@ -0,0 +1,11 @@
+! Demonstrate usage of `is_directory`
+program example_is_directory
+  use stdlib_system, only: is_directory
+  implicit none
+  ! Test a directory path
+  if (is_directory("/path/to/check")) then 
+    print *, "The specified path is a directory."
+  else
+    print *, "The specified path is not a directory."
+  end if
+end program example_is_directory

src/stdlib_system.F90

@@ -1,6 +1,7 @@
 module stdlib_system
 use, intrinsic :: iso_c_binding, only : c_int, c_long, c_null_ptr, c_int64_t
-use stdlib_kinds, only: int64, dp
+use stdlib_kinds, only: int64, dp, c_bool, c_char
+use stdlib_strings, only: to_c_char
 implicit none
 private
 public :: sleep
@@ -81,6 +82,22 @@ module stdlib_system
 public :: elapsed
 public :: is_windows
 
+!! version: experimental
+!!
+!! Tests if a given path matches an existing directory.
+!! ([Specification](../page/specs/stdlib_io.html#is_directory-test-if-a-path-is-a-directory))
+!!
+!!### Summary
+!! Function to evaluate whether a specified path corresponds to an existing directory.
+!!
+!!### Description
+!! 
+!! This function checks if a given file system path is a directory. It is cross-platform and avoids reliance 
+!! on external C libraries by utilizing system calls. It supports common operating systems such as Linux, macOS, 
+!! Windows, and various UNIX-like environments. On unsupported operating systems, the function will return `.false.`.
+!!
+public :: is_directory
+
 ! CPU clock ticks storage
 integer, parameter, private :: TICKS = int64
 integer, parameter, private :: RTICKS = dp
@@ -618,4 +635,23 @@ pure function OS_NAME(os)
     end select
 end function OS_NAME
 
+!! Tests if a given path matches an existing directory.
+!! Cross-platform implementation without using external C libraries.
+logical function is_directory(path)
+    !> Input path to evaluate
+    character(*), intent(in) :: path
+
+    interface
+
+        logical(c_bool) function stdlib_is_directory(path) bind(c, name="stdlib_is_directory")
+            import c_bool, c_char
+            character(kind=c_char), intent(in) :: path(*)
+        end function stdlib_is_directory
+
+    end interface        
+
+    is_directory = logical(stdlib_is_directory(to_c_char(trim(path))))
+
+end function is_directory
+
 end module stdlib_system

src/stdlib_system_subprocess.F90

@@ -1,7 +1,7 @@
 submodule (stdlib_system) stdlib_system_subprocess
     use iso_c_binding  
     use iso_fortran_env, only: int64, real64
-    use stdlib_strings, only: to_c_char, join
+    use stdlib_strings, only: join
     use stdlib_linalg_state, only: linalg_state_type, LINALG_ERROR, linalg_error_handling
     implicit none(type, external)
 

src/stdlib_system_subprocess.c

@@ -10,6 +10,7 @@
 #else
 #define _POSIX_C_SOURCE 199309L
 #include <sys/wait.h>
+#include <sys/stat.h>  
 #include <unistd.h>
 #include <time.h>
 #include <errno.h>
@@ -220,6 +221,12 @@ bool process_kill_windows(stdlib_pid pid) {
     return true;
 }
 
+// Check if input path is a directory
+bool stdlib_is_directory_windows(const char *path) {
+    DWORD attrs = GetFileAttributesA(path);
+    return    (attrs != INVALID_FILE_ATTRIBUTES)  // Path exists
+           && (attrs & FILE_ATTRIBUTE_DIRECTORY); // Path is a directory
+}
 
 #else // _WIN32
 
@@ -292,12 +299,29 @@ void process_create_posix(stdlib_pid* pid)
     (*pid) = (stdlib_pid) fork();
 }
 
+// On UNIX systems: check if input path is a directory
+bool stdlib_is_directory_posix(const char *path) {
+    struct stat sb;
+    return stat(path, &sb) == 0 && S_ISDIR(sb.st_mode);
+}
+
 #endif // _WIN32
 
 /////////////////////////////////////////////////////////////////////////////////////
 // Cross-platform interface
 /////////////////////////////////////////////////////////////////////////////////////
 
+// Cross-platform interface: query directory state
+bool stdlib_is_directory(const char *path) {
+    // Invalid input
+    if (path == NULL || strlen(path) == 0) return false;  
+#ifdef _WIN32
+    return stdlib_is_directory_windows(path);
+#else
+    return stdlib_is_directory_posix(path);
+#endif // _WIN32
+}
+
 // Create or fork process
 void process_create(const char* cmd, const char* stdin_stream, const char* stdin_file, 
                     const char* stdout_file, const char* stderr_file, 

test/system/CMakeLists.txt

@@ -1,3 +1,4 @@
+ADDTEST(filesystem)
 ADDTEST(os)
 ADDTEST(sleep)
 ADDTEST(subprocess)

test/system/test_filesystem.f90

@@ -0,0 +1,99 @@
+module test_filesystem
+    use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test
+    use stdlib_system, only: is_directory
+
+    implicit none
+
+contains
+
+    !> Collect all exported unit tests
+    subroutine collect_suite(testsuite)
+        !> Collection of tests
+        type(unittest_type), allocatable, intent(out) :: testsuite(:)
+
+        testsuite = [ &
+            new_unittest("fs_is_directory_dir", test_is_directory_dir), &
+            new_unittest("fs_is_directory_file", test_is_directory_file) &
+        ]
+    end subroutine collect_suite
+
+    ! Test `is_directory` for a directory
+    subroutine test_is_directory_dir(error)
+        type(error_type), allocatable, intent(out) :: error
+        character(len=256) :: dirname
+        integer :: ios, iocmd
+        character(len=512) :: msg
+
+        dirname = "this_test_dir_tmp"
+
+        ! Create a directory
+        call execute_command_line("mkdir " // dirname, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
+        call check(error, ios == 0 .and. iocmd == 0, "Cannot create test directory: " // trim(msg))
+        if (allocated(error)) return
+
+        ! Verify `is_directory` identifies it as a directory
+        call check(error, is_directory(dirname), "is_directory did not recognize a valid directory")
+        if (allocated(error)) return
+
+        ! Clean up: remove the directory
+        call execute_command_line("rmdir " // dirname, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
+        call check(error, ios == 0 .and. iocmd == 0, "Cannot remove test directory: " // trim(msg))
+    end subroutine test_is_directory_dir
+
+    ! Test `is_directory` for a regular file
+    subroutine test_is_directory_file(error)
+        type(error_type), allocatable, intent(out) :: error
+        character(len=256) :: filename
+        logical :: result
+        integer :: ios, iunit
+        character(len=512) :: msg
+
+        filename = "test_file.txt"
+
+        ! Create a file
+        open(newunit=iunit, file=filename, status="replace", iostat=ios, iomsg=msg)
+        call check(error, ios == 0, "Cannot create test file: " // trim(msg))
+        if (allocated(error)) return        
+
+        ! Verify `is_directory` identifies it as not a directory
+        result = is_directory(filename)
+        call check(error, .not. result, "is_directory falsely recognized a regular file as a directory")
+        if (allocated(error)) return
+
+        ! Clean up: remove the file
+        close(iunit,status='delete',iostat=ios,iomsg=msg)
+        call check(error, ios == 0, "Cannot delete test file: " // trim(msg))
+        if (allocated(error)) return                
+
+    end subroutine test_is_directory_file
+
+
+end module test_filesystem
+
+program tester
+    use, intrinsic :: iso_fortran_env, only : error_unit
+    use testdrive, only : run_testsuite, new_testsuite, testsuite_type
+    use test_filesystem, only : collect_suite
+
+    implicit none
+
+    integer :: stat, is
+    type(testsuite_type), allocatable :: testsuites(:)
+    character(len=*), parameter :: fmt = '("#", *(1x, a))'
+
+    stat = 0
+
+    testsuites = [ &
+        new_testsuite("filesystem", collect_suite) &
+    ]
+
+    do is = 1, size(testsuites)
+        write(error_unit, fmt) "Testing:", testsuites(is)%name
+        call run_testsuite(testsuites(is)%collect, error_unit, stat)
+    end do
+
+    if (stat > 0) then
+        write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
+        error stop
+    end if
+end program