summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/testsuite/gfortran.dg')
-rw-r--r--gcc/testsuite/gfortran.dg/entry_7.f902
-rw-r--r--gcc/testsuite/gfortran.dg/proc_ptr_11.f9030
-rw-r--r--gcc/testsuite/gfortran.dg/proc_ptr_12.f9015
-rw-r--r--gcc/testsuite/gfortran.dg/proc_ptr_2.f905
-rw-r--r--gcc/testsuite/gfortran.dg/proc_ptr_3.f9012
-rw-r--r--gcc/testsuite/gfortran.dg/result_1.f9018
6 files changed, 77 insertions, 5 deletions
diff --git a/gcc/testsuite/gfortran.dg/entry_7.f90 b/gcc/testsuite/gfortran.dg/entry_7.f90
index fbe4b8e2af1..52940984551 100644
--- a/gcc/testsuite/gfortran.dg/entry_7.f90
+++ b/gcc/testsuite/gfortran.dg/entry_7.f90
@@ -9,7 +9,7 @@
MODULE TT
CONTAINS
FUNCTION K(I) RESULT(J)
- ENTRY J() ! { dg-error "conflicts with PROCEDURE attribute" }
+ ENTRY J() ! { dg-error "conflicts with RESULT attribute" }
END FUNCTION K
integer function foo ()
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_11.f90
new file mode 100644
index 00000000000..a5cdbb54890
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_11.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR 38290: Procedure pointer assignment checking.
+!
+! Test case found at http://de.wikibooks.org/wiki/Fortran:_Fortran_2003:_Zeiger
+! Adapted by Janus Weil <janus@gcc.gnu.org>
+
+program bsp
+ implicit none
+
+ abstract interface
+ subroutine up()
+ end subroutine up
+ end interface
+
+ procedure( up ) , pointer :: pptr
+
+ pptr => add ! { dg-error "Interfaces don't match" }
+
+ print *, pptr() ! { dg-error "is not a function" }
+
+ contains
+
+ function add( a, b )
+ integer :: add
+ integer, intent( in ) :: a, b
+ add = a + b
+ end function add
+
+end program bsp
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_12.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_12.f90
new file mode 100644
index 00000000000..325703f499d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_12.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+!
+! PR 36704: Procedure pointer as function result
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+procedure(integer),pointer :: p
+p => foo()
+if (p(-1)/=1) call abort
+contains
+ function foo() result(bar)
+ procedure(integer),pointer :: bar
+ bar => iabs
+ end function
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_2.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_2.f90
index d19b81d6e47..6224dc5980b 100644
--- a/gcc/testsuite/gfortran.dg/proc_ptr_2.f90
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_2.f90
@@ -6,8 +6,11 @@
PROCEDURE(REAL), POINTER :: ptr
PROCEDURE(REAL), SAVE :: noptr ! { dg-error "attribute conflicts with" }
+REAL :: x
-ptr => cos(4.0) ! { dg-error "Invalid character" }
+ptr => cos(4.0) ! { dg-error "Invalid procedure pointer assignment" }
+ptr => x ! { dg-error "Invalid procedure pointer assignment" }
+ptr => sin(x) ! { dg-error "Invalid procedure pointer assignment" }
ALLOCATE(ptr) ! { dg-error "must be ALLOCATABLE" }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_3.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_3.f90
index 34d4f1625fb..5c4233d60e4 100644
--- a/gcc/testsuite/gfortran.dg/proc_ptr_3.f90
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_3.f90
@@ -6,14 +6,12 @@
real function e1(x)
real :: x
- print *,'e1!',x
e1 = x * 3.0
end function
subroutine e2(a,b)
real, intent(inout) :: a
real, intent(in) :: b
- print *,'e2!',a,b
a = a + b
end subroutine
@@ -29,7 +27,15 @@ interface
end subroutine sp
end interface
-external :: e1,e2
+external :: e1
+
+interface
+ subroutine e2(a,b)
+ real, intent(inout) :: a
+ real, intent(in) :: b
+ end subroutine e2
+end interface
+
real :: c = 1.2
fp => e1
diff --git a/gcc/testsuite/gfortran.dg/result_1.f90 b/gcc/testsuite/gfortran.dg/result_1.f90
new file mode 100644
index 00000000000..162ffaf5857
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/result_1.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR 36704: Procedure pointer as function result
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+function f() result(r)
+real, parameter :: r = 5.0 ! { dg-error "attribute conflicts" }
+end function
+
+function g() result(s)
+real :: a,b,c
+namelist /s/ a,b,c ! { dg-error "attribute conflicts" }
+end function
+
+function h() result(t)
+type t ! { dg-error "attribute conflicts" }
+end function