From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Wed, 14 Nov 2007 01:06:13 +0000 (+0000)
Subject: re PR fortran/33162 (INTRINSIC functions as ACTUAL argument)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=2daddc8e15c4cded89cf6090626ca87bfd8083ae;p=gcc.git

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
---

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 57dbf78baae..a016d231734 100644
--- 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 2070b2ae21c..c01f7c6101e 100644
--- 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
index 00000000000..88fd6d8a793
--- /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
index 00000000000..79f413754c1
--- /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
index 00000000000..67c1ddb0ee6
--- /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
index 00000000000..08faee931e6
--- /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