]> git.ipfire.org Git - thirdparty/gcc.git/blobdiff - libgfortran/io/format.c
Update copyright years.
[thirdparty/gcc.git] / libgfortran / io / format.c
index 0b23721c05533b8b70fe8ef50116e776574f2226..ac92acc175c28075162e0ad6cee4aa76251ad216 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002-2019 Free Software Foundation, Inc.
+/* Copyright (C) 2002-2024 Free Software Foundation, Inc.
    Contributed by Andy Vaught
    F2003 I/O support contributed by Jerry DeLisle
 
@@ -29,7 +29,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 #include "io.h"
 #include "format.h"
-#include <ctype.h>
 #include <string.h>
 
 
@@ -38,7 +37,7 @@ static const fnode colon_node = { FMT_COLON, 0, NULL, NULL, {{ 0, 0, 0 }}, 0,
 
 /* Error messages. */
 
-static const char posint_required[] = "Positive width required in format",
+static const char posint_required[] = "Positive integer required in format",
   period_required[] = "Period required in format",
   nonneg_required[] = "Nonnegative width required in format",
   unexpected_element[] = "Unexpected element '%c' in format\n",
@@ -193,7 +192,7 @@ next_char (format_data *fmt, int literal)
        return -1;
 
       fmt->format_string_len--;
-      c = toupper (*fmt->format_string++);
+      c = safe_toupper (*fmt->format_string++);
       fmt->error_element = c;
     }
   while ((c == ' ' || c == '\t') && !literal);
@@ -270,8 +269,7 @@ free_format_data (format_data *fmt)
        fnp->format != FMT_NONE; fnp++)
     if (fnp->format == FMT_DT)
        {
-         if (GFC_DESCRIPTOR_DATA(fnp->u.udf.vlist))
-           free (GFC_DESCRIPTOR_DATA(fnp->u.udf.vlist));
+         free (GFC_DESCRIPTOR_DATA(fnp->u.udf.vlist));
          free (fnp->u.udf.vlist);
        }
 
@@ -328,7 +326,7 @@ format_lex (format_data *fmt)
 
     case '+':
       c = next_char (fmt, 0);
