Commit 41cc1dd0 by Janus Weil

re PR fortran/63674 ([F03] procedure pointer and non/pure procedure)

2014-12-15  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/63674
	* resolve.c (check_pure_function): Rewording in error message.


2014-12-15  Janus Weil  <janus@gcc.gnu.org>

	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
parent 952e7819
2014-12-15 Janus Weil <janus@gcc.gnu.org>
PR fortran/63674
* resolve.c (check_pure_function): Rewording in error message.
2014-12-14 Janus Weil <janus@gcc.gnu.org> 2014-12-14 Janus Weil <janus@gcc.gnu.org>
PR fortran/63674 PR fortran/63674
......
...@@ -2808,7 +2808,7 @@ pure_stmt_function (gfc_expr *e, gfc_symbol *sym) ...@@ -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) static bool check_pure_function (gfc_expr *e)
{ {
...@@ -2817,21 +2817,21 @@ static bool check_pure_function (gfc_expr *e) ...@@ -2817,21 +2817,21 @@ static bool check_pure_function (gfc_expr *e)
{ {
if (forall_flag) 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 %s", name, &e->where,
forall_flag == 2 ? "mask" : "block"); forall_flag == 2 ? "mask" : "block");
return false; return false;
} }
else if (gfc_do_concurrent_flag) 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, "DO CONCURRENT %s", name, &e->where,
gfc_do_concurrent_flag == 2 ? "mask" : "block"); gfc_do_concurrent_flag == 2 ? "mask" : "block");
return false; return false;
} }
else if (gfc_pure (NULL)) 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); "within a PURE procedure", name, &e->where);
return false; return false;
} }
......
2014-12-15 Janus Weil <janus@gcc.gnu.org>
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 <rguenther@suse.de> 2014-12-15 Richard Biener <rguenther@suse.de>
PR tree-optimization/64284 PR tree-optimization/64284
......
...@@ -18,14 +18,14 @@ end module foo ...@@ -18,14 +18,14 @@ end module foo
logical :: s(n) logical :: s(n)
a = 0 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 () 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 () if (any (a .ne. (/0,3,2,1/))) call abort ()
a = 0 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 () if (any (a .ne. (/0,2,0,4/))) call abort ()
contains contains
......
...@@ -25,7 +25,7 @@ contains ...@@ -25,7 +25,7 @@ contains
pure integer function eval(a) pure integer function eval(a)
type(t), intent(in) :: a type(t), intent(in) :: a
eval = a%pf() 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%ps()
call a%ns() ! { dg-error "is not PURE" } call a%ns() ! { dg-error "is not PURE" }
end function end function
......
...@@ -24,6 +24,6 @@ ...@@ -24,6 +24,6 @@
character(*), intent(in) :: string character(*), intent(in) :: string
integer(4), intent(in) :: ignore_case integer(4), intent(in) :: ignore_case
integer i integer i
if (end > impure (self)) & ! { dg-error "non-PURE function" } if (end > impure (self)) & ! { dg-error "impure function" }
return return
end function end function
...@@ -17,12 +17,12 @@ ...@@ -17,12 +17,12 @@
FORALL(i=1:4) a(i) = u (a(i)) - a(i)** 2 FORALL(i=1:4) a(i) = u (a(i)) - a(i)** 2
if (any (a .ne. 0)) call abort () if (any (a .ne. 0)) call abort ()
if (i .ne. 99) 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) = st3 (i) ! { dg-error "impure function" "impure reference in FORALL" { xfail *-*-*} }
FORALL (i=1:4) a(i) = v(i) ! { dg-error "non-PURE function" } FORALL (i=1:4) a(i) = v(i) ! { dg-error "impure function" }
contains contains
pure integer function u (x) pure integer function u (x)
integer,intent(in) :: 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) u = st2(x)
end function end function
integer function v (x) integer function v (x)
......
...@@ -63,8 +63,8 @@ CONTAINS ...@@ -63,8 +63,8 @@ CONTAINS
TYPE(myint) :: x TYPE(myint) :: x
x = 0 ! { dg-bogus "is not PURE" } x = 0 ! { dg-bogus "is not PURE" }
x = x + 42 ! { dg-bogus "to a non-PURE procedure" } x = x + 42 ! { dg-bogus "to a impure procedure" }
x = x .PLUS. 5 ! { dg-bogus "to a non-PURE procedure" } x = x .PLUS. 5 ! { dg-bogus "to a impure procedure" }
END SUBROUTINE iampure END SUBROUTINE iampure
END MODULE m END MODULE m
...@@ -75,8 +75,8 @@ PURE SUBROUTINE iampure2 () ...@@ -75,8 +75,8 @@ PURE SUBROUTINE iampure2 ()
TYPE(myreal) :: x TYPE(myreal) :: x
x = 0.0 ! { dg-error "is not PURE" } x = 0.0 ! { dg-error "is not PURE" }
x = x + 42.0 ! { dg-error "non-PURE function" } x = x + 42.0 ! { dg-error "impure function" }
x = x .PLUS. 5.0 ! { dg-error "non-PURE function" } x = x .PLUS. 5.0 ! { dg-error "impure function" }
END SUBROUTINE iampure2 END SUBROUTINE iampure2
PROGRAM main PROGRAM main
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment