diff options
author | Janus Weil <janus@gcc.gnu.org> | 2011-10-16 21:16:59 +0200 |
---|---|---|
committer | Janus Weil <janus@gcc.gnu.org> | 2011-10-16 21:16:59 +0200 |
commit | fe445bf7bea544ca11c512d990ca1cb1c6f71c69 (patch) | |
tree | c30b2e718c98ffe8ba914ec7e55473d665d3d68e | |
parent | aede122782e489f97b367e786ad56487b790a4ee (diff) | |
download | gcc-fe445bf7bea544ca11c512d990ca1cb1c6f71c69.zip gcc-fe445bf7bea544ca11c512d990ca1cb1c6f71c69.tar.gz gcc-fe445bf7bea544ca11c512d990ca1cb1c6f71c69.tar.bz2 |
re PR fortran/50547 (dummy procedure argument of PURE shall be PURE)
2011-10-16 Janus Weil <janus@gcc.gnu.org>
PR fortran/50547
* resolve.c (resolve_formal_arglist): Remove unneeded error message.
Some reshuffling.
2011-10-16 Janus Weil <janus@gcc.gnu.org>
PR fortran/50547
* gfortran.dg/elemental_args_check_4.f90: New.
From-SVN: r180061
-rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 124 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/elemental_args_check_4.f90 | 12 |
4 files changed, 79 insertions, 68 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 591745d..a6be321 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-10-16 Janus Weil <janus@gcc.gnu.org> + + PR fortran/50547 + * resolve.c (resolve_formal_arglist): Remove unneeded error message. + Some reshuffling. + 2011-10-15 Tobias Burnus <burnus@net-b.de> * gfortran.texi (Fortran 2008 status, TS 29113 status, diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index edeb49d..9b76f98 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -269,50 +269,18 @@ resolve_formal_arglist (gfc_symbol *proc) if (sym->attr.if_source != IFSRC_UNKNOWN) resolve_formal_arglist (sym); - /* F08:C1279. */ - if (gfc_pure (proc) - && sym->attr.flavor == FL_PROCEDURE && !gfc_pure (sym)) + if (sym->attr.subroutine || sym->attr.external) { - gfc_error ("Dummy procedure '%s' of PURE procedure at %L must " - "also be PURE", sym->name, &sym->declared_at); - continue; + if (sym->attr.flavor == FL_UNKNOWN) + gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, &sym->declared_at); } - - if (sym->attr.subroutine || sym->attr.external || sym->attr.intrinsic) + else { - if (proc->attr.implicit_pure && !gfc_pure(sym)) - proc->attr.implicit_pure = 0; - - /* F08:C1289. */ - if (gfc_elemental (proc)) - { - gfc_error ("Dummy procedure at %L not allowed in ELEMENTAL " - "procedure", &sym->declared_at); - continue; - } - - if (sym->attr.function - && sym->ts.type == BT_UNKNOWN - && sym->attr.intrinsic) - { - gfc_intrinsic_sym *isym; - isym = gfc_find_function (sym->name); - if (isym == NULL || !isym->specific) - { - gfc_error ("Unable to find a specific INTRINSIC procedure " - "for the reference '%s' at %L", sym->name, - &sym->declared_at); - } - sym->ts = isym->ts; - } - - continue; + if (sym->ts.type == BT_UNKNOWN && !proc->attr.intrinsic + && (!sym->attr.function || sym->result == sym)) + gfc_set_default_type (sym, 1, sym->ns); } - if (sym->ts.type == BT_UNKNOWN && !proc->attr.intrinsic - && (!sym->attr.function || sym->result == sym)) - gfc_set_default_type (sym, 1, sym->ns); - gfc_resolve_array_spec (sym->as, 0); /* We can't tell if an array with dimension (:) is assumed or deferred @@ -343,44 +311,64 @@ resolve_formal_arglist (gfc_symbol *proc) if (sym->attr.flavor == FL_UNKNOWN) gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, &sym->declared_at); - if (gfc_pure (proc) && !sym->attr.pointer - && sym->attr.flavor != FL_PROCEDURE) + if (gfc_pure (proc)) { - if (proc->attr.function && sym->attr.intent != INTENT_IN) + if (sym->attr.flavor == FL_PROCEDURE) { - if (sym->attr.value) - gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Argument '%s' " - "of pure function '%s' at %L with VALUE " - "attribute but without INTENT(IN)", sym->name, - proc->name, &sym->declared_at); - else - gfc_error ("Argument '%s' of pure function '%s' at %L must be " - "INTENT(IN) or VALUE", sym->name, proc->name, - &sym->declared_at); + /* F08:C1279. */ + if (!gfc_pure (sym)) + { + gfc_error ("Dummy procedure '%s' of PURE procedure at %L must " + "also be PURE", sym->name, &sym->declared_at); + continue; + } } - - if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN) + else if (!sym->attr.pointer) { - if (sym->attr.value) - gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Argument '%s' " - "of pure subroutine '%s' at %L with VALUE " - "attribute but without INTENT", sym->name, - proc->name, &sym->declared_at); - else - gfc_error ("Argument '%s' of pure subroutine '%s' at %L must " - "have its INTENT specified or have the VALUE " - "attribute", sym->name, proc->name, &sym->declared_at); + if (proc->attr.function && sym->attr.intent != INTENT_IN) + { + if (sym->attr.value) + gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Argument '%s'" + " of pure function '%s' at %L with VALUE " + "attribute but without INTENT(IN)", + sym->name, proc->name, &sym->declared_at); + else + gfc_error ("Argument '%s' of pure function '%s' at %L must " + "be INTENT(IN) or VALUE", sym->name, proc->name, + &sym->declared_at); + } + + if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN) + { + if (sym->attr.value) + gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Argument '%s'" + " of pure subroutine '%s' at %L with VALUE " + "attribute but without INTENT", sym->name, + proc->name, &sym->declared_at); + else + gfc_error ("Argument '%s' of pure subroutine '%s' at %L " + "must have its INTENT specified or have the " + "VALUE attribute", sym->name, proc->name, + &sym->declared_at); + } } } - if (proc->attr.implicit_pure && !sym->attr.pointer - && sym->attr.flavor != FL_PROCEDURE) + if (proc->attr.implicit_pure) { - if (proc->attr.function && sym->attr.intent != INTENT_IN) - proc->attr.implicit_pure = 0; + if (sym->attr.flavor == FL_PROCEDURE) + { + if (!gfc_pure(sym)) + proc->attr.implicit_pure = 0; + } + else if (!sym->attr.pointer) + { + if (proc->attr.function && sym->attr.intent != INTENT_IN) + proc->attr.implicit_pure = 0; - if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN) - proc->attr.implicit_pure = 0; + if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN) + proc->attr.implicit_pure = 0; + } } if (gfc_elemental (proc)) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c449d32..9900074 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-10-16 Janus Weil <janus@gcc.gnu.org> + + PR fortran/50547 + * gfortran.dg/elemental_args_check_4.f90: New. + 2011-10-16 Ira Rosen <ira.rosen@linaro.org> PR tree-optimization/50727 diff --git a/gcc/testsuite/gfortran.dg/elemental_args_check_4.f90 b/gcc/testsuite/gfortran.dg/elemental_args_check_4.f90 new file mode 100644 index 0000000..2c50f58 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/elemental_args_check_4.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +! +! PR 50547: dummy procedure argument of PURE shall be PURE +! +! Contributed by Janus Weil <janus@gcc.gnu.org> + +elemental function fun (sub) + interface + pure subroutine sub ! { dg-error "not allowed in elemental procedure" } + end subroutine + end interface +end function |