-/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
- Free Software Foundation, Inc.
+/* Copyright (C) 2002-2015 Free Software Foundation, Inc.
Contributed by Andy Vaught
F2003 I/O support contributed by Jerry DeLisle
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran 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
#include "format.h"
#include <ctype.h>
#include <string.h>
-#include <stdbool.h>
+#include <stdlib.h>
-#define FARRAY_SIZE 64
-
-typedef struct fnode_array
-{
- struct fnode_array *next;
- fnode array[FARRAY_SIZE];
-}
-fnode_array;
-
-typedef struct format_data
-{
- char *format_string, *string;
- const char *error;
- char error_element;
- format_token saved_token;
- int value, format_string_len, reversion_ok;
- fnode *avail;
- const fnode *saved_format;
- fnode_array *last;
- fnode_array array;
-}
-format_data;
static const fnode colon_node = { FMT_COLON, 0, NULL, NULL, {{ 0, 0, 0 }}, 0,
NULL };
if (u->format_hash_table[i].hashed_fmt != NULL)
{
free_format_data (u->format_hash_table[i].hashed_fmt);
- free_mem (u->format_hash_table[i].key);
+ free (u->format_hash_table[i].key);
}
u->format_hash_table[i].key = NULL;
u->format_hash_table[i].key_len = 0;
/* A simple hashing function to generate an index into the hash table. */
-static inline
-uint32_t format_hash (st_parameter_dt *dtp)
+static uint32_t
+format_hash (st_parameter_dt *dtp)
{
char *key;
gfc_charlen_type key_len;
free_format_data (u->format_hash_table[hash].hashed_fmt);
u->format_hash_table[hash].hashed_fmt = NULL;
- if (u->format_hash_table[hash].key != NULL)
- free_mem (u->format_hash_table[hash].key);
- u->format_hash_table[hash].key = get_mem (dtp->format_len);
- memcpy (u->format_hash_table[hash].key, dtp->format, dtp->format_len);
+ free (u->format_hash_table[hash].key);
+ u->format_hash_table[hash].key = dtp->format;
u->format_hash_table[hash].key_len = dtp->format_len;
u->format_hash_table[hash].hashed_fmt = dtp->u.p.fmt;
if (fmt->avail == &fmt->last->array[FARRAY_SIZE])
{
- fmt->last->next = get_mem (sizeof (fnode_array));
+ fmt->last->next = xmalloc (sizeof (fnode_array));
fmt->last = fmt->last->next;
fmt->last->next = NULL;
fmt->avail = &fmt->last->array[0];
}
+/* free_format()-- Free allocated format string. */
+void
+free_format (st_parameter_dt *dtp)
+{
+ if ((dtp->common.flags & IOPARM_DT_HAS_FORMAT) && dtp->format)
+ {
+ free (dtp->format);
+ dtp->format = NULL;
+ }
+}
+
+
/* free_format_data()-- Free all allocated format data. */
void
for (fa = fmt->array.next; fa; fa = fa_next)
{
fa_next = fa->next;
- free_mem (fa);
+ free (fa);
}
- free_mem (fmt);
+ free (fmt);
fmt = NULL;
}
* parenthesis node which contains the rest of the list. */
static fnode *
-parse_format_list (st_parameter_dt *dtp, bool *save_ok)
+parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
{
fnode *head, *tail;
format_token t, u, t2;
int repeat;
format_data *fmt = dtp->u.p.fmt;
- bool saveit;
+ bool seen_data_desc = false;
head = tail = NULL;
- saveit = *save_ok;
/* Get the next format item */
format_item:
}
get_fnode (fmt, &head, &tail, FMT_LPAREN);
tail->repeat = -2; /* Signifies unlimited format. */
- tail->u.child = parse_format_list (dtp, &saveit);
+ tail->u.child = parse_format_list (dtp, &seen_data_desc);
+ *seen_dd = seen_data_desc;
if (fmt->error != NULL)
goto finished;
-
+ if (!seen_data_desc)
+ {
+ fmt->error = "'*' requires at least one associated data descriptor";
+ goto finished;
+ }
goto between_desc;
case FMT_POSINT:
case FMT_LPAREN:
get_fnode (fmt, &head, &tail, FMT_LPAREN);
tail->repeat = repeat;
- tail->u.child = parse_format_list (dtp, &saveit);
+ tail->u.child = parse_format_list (dtp, &seen_data_desc);
+ *seen_dd = seen_data_desc;
if (fmt->error != NULL)
goto finished;
case FMT_LPAREN:
get_fnode (fmt, &head, &tail, FMT_LPAREN);
tail->repeat = 1;
- tail->u.child = parse_format_list (dtp, &saveit);
+ tail->u.child = parse_format_list (dtp, &seen_data_desc);
+ *seen_dd = seen_data_desc;
if (fmt->error != NULL)
goto finished;
goto between_desc;
case FMT_STRING:
- /* TODO: Find out why it is necessary to turn off format caching. */
- saveit = false;
get_fnode (fmt, &head, &tail, FMT_STRING);
tail->u.string.p = fmt->string;
tail->u.string.length = fmt->value;
case FMT_F:
case FMT_G:
repeat = 1;
+ *seen_dd = true;
goto data_desc;
case FMT_H:
switch (t)
{
case FMT_L:
+ *seen_dd = true;
t = format_lex (fmt);
if (t != FMT_POSINT)
{
break;
case FMT_A:
+ *seen_dd = true;
t = format_lex (fmt);
if (t == FMT_ZERO)
{
case FMT_G:
case FMT_EN:
case FMT_ES:
+ *seen_dd = true;
get_fnode (fmt, &head, &tail, t);
tail->repeat = repeat;
u = format_lex (fmt);
if (t == FMT_G && u == FMT_ZERO)
{
+ *seen_dd = true;
if (notification_std (GFC_STD_F2008) == NOTIFICATION_ERROR
|| dtp->u.p.mode == READING)
{
}
if (t == FMT_F && dtp->u.p.mode == WRITING)
{
+ *seen_dd = true;
if (u != FMT_POSINT && u != FMT_ZERO)
{
fmt->error = nonneg_required;
tail->u.real.e = -1;
if (t2 == FMT_D || t2 == FMT_F)
- break;
-
+ {
+ *seen_dd = true;
+ break;
+ }
/* Look for optional exponent */
t = format_lex (fmt);
case FMT_B:
case FMT_O:
case FMT_Z:
+ *seen_dd = true;
get_fnode (fmt, &head, &tail, t);
tail->repeat = repeat;
finished:
- *save_ok = saveit;
-
return head;
}
void
format_error (st_parameter_dt *dtp, const fnode *f, const char *message)
{
- int width, i, j, offset;
- char *p, buffer[300];
+ int width, i, offset;
+#define BUFLEN 300
+ char *p, buffer[BUFLEN];
format_data *fmt = dtp->u.p.fmt;
if (f != NULL)
- fmt->format_string = f->source;
+ p = f->source;
+ else /* This should not happen. */
+ p = dtp->format;
if (message == unexpected_element)
- sprintf (buffer, message, fmt->error_element);
+ snprintf (buffer, BUFLEN, message, fmt->error_element);
else
- sprintf (buffer, "%s\n", message);
-
- j = fmt->format_string - dtp->format;
+ snprintf (buffer, BUFLEN, "%s\n", message);
- offset = (j > 60) ? j - 40 : 0;
+ /* Get the offset into the format string where the error occurred. */
+ offset = dtp->format_len - (fmt->reversion_ok ?
+ (int) strlen(p) : fmt->format_string_len);
- j -= offset;
- width = dtp->format_len - offset;
+ width = dtp->format_len;
if (width > 80)
width = 80;
p = strchr (buffer, '\0');
- memcpy (p, dtp->format + offset, width);
+ if (dtp->format)
+ memcpy (p, dtp->format, width);
p += width;
*p++ = '\n';
/* Show where the problem is */
- for (i = 1; i < j; i++)
+ for (i = 1; i < offset; i++)
*p++ = ' ';
*p++ = '^';
*p = '\0';
+ /* Cleanup any left over memory allocations before calling generate
+ error. */
+ if (is_internal_unit (dtp))
+ {
+ if (dtp->format != NULL)
+ {
+ free (dtp->format);
+ dtp->format = NULL;
+ }
+
+ /* Leave these alone if IOSTAT was given because execution will
+ return from generate error in those cases. */
+ if (!(dtp->common.flags & IOPARM_HAS_IOSTAT))
+ {
+ free (dtp->u.p.fmt);
+ free_format_hash_table (dtp->u.p.current_unit);
+ free_internal_unit (dtp);
+ }
+ }
+
generate_error (&dtp->common, LIBERROR_FORMAT, buffer);
}
parse_format (st_parameter_dt *dtp)
{
format_data *fmt;
- bool format_cache_ok;
+ bool format_cache_ok, seen_data_desc = false;
/* Don't cache for internal units and set an arbitrary limit on the size of
format strings we will cache. (Avoids memory issues.) */
/* Not found so proceed as follows. */
- dtp->u.p.fmt = fmt = get_mem (sizeof (format_data));
+ char *fmt_string = fc_strdup_notrim (dtp->format, dtp->format_len);
+ dtp->format = fmt_string;
+
+ dtp->u.p.fmt = fmt = xmalloc (sizeof (format_data));
fmt->format_string = dtp->format;
fmt->format_string_len = dtp->format_len;
fmt->avail++;
if (format_lex (fmt) == FMT_LPAREN)
- fmt->array.array[0].u.child = parse_format_list (dtp, &format_cache_ok);
+ fmt->array.array[0].u.child = parse_format_list (dtp, &seen_data_desc);
else
fmt->error = "Missing initial left parenthesis in format";
- if (fmt->error)
- {
- format_error (dtp, NULL, fmt->error);
- free_format_hash_table (dtp->u.p.current_unit);
- return;
- }
-
if (format_cache_ok)
save_parsed_format (dtp);
else
dtp->u.p.format_not_saved = 1;
+
+ if (fmt->error)
+ format_error (dtp, NULL, fmt->error);
}
projects / gcc.git / blobdiff