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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 591745d349c6e9791ba5d89a91949b1869d3fce8..a6be321f2c52721d6b40c8c1ddc72584c06acbdb 100644 (file)
--- 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 edeb49daf7dd49129a308793fefa5b23039ea1be..9b76f98a562d671308abc5250705b6c65e7cdc00 100644 (file)
--- 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 c449d32f91b093f76efc7d5c02e61145238d66ab..9900074e0aa095c730148793e0cf70c2e560c4a2 100644 (file)
--- 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 (file)
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