re PR fortran/33162 (INTRINSIC functions as ACTUAL argument)

2007-11-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/33162
	*gfortran.dg/proc_decl_1.f90: Update.
	*gfortran.dg/proc_decl_7.f90: New test.
	*gfortran.dg/proc_decl_8.f90: New test.
	*gfortran.dg/proc_decl_9.f90: New test.
	*gfortran.dg/proc_decl_10.f90: New test.

From-SVN: r130169

gcc/testsuite/ChangeLog

+2007-11-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33162
+	*gfortran.dg/proc_decl_1.f90: Update.
+	*gfortran.dg/proc_decl_7.f90: New test.
+	*gfortran.dg/proc_decl_8.f90: New test.
+	*gfortran.dg/proc_decl_9.f90: New test.
+	*gfortran.dg/proc_decl_10.f90: New test.
+
 2007-11-13  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/34080

gcc/testsuite/gfortran.dg/proc_decl_1.f90

@@ -37,7 +37,7 @@ program prog
   procedure(), allocatable:: b  ! { dg-error "PROCEDURE attribute conflicts with ALLOCATABLE attribute" }
   procedure(), save:: c  ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" }
 
-  procedure(dcos) :: my1  ! { dg-error "PROCEDURE statement at .1. not yet implemented" }
+  procedure(dcos) :: my1
   procedure(amax0) :: my2  ! { dg-error "not allowed in PROCEDURE statement" }
 
   procedure(),pointer:: ptr  ! { dg-error "not yet implemented" }

gcc/testsuite/gfortran.dg/proc_decl_10.f90

+! { dg-do compile }
+! PR33162 INTRINSIC functions as ACTUAL argument
+! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+module m
+implicit none
+  interface
+    double precision function my1(x)
+      double precision, intent(in) :: x
+    end function my1
+  end interface
+  interface
+    real(kind=4) function my2(x)
+      real, intent(in) :: x
+    end function my2
+  end interface
+  interface
+    real function  my3(x, y)
+      real, intent(in) :: x, y
+    end function my3
+  end interface
+end module
+
+program test
+use m
+implicit none
+procedure(dcos):: my1 ! { dg-error "Cannot change attributes" }
+procedure(cos) :: my2 ! { dg-error "Cannot change attributes" }
+procedure(dprod) :: my3 ! { dg-error "Cannot change attributes" }
+
+end program test
+
+! { dg-final { cleanup-modules "m" } }

gcc/testsuite/gfortran.dg/proc_decl_7.f90

+! { dg-do compile }
+! PR33162 INTRINSIC functions as ACTUAL argument
+! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+module m
+implicit none
+contains
+  subroutine sub(a)
+    interface
+      function a()
+        real :: a
+      end function a
+    end interface
+    print *, a()
+  end subroutine sub
+end module m
+use m
+implicit none
+intrinsic cos
+call sub(cos) ! { dg-error "Type/rank mismatch in argument" }
+end
+! { dg-final { cleanup-modules "m" } }

gcc/testsuite/gfortran.dg/proc_decl_8.f90

+! { dg-do compile }
+! PR33162 INTRINSIC functions as ACTUAL argument
+! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+module m
+implicit none
+contains
+  subroutine sub(a)
+    interface
+      function a(x)
+        real :: a, x
+        intent(in) :: x
+      end function a
+    end interface
+    print *, a(4.0)
+  end subroutine sub
+
+end module m
+
+use m
+implicit none
+EXTERNAL foo  ! interface is undefined
+procedure(cos) :: foo ! { dg-error "Duplicate EXTERNAL attribute specified" }
+call sub(foo)         ! { dg-error "Type/rank mismatch in argument" }
+end
+! { dg-final { cleanup-modules "m" } }

gcc/testsuite/gfortran.dg/proc_decl_9.f90

+! { dg-do run }
+! PR33162 INTRINSIC functions as ACTUAL argument
+! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+real function t(x)
+  real ::x
+  t = x
+end function
+
+program p
+  implicit none
+  intrinsic sin
+  procedure(sin):: t
+  if (t(1.0) /= 1.0) call abort
+end program