2
0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-20 17:40:46 +08:00

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
This commit is contained in:
Janus Weil 2014-12-15 11:34:46 +01:00
parent 952e78198d
commit 41cc1dd00e
8 changed files with 30 additions and 16 deletions

@ -1,3 +1,8 @@
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>
PR fortran/63674

@ -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;
}

@ -1,3 +1,12 @@
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>
PR tree-optimization/64284

@ -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

@ -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

@ -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

@ -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)

@ -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