diff options
| author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2007-10-27 17:59:59 +0000 |
|---|---|---|
| committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2007-10-27 17:59:59 +0000 |
| commit | cba28dad932e26ec7bbda71550c8c28fcd67f199 (patch) | |
| tree | 61008037e02804d3587a8239de8ada3d2a7c1efc /gcc | |
| parent | 735da29ae3b49afa8f4e14b622713f9daf6523da (diff) | |
| download | gcc-cba28dad932e26ec7bbda71550c8c28fcd67f199.zip gcc-cba28dad932e26ec7bbda71550c8c28fcd67f199.tar.gz gcc-cba28dad932e26ec7bbda71550c8c28fcd67f199.tar.bz2 | |
re PR fortran/31306 (ICE with implicit character variables)
2007-10-27 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/31306
* decl.c (char_len_param_value): Add check for conflicting attributes of
function argument.
From-SVN: r129685
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/decl.c | 28 |
2 files changed, 33 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ae70edd..2dd0c38 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2007-10-27 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/31306 + * decl.c (char_len_param_value): Add check for conflicting attributes of + function argument. + 2007-10-27 Tobias Burnus <burnus@net-b.de> PR fortran/33862 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 44bd695..0ecb008 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -566,13 +566,39 @@ match_intent_spec (void) static match char_len_param_value (gfc_expr **expr) { + match m; + if (gfc_match_char ('*') == MATCH_YES) { *expr = NULL; return MATCH_YES; } - return gfc_match_expr (expr); + m = gfc_match_expr (expr); + if (m == MATCH_YES && (*expr)->expr_type == EXPR_FUNCTION) + { + if ((*expr)->value.function.actual + && (*expr)->value.function.actual->expr->symtree) + { + gfc_expr *e; + e = (*expr)->value.function.actual->expr; + if (e->symtree->n.sym->attr.flavor == FL_PROCEDURE + && e->expr_type == EXPR_VARIABLE) + { + if (e->symtree->n.sym->ts.type == BT_UNKNOWN) + goto syntax; + if (e->symtree->n.sym->ts.type == BT_CHARACTER + && e->symtree->n.sym->ts.cl + && e->symtree->n.sym->ts.cl->length->ts.type == BT_UNKNOWN) + goto syntax; + } + } + } + return m; + +syntax: + gfc_error ("Conflict in attributes of function argument at %C"); + return MATCH_ERROR; } |