Update copyright years.

[thirdparty/gcc.git] / libgfortran / io / intrinsics.c

diff --git a/libgfortran/io/intrinsics.c b/libgfortran/io/intrinsics.c
index 4beb0135c86eeace87f1b7ec0439d377c28e76ae..ad7c8003d279f0bbde75df0254125d8c3a49ce1a 100644 (file)
--- a/libgfortran/io/intrinsics.c
+++ b/libgfortran/io/intrinsics.c
@@ -1,6 +1,6 @@
 /* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH 
    FTELL, TTYNAM and ISATTY intrinsics.
-   Copyright (C) 2005, 2007, 2009, 2010 Free Software Foundation, Inc.
+   Copyright (C) 2005-2020 Free Software Foundation, Inc.
 
 This file is part of the GNU Fortran runtime library (libgfortran).
 
@@ -26,13 +26,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include "io.h"
 #include "fbuf.h"
 #include "unix.h"
-
-#ifdef HAVE_STDLIB_H
-#include <stdlib.h>
-#endif
-
 #include <string.h>
 
+
 static const int five = 5;
 static const int six = 6;
 
@@ -40,10 +36,10 @@ extern int PREFIX(fgetc) (const int *, char *, gfc_charlen_type);
 export_proto_np(PREFIX(fgetc));
 
 int
-PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len)
+PREFIX(fgetc) (const int *unit, char *c, gfc_charlen_type c_len)
 {
   int ret;
-  gfc_unit * u = find_unit (*unit);
+  gfc_unit *u = find_unit (*unit);
 
   if (u == NULL)
     return -1;
@@ -74,7 +70,7 @@ PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len)
     (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
   export_proto(fgetc_i ## kind ## _sub); \
   void fgetc_i ## kind ## _sub \
-  (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+  (const int *unit, char *c, GFC_INTEGER_ ## kind *st, gfc_charlen_type c_len) \
     { if (st != NULL) \
         *st = PREFIX(fgetc) (unit, c, c_len); \
       else \
@@ -90,7 +86,7 @@ extern int PREFIX(fget) (char *, gfc_charlen_type);
 export_proto_np(PREFIX(fget));
 
 int
-PREFIX(fget) (char * c, gfc_charlen_type c_len)
+PREFIX(fget) (char *c, gfc_charlen_type c_len)
 {
   return PREFIX(fgetc) (&five, c, c_len);
 }
@@ -101,7 +97,7 @@ PREFIX(fget) (char * c, gfc_charlen_type c_len)
     (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
   export_proto(fget_i ## kind ## _sub); \
   void fget_i ## kind ## _sub \
-  (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+  (char *c, GFC_INTEGER_ ## kind *st, gfc_charlen_type c_len) \
     { if (st != NULL) \
         *st = PREFIX(fgetc) (&five, c, c_len); \
       else \
@@ -118,11 +114,11 @@ extern int PREFIX(fputc) (const int *, char *, gfc_charlen_type);
 export_proto_np(PREFIX(fputc));
 
 int
-PREFIX(fputc) (const int * unit, char * c,
+PREFIX(fputc) (const int *unit, char *c,
               gfc_charlen_type c_len __attribute__((unused)))
 {
   ssize_t s;
-  gfc_unit * u = find_unit (*unit);
+  gfc_unit *u = find_unit (*unit);
 
   if (u == NULL)
     return -1;
@@ -147,7 +143,7 @@ PREFIX(fputc) (const int * unit, char * c,
     (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
   export_proto(fputc_i ## kind ## _sub); \
   void fputc_i ## kind ## _sub \
-  (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+  (const int *unit, char *c, GFC_INTEGER_ ## kind *st, gfc_charlen_type c_len) \
     { if (st != NULL) \
         *st = PREFIX(fputc) (unit, c, c_len); \
       else \
@@ -163,7 +159,7 @@ extern int PREFIX(fput) (char *, gfc_charlen_type);
 export_proto_np(PREFIX(fput));
 
 int
-PREFIX(fput) (char * c, gfc_charlen_type c_len)
+PREFIX(fput) (char *c, gfc_charlen_type c_len)
 {
   return PREFIX(fputc) (&six, c, c_len);
 }
@@ -174,7 +170,7 @@ PREFIX(fput) (char * c, gfc_charlen_type c_len)
     (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
   export_proto(fput_i ## kind ## _sub); \
   void fput_i ## kind ## _sub \
-  (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+  (char *c, GFC_INTEGER_ ## kind *st, gfc_charlen_type c_len) \
     { if (st != NULL) \
         *st = PREFIX(fputc) (&six, c, c_len); \
       else \
@@ -240,12 +236,12 @@ extern void fseek_sub (int *, GFC_IO_INT *, int *, int *);
 export_proto(fseek_sub);
 
 void
-fseek_sub (int * unit, GFC_IO_INT * offset, int * whence, int * status)
+fseek_sub (int *unit, GFC_IO_INT *offset, int *whence, int *status)
 {
-  gfc_unit * u = find_unit (*unit);
+  gfc_unit *u = find_unit (*unit);
   ssize_t result = -1;
 
-  if (u != NULL && is_seekable(u->s))
+  if (u != NULL)
     {
       result = sseek(u->s, *offset, *whence);
 
@@ -260,35 +256,38 @@ fseek_sub (int * unit, GFC_IO_INT * offset, int * whence, int * status)
 
 /* FTELL intrinsic */
 
-extern size_t PREFIX(ftell) (int *);
-export_proto_np(PREFIX(ftell));
-
-size_t
-PREFIX(ftell) (int * unit)
+static gfc_offset
+gf_ftell (int unit)
 {
-  gfc_unit * u = find_unit (*unit);
-  gfc_offset ret;
+  gfc_unit *u = find_unit (unit);
   if (u == NULL)
-    return ((size_t) -1);
-  ret = stell (u->s) + fbuf_reset (u);
+    return -1;
+  int pos = fbuf_reset (u);
+  if (pos != 0)
+    sseek (u->s, pos, SEEK_CUR);
+  gfc_offset ret = stell (u->s);
   unlock_unit (u);
   return ret;
 }
 
+
+extern GFC_IO_INT PREFIX(ftell) (int *);
+export_proto_np(PREFIX(ftell));
+
+GFC_IO_INT
+PREFIX(ftell) (int *unit)
+{
+  return gf_ftell (*unit);
+}
+
+
 #define FTELL_SUB(kind) \
   extern void ftell_i ## kind ## _sub (int *, GFC_INTEGER_ ## kind *); \
   export_proto(ftell_i ## kind ## _sub); \
   void \
-  ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \
+  ftell_i ## kind ## _sub (int *unit, GFC_INTEGER_ ## kind *offset) \
   { \
-    gfc_unit * u = find_unit (*unit); \
-    if (u == NULL) \
-      *offset = -1; \
-    else \
-      { \
-       *offset = stell (u->s) + fbuf_reset (u);        \
-       unlock_unit (u); \
-      } \
+    *offset = gf_ftell (*unit);                        \
   }
 
 FTELL_SUB(1)
@@ -347,25 +346,26 @@ extern void ttynam_sub (int *, char *, gfc_charlen_type);
 export_proto(ttynam_sub);
 
 void
-ttynam_sub (int *unit, char * name, gfc_charlen_type name_len)
+ttynam_sub (int *unit, char *name, gfc_charlen_type name_len)
 {
   gfc_unit *u;
-  char * n;
-  int i;
+  int nlen;
+  int err = 1;
 
-  memset (name, ' ', name_len);
   u = find_unit (*unit);
   if (u != NULL)
     {
-      n = stream_ttyname (u->s);
-      if (n != NULL)
+      err = stream_ttyname (u->s, name, name_len);
+      if (err == 0)
        {
-         i = 0;
-         while (*n && i < name_len)
-           name[i++] = *(n++);
+         nlen = strlen (name);
+         memset (&name[nlen], ' ', name_len - nlen);
        }
+
       unlock_unit (u);
     }
+  if (err != 0)
+    memset (name, ' ', name_len);
 }
 
 
@@ -373,21 +373,22 @@ extern void ttynam (char **, gfc_charlen_type *, int);
 export_proto(ttynam);
 
 void
-ttynam (char ** name, gfc_charlen_type * name_len, int unit)
+ttynam (char **name, gfc_charlen_type *name_len, int unit)
 {
   gfc_unit *u;
 
   u = find_unit (unit);
   if (u != NULL)
     {
-      *name = stream_ttyname (u->s);
-      if (*name != NULL)
+      *name = xmalloc (TTY_NAME_MAX);
+      int err = stream_ttyname (u->s, *name, TTY_NAME_MAX);
+      if (err == 0)
        {
          *name_len = strlen (*name);
-         *name = strdup (*name);
          unlock_unit (u);
          return;
        }
+      free (*name);
       unlock_unit (u);
     }