diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg')
-rw-r--r-- | gcc/testsuite/gfortran.dg/entry_7.f90 | 2 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_11.f90 | 30 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_12.f90 | 15 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_2.f90 | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_3.f90 | 12 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/result_1.f90 | 18 |
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 |