re PR fortran/30034 ([4.1 only] pure subroutine requires intent for procedure argument)

2006-12-28  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30034
	* resolve.c (resolve_formal_arglist): Exclude the test for
	pointers and procedures for subroutine arguments as well as
	functions.

	PR fortran/30237
	* intrinsic.c (remove_nullargs): Do not pass up arguments with
	a label. If the actual has a label and the formal has a type
	then emit an error.

2006-12-28  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30034
	* gfortran.dg/pure_formal_proc_1.f90: New test.

	PR fortran/30237
	* gfortran.dg/intrinsic_actual_3.f90: New test.

From-SVN: r120244

6 files changed, 74 insertions, 14 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8d9fd6e..f1042bc 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2006-12-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30034
+	* resolve.c (resolve_formal_arglist): Exclude the test for
+	pointers and procedures for subroutine arguments as well as
+	functions.
+
+	PR fortran/30237
+	* intrinsic.c (remove_nullargs): Do not pass up arguments with
+	a label. If the actual has a label and the formal has a type
+	then emit an error.
+
 2006-12-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/30014
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index ea68d69..2ed4291 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -2782,7 +2782,7 @@ remove_nullargs (gfc_actual_arglist ** ap)
     {
       next = head->next;
 
-      if (head->expr == NULL)
+      if (head->expr == NULL && !head->label)
 	{
 	  head->next = NULL;
 	  gfc_free_actual_arglist (head);
@@ -2898,6 +2898,12 @@ do_sort:
 
   for (f = formal; f; f = f->next)
     {
+      if (f->actual && f->actual->label != NULL && f->ts.type)
+	{
+	  gfc_error ("ALTERNATE RETURN not permitted at %L", where);
+	  return FAILURE;
+	}
+
       if (f->actual == NULL)
 	{
 	  a = gfc_get_actual_arglist ();
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 9794446..2c71ae4 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -173,26 +173,20 @@ 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))
+      if (gfc_pure (proc) && !sym->attr.pointer
+            && sym->attr.flavor != FL_PROCEDURE)
 	{
-	  if (proc->attr.function && !sym->attr.pointer
-              && sym->attr.flavor != FL_PROCEDURE
-	      && sym->attr.intent != INTENT_IN)
-
+	  if (proc->attr.function && sym->attr.intent != INTENT_IN)
 	    gfc_error ("Argument '%s' of pure function '%s' at %L must be "
 		       "INTENT(IN)", sym->name, proc->name,
 		       &sym->declared_at);
 
-	  if (proc->attr.subroutine && !sym->attr.pointer
-	      && sym->attr.intent == INTENT_UNKNOWN)
-
-	    gfc_error
-	      ("Argument '%s' of pure subroutine '%s' at %L must have "
-	       "its INTENT specified", sym->name, proc->name,
-	       &sym->declared_at);
+	  if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN)
+	    gfc_error ("Argument '%s' of pure subroutine '%s' at %L must "
+		       "have its INTENT specified", sym->name, proc->name,
+		       &sym->declared_at);
 	}
 
-
       if (gfc_elemental (proc))
 	{
 	  if (sym->as != NULL)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6912966..7a5a719 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2006-12-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30034
+	* gfortran.dg/pure_formal_proc_1.f90: New test.
+
+	PR fortran/30237
+	* gfortran.dg/intrinsic_actual_3.f90: New test.
+
 2006-12-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/30014
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90
new file mode 100644
index 0000000..c2dd07c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! Tests the fix for PR30237 in which alternate returns in intrinsic
+! actual arglists were quietly ignored.
+!
+! Contributed by Brooks Moses <brooks@gcc.gnu.org>
+!
+program ar1
+    interface random_seed
+      subroutine x (a, *)
+        integer a
+      end subroutine x
+    end interface random_seed
+
+    real t1(2)
+    call cpu_time(*20)        ! { dg-error "not permitted" }
+    call cpu_time(*20, t1(1)) ! { dg-error "Too many arguments" }
+! This specific version is permitted by the generic interface.
+    call random_seed(i, *20)
+! The new error gets overwritten but the diagnostic is clear enough.
+    call random_seed(i, *20, *30) ! { dg-error "not consistent" }
+    stop
+20  write(*,*) t1
+30 stop
+end
diff --git a/gcc/testsuite/gfortran.dg/pure_formal_proc_1.f90 b/gcc/testsuite/gfortran.dg/pure_formal_proc_1.f90
new file mode 100644
index 0000000..4a55563
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_formal_proc_1.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! Test fix for PR30034 in which the legal, pure procedure formal
+! argument was rejected as an error.
+!
+! Contgributed by Troban Trumsko <trumsko@yahoo.com>
+!
+ pure subroutine s_one ( anum, afun )
+    integer, intent(in) :: anum
+    interface
+      pure function afun (k) result (l)
+        implicit none
+        integer, intent(in) :: k
+        integer :: l
+      end function afun
+    end interface
+end subroutine s_one