[gcc r13-4818] gfortran.dg/read_dir.f90: Make PASS on Windows

[gcc r13-4818] gfortran.dg/read_dir.f90: Make PASS on Windows

[Tobias Burnus]

https://gcc.gnu.org/g:18fc70aa9c753d17c00211cea9fa5bd843fe94fd

commit r13-4818-g18fc70aa9c753d17c00211cea9fa5bd843fe94fd
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Wed Dec 21 08:06:29 2022 +0100

    gfortran.dg/read_dir.f90: Make PASS on Windows
    
    On non-Cygwin Windows, use '.' and expect the documented fail when opening
    a directory (EACCESS).  As gfortran does not set __WIN32__ this check is
    done on the C side. (On __CYGWIN__, __WIN32__ is not set - but to make it
    clear, !__CYGWIN__ is used in #if.)
    
    On non-Windows, replace the 'call system' shell call by the POSIX functions
    stat/mkdir/rmdir for better compatibility, especially on embedded systems;
    additionally add some more checks. In particular, confirm that 'close' with
    status='delete' indeed deleted the directory.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/read_dir-aux.c: New; provides my_mkdir, my_rmdir,
            my_verify_not_exists and expect_open_to_fail.
            * gfortran.dg/read_dir.f90: Call those; expect that opening a
            directory fails on Windows.

Diff:
---
 gcc/testsuite/gfortran.dg/read_dir-aux.c | 68 ++++++++++++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/read_dir.f90   | 54 ++++++++++++++++++++++---
 2 files changed, 117 insertions(+), 5 deletions(-)

diff --git a/gcc/testsuite/gfortran.dg/read_dir-aux.c b/gcc/testsuite/gfortran.dg/read_dir-aux.c
new file mode 100644
index 00000000000..307b44472af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_dir-aux.c
@@ -0,0 +1,68 @@
+#if defined(__WIN32__) && !defined(__CYGWIN__)
+  /* Mostly skip on Windows, cf. main file why. */
+
+int expect_open_to_fail () { return 1; }
+
+void my_verify_not_exists (const char *dir) { }
+void my_mkdir (const char *dir) { }
+void my_rmdir (const char *dir) { }
+
+#else
+
+#include <sys/stat.h>  /* For mkdir + permission bits.  */
+#include <unistd.h>  /* For rmdir.  */
+#include <errno.h>  /* For errno.  */
+#include <stdio.h>  /* For perror.  */
+#include <stdlib.h>  /* For abort.  */
+ 
+
+int expect_open_to_fail () { return 0; }
+
+void
+my_verify_not_exists (const char *dir)
+{
+  struct stat path_stat;
+  int err = stat (dir, &path_stat);
+  if (err && errno == ENOENT)
+    return;  /* OK */
+  if (err)
+    perror ("my_verify_not_exists");
+  else
+    printf ("my_verify_not_exists: pathname %s still exists\n", dir);
+  abort ();
+ }
+
+void
+my_mkdir (const char *dir)
+{
+  int err;
+  struct stat path_stat;
+
+  /* Check whether 'dir' exists and is a directory.  */
+  err = stat (dir, &path_stat);
+  if (err && errno != ENOENT)
+    {
+      perror ("my_mkdir: failed to call stat for directory");
+      abort ();
+    }
+  if (err == 0 && !S_ISDIR (path_stat.st_mode))
+    {
+      printf ("my_mkdir: pathname %s is not a directory\n", dir);
+      abort ();
+    }
+
+  err = mkdir (dir, S_IRWXU | S_IRGRP | S_IXGRP | S_IROTH | S_IXOTH);
+  if (err != 0)
+    {
+      perror ("my_mkdir: failed to create directory");
+      abort ();
+    }    
+}
+
+void
+my_rmdir (const char *dir)
+{
+  rmdir (dir);
+}
+
+#endif  /* !defined(__WIN32__) || defined(__CYGWIN__) */
diff --git a/gcc/testsuite/gfortran.dg/read_dir.f90 b/gcc/testsuite/gfortran.dg/read_dir.f90
index c7ddc51fb90..2778210f079 100644
--- a/gcc/testsuite/gfortran.dg/read_dir.f90
+++ b/gcc/testsuite/gfortran.dg/read_dir.f90
@@ -1,20 +1,64 @@
 ! { dg-do run }
+! { dg-additional-sources read_dir-aux.c }
+!
 ! PR67367
+
 program bug
+   use iso_c_binding
    implicit none
+
+   interface
+     integer(c_int) function expect_open_to_fail () bind(C)
+       import
+     end
+     subroutine my_verify_not_exists(s) bind(C)
+       ! Aborts if the passed pathname (still) exists
+       import
+       character(len=1,kind=c_char) :: s(*)
+     end subroutine
+     subroutine my_mkdir(s) bind(C)
+       ! Call POSIX's mkdir - and ignore fails due to
+       ! existing directories but fail otherwise
+       import
+       character(len=1,kind=c_char) :: s(*)
+     end subroutine
+     subroutine my_rmdir(s) bind(C)
+       ! Call POSIX's rmdir - and ignore fails
+       import
+       character(len=1,kind=c_char) :: s(*)
+     end subroutine
+   end interface
+
+   character(len=*), parameter :: sdir = "junko.dir"
+   character(len=*,kind=c_char), parameter :: c_sdir = sdir // c_null_char
+
    character(len=1) :: c
-   character(len=256) :: message
    integer ios
-   call system('[ -d junko.dir ] || mkdir junko.dir')
-   open(unit=10, file='junko.dir',iostat=ios,action='read',access='stream')
+
+   if (expect_open_to_fail () /= 0) then
+      ! Windows is documented to fail with EACCESS when trying to open a
+      ! directory. However, target macros such as __WIN32__ are not defined
+      ! in Fortran; hence, we use a detour via this C function.
+      ! Check for '.' which is a known-to-exist directory:
+      open(unit=10, file='.',iostat=ios,action='read',access='stream')
+      if (ios == 0) &
+          stop 3  ! Error: open to fail (EACCESS)
+       stop 0  ! OK
+   endif
+
+   call my_mkdir(c_sdir)
+   open(unit=10, file=sdir,iostat=ios,action='read',access='stream')
+
    if (ios.ne.0) then
-      call system('rmdir junko.dir')
+      call my_rmdir(c_sdir)
       STOP 1
    end if
    read(10, iostat=ios) c
-   if (ios.ne.21.and.ios.ne.0) then 
+   if (ios.ne.21.and.ios.ne.0) then  ! EISDIR has often the value 21
       close(10, status='delete')
+      call my_verify_not_exists(c_sdir)
       STOP 2
    end if
    close(10, status='delete')
+   call my_verify_not_exists(c_sdir)
 end program bug