-/* Copyright (C) 2002-2017 Free Software Foundation, Inc.
+/* Copyright (C) 2002-2024 Free Software Foundation, Inc.
Contributed by Andy Vaught
F2003 I/O support contributed by Jerry DeLisle
#include "io.h"
#include "format.h"
-#include <ctype.h>
#include <string.h>
/* 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",
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);
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);
}
case '+':
c = next_char (fmt, 0);
- if (!isdigit (c))
+ if (!safe_isdigit (c))
{
token = FMT_UNKNOWN;
break;
for (;;)
{
c = next_char (fmt, 0);
- if (!isdigit (c))
+ if (!safe_isdigit (c))
break;
fmt->value = 10 * fmt->value + c - '0';
for (;;)
{
c = next_char (fmt, 0);
- if (!isdigit (c))
+ if (!safe_isdigit (c))
break;
fmt->value = 10 * fmt->value + c - '0';
int repeat;
format_data *fmt = dtp->u.p.fmt;
bool seen_data_desc = false;
+ int standard;
head = tail = NULL;
tail->repeat = repeat;
u = format_lex (fmt);
- if (t == FMT_G && u == FMT_ZERO)
+
+ /* 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)
{
break;
}
+ /* Look for the precision. */
u = format_lex (fmt);
- if (u != FMT_POSINT)
+ if (u != FMT_ZERO && u != FMT_POSINT)
{
- fmt->error = posint_required;
+ fmt->error = nonneg_required;
goto finished;
}
tail->u.real.d = fmt->value;
+
+ /* 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
+ {
+ u = format_lex (fmt);
+ if (u != FMT_POSINT)
+ {
+ 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;
+ }
break;
}
- if (t == FMT_F && dtp->u.p.mode == WRITING)
+
+ /* Processing for positive width formats. */
+ if (u == FMT_POSINT)
{
- *seen_dd = true;
- if (u != FMT_POSINT && u != FMT_ZERO)
+ 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)
{
- fmt->error = nonneg_required;
- goto finished;
+ /* 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;
+ break;
}
- }
- else if (u != FMT_POSINT)
- {
- 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;
+ /* Done with D and F formats. */
+ if (t2 == FMT_D || t2 == FMT_F)
+ {
+ *seen_dd = true;
+ break;
+ }
- if (t2 == FMT_D || t2 == FMT_F)
- {
- *seen_dd = true;
+ /* Look for optional exponent */
+ u = format_lex (fmt);
+ if (u != FMT_E)
+ fmt->saved_token = u;
+ else
+ {
+ u = format_lex (fmt);
+ if (u != FMT_POSINT)
+ {
+ 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;
+ }
break;
}
- /* Look for optional exponent */
- t = format_lex (fmt);
- if (t != FMT_E)
- fmt->saved_token = t;
- else
+ /* Old DEC codes may not have width or precision specified. */
+ if (dtp->u.p.mode == WRITING && (dtp->common.flags & IOPARM_DT_DEC_EXT))
{
- t = format_lex (fmt);
- if (t != FMT_POSINT)
- {
- fmt->error = "Positive exponent width required in format";
- goto finished;
- }
-
- tail->u.real.e = fmt->value;
+ 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);
t = format_lex (fmt);
- /* Initialize the vlist to a zero size array. */
- tail->u.udf.vlist= xmalloc (sizeof(gfc_array_i4));
+ /* Initialize the vlist to a zero size, rank-one array. */
+ tail->u.udf.vlist= xmalloc (sizeof(gfc_array_i4)
+ + sizeof (descriptor_dimension));
GFC_DESCRIPTOR_DATA(tail->u.udf.vlist) = NULL;
GFC_DIMENSION_SET(tail->u.udf.vlist->dim[0],1, 0, 0);
{
/* We have parsed the complete vlist so initialize the
array descriptor and save it in the format node. */
- gfc_array_i4 *vp = tail->u.udf.vlist;
+ gfc_full_array_i4 *vp = tail->u.udf.vlist;
GFC_DESCRIPTOR_DATA(vp) = xmalloc (i * sizeof(GFC_INTEGER_4));
GFC_DIMENSION_SET(vp->dim[0],1, i, 1);
memcpy (GFC_DESCRIPTOR_DATA(vp), temp, i * sizeof(GFC_INTEGER_4));
{
if (t != FMT_POSINT)
{
+ if (dtp->common.flags & IOPARM_DT_DEC_EXT)
+ {
+ tail->u.integer.w = DEFAULT_WIDTH;
+ tail->u.integer.m = -1;
+ fmt->saved_token = t;
+ break;
+ }
fmt->error = posint_required;
goto finished;
}
{
if (t != FMT_ZERO && t != FMT_POSINT)
{
+ if (dtp->common.flags & IOPARM_DT_DEC_EXT)
+ {
+ tail->u.integer.w = DEFAULT_WIDTH;
+ tail->u.integer.m = -1;
+ fmt->saved_token = t;
+ break;
+ }
fmt->error = nonneg_required;
goto finished;
}