From 0252ef5c6729e472adcd95b49d4a33521d908ee3 Mon Sep 17 00:00:00 2001 From: janus Date: Sun, 14 Dec 2014 12:04:49 +0000 Subject: 2014-12-14 Janus Weil PR fortran/63674 * resolve.c (pure_function): Treat procedure-pointer components. (check_pure_function): New function. (resolve_function): Use it. (pure_subroutine): Return a bool to indicate success and modify arguments. (resolve_generic_s0,resolve_specific_s0,resolve_unknown_s): Use return value of 'pure_subroutine'. (resolve_ppc_call): Call 'pure_subroutine'. (resolve_expr_ppc): Call 'check_pure_function'. 2014-12-14 Janus Weil PR fortran/63674 * gfortran.dg/proc_ptr_comp_39.f90: New. * gfortran.dg/pure_dummy_length_1.f90: Modified error message. * gfortran.dg/stfunc_6.f90: Ditto. * gfortran.dg/typebound_operator_4.f90: Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@218717 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/testsuite/gfortran.dg/proc_ptr_comp_39.f90 | 32 ++++++++++++++++++++++ gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90 | 2 +- gcc/testsuite/gfortran.dg/stfunc_6.f90 | 2 +- gcc/testsuite/gfortran.dg/typebound_operator_4.f03 | 4 +-- 4 files changed, 36 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_comp_39.f90 (limited to 'gcc/testsuite/gfortran.dg') diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_39.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_39.f90 new file mode 100644 index 00000000000..cc4096a4ecc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_39.f90 @@ -0,0 +1,32 @@ +! { dg-do compile } +! +! PR 63674: [F03] procedure pointer and non/pure procedure +! +! Contributed by Valery Weber + +program prog + interface + integer function nf() + end function + pure integer function pf() + end function + subroutine ns() + end subroutine + pure subroutine ps() + end subroutine + end interface + type :: t + procedure(nf), nopass, pointer :: nf => NULL() ! non-pure function + procedure(pf), nopass, pointer :: pf => NULL() ! pure function + procedure(ns), nopass, pointer :: ns => NULL() ! non-pure subroutine + procedure(ps), nopass, pointer :: ps => NULL() ! pure subroutine + end type +contains + pure integer function eval(a) + type(t), intent(in) :: a + eval = a%pf() + eval = a%nf() ! { dg-error "Reference to non-PURE function" } + call a%ps() + call a%ns() ! { dg-error "is not PURE" } + end function +end diff --git a/gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90 b/gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90 index c1bc1722431..b3e75a4115b 100644 --- a/gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90 +++ b/gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90 @@ -24,6 +24,6 @@ character(*), intent(in) :: string integer(4), intent(in) :: ignore_case integer i - if (end > impure (self)) & ! { dg-error "non-PURE procedure" } + if (end > impure (self)) & ! { dg-error "non-PURE function" } return end function diff --git a/gcc/testsuite/gfortran.dg/stfunc_6.f90 b/gcc/testsuite/gfortran.dg/stfunc_6.f90 index 482d12592f3..413e583759b 100644 --- a/gcc/testsuite/gfortran.dg/stfunc_6.f90 +++ b/gcc/testsuite/gfortran.dg/stfunc_6.f90 @@ -22,7 +22,7 @@ contains pure integer function u (x) integer,intent(in) :: x - st2 (i) = i * v(i) ! { dg-error "non-PURE procedure" } + st2 (i) = i * v(i) ! { dg-error "non-PURE function" } u = st2(x) end function integer function v (x) diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_4.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_4.f03 index 6ede14e878e..0a8415fc667 100644 --- a/gcc/testsuite/gfortran.dg/typebound_operator_4.f03 +++ b/gcc/testsuite/gfortran.dg/typebound_operator_4.f03 @@ -75,8 +75,8 @@ PURE SUBROUTINE iampure2 () TYPE(myreal) :: x x = 0.0 ! { dg-error "is not PURE" } - x = x + 42.0 ! { dg-error "to a non-PURE procedure" } - x = x .PLUS. 5.0 ! { dg-error "to a non-PURE procedure" } + x = x + 42.0 ! { dg-error "non-PURE function" } + x = x .PLUS. 5.0 ! { dg-error "non-PURE function" } END SUBROUTINE iampure2 PROGRAM main -- cgit v1.2.1