Skip to content

R
riscv-gcc-1
Commit fe445bf7 by Janus Weil
Options

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
parent aede1227
Showing with 79 additions and 68 deletions
gcc/fortran/ChangeLog
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> 2011-10-15 Tobias Burnus <burnus@net-b.de>
* gfortran.texi (Fortran 2008 status, TS 29113 status, * gfortran.texi (Fortran 2008 status, TS 29113 status,
......
gcc/fortran/resolve.c
...@@ -269,50 +269,18 @@ resolve_formal_arglist (gfc_symbol *proc) ...@@ -269,50 +269,18 @@ resolve_formal_arglist (gfc_symbol *proc)
if (sym->attr.if_source != IFSRC_UNKNOWN) if (sym->attr.if_source != IFSRC_UNKNOWN)
resolve_formal_arglist (sym); resolve_formal_arglist (sym);
/* F08:C1279. */ if (sym->attr.subroutine || sym->attr.external)
if (gfc_pure (proc)
&& sym->attr.flavor == FL_PROCEDURE && !gfc_pure (sym))
{ {
gfc_error ("Dummy procedure '%s' of PURE procedure at %L must " if (sym->attr.flavor == FL_UNKNOWN)
"also be PURE", sym->name, &sym->declared_at); gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, &sym->declared_at);
continue;
} }
else
if (sym->attr.subroutine || sym->attr.external || sym->attr.intrinsic)
{ {
if (proc->attr.implicit_pure && !gfc_pure(sym)) if (sym->ts.type == BT_UNKNOWN && !proc->attr.intrinsic
proc->attr.implicit_pure = 0; && (!sym->attr.function || sym->result == sym))
gfc_set_default_type (sym, 1, sym->ns);
/* 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);
gfc_resolve_array_spec (sym->as, 0); gfc_resolve_array_spec (sym->as, 0);
/* We can't tell if an array with dimension (:) is assumed or deferred /* We can't tell if an array with dimension (:) is assumed or deferred
...@@ -343,44 +311,64 @@ resolve_formal_arglist (gfc_symbol *proc) ...@@ -343,44 +311,64 @@ resolve_formal_arglist (gfc_symbol *proc)
if (sym->attr.flavor == FL_UNKNOWN) if (sym->attr.flavor == FL_UNKNOWN)
gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, &sym->declared_at); gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, &sym->declared_at);
if (gfc_pure (proc) && !sym->attr.pointer if (gfc_pure (proc))
&& sym->attr.flavor != FL_PROCEDURE)
{ {
if (proc->attr.function && sym->attr.intent != INTENT_IN) if (sym->attr.flavor == FL_PROCEDURE)
{ {
if (sym->attr.value) /* F08:C1279. */
gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Argument '%s' " if (!gfc_pure (sym))
"of pure function '%s' at %L with VALUE " {
"attribute but without INTENT(IN)", sym->name, gfc_error ("Dummy procedure '%s' of PURE procedure at %L must "
proc->name, &sym->declared_at); "also be PURE", sym->name, &sym->declared_at);
else continue;
gfc_error ("Argument '%s' of pure function '%s' at %L must be " }
"INTENT(IN) or VALUE", sym->name, proc->name,
&sym->declared_at);
} }
else if (!sym->attr.pointer)
if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN)
{ {
if (sym->attr.value) if (proc->attr.function && sym->attr.intent != INTENT_IN)
gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Argument '%s' " {
"of pure subroutine '%s' at %L with VALUE " if (sym->attr.value)
"attribute but without INTENT", sym->name, gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Argument '%s'"
proc->name, &sym->declared_at); " of pure function '%s' at %L with VALUE "
else "attribute but without INTENT(IN)",
gfc_error ("Argument '%s' of pure subroutine '%s' at %L must " sym->name, proc->name, &sym->declared_at);
"have its INTENT specified or have the VALUE " else
"attribute", sym->name, proc->name, &sym->declared_at); 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 if (proc->attr.implicit_pure)
&& sym->attr.flavor != FL_PROCEDURE)
{ {
if (proc->attr.function && sym->attr.intent != INTENT_IN) if (sym->attr.flavor == FL_PROCEDURE)
proc->attr.implicit_pure = 0; {
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) if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN)
proc->attr.implicit_pure = 0; proc->attr.implicit_pure = 0;
}
} }
if (gfc_elemental (proc)) if (gfc_elemental (proc))
......
gcc/testsuite/ChangeLog
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> 2011-10-16 Ira Rosen <ira.rosen@linaro.org>
PR tree-optimization/50727 PR tree-optimization/50727
......
gcc/testsuite/gfortran.dg/elemental_args_check_4.f90 0 → 100644
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment