From: Tobias Schlüter Date: Sun, 29 Aug 2004 16:58:39 +0000 (+0200) Subject: re PR fortran/13910 (Cannot initialize variables with declation as allowed by g77) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=294fbfc89faac46092334188d2bbe527880794a7;p=gcc.git re PR fortran/13910 (Cannot initialize variables with declation as allowed by g77) fortran/ 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. testsuite/ PR fortran/13910 * gfortran.dg/oldstyle_1.f90: New test. From-SVN: r86729 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index fd405fef921..d1f3edb2b8f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2004-08-29 Tobias Schlueter + + 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 Paul Brook diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 4ab58399f3d..a3aa28b06df 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -48,6 +48,405 @@ static int colon_seen; 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. */ @@ -524,6 +923,24 @@ variable_decl (void) 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) diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index f9811857d7e..ab830645074 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1983,3 +1983,30 @@ gfc_default_initializer (gfc_typespec *ts) } 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; +} + diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 89c182d507c..3c5e69a906b 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -789,6 +789,8 @@ typedef struct gfc_namespace 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; @@ -1688,6 +1690,8 @@ try gfc_check_pointer_assign (gfc_expr *, gfc_expr *); 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; diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index c1a0fe1c1c7..8f6c0e6ecf4 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -128,9 +128,10 @@ not accurately reflect the status of the most recent @command{gfortran}. * 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 @@ -608,7 +609,71 @@ Variable for swapping endianness during unformatted read. 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 diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index cd1dbe80cd6..f9628e8164f 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2614,361 +2614,6 @@ undo_error: } -/********************* 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. */ diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 032a6a310b9..1d46e85960c 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -80,7 +80,6 @@ match gfc_match_namelist (void); 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 *); @@ -93,6 +92,7 @@ gfc_common_head *gfc_get_common (const char *, int); /* 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 *); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index b7097215e10..25419cc212a 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -1763,13 +1763,13 @@ ambiguous_symbol (const char *name, gfc_symtree * st) } -/* 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; @@ -1803,6 +1803,8 @@ gfc_find_sym_tree (const char *name, gfc_namespace * ns, int parent_flag, } +/* Same, but returns the symbol instead. */ + int gfc_find_symbol (const char *name, gfc_namespace * ns, int parent_flag, gfc_symbol ** result) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 84c03ab5f7d..ada3528d9e2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2004-08-29 Tobias Schlueter + + PR fortran/13910 + * gfortran.dg/oldstyle_1.f90: New test. + 2004-08-29 Steven G. Kargl Paul Brook diff --git a/gcc/testsuite/gfortran.dg/oldstyle_1.f90 b/gcc/testsuite/gfortran.dg/oldstyle_1.f90 new file mode 100644 index 00000000000..e26c467bf85 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/oldstyle_1.f90 @@ -0,0 +1,9 @@ + 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