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. 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 /* For mkdir + permission bits. */ +#include /* For rmdir. */ +#include /* For errno. */ +#include /* For perror. */ +#include /* 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