+2004-08-29 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
+
+ PR fortran/13910
+ * decl.c (free_variable, free_value, gfc_free_data, var_list,
+ var_element, top_var_list, match_data_constant, top_val_list,
+ gfc_match_data): Move here from match.c.
+ (match_old_style_init): New function.
+ (variable_decl): Match old-style initialization.
+ * expr.c (gfc_get_variable_expr): New function.
+ * gfortran.h (gfc_get_variable_expr): Add prototype.
+ * gfortran.texi: Start documentation for supported extensions.
+ * match.c: Remove the functions moved to decl.c.
+ * match.h (gfc_match_data): Move prototype to under decl.c.
+ * symbol.c (gfc_find_sym_tree, gfc_find_symbol): Add/correct
+ comments.
+
2004-08-29 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
gfc_symbol *gfc_new_block;
+/********************* DATA statement subroutines *********************/
+
+/* Free a gfc_data_variable structure and everything beneath it. */
+
+static void
+free_variable (gfc_data_variable * p)
+{
+ gfc_data_variable *q;
+
+ for (; p; p = q)
+ {
+ q = p->next;
+ gfc_free_expr (p->expr);
+ gfc_free_iterator (&p->iter, 0);
+ free_variable (p->list);
+
+ gfc_free (p);
+ }
+}
+
+
+/* Free a gfc_data_value structure and everything beneath it. */
+
+static void
+free_value (gfc_data_value * p)
+{
+ gfc_data_value *q;
+
+ for (; p; p = q)
+ {
+ q = p->next;
+ gfc_free_expr (p->expr);
+ gfc_free (p);
+ }
+}
+
+
+/* Free a list of gfc_data structures. */
+
+void
+gfc_free_data (gfc_data * p)
+{
+ gfc_data *q;
+
+ for (; p; p = q)
+ {
+ q = p->next;
+
+ free_variable (p->var);
+ free_value (p->value);
+
+ gfc_free (p);
+ }
+}
+
+
+static match var_element (gfc_data_variable *);
+
+/* Match a list of variables terminated by an iterator and a right
+ parenthesis. */
+
+static match
+var_list (gfc_data_variable * parent)
+{
+ gfc_data_variable *tail, var;
+ match m;
+
+ m = var_element (&var);
+ if (m == MATCH_ERROR)
+ return MATCH_ERROR;
+ if (m == MATCH_NO)
+ goto syntax;
+
+ tail = gfc_get_data_variable ();
+ *tail = var;
+
+ parent->list = tail;
+
+ for (;;)
+ {
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+
+ m = gfc_match_iterator (&parent->iter, 1);
+ if (m == MATCH_YES)
+ break;
+ if (m == MATCH_ERROR)
+ return MATCH_ERROR;
+
+ m = var_element (&var);
+ if (m == MATCH_ERROR)
+ return MATCH_ERROR;
+ if (m == MATCH_NO)
+ goto syntax;
+
+ tail->next = gfc_get_data_variable ();
+ tail = tail->next;
+
+ *tail = var;
+ }
+
+ if (gfc_match_char (')') != MATCH_YES)
+ goto syntax;
+ return MATCH_YES;
+
+syntax:
+ gfc_syntax_error (ST_DATA);
+ return MATCH_ERROR;
+}
+
+
+/* Match a single element in a data variable list, which can be a
+ variable-iterator list. */
+
+static match
+var_element (gfc_data_variable * new)
+{
+ match m;
+ gfc_symbol *sym;
+
+ memset (new, 0, sizeof (gfc_data_variable));
+
+ if (gfc_match_char ('(') == MATCH_YES)
+ return var_list (new);
+
+ m = gfc_match_variable (&new->expr, 0);
+ if (m != MATCH_YES)
+ return m;
+
+ sym = new->expr->symtree->n.sym;
+
+ if(sym->value != NULL)
+ {
+ gfc_error ("Variable '%s' at %C already has an initialization",
+ sym->name);
+ return MATCH_ERROR;
+ }
+
+#if 0 // TODO: Find out where to move this message
+ if (sym->attr.in_common)
+ /* See if sym is in the blank common block. */
+ for (t = &sym->ns->blank_common; t; t = t->common_next)
+ if (sym == t->head)
+ {
+ gfc_error ("DATA statement at %C may not initialize variable "
+ "'%s' from blank COMMON", sym->name);
+ return MATCH_ERROR;
+ }
+#endif
+
+ if (gfc_add_data (&sym->attr, &new->expr->where) == FAILURE)
+ return MATCH_ERROR;
+
+ return MATCH_YES;
+}
+
+
+/* Match the top-level list of data variables. */
+
+static match
+top_var_list (gfc_data * d)
+{
+ gfc_data_variable var, *tail, *new;
+ match m;
+
+ tail = NULL;
+
+ for (;;)
+ {
+ m = var_element (&var);
+ if (m == MATCH_NO)
+ goto syntax;
+ if (m == MATCH_ERROR)
+ return MATCH_ERROR;
+
+ new = gfc_get_data_variable ();
+ *new = var;
+
+ if (tail == NULL)
+ d->var = new;
+ else
+ tail->next = new;
+
+ tail = new;
+
+ if (gfc_match_char ('/') == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ return MATCH_YES;
+
+syntax:
+ gfc_syntax_error (ST_DATA);
+ return MATCH_ERROR;
+}
+
+
+static match
+match_data_constant (gfc_expr ** result)
+{
+ char name[GFC_MAX_SYMBOL_LEN + 1];
+ gfc_symbol *sym;
+ gfc_expr *expr;
+ match m;
+
+ m = gfc_match_literal_constant (&expr, 1);
+ if (m == MATCH_YES)
+ {
+ *result = expr;
+ return MATCH_YES;
+ }
+
+ if (m == MATCH_ERROR)
+ return MATCH_ERROR;
+
+ m = gfc_match_null (result);
+ if (m != MATCH_NO)
+ return m;
+
+ m = gfc_match_name (name);
+ if (m != MATCH_YES)
+ return m;
+
+ if (gfc_find_symbol (name, NULL, 1, &sym))
+ return MATCH_ERROR;
+
+ if (sym == NULL
+ || (sym->attr.flavor != FL_PARAMETER && sym->attr.flavor != FL_DERIVED))
+ {
+ gfc_error ("Symbol '%s' must be a PARAMETER in DATA statement at %C",
+ name);
+ return MATCH_ERROR;
+ }
+ else if (sym->attr.flavor == FL_DERIVED)
+ return gfc_match_structure_constructor (sym, result);
+
+ *result = gfc_copy_expr (sym->value);
+ return MATCH_YES;
+}
+
+
+/* Match a list of values in a DATA statement. The leading '/' has
+ already been seen at this point. */
+
+static match
+top_val_list (gfc_data * data)
+{
+ gfc_data_value *new, *tail;
+ gfc_expr *expr;
+ const char *msg;
+ match m;
+
+ tail = NULL;
+
+ for (;;)
+ {
+ m = match_data_constant (&expr);
+ if (m == MATCH_NO)
+ goto syntax;
+ if (m == MATCH_ERROR)
+ return MATCH_ERROR;
+
+ new = gfc_get_data_value ();
+
+ if (tail == NULL)
+ data->value = new;
+ else
+ tail->next = new;
+
+ tail = new;
+
+ if (expr->ts.type != BT_INTEGER || gfc_match_char ('*') != MATCH_YES)
+ {
+ tail->expr = expr;
+ tail->repeat = 1;
+ }
+ else
+ {
+ signed int tmp;
+ msg = gfc_extract_int (expr, &tmp);
+ gfc_free_expr (expr);
+ if (msg != NULL)
+ {
+ gfc_error (msg);
+ return MATCH_ERROR;
+ }
+ tail->repeat = tmp;
+
+ m = match_data_constant (&tail->expr);
+ if (m == MATCH_NO)
+ goto syntax;
+ if (m == MATCH_ERROR)
+ return MATCH_ERROR;
+ }
+
+ if (gfc_match_char ('/') == MATCH_YES)
+ break;
+ if (gfc_match_char (',') == MATCH_NO)
+ goto syntax;
+ }
+
+ return MATCH_YES;
+
+syntax:
+ gfc_syntax_error (ST_DATA);
+ return MATCH_ERROR;
+}
+
+
+/* Matches an old style initialization. */
+
+static match
+match_old_style_init (const char *name)
+{
+ match m;
+ gfc_symtree *st;
+ gfc_data *newdata;
+
+ /* Set up data structure to hold initializers. */
+ gfc_find_sym_tree (name, NULL, 0, &st);
+
+ newdata = gfc_get_data ();
+ newdata->var = gfc_get_data_variable ();
+ newdata->var->expr = gfc_get_variable_expr (st);
+
+ /* Match initial value list. This also eats the terminal
+ '/'. */
+ m = top_val_list (newdata);
+ if (m != MATCH_YES)
+ {
+ gfc_free (newdata);
+ return m;
+ }
+
+ if (gfc_pure (NULL))
+ {
+ gfc_error ("Initialization at %C is not allowed in a PURE procedure");
+ gfc_free (newdata);
+ return MATCH_ERROR;
+ }
+
+ /* Chain in namespace list of DATA initializers. */
+ newdata->next = gfc_current_ns->data;
+ gfc_current_ns->data = newdata;
+
+ return m;
+}
+
+/* Match the stuff following a DATA statement. If ERROR_FLAG is set,
+ we are matching a DATA stement and are therefore issuing an error
+ if we encounter something unexpected, if not, we're trying to match
+ an old-style intialization expression of the form INTEGER I /2/. */
+
+match
+gfc_match_data (void)
+{
+ gfc_data *new;
+ match m;
+
+ for (;;)
+ {
+ new = gfc_get_data ();
+ new->where = gfc_current_locus;
+
+ m = top_var_list (new);
+ if (m != MATCH_YES)
+ goto cleanup;
+
+ m = top_val_list (new);
+ if (m != MATCH_YES)
+ goto cleanup;
+
+ new->next = gfc_current_ns->data;
+ gfc_current_ns->data = new;
+
+ if (gfc_match_eos () == MATCH_YES)
+ break;
+
+ gfc_match_char (','); /* Optional comma */
+ }
+
+ if (gfc_pure (NULL))
+ {
+ gfc_error ("DATA statement at %C is not allowed in a PURE procedure");
+ return MATCH_ERROR;
+ }
+
+ return MATCH_YES;
+
+cleanup:
+ gfc_free_data (new);
+ return MATCH_ERROR;
+}
+
+
+/************************ Declaration statements *********************/
+
/* Match an intent specification. Since this can only happen after an
INTENT word, a legal intent-spec must follow. */
goto cleanup;
}
+ /* We allow old-style initializations of the form
+ integer i /2/, j(4) /3*3, 1/
+ (if no colon has been seen). These are different from data
+ statements in that initializers are only allowed to apply to the
+ variable immediately preceding, i.e.
+ integer i, j /1, 2/
+ is not allowed. Therefore we have to do some work manually, that
+ could otherwise be let to the matchers for DATA statements. */
+
+ if (!colon_seen && gfc_match (" /") == MATCH_YES)
+ {
+ if (gfc_notify_std (GFC_STD_GNU, "Extension: Old-style "
+ "initialization at %C") == FAILURE)
+ return MATCH_ERROR;
+
+ return match_old_style_init (name);
+ }
+
/* The double colon must be present in order to have initializers.
Otherwise the statement is ambiguous with an assignment statement. */
if (colon_seen)
}
return init;
}
+
+
+/* Given a symbol, create an expression node with that symbol as a
+ variable. If the symbol is array valued, setup a reference of the
+ whole array. */
+
+gfc_expr *
+gfc_get_variable_expr (gfc_symtree * var)
+{
+ gfc_expr *e;
+
+ e = gfc_get_expr ();
+ e->expr_type = EXPR_VARIABLE;
+ e->symtree = var;
+ e->ts = var->n.sym->ts;
+
+ if (var->n.sym->as != NULL)
+ {
+ e->rank = var->n.sym->as->rank;
+ e->ref = gfc_get_ref ();
+ e->ref->type = REF_ARRAY;
+ e->ref->u.ar.type = AR_FULL;
+ }
+
+ return e;
+}
+
gfc_access default_access, operator_access[GFC_INTRINSIC_OPS];
gfc_st_label *st_labels;
+ /* This list holds information about all the data initializers in
+ this namespace. */
struct gfc_data *data;
gfc_charlen *cl_list;
try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
gfc_expr *gfc_default_initializer (gfc_typespec *);
+gfc_expr *gfc_get_variable_expr (gfc_symtree *);
+
/* st.c */
extern gfc_code new_st;
* GFORTRAN and GCC:: You can compile Fortran, C, or other programs.
* GFORTRAN and G77:: Why we choose to start from scratch.
* Invoking GFORTRAN:: Command options supported by @command{gfortran}.
-* Project Status:: Status of GFORTRAN, Roadmap, proposed extensions.
+* Project Status:: Status of @command{gfortran}, Roadmap, proposed extensions.
* Contributing:: Helping you can help.
-* Standards:: Standards supported by GFORTRAN.
+* Standards:: Standards supported by @command{gfortran}
+* Extensions:: Laguage extensions implemented by @command{gfortran}
* Index:: Index of this documentation.
@end menu
Variable for swapping Endianness during unformatted write.
@end itemize
+@c ---------------------------------------------------------------------
+@c Extensions
+@c ---------------------------------------------------------------------
+
+@c Maybe this chapter should be merged with the 'Standards' section,
+@c whenever that is written :-)
+
+@node Extensions
+@chapter Extensions
+@cindex Extension
+
+@command{gfortran} implements a number of extensions over standard
+Fortran. This chapter contains information on their syntax and
+meaning.
+
+@menu
+* Old-style kind specifications::
+* Old-style variable initialization::
+@end menu
+@node Old-style kind specifications
+@section Old-style kind specifications
+@cindex Kind specifications
+
+@command{gfortran} allows old-style kind specifications in
+declarations. These look like:
+@smallexample
+ TYPESPEC*k x,y,z
+@end smallexample
+where @code{TYPESPEC} is a basic type, and where @code{k} is a valid kind
+number for that type. The statement then declares @code{x}, @code{y}
+and @code{z} to be of type @code{TYPESPEC} with kind @code{k}. In
+other words, it is equivalent to the standard conforming declaration
+@smallexample
+ TYPESPEC(k) x,y,z
+@end smallexample
+
+@node Old-style variable initialization
+@section Old-style variable initialization
+@cindex Initialization
+
+@command{gfortran} allows old-style initialization of variables of the
+form:
+@smallexample
+ INTEGER*4 i/1/,j/2/
+ REAL*8 x(2,2) /3*0.,1./
+@end smallexample
+These are only allowed in declarations without double colons
+(@code{::}), as these were introduced in Fortran 90 which also
+introduced a new syntax for variable initializations. The syntax for
+the individual initializers is as for the @code{DATA} statement, but
+unlike in a @code{DATA} statement, an initializer only applies to the
+variable immediately preceding. In other words, something like
+@code{INTEGER I,J/2,3/} is not valid.
+
+Examples of standard conforming code equivalent to the above example, are:
+@smallexample
+! Fortran 90
+ INTEGER(4) :: i = 1, j = 2
+ REAL(8) :: x(2,2) = RESHAPE((/0.,0.,0.,1./),SHAPE(x))
+! Fortran 77
+ INTEGER i, j
+ DOUBLE PRECISION x(2,2)
+ DATA i,j,x /1,2,3*0.,1./
+@end smallexample
@c ---------------------------------------------------------------------
@c Contributing
}
-/********************* DATA statement subroutines *********************/
-
-/* Free a gfc_data_variable structure and everything beneath it. */
-
-static void
-free_variable (gfc_data_variable * p)
-{
- gfc_data_variable *q;
-
- for (; p; p = q)
- {
- q = p->next;
- gfc_free_expr (p->expr);
- gfc_free_iterator (&p->iter, 0);
- free_variable (p->list);
-
- gfc_free (p);
- }
-}
-
-
-/* Free a gfc_data_value structure and everything beneath it. */
-
-static void
-free_value (gfc_data_value * p)
-{
- gfc_data_value *q;
-
- for (; p; p = q)
- {
- q = p->next;
- gfc_free_expr (p->expr);
- gfc_free (p);
- }
-}
-
-
-/* Free a list of gfc_data structures. */
-
-void
-gfc_free_data (gfc_data * p)
-{
- gfc_data *q;
-
- for (; p; p = q)
- {
- q = p->next;
-
- free_variable (p->var);
- free_value (p->value);
-
- gfc_free (p);
- }
-}
-
-
-static match var_element (gfc_data_variable *);
-
-/* Match a list of variables terminated by an iterator and a right
- parenthesis. */
-
-static match
-var_list (gfc_data_variable * parent)
-{
- gfc_data_variable *tail, var;
- match m;
-
- m = var_element (&var);
- if (m == MATCH_ERROR)
- return MATCH_ERROR;
- if (m == MATCH_NO)
- goto syntax;
-
- tail = gfc_get_data_variable ();
- *tail = var;
-
- parent->list = tail;
-
- for (;;)
- {
- if (gfc_match_char (',') != MATCH_YES)
- goto syntax;
-
- m = gfc_match_iterator (&parent->iter, 1);
- if (m == MATCH_YES)
- break;
- if (m == MATCH_ERROR)
- return MATCH_ERROR;
-
- m = var_element (&var);
- if (m == MATCH_ERROR)
- return MATCH_ERROR;
- if (m == MATCH_NO)
- goto syntax;
-
- tail->next = gfc_get_data_variable ();
- tail = tail->next;
-
- *tail = var;
- }
-
- if (gfc_match_char (')') != MATCH_YES)
- goto syntax;
- return MATCH_YES;
-
-syntax:
- gfc_syntax_error (ST_DATA);
- return MATCH_ERROR;
-}
-
-
-/* Match a single element in a data variable list, which can be a
- variable-iterator list. */
-
-static match
-var_element (gfc_data_variable * new)
-{
- match m;
- gfc_symbol *sym;
-
- memset (new, '\0', sizeof (gfc_data_variable));
-
- if (gfc_match_char ('(') == MATCH_YES)
- return var_list (new);
-
- m = gfc_match_variable (&new->expr, 0);
- if (m != MATCH_YES)
- return m;
-
- sym = new->expr->symtree->n.sym;
-
- if(sym->value != NULL)
- {
- gfc_error ("Variable '%s' at %C already has an initialization",
- sym->name);
- return MATCH_ERROR;
- }
-
-#if 0 // TODO: Find out where to move this message
- if (sym->attr.in_common)
- /* See if sym is in the blank common block. */
- for (t = &sym->ns->blank_common; t; t = t->common_next)
- if (sym == t->head)
- {
- gfc_error ("DATA statement at %C may not initialize variable "
- "'%s' from blank COMMON", sym->name);
- return MATCH_ERROR;
- }
-#endif
-
- if (gfc_add_data (&sym->attr, &new->expr->where) == FAILURE)
- return MATCH_ERROR;
-
- return MATCH_YES;
-}
-
-
-/* Match the top-level list of data variables. */
-
-static match
-top_var_list (gfc_data * d)
-{
- gfc_data_variable var, *tail, *new;
- match m;
-
- tail = NULL;
-
- for (;;)
- {
- m = var_element (&var);
- if (m == MATCH_NO)
- goto syntax;
- if (m == MATCH_ERROR)
- return MATCH_ERROR;
-
- new = gfc_get_data_variable ();
- *new = var;
-
- if (tail == NULL)
- d->var = new;
- else
- tail->next = new;
-
- tail = new;
-
- if (gfc_match_char ('/') == MATCH_YES)
- break;
- if (gfc_match_char (',') != MATCH_YES)
- goto syntax;
- }
-
- return MATCH_YES;
-
-syntax:
- gfc_syntax_error (ST_DATA);
- return MATCH_ERROR;
-}
-
-
-static match
-match_data_constant (gfc_expr ** result)
-{
- char name[GFC_MAX_SYMBOL_LEN + 1];
- gfc_symbol *sym;
- gfc_expr *expr;
- match m;
-
- m = gfc_match_literal_constant (&expr, 1);
- if (m == MATCH_YES)
- {
- *result = expr;
- return MATCH_YES;
- }
-
- if (m == MATCH_ERROR)
- return MATCH_ERROR;
-
- m = gfc_match_null (result);
- if (m != MATCH_NO)
- return m;
-
- m = gfc_match_name (name);
- if (m != MATCH_YES)
- return m;
-
- if (gfc_find_symbol (name, NULL, 1, &sym))
- return MATCH_ERROR;
-
- if (sym == NULL
- || (sym->attr.flavor != FL_PARAMETER && sym->attr.flavor != FL_DERIVED))
- {
- gfc_error ("Symbol '%s' must be a PARAMETER in DATA statement at %C",
- name);
- return MATCH_ERROR;
- }
- else if (sym->attr.flavor == FL_DERIVED)
- return gfc_match_structure_constructor (sym, result);
-
- *result = gfc_copy_expr (sym->value);
- return MATCH_YES;
-}
-
-
-/* Match a list of values in a DATA statement. The leading '/' has
- already been seen at this point. */
-
-static match
-top_val_list (gfc_data * data)
-{
- gfc_data_value *new, *tail;
- gfc_expr *expr;
- const char *msg;
- match m;
-
- tail = NULL;
-
- for (;;)
- {
- m = match_data_constant (&expr);
- if (m == MATCH_NO)
- goto syntax;
- if (m == MATCH_ERROR)
- return MATCH_ERROR;
-
- new = gfc_get_data_value ();
-
- if (tail == NULL)
- data->value = new;
- else
- tail->next = new;
-
- tail = new;
-
- if (expr->ts.type != BT_INTEGER || gfc_match_char ('*') != MATCH_YES)
- {
- tail->expr = expr;
- tail->repeat = 1;
- }
- else
- {
- signed int tmp;
- msg = gfc_extract_int (expr, &tmp);
- gfc_free_expr (expr);
- if (msg != NULL)
- {
- gfc_error (msg);
- return MATCH_ERROR;
- }
- tail->repeat = tmp;
-
- m = match_data_constant (&tail->expr);
- if (m == MATCH_NO)
- goto syntax;
- if (m == MATCH_ERROR)
- return MATCH_ERROR;
- }
-
- if (gfc_match_char ('/') == MATCH_YES)
- break;
- if (gfc_match_char (',') == MATCH_NO)
- goto syntax;
- }
-
- return MATCH_YES;
-
-syntax:
- gfc_syntax_error (ST_DATA);
- return MATCH_ERROR;
-}
-
-
-/* Match a DATA statement. */
-
-match
-gfc_match_data (void)
-{
- gfc_data *new;
- match m;
-
- for (;;)
- {
- new = gfc_get_data ();
- new->where = gfc_current_locus;
-
- m = top_var_list (new);
- if (m != MATCH_YES)
- goto cleanup;
-
- m = top_val_list (new);
- if (m != MATCH_YES)
- goto cleanup;
-
- new->next = gfc_current_ns->data;
- gfc_current_ns->data = new;
-
- if (gfc_match_eos () == MATCH_YES)
- break;
-
- gfc_match_char (','); /* Optional comma */
- }
-
- if (gfc_pure (NULL))
- {
- gfc_error ("DATA statement at %C is not allowed in a PURE procedure");
- return MATCH_ERROR;
- }
-
- return MATCH_YES;
-
-cleanup:
- gfc_free_data (new);
- return MATCH_ERROR;
-}
-
-
/***************** SELECT CASE subroutines ******************/
/* Free a single case structure. */
match gfc_match_module (void);
match gfc_match_equivalence (void);
match gfc_match_st_function (void);
-match gfc_match_data (void);
match gfc_match_case (void);
match gfc_match_select (void);
match gfc_match_where (gfc_statement *);
/* decl.c */
+match gfc_match_data (void);
match gfc_match_null (gfc_expr **);
match gfc_match_kind_spec (gfc_typespec *);
match gfc_match_old_kind_spec (gfc_typespec *);
}
-/* Search for a symbol starting in the current namespace, resorting to
+/* Search for a symtree starting in the current namespace, resorting to
any parent namespaces if requested by a nonzero parent_flag.
- Returns nonzero if the symbol is ambiguous. */
+ Returns nonzero if the name is ambiguous. */
int
gfc_find_sym_tree (const char *name, gfc_namespace * ns, int parent_flag,
- gfc_symtree ** result)
+ gfc_symtree ** result)
{
gfc_symtree *st;
}
+/* Same, but returns the symbol instead. */
+
int
gfc_find_symbol (const char *name, gfc_namespace * ns, int parent_flag,
gfc_symbol ** result)
+2004-08-29 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
+
+ PR fortran/13910
+ * gfortran.dg/oldstyle_1.f90: New test.
+
2004-08-29 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
--- /dev/null
+ integer i, j /1/, g/2/, h ! { dg-warning "" "" }
+ integer k, l(3) /2*2,1/ ! { dg-warning "" "" }
+ real pi /3.1416/, e ! { dg-warning "" "" }
+
+ if (j /= 1) call abort ()
+ if (g /= 2) call abort ()
+ if (any(l /= (/2,2,1/))) call abort ()
+ if (pi /= 3.1416) call abort ()
+ end