PR 78534, 83704 Handle large formatted I/O

[gcc.git] / libgfortran / io / close.c

diff --git a/libgfortran/io/close.c b/libgfortran/io/close.c
index 9e2a5a398ce90f4268f3c3dd14ad658c11cd03f9..2117c40ac0d1f455ea6f123f6526e9d8492f672e 100644 (file)
--- a/libgfortran/io/close.c
+++ b/libgfortran/io/close.c
@@ -1,11 +1,11 @@
-/* Copyright (C) 2002-2003 Free Software Foundation, Inc.
+/* Copyright (C) 2002-2018 Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of the GNU Fortran 95 runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
 any later version.
 
 Libgfortran is distributed in the hope that it will be useful,
@@ -13,58 +13,99 @@ but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU General Public License for more details.
 
-You should have received a copy of the GNU General Public License
-along with Libgfortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.  */
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
 
-#include "config.h"
-#include "libgfortran.h"
 #include "io.h"
+#include "unix.h"
+#include <limits.h>
 
 typedef enum
 { CLOSE_DELETE, CLOSE_KEEP, CLOSE_UNSPECIFIED }
 close_status;
 
-static st_option status_opt[] = {
+static const st_option status_opt[] = {
   {"keep", CLOSE_KEEP},
   {"delete", CLOSE_DELETE},
-  {NULL}
+  {NULL, 0}
 };
 
 
+extern void st_close (st_parameter_close *);
+export_proto(st_close);
+
 void
-st_close (void)
+st_close (st_parameter_close *clp)
 {
   close_status status;
-  unit_t *u;
+  gfc_unit *u;
+#if !HAVE_UNLINK_OPEN_FILE
+  char *path;
+
+  path = NULL;
+#endif
 
-  library_start ();
+  library_start (&clp->common);
 
-  status = (ioparm.status == NULL) ? CLOSE_UNSPECIFIED :
-    find_option (ioparm.status, ioparm.status_len, status_opt,
-                "Bad STATUS parameter in CLOSE statement");
+  status = !(clp->common.flags & IOPARM_CLOSE_HAS_STATUS) ? CLOSE_UNSPECIFIED :
+    find_option (&clp->common, clp->status, clp->status_len,
+                status_opt, "Bad STATUS parameter in CLOSE statement");
 
-  if (ioparm.library_return != LIBRARY_OK)
+  if ((clp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
+  {
+    library_end ();
     return;
+  }
 
-  u = find_unit (ioparm.unit);
+  u = find_unit (clp->common.unit);
   if (u != NULL)
     {
+      if (close_share (u) < 0)
+       generate_error (&clp->common, LIBERROR_OS, "Problem in CLOSE");
       if (u->flags.status == STATUS_SCRATCH)
        {
          if (status == CLOSE_KEEP)
-           generate_error (ERROR_BAD_OPTION,
+           generate_error (&clp->common, LIBERROR_BAD_OPTION,
                            "Can't KEEP a scratch file on CLOSE");
+#if !HAVE_UNLINK_OPEN_FILE
+         path = strdup (u->filename);
+#endif
        }
       else
        {
          if (status == CLOSE_DELETE)
-           delete_file (u);
+           {
+             if (u->flags.readonly)
+               generate_warning (&clp->common, "STATUS set to DELETE on CLOSE"
+                                 " but file protected by READONLY specifier");
+             else
+               {
+#if HAVE_UNLINK_OPEN_FILE
+                 remove (u->filename);
+#else
+                 path = strdup (u->filename);
+#endif
+               }
+           }
        }
 
       close_unit (u);
+
+#if !HAVE_UNLINK_OPEN_FILE
+      if (path != NULL)
+       {
+         remove (path);
+         free (path);
+       }
+#endif
     }
 
+  /* CLOSE on unconnected unit is legal and a no-op: F95 std., 9.3.5. */ 
   library_end ();
 }