From 41cc1dd00efd0187e146687e655ae86d4e208c7f Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Mon, 15 Dec 2014 11:34:46 +0100 Subject: [PATCH] re PR fortran/63674 ([F03] procedure pointer and non/pure procedure) 2014-12-15 Janus Weil PR fortran/63674 * resolve.c (check_pure_function): Rewording in error message. 2014-12-15 Janus Weil PR fortran/63674 * gfortran.dg/forall_5.f90: Modified error message. * gfortran.dg/proc_ptr_comp_39.f90: Ditto. * gfortran.dg/pure_dummy_length_1.f90: Ditto. * gfortran.dg/stfunc_6.f90: Ditto. * gfortran.dg/typebound_operator_4.f90: Ditto. From-SVN: r218738 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/resolve.c | 8 ++++---- gcc/testsuite/ChangeLog | 9 +++++++++ gcc/testsuite/gfortran.dg/forall_5.f90 | 6 +++--- gcc/testsuite/gfortran.dg/proc_ptr_comp_39.f90 | 2 +- gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90 | 2 +- gcc/testsuite/gfortran.dg/stfunc_6.f90 | 6 +++--- gcc/testsuite/gfortran.dg/typebound_operator_4.f03 | 8 ++++---- 8 files changed, 30 insertions(+), 16 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 24bddef50d5..8b10a486492 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2014-12-15 Janus Weil + + PR fortran/63674 + * resolve.c (check_pure_function): Rewording in error message. + 2014-12-14 Janus Weil PR fortran/63674 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 6a0a869f68c..fec36c9cdfa 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2808,7 +2808,7 @@ pure_stmt_function (gfc_expr *e, gfc_symbol *sym) } -/* Check if a non-pure function function is allowed in the current context. */ +/* Check if an impure function is allowed in the current context. */ static bool check_pure_function (gfc_expr *e) { @@ -2817,21 +2817,21 @@ static bool check_pure_function (gfc_expr *e) { if (forall_flag) { - gfc_error ("Reference to non-PURE function %qs at %L inside a " + gfc_error ("Reference to impure function %qs at %L inside a " "FORALL %s", name, &e->where, forall_flag == 2 ? "mask" : "block"); return false; } else if (gfc_do_concurrent_flag) { - gfc_error ("Reference to non-PURE function %qs at %L inside a " + gfc_error ("Reference to impure function %qs at %L inside a " "DO CONCURRENT %s", name, &e->where, gfc_do_concurrent_flag == 2 ? "mask" : "block"); return false; } else if (gfc_pure (NULL)) { - gfc_error ("Reference to non-PURE function %qs at %L " + gfc_error ("Reference to impure function %qs at %L " "within a PURE procedure", name, &e->where); return false; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2e21868effb..9a0df058245 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2014-12-15 Janus Weil + + PR fortran/63674 + * gfortran.dg/forall_5.f90: Modified error message. + * gfortran.dg/proc_ptr_comp_39.f90: Ditto. + * gfortran.dg/pure_dummy_length_1.f90: Ditto. + * gfortran.dg/stfunc_6.f90: Ditto. + * gfortran.dg/typebound_operator_4.f90: Ditto. + 2014-12-15 Richard Biener PR tree-optimization/64284 diff --git a/gcc/testsuite/gfortran.dg/forall_5.f90 b/gcc/testsuite/gfortran.dg/forall_5.f90 index 43ed2b5c313..55491f5bd45 100644 --- a/gcc/testsuite/gfortran.dg/forall_5.f90 +++ b/gcc/testsuite/gfortran.dg/forall_5.f90 @@ -18,14 +18,14 @@ end module foo logical :: s(n) a = 0 - forall (i=1:n, foot (i)) a(i) = i ! { dg-error "non-PURE" } + forall (i=1:n, foot (i)) a(i) = i ! { dg-error "impure" } if (any (a .ne. (/0,2,3,0/))) call abort () - forall (i=1:n, s (i) .or. t(i)) a(i) = i ! { dg-error "non-PURE|LOGICAL" } + forall (i=1:n, s (i) .or. t(i)) a(i) = i ! { dg-error "impure|LOGICAL" } if (any (a .ne. (/0,3,2,1/))) call abort () a = 0 - forall (i=1:n, mod (i, 2) == 0) a(i) = w (i) ! { dg-error "non-PURE" } + forall (i=1:n, mod (i, 2) == 0) a(i) = w (i) ! { dg-error "impure" } if (any (a .ne. (/0,2,0,4/))) call abort () contains diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_39.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_39.f90 index cc4096a4ecc..8294ddcc1bf 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_comp_39.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_39.f90 @@ -25,7 +25,7 @@ contains pure integer function eval(a) type(t), intent(in) :: a eval = a%pf() - eval = a%nf() ! { dg-error "Reference to non-PURE function" } + eval = a%nf() ! { dg-error "Reference to impure function" } call a%ps() call a%ns() ! { dg-error "is not PURE" } end function diff --git a/gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90 b/gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90 index b3e75a4115b..407780ddbe2 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 function" } + if (end > impure (self)) & ! { dg-error "impure function" } return end function diff --git a/gcc/testsuite/gfortran.dg/stfunc_6.f90 b/gcc/testsuite/gfortran.dg/stfunc_6.f90 index 413e583759b..37137fb41f8 100644 --- a/gcc/testsuite/gfortran.dg/stfunc_6.f90 +++ b/gcc/testsuite/gfortran.dg/stfunc_6.f90 @@ -17,12 +17,12 @@ FORALL(i=1:4) a(i) = u (a(i)) - a(i)** 2 if (any (a .ne. 0)) call abort () if (i .ne. 99) call abort () - FORALL (i=1:4) a(i) = st3 (i) ! { dg-error "non-PURE function" "non-PURE reference in FORALL" { xfail *-*-*} } - FORALL (i=1:4) a(i) = v(i) ! { dg-error "non-PURE function" } + FORALL (i=1:4) a(i) = st3 (i) ! { dg-error "impure function" "impure reference in FORALL" { xfail *-*-*} } + FORALL (i=1:4) a(i) = v(i) ! { dg-error "impure function" } contains pure integer function u (x) integer,intent(in) :: x - st2 (i) = i * v(i) ! { dg-error "non-PURE function" } + st2 (i) = i * v(i) ! { dg-error "impure 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 0a8415fc667..f9a2612530c 100644 --- a/gcc/testsuite/gfortran.dg/typebound_operator_4.f03 +++ b/gcc/testsuite/gfortran.dg/typebound_operator_4.f03 @@ -63,8 +63,8 @@ CONTAINS TYPE(myint) :: x x = 0 ! { dg-bogus "is not PURE" } - x = x + 42 ! { dg-bogus "to a non-PURE procedure" } - x = x .PLUS. 5 ! { dg-bogus "to a non-PURE procedure" } + x = x + 42 ! { dg-bogus "to a impure procedure" } + x = x .PLUS. 5 ! { dg-bogus "to a impure procedure" } END SUBROUTINE iampure END MODULE m @@ -75,8 +75,8 @@ PURE SUBROUTINE iampure2 () TYPE(myreal) :: x x = 0.0 ! { dg-error "is not PURE" } - x = x + 42.0 ! { dg-error "non-PURE function" } - x = x .PLUS. 5.0 ! { dg-error "non-PURE function" } + x = x + 42.0 ! { dg-error "impure function" } + x = x .PLUS. 5.0 ! { dg-error "impure function" } END SUBROUTINE iampure2 PROGRAM main -- 2.30.2