[Patch, fortran] PR30034 and PR30237 - alternate returns in intrinsic procedures and pure procedure arguments

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

These patches are nearly 'obvious'.  One results because nobody, 
apparently, thought that anybody would try to use alternate returns with 
intrinsic procedures :-)   The other is just a simple error in not 
treating subroutine and function arguments in the same fashion in pure 
procedures.  In both cases the testcase is more or less that of the 
reporter.

Regtested on Cywin_NT/amd64 - OK for trunk and, a week later, 4.2?

Paul

2006-12-27  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,
	emit an error.

2006-12-27  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.

Index: gcc/fortran/intrinsic.c
===================================================================
*** gcc/fortran/intrinsic.c	(revision 120217)
--- gcc/fortran/intrinsic.c	(working copy)
*************** remove_nullargs (gfc_actual_arglist ** a
*** 2782,2788 ****
      {
        next = head->next;
  
!       if (head->expr == NULL)
  	{
  	  head->next = NULL;
  	  gfc_free_actual_arglist (head);
--- 2782,2788 ----
      {
        next = head->next;
  
!       if (head->expr == NULL && !head->label)
  	{
  	  head->next = NULL;
  	  gfc_free_actual_arglist (head);
*************** do_sort:
*** 2898,2903 ****
--- 2898,2909 ----
  
    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 ();
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 120218)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_formal_arglist (gfc_symbol * pro
*** 173,198 ****
        if (sym->attr.flavor == FL_UNKNOWN)
  	gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, &sym->declared_at);
  
!       if (gfc_pure (proc))
  	{
! 	  if (proc->attr.function && !sym->attr.pointer
!               && sym->attr.flavor != FL_PROCEDURE
! 	      && 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 (gfc_elemental (proc))
  	{
  	  if (sym->as != NULL)
--- 173,192 ----
        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 (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.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)
Index: gcc/testsuite/gfortran.dg/pure_formal_proc_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/pure_formal_proc_1.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/pure_formal_proc_1.f90	(revision 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
Index: gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90
===================================================================
*** gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90	(revision 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