2009-08-13 Janus Weil <janus@gcc.gnu.org>

	PR fortran/40995
	* resolve.c (resolve_symbol): Move some checking code to
	resolve_intrinsic, and call this from here.
	(resolve_intrinsic): Some checking code moved here from resolve_symbol.
	Make sure each intrinsic is only resolved once.

2009-08-13  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40995
	* gfortran.dg/intrinsic_4.f90: New.
	* gfortran.dg/intrinsic_subroutine.f90: An error message moved to a
	different line.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150716 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 33e0c34..a07ee12 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2009-08-13  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/40995
+       * resolve.c (resolve_symbol): Move some checking code to
+       resolve_intrinsic, and call this from here.
+       (resolve_intrinsic): Some checking code moved here from resolve_symbol.
+       Make sure each intrinsic is only resolved once.
+
 2009-08-12  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/41034

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5c43704..bc71af1 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1148,24 +1148,64 @@ is_illegal_recursion (gfc_symbol* sym, gfc_namespace* context)
 static gfc_try
 resolve_intrinsic (gfc_symbol *sym, locus *loc)
 {
-  gfc_intrinsic_sym *isym = gfc_find_function (sym->name);
-  if (isym)
+  gfc_intrinsic_sym* isym;
+  const char* symstd;
+
+  if (sym->formal)
+    return SUCCESS;
+
+  /* We already know this one is an intrinsic, so we don't call
+     gfc_is_intrinsic for full checking but rather use gfc_find_function and
+     gfc_find_subroutine directly to check whether it is a function or
+     subroutine.  */
+
+  if ((isym = gfc_find_function (sym->name)))
     {
+      if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising
+         && !sym->attr.implicit_type)
+       gfc_warning ("Type specified for intrinsic function '%s' at %L is"
+                     " ignored", sym->name, &sym->declared_at);
+
       if (!sym->attr.function &&
          gfc_add_function (&sym->attr, sym->name, loc) == FAILURE)
        return FAILURE;
+
       sym->ts = isym->ts;
     }
-  else
+  else if ((isym = gfc_find_subroutine (sym->name)))
     {
-      isym = gfc_find_subroutine (sym->name);
-      gcc_assert (isym);
+      if (sym->ts.type != BT_UNKNOWN && !sym->attr.implicit_type)
+       {
+         gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type"
+                     " specifier", sym->name, &sym->declared_at);
+         return FAILURE;
+       }
+
       if (!sym->attr.subroutine &&
          gfc_add_subroutine (&sym->attr, sym->name, loc) == FAILURE)
        return FAILURE;
     }
-  if (!sym->formal)
-    gfc_copy_formal_args_intr (sym, isym);
+  else
+    {
+      gfc_error ("'%s' declared INTRINSIC at %L does not exist", sym->name,
+                &sym->declared_at);
+      return FAILURE;
+    }
+
+  gfc_copy_formal_args_intr (sym, isym);
+
+  /* Check it is actually available in the standard settings.  */
+  if (gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at)
+      == FAILURE)
+    {
+      gfc_error ("The intrinsic '%s' declared INTRINSIC at %L is not"
+                " available in the current standard settings but %s.  Use"
+                " an appropriate -std=* option or enable -fall-intrinsics"
+                " in order to use it.",
+                sym->name, &sym->declared_at, symstd);
+      return FAILURE;
+    }
+
   return SUCCESS;
 }
 
@@ -9944,51 +9984,9 @@ resolve_symbol (gfc_symbol *sym)
   /* Make sure that the intrinsic is consistent with its internal 
      representation. This needs to be done before assigning a default 
      type to avoid spurious warnings.  */
-  if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic)
-    {
-      gfc_intrinsic_sym* isym;
-      const char* symstd;
-
-      /* We already know this one is an intrinsic, so we don't call
-        gfc_is_intrinsic for full checking but rather use gfc_find_function and
-        gfc_find_subroutine directly to check whether it is a function or
-        subroutine.  */
-
-      if ((isym = gfc_find_function (sym->name)))
-       {
-         if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising
-             && !sym->attr.implicit_type)
-           gfc_warning ("Type specified for intrinsic function '%s' at %L is"
-                        " ignored", sym->name, &sym->declared_at);
-       }
-      else if ((isym = gfc_find_subroutine (sym->name)))
-       {
-         if (sym->ts.type != BT_UNKNOWN && !sym->attr.implicit_type)
-           {
-             gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type"
-                        " specifier", sym->name, &sym->declared_at);
-             return;
-           }
-       }
-      else
-       {
-         gfc_error ("'%s' declared INTRINSIC at %L does not exist",
-                    sym->name, &sym->declared_at);
-         return;
-       }
-
-      /* Check it is actually available in the standard settings.  */
-      if (gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at)
-           == FAILURE)
-       {
-         gfc_error ("The intrinsic '%s' declared INTRINSIC at %L is not"
-                    " available in the current standard settings but %s.  Use"
-                     " an appropriate -std=* option or enable -fall-intrinsics"
-                     " in order to use it.",
-                     sym->name, &sym->declared_at, symstd);
-         return;
-       }
-     }
+  if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic
+      && resolve_intrinsic (sym, &sym->declared_at) == FAILURE)
+    return;
 
   /* Assign default type to symbols that need one and don't have one.  */
   if (sym->ts.type == BT_UNKNOWN)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 92575a3..25fc2bc 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2009-08-13  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/40995
+       * gfortran.dg/intrinsic_4.f90: New.
+       * gfortran.dg/intrinsic_subroutine.f90: An error message moved to a
+       different line.
+
 2009-08-13  Richard Guenther  <rguenther@suse.de>
 
        PR middle-end/41047

diff --git a/gcc/testsuite/gfortran.dg/intrinsic_4.f90 b/gcc/testsuite/gfortran.dg/intrinsic_4.f90
new file mode 100644 (file)
index 0000000..300dfde
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_4.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-Wsurprising" }
+!
+! PR 40995: [4.5 Regression] Spurious "Type specified for intrinsic function...ignored" message
+!
+! Contributed by Mat Cross <mathewc@nag.co.uk>
+
+subroutine sub(n,x)
+  intrinsic abs
+  integer n, x(abs(n))
+end
+

diff --git a/gcc/testsuite/gfortran.dg/intrinsic_subroutine.f90 b/gcc/testsuite/gfortran.dg/intrinsic_subroutine.f90
index 87853db..d3f84cd 100644 (file)
--- a/gcc/testsuite/gfortran.dg/intrinsic_subroutine.f90
+++ b/gcc/testsuite/gfortran.dg/intrinsic_subroutine.f90
@@ -1,7 +1,7 @@
 ! { dg-do compile }
 ! PR 33229
 implicit none
-intrinsic cpu_time
+intrinsic cpu_time  ! { dg-error "attribute conflicts with" }
 real :: time
-print *, CPU_TIME(TIME)  ! { dg-error "attribute conflicts with" }
+print *, CPU_TIME(TIME)  ! { dg-error "is not a function" }
 end