gfortran.dg/read_dir.f90: Make PASS on Windows Call POSIX's stat/mkdir/rmdir instead of using the shell via 'call system'. Additionally, expect EACCESS on non-Cygwin Windows as documented for trying to open a directory. gcc/testsuite/ChangeLog: * gfortran.dg/read_dir-aux.c: New; provides my_mkdir and my_rmdir. * gfortran.dg/read_dir.f90: Call my_mkdir/my_rmdir; expect error on Windows when opening a directory. gcc/testsuite/gfortran.dg/read_dir-aux.c | 39 +++++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/read_dir.f90 | 43 ++++++++++++++++++++++++++++---- 2 files changed, 77 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..e8404478517 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/read_dir-aux.c @@ -0,0 +1,39 @@ +#include /* For mkdir + permission bits. */ +#include /* For rmdir. */ +#include /* For errno. */ +#include /* For perror. */ +#include /* For 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); +} diff --git a/gcc/testsuite/gfortran.dg/read_dir.f90 b/gcc/testsuite/gfortran.dg/read_dir.f90 index c7ddc51fb90..3a8ff6adbc7 100644 --- a/gcc/testsuite/gfortran.dg/read_dir.f90 +++ b/gcc/testsuite/gfortran.dg/read_dir.f90 @@ -1,18 +1,51 @@ ! { dg-do run } +! { dg-additional-options "-cpp" } +! { dg-additional-sources read_dir-aux.c } +! ! PR67367 + program bug + use iso_c_binding implicit none + + interface + 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') + + call my_mkdir(c_sdir) + open(unit=10, file=sdir,iostat=ios,action='read',access='stream') + +#if defined(__MINGW32__) + ! Windows is documented to fail with EACCESS when trying to open a directory + ! Note: Testing showed that __CYGWIN__ does permit opening directories + call my_rmdir(c_sdir) + if (ios == 0) & + stop 3 ! Expected EACCESS + stop 0 ! OK +#endif + 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') STOP 2 end if