diff options
| author | Tobias Burnus <burnus@net-b.de> | 2008-01-19 16:41:04 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2008-01-19 16:41:04 +0100 |
| commit | d7e2fcd0038214e3e3d9301fa7f22cccb54de009 (patch) | |
| tree | 1be5fcc97dfa3af194b49fcac90136b7e4261ed0 /gcc/fortran/primary.c | |
| parent | 0a84fec6967c3b45c3bf62d5e00d3e8f6cfb6368 (diff) | |
| download | gcc-d7e2fcd0038214e3e3d9301fa7f22cccb54de009.zip gcc-d7e2fcd0038214e3e3d9301fa7f22cccb54de009.tar.gz gcc-d7e2fcd0038214e3e3d9301fa7f22cccb54de009.tar.bz2 | |
re PR fortran/34760 (PRIVATE variable not allowed as STAT variable in ALLOCATE)
2008-01-19 Tobias Burnus <burnus@net-b.de>
PR fortran/34760
* primary.c (match_variable): Handle FL_UNKNOWN without
uneducated guessing.
(match_variable): Improve error message.
2008-01-19 Tobias Burnus <burnus@net-b.de>
PR fortran/34760
* gfortran.dg/implicit_11.f90: New.
* gfortran.dg/allocate_stat.f90: Update dg-error pattern.
* gfortran.dg/entry_15.f90: Ditto.
* gfortran.dg/func_assign.f90: Ditto.
* gfortran.dg/gomp/reduction3.f90: Ditto.
* gfortran.dg/proc_assign_1.f90: Ditto.
* gfortran.dg/interface_proc_end.f90: Use dg-error instead
of dg-excess-errors.
From-SVN: r131652
Diffstat (limited to 'gcc/fortran/primary.c')
| -rw-r--r-- | gcc/fortran/primary.c | 24 |
1 files changed, 17 insertions, 7 deletions
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 1d282f2..4e7d4a1 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2521,12 +2521,22 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) break; case FL_UNKNOWN: - if (sym->attr.access == ACCESS_PUBLIC - || sym->attr.access == ACCESS_PRIVATE) - break; - if (gfc_add_flavor (&sym->attr, FL_VARIABLE, - sym->name, NULL) == FAILURE) - return MATCH_ERROR; + { + sym_flavor flavor = FL_UNKNOWN; + + gfc_gobble_whitespace (); + + if (sym->attr.external || sym->attr.procedure + || sym->attr.function || sym->attr.subroutine) + flavor = FL_PROCEDURE; + else if (gfc_peek_char () != '(' || sym->ts.type != BT_UNKNOWN + || sym->attr.pointer || sym->as != NULL) + flavor = FL_VARIABLE; + + if (flavor != FL_UNKNOWN + && gfc_add_flavor (&sym->attr, flavor, sym->name, NULL) == FAILURE) + return MATCH_ERROR; + } break; case FL_PARAMETER: @@ -2553,7 +2563,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) /* Fall through to error */ default: - gfc_error ("Expected VARIABLE at %C"); + gfc_error ("'%s' at %C is not a variable", sym->name); return MATCH_ERROR; } |