-      if (!isdigit (c))
+      if (!safe_isdigit (c))
        {
          token = FMT_UNKNOWN;
          break;
@@ -339,7 +337,7 @@ format_lex (format_data *fmt)
       for (;;)
        {
          c = next_char (fmt, 0);
-         if (!isdigit (c))
+         if (!safe_isdigit (c))
            break;
 
          fmt->value = 10 * fmt->value + c - '0';
@@ -367,7 +365,7 @@ format_lex (format_data *fmt)
       for (;;)
        {
          c = next_char (fmt, 0);
-         if (!isdigit (c))
+         if (!safe_isdigit (c))
            break;
 
          fmt->value = 10 * fmt->value + c - '0';
@@ -617,6 +615,7 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
   int repeat;
   format_data *fmt = dtp->u.p.fmt;
   bool seen_data_desc = false;
+  int standard;
 
   head = tail = NULL;
 
@@ -925,16 +924,26 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
       tail->repeat = repeat;
 
       u = format_lex (fmt);
+      
+      /* Processing for zero width formats.  */
       if (u == FMT_ZERO)
        {
-         *seen_dd = true;
-         if (notification_std (GFC_STD_F2008) == NOTIFICATION_ERROR
+          if (t == FMT_F)
+           standard = GFC_STD_F95;
+         else if (t == FMT_G)
+           standard = GFC_STD_F2008;
+         else
+           standard = GFC_STD_F2018;
+
+         if (notification_std (standard) == NOTIFICATION_ERROR
              || dtp->u.p.mode == READING)
            {
              fmt->error = zero_width;
              goto finished;
            }
          tail->u.real.w = 0;
+
+         /* Look for the dot seperator.  */
          u = format_lex (fmt);
          if (u != FMT_PERIOD)
            {
@@ -942,108 +951,121 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
              break;
            }
 
+         /* Look for the precision.  */
          u = format_lex (fmt);
-         if (u != FMT_POSINT)
-           notify_std (&dtp->common, GFC_STD_F2003,
-                       "Positive width required");
+         if (u != FMT_ZERO && u != FMT_POSINT)
+           {
+             fmt->error = nonneg_required;
+             goto finished;
+           }
          tail->u.real.d = fmt->value;
-         break;
-       }
-      if (t == FMT_F && dtp->u.p.mode == WRITING)
-       {
-         *seen_dd = true;
-         if (u != FMT_POSINT && u != FMT_ZERO)
+         
+         /* Look for optional exponent, not allowed for FMT_D */
+         if (t == FMT_D)
+           break;
+         u = format_lex (fmt);
+         if (u != FMT_E)
+           fmt->saved_token = u;
+         else
            {
-             if (dtp->common.flags & IOPARM_DT_DEC_EXT)
+             u = format_lex (fmt);
+             if (u != FMT_POSINT)
                {
-                 tail->u.real.w = DEFAULT_WIDTH;
-                 tail->u.real.d = 0;
-                 tail->u.real.e = -1;
-                 fmt->saved_token = u;
-                 break;
+                 if (u == FMT_ZERO)
+                   {
+                     notify_std (&dtp->common, GFC_STD_F2018,
+                                 "Positive exponent width required");
+                   }
+                 else
+                   {
+                     fmt->error = "Positive exponent width required in "
+                                  "format string at %L";
+                     goto finished;
+                   }
                }
-             fmt->error = nonneg_required;
-             goto finished;
+             tail->u.real.e = fmt->value;
            }
+         break;
        }
-      else if (u == FMT_ZERO)
-       {
-         fmt->error = posint_required;
-         goto finished;
-       }
-      else if (u != FMT_POSINT)
+
+      /* Processing for positive width formats.  */
+      if (u == FMT_POSINT)
        {
-         if (dtp->common.flags & IOPARM_DT_DEC_EXT)
+         tail->u.real.w = fmt->value;
+
+         /* Look for the dot separator. Because of legacy behaviors
+            we do some look ahead for missing things.  */
+         t2 = t;
+         t = format_lex (fmt);
+         if (t != FMT_PERIOD)
            {
-             tail->u.real.w = DEFAULT_WIDTH;
+             /* We treat a missing decimal descriptor as 0.  Note: This is only
+                allowed if -std=legacy, otherwise an error occurs.  */
+             if (compile_options.warn_std != 0)
+               {
+                 fmt->error = period_required;
+                 goto finished;
+               }
+             fmt->saved_token = t;
              tail->u.real.d = 0;
              tail->u.real.e = -1;
-             fmt->saved_token = u;
              break;
            }
-         fmt->error = posint_required;
-         goto finished;
-       }
 
-      tail->u.real.w = fmt->value;
-      t2 = t;
-      t = format_lex (fmt);
-      if (t != FMT_PERIOD)
-       {
-         /* We treat a missing decimal descriptor as 0.  Note: This is only
-            allowed if -std=legacy, otherwise an error occurs.  */
-         if (compile_options.warn_std != 0)
+         /* If we made it here, we should have the dot so look for the
+            precision.  */
+         t = format_lex (fmt);
+         if (t != FMT_ZERO && t != FMT_POSINT)
            {
-             fmt->error = period_required;
+             fmt->error = nonneg_required;
              goto finished;
            }
-         fmt->saved_token = t;
-         tail->u.real.d = 0;
+         tail->u.real.d = fmt->value;
          tail->u.real.e = -1;
-         break;
-       }
-
-      t = format_lex (fmt);
-      if (t != FMT_ZERO && t != FMT_POSINT)
-       {
-         fmt->error = nonneg_required;
-         goto finished;
-       }
 
-      tail->u.real.d = fmt->value;
-      tail->u.real.e = -1;
-
-      if (t2 == FMT_D || t2 == FMT_F)
-       {
-         *seen_dd = true;
-         break;
-       }
+         /* Done with D and F formats.  */
+         if (t2 == FMT_D || t2 == FMT_F)
+           {
+             *seen_dd = true;
+             break;
+           }
 
-      /* Look for optional exponent */
-      t = format_lex (fmt);
-      if (t != FMT_E)
-       fmt->saved_token = t;
-      else
-       {
-         t = format_lex (fmt);
-         if (t != FMT_POSINT)
+         /* Look for optional exponent */
+         u = format_lex (fmt);
+         if (u != FMT_E)
+           fmt->saved_token = u;
+         else
            {
-             if (t == FMT_ZERO)
-               {
-                 notify_std (&dtp->common, GFC_STD_F2018,
-                             "Positive exponent width required");
-               }
-             else
+             u = format_lex (fmt);
+             if (u != FMT_POSINT)
                {
-                 fmt->error = "Positive exponent width required in "
-                              "format string at %L";
-                 goto finished;
+                 if (u == FMT_ZERO)
+                   {
+                     notify_std (&dtp->common, GFC_STD_F2018,
+                                 "Positive exponent width required");
+                   }
+                 else
+                   {
+                     fmt->error = "Positive exponent width required in "
+                                  "format string at %L";
+                     goto finished;
+                   }
                }
+             tail->u.real.e = fmt->value;
            }
-         tail->u.real.e = fmt->value;
+         break;
        }
 
+      /* Old DEC codes may not have width or precision specified.  */
+      if (dtp->u.p.mode == WRITING && (dtp->common.flags & IOPARM_DT_DEC_EXT))
+       {
+         tail->u.real.w = DEFAULT_WIDTH;
+         tail->u.real.d = 0;
+         tail->u.real.e = -1;
+         fmt->saved_token = u;
+       }
       break;
+
     case FMT_DT:
       *seen_dd = true;
       get_fnode (fmt, &head, &tail, t);