diff options
| author | Tobias Burnus <burnus@net-b.de> | 2007-09-17 12:12:06 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2007-09-17 12:12:06 +0200 |
| commit | 0ab7816b23a53b7558deadf841591ef02e177685 (patch) | |
| tree | 56db3b58416c1136678431d5bd3e7a342b178613 /gcc/fortran/resolve.c | |
| parent | dfcf0b12d158836cc29b0c373584a73dd7b68de8 (diff) | |
| download | gcc-0ab7816b23a53b7558deadf841591ef02e177685.zip gcc-0ab7816b23a53b7558deadf841591ef02e177685.tar.gz gcc-0ab7816b23a53b7558deadf841591ef02e177685.tar.bz2 | |
resolve.c (resolve_fl_procedure): Allow private dummies for Fortran 2003.
2007-09-17 Tobias Burnus <burnus@net-b.de>
* resolve.c (resolve_fl_procedure): Allow private dummies
for Fortran 2003.
2007-09-17 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/interface_15.f90: Compile with -std=f95.
* gfortran.dg/private_type_1.f90: Ditto
* gfortran.dg/interface_18.f90: New.
* gfortran.dg/private_type_8.f90: New.
From-SVN: r128541
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 35 |
1 files changed, 20 insertions, 15 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 55d087f..a2444a3 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -6885,12 +6885,13 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) && arg->sym->ts.type == BT_DERIVED && !arg->sym->ts.derived->attr.use_assoc && !gfc_check_access (arg->sym->ts.derived->attr.access, - arg->sym->ts.derived->ns->default_access)) + arg->sym->ts.derived->ns->default_access) + && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' is of a " + "PRIVATE type and cannot be a dummy argument" + " of '%s', which is PUBLIC at %L", + arg->sym->name, sym->name, &sym->declared_at) + == FAILURE) { - gfc_error_now ("'%s' is of a PRIVATE type and cannot be " - "a dummy argument of '%s', which is " - "PUBLIC at %L", arg->sym->name, sym->name, - &sym->declared_at); /* Stop this message from recurring. */ arg->sym->ts.derived->attr.access = ACCESS_PUBLIC; return FAILURE; @@ -6907,12 +6908,14 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) && arg->sym->ts.type == BT_DERIVED && !arg->sym->ts.derived->attr.use_assoc && !gfc_check_access (arg->sym->ts.derived->attr.access, - arg->sym->ts.derived->ns->default_access)) + arg->sym->ts.derived->ns->default_access) + && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure " + "'%s' in PUBLIC interface '%s' at %L " + "takes dummy arguments of '%s' which is " + "PRIVATE", iface->sym->name, sym->name, + &iface->sym->declared_at, + gfc_typename (&arg->sym->ts)) == FAILURE) { - gfc_error_now ("Procedure '%s' in PUBLIC interface '%s' at %L takes " - "dummy arguments of '%s' which is PRIVATE", - iface->sym->name, sym->name, &iface->sym->declared_at, - gfc_typename(&arg->sym->ts)); /* Stop this message from recurring. */ arg->sym->ts.derived->attr.access = ACCESS_PUBLIC; return FAILURE; @@ -6930,12 +6933,14 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) && arg->sym->ts.type == BT_DERIVED && !arg->sym->ts.derived->attr.use_assoc && !gfc_check_access (arg->sym->ts.derived->attr.access, - arg->sym->ts.derived->ns->default_access)) + arg->sym->ts.derived->ns->default_access) + && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure " + "'%s' in PUBLIC interface '%s' at %L " + "takes dummy arguments of '%s' which is " + "PRIVATE", iface->sym->name, sym->name, + &iface->sym->declared_at, + gfc_typename (&arg->sym->ts)) == FAILURE) { - gfc_error_now ("Procedure '%s' in PUBLIC interface '%s' at %L takes " - "dummy arguments of '%s' which is PRIVATE", - iface->sym->name, sym->name, &iface->sym->declared_at, - gfc_typename(&arg->sym->ts)); /* Stop this message from recurring. */ arg->sym->ts.derived->attr.access = ACCESS_PUBLIC; return FAILURE; |