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.

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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 57dbf78..a016d23 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/proc_decl_1.f90 b/gcc/testsuite/gfortran.dg/proc_decl_1.f90
index 2070b2a..c01f7c6 100644 (file)
--- a/gcc/testsuite/gfortran.dg/proc_decl_1.f90
+++ b/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" }

diff --git a/gcc/testsuite/gfortran.dg/proc_decl_10.f90 b/gcc/testsuite/gfortran.dg/proc_decl_10.f90
new file mode 100644 (file)
index 0000000..88fd6d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_10.f90
@@ -0,0 +1,32 @@
+! { 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" } }

diff --git a/gcc/testsuite/gfortran.dg/proc_decl_7.f90 b/gcc/testsuite/gfortran.dg/proc_decl_7.f90
new file mode 100644 (file)
index 0000000..79f4137
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_7.f90
@@ -0,0 +1,21 @@
+! { 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" } }

diff --git a/gcc/testsuite/gfortran.dg/proc_decl_8.f90 b/gcc/testsuite/gfortran.dg/proc_decl_8.f90
new file mode 100644 (file)
index 0000000..67c1ddb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_8.f90
@@ -0,0 +1,25 @@
+! { 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" } }

diff --git a/gcc/testsuite/gfortran.dg/proc_decl_9.f90 b/gcc/testsuite/gfortran.dg/proc_decl_9.f90
new file mode 100644 (file)
index 0000000..08faee9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_9.f90
@@ -0,0 +1,14 @@
+! { 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