aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/primary.c
diff options
context:
space:
mode:
authorTobias Schlüter <tobi@gcc.gnu.org>2004-07-09 16:53:45 +0200
committerTobias Schlüter <tobi@gcc.gnu.org>2004-07-09 16:53:45 +0200
commitd3fcc995c27e851a73a433b6ffd967563af080cd (patch)
treef2e67cc2562a5c7a5081a98c7b2a88756df9ea67 /gcc/fortran/primary.c
parent5b1c60e9de5246e484e15305795b8f9557ccefcd (diff)
downloadgcc-d3fcc995c27e851a73a433b6ffd967563af080cd.zip
gcc-d3fcc995c27e851a73a433b6ffd967563af080cd.tar.gz
gcc-d3fcc995c27e851a73a433b6ffd967563af080cd.tar.bz2
re PR fortran/15481 ([meta-bugs] frontend adds superfluous symbols to namespaces)
fortran/ 2004-07-09 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de> PR fortran/15481 PR fortran/13372 PR fortran/13575 PR fortran/15978 * module.c (write_symbol, write_symtree): Remove workaround. * primary.c (match_actual_arglist): Enhance comment. (gfc_match_rvalue): Handle function call with first argument a keyword argument correctly. * resolve.c (resolve_symbol): Change call to gfc_set_default_type to issue error if no implicit type can be found. * trans-decl.c (gfc_create_module_variable): Remove workaround. testsuite/ PR fortran/15481 PR fortran/13372 PR fortran/13575 PR fortran/15978 * gfortran.fortran-torture/compile/implicit_2.f90: New test. Also fixed David Billinghursts ChangeLog entry to use GMT From-SVN: r84373
Diffstat (limited to 'gcc/fortran/primary.c')
-rw-r--r--gcc/fortran/primary.c58
1 files changed, 35 insertions, 23 deletions
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index e1f4049..3593155 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1400,7 +1400,8 @@ cleanup:
the opening parenthesis to the closing parenthesis. The argument
list is assumed to allow keyword arguments because we don't know if
the symbol associated with the procedure has an implicit interface
- or not. We make sure keywords are unique. */
+ or not. We make sure keywords are unique. If SUB_FLAG is set,
+ we're matching the argument list of a subroutine. */
match
gfc_match_actual_arglist (int sub_flag, gfc_actual_arglist ** argp)
@@ -1839,13 +1840,13 @@ match
gfc_match_rvalue (gfc_expr ** result)
{
gfc_actual_arglist *actual_arglist;
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ char name[GFC_MAX_SYMBOL_LEN + 1], argname[GFC_MAX_SYMBOL_LEN + 1];
gfc_state_data *st;
gfc_symbol *sym;
gfc_symtree *symtree;
- locus where;
+ locus where, old_loc;
gfc_expr *e;
- match m;
+ match m, m2;
int i;
m = gfc_match_name (name);
@@ -2044,35 +2045,46 @@ gfc_match_rvalue (gfc_expr ** result)
break;
}
- /* See if this could possibly be a substring reference of a name
- that we're not sure is a variable yet. */
+ /* See if this is a function reference with a keyword argument
+ as first argument. We do this because otherwise a spurious
+ symbol would end up in the symbol table. */
+
+ old_loc = gfc_current_locus;
+ m2 = gfc_match (" ( %n =", argname);
+ gfc_current_locus = old_loc;
e = gfc_get_expr ();
e->symtree = symtree;
- if ((sym->ts.type == BT_UNKNOWN || sym->ts.type == BT_CHARACTER)
- && match_substring (sym->ts.cl, 0, &e->ref) == MATCH_YES)
+ if (m2 != MATCH_YES)
{
+ /* See if this could possibly be a substring reference of a name
+ that we're not sure is a variable yet. */
- e->expr_type = EXPR_VARIABLE;
-
- if (sym->attr.flavor != FL_VARIABLE
- && gfc_add_flavor (&sym->attr, FL_VARIABLE, NULL) == FAILURE)
+ if ((sym->ts.type == BT_UNKNOWN || sym->ts.type == BT_CHARACTER)
+ && match_substring (sym->ts.cl, 0, &e->ref) == MATCH_YES)
{
- m = MATCH_ERROR;
- break;
- }
- if (sym->ts.type == BT_UNKNOWN
- && gfc_set_default_type (sym, 1, NULL) == FAILURE)
- {
- m = MATCH_ERROR;
+ e->expr_type = EXPR_VARIABLE;
+
+ if (sym->attr.flavor != FL_VARIABLE
+ && gfc_add_flavor (&sym->attr, FL_VARIABLE, NULL) == FAILURE)
+ {
+ m = MATCH_ERROR;
+ break;
+ }
+
+ if (sym->ts.type == BT_UNKNOWN
+ && gfc_set_default_type (sym, 1, NULL) == FAILURE)
+ {
+ m = MATCH_ERROR;
+ break;
+ }
+
+ e->ts = sym->ts;
+ m = MATCH_YES;
break;
}
-
- e->ts = sym->ts;
- m = MATCH_YES;
- break;
}
/* Give up, assume we have a function. */