Commit 98a36c7c by Paul Thomas

re PR fortran/33664 (crash on invalid program)

2007-10-12  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33664
	* expr.c (gfc_specification_expr): If a function is not
	external, intrinsic or pure is an error.  Set the symbol pure
	to prevent repeat errors.

2007-10-12  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33664
	* gfortran.dg/impure_spec_expr_1.f90: New test.
	* gfortran.dg/char_result_7.f90: Remove illegal test.

From-SVN: r129267
parent e69f1bad
2007-10-12 Paul Thomas <pault@gcc.gnu.org>
PR fortran/33664
* expr.c (gfc_specification_expr): If a function is not
external, intrinsic or pure is an error. Set the symbol pure
to prevent repeat errors.
2007-10-10 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> 2007-10-10 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/33636 PR fortran/33636
......
...@@ -2526,6 +2526,18 @@ gfc_specification_expr (gfc_expr *e) ...@@ -2526,6 +2526,18 @@ gfc_specification_expr (gfc_expr *e)
return FAILURE; return FAILURE;
} }
if (e->expr_type == EXPR_FUNCTION
&& !e->value.function.isym
&& !e->value.function.esym
&& !gfc_pure (e->symtree->n.sym))
{
gfc_error ("Function '%s' at %L must be PURE",
e->symtree->n.sym->name, &e->where);
/* Prevent repeat error messages. */
e->symtree->n.sym->attr.pure = 1;
return FAILURE;
}
if (e->rank != 0) if (e->rank != 0)
{ {
gfc_error ("Expression at %L must be scalar", &e->where); gfc_error ("Expression at %L must be scalar", &e->where);
......
2007-10-12 Paul Thomas <pault@gcc.gnu.org>
PR fortran/33664
* gfortran.dg/impure_spec_expr_1.f90: New test.
* gfortran.dg/char_result_7.f90: Remove illegal test.
2007-10-12 Nathan Froyd <froydnj@codesourcery.com> 2007-10-12 Nathan Froyd <froydnj@codesourcery.com>
PR 11001 PR 11001
...@@ -16,7 +16,6 @@ program main ...@@ -16,7 +16,6 @@ program main
end interface end interface
call test (f1 (double, 100), 200) call test (f1 (double, 100), 200)
call test (f2 (double, 70), 140)
call indirect (double) call indirect (double)
contains contains
...@@ -31,12 +30,6 @@ contains ...@@ -31,12 +30,6 @@ contains
f1 = '' f1 = ''
end function f1 end function f1
function f2 (fn, i)
integer :: i, fn
character (len = fn (i)) :: f2
f2 = ''
end function f2
subroutine indirect (fn) subroutine indirect (fn)
interface interface
integer pure function fn (x) integer pure function fn (x)
...@@ -44,7 +37,6 @@ contains ...@@ -44,7 +37,6 @@ contains
end function fn end function fn
end interface end interface
call test (f1 (fn, 100), 200) call test (f1 (fn, 100), 200)
call test (f2 (fn, 70), 140)
end subroutine indirect end subroutine indirect
subroutine test (string, length) subroutine test (string, length)
......
! { dg-do compile }
! Checks the fix for PR33664, in which the apparent function reference
! n(1) caused a seg-fault.
!
! Contributed by Henrik Holst <holst@matmech.com>
!
module test
contains
subroutine func_1(u,n)
integer :: n
integer :: u(n(1)) ! { dg-error "must be PURE" }
end subroutine
end module test
! { dg-final { cleanup-modules "test" } }
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