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.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8d9fd6e..f1042bc 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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