On Wed, Sep 2, 2015 at 6:03 PM, Steve Kargl <s...@troutmask.apl.washington.edu> wrote: > On Wed, Sep 02, 2015 at 11:30:07AM +0300, Janne Blomqvist wrote: >> On Wed, Sep 2, 2015 at 1:28 AM, Jerry DeLisle <jvdeli...@charter.net> wrote: >> > On 09/01/2015 11:18 AM, Steve Kargl wrote: >> >> On Tue, Sep 01, 2015 at 11:16:27AM -0700, Steve Kargl wrote: >> >>> open(unit=10, >> >>> file='junko.dir',iostat=ios,action='read',access='stream') >> >>> if (ios.ne.0) call abort >> >>> read(10, iostat=ios) c >> >>> - if (ios.ne.21) call abort >> >>> + if (ios.ne.21) then >> >>> + close(10) >> >> >> >> I forgot to mention that 'close(10, status="delete')' does not >> >> work on a directory. Should it? >> >> >> >>> + call system('rmdir junko.dir') >> >>> + call abort >> >>> + end if >> >>> + close(10) >> >>> call system('rmdir junko.dir') >> >> >> > >> > Thanks for the touch up Steve. I suspect other OS's will not work either. >> > I >> > assumed close with Status="delete" would not work on a directory. >> >> That's because libgfortran uses unlink(2), which only works for files, >> not directories. One could change that to use remove(3), which works >> for both. > > I suspect people who create directories and then > want to delete them will use SYSTEM or the > standard conforming equivalent.
Probably. Anyway, it's no big deal to fix it and shouldn't have any negative side effects, so I committed the attached patch as obvious. testsuite: 2015-09-04 Janne Blomqvist <j...@gcc.gnu.org> * gfortran.dg/read_dir.f90: Delete empty directory when closing rather than calling rmdir, cleanup if open fails. libgfortran: 2015-09-04 Janne Blomqvist <j...@gcc.gnu.org> * io/unix.h (delete_file): Remove prototype. * io/unix.c (delete_file): Remove function. * io/close.c (st_close): Replace delete_file and unlink with remove. * io/open.c (already_open): Replace unlink with remove. >> Also, I suspect the reason why it fails on freebsd is that errno >> EISDIR is not 21 there. Perhaps one should just check for ios /= 0? > > I checked. FreeBSD's EISDIR is 21; howevr, ios == 0 in this > case. I haven't looked too deep. FreeBSD is probably > adhering to the unix philosophy of "everything is a file". Hmm, Ok. Reading the POSIX spec for read() http://pubs.opengroup.org/onlinepubs/9699919799/functions/read.html it seems it's allowed, but not required for an implementation to return data when reading from a directory fd. The portable would be to use readdir(). -- Janne Blomqvist
diff --git a/gcc/testsuite/gfortran.dg/read_dir.f90 b/gcc/testsuite/gfortran.dg/read_dir.f90 index 0e28f9f..4009ed6 100644 --- a/gcc/testsuite/gfortran.dg/read_dir.f90 +++ b/gcc/testsuite/gfortran.dg/read_dir.f90 @@ -7,13 +7,14 @@ program bug integer ios call system('[ -d junko.dir ] || mkdir junko.dir') open(unit=10, file='junko.dir',iostat=ios,action='read',access='stream') - if (ios.ne.0) call abort + if (ios.ne.0) then + call system('rmdir junko.dir') + call abort + end if read(10, iostat=ios) c if (ios.ne.21) then - close(10) - call system('rmdir junko.dir') + close(10, status='delete') call abort end if - close(10) - call system('rmdir junko.dir') + close(10, status='delete') end program bug diff --git a/libgfortran/io/close.c b/libgfortran/io/close.c index 38855ee..1e10993 100644 --- a/libgfortran/io/close.c +++ b/libgfortran/io/close.c @@ -80,7 +80,7 @@ st_close (st_parameter_close *clp) if (status == CLOSE_DELETE) { #if HAVE_UNLINK_OPEN_FILE - delete_file (u); + remove (u->filename); #else path = strdup (u->filename); #endif @@ -92,7 +92,7 @@ st_close (st_parameter_close *clp) #if !HAVE_UNLINK_OPEN_FILE if (path != NULL) { - unlink (path); + remove (path); free (path); } #endif diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index 4654de2..630bca6 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -664,7 +664,7 @@ already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) #if !HAVE_UNLINK_OPEN_FILE if (u->filename && u->flags.status == STATUS_SCRATCH) - unlink (u->filename); + remove (u->filename); #endif free (u->filename); u->filename = NULL; diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c index fd5f277..5385d8b 100644 --- a/libgfortran/io/unix.c +++ b/libgfortran/io/unix.c @@ -1716,16 +1716,6 @@ flush_all_units (void) } -/* delete_file()-- Given a unit structure, delete the file associated - * with the unit. Returns nonzero if something went wrong. */ - -int -delete_file (gfc_unit * u) -{ - return unlink (u->filename); -} - - /* file_exists()-- Returns nonzero if the current filename exists on * the system */ diff --git a/libgfortran/io/unix.h b/libgfortran/io/unix.h index 78a41f7..d1aa75d 100644 --- a/libgfortran/io/unix.h +++ b/libgfortran/io/unix.h @@ -141,9 +141,6 @@ internal_proto(compare_file_filename); extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len); internal_proto(find_file); -extern int delete_file (gfc_unit *); -internal_proto(delete_file); - extern int file_exists (const char *file, gfc_charlen_type file_len); internal_proto(file_exists);