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

5 files changed, 40 insertions, 8 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3b36e3f..c6e6d7e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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>
 
 	PR fortran/33636
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 16dc2b1..447263a 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2526,6 +2526,18 @@ gfc_specification_expr (gfc_expr *e)
       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)
     {
       gfc_error ("Expression at %L must be scalar", &e->where);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8c03b11..890da97 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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>
 
 	PR 11001
diff --git a/gcc/testsuite/gfortran.dg/char_result_7.f90 b/gcc/testsuite/gfortran.dg/char_result_7.f90
index a037d2b..7b8692f 100644
--- a/gcc/testsuite/gfortran.dg/char_result_7.f90
+++ b/gcc/testsuite/gfortran.dg/char_result_7.f90
@@ -16,7 +16,6 @@ program main
   end interface
 
   call test (f1 (double, 100), 200)
-  call test (f2 (double, 70), 140)
 
   call indirect (double)
 contains
@@ -31,12 +30,6 @@ contains
     f1 = ''
   end function f1
 
-  function f2 (fn, i)
-    integer :: i, fn
-    character (len = fn (i)) :: f2
-    f2 = ''
-  end function f2
-
   subroutine indirect (fn)
     interface
       integer pure function fn (x)
@@ -44,7 +37,6 @@ contains
       end function fn
     end interface
     call test (f1 (fn, 100), 200)
-    call test (f2 (fn, 70), 140)
   end subroutine indirect
 
   subroutine test (string, length)
diff --git a/gcc/testsuite/gfortran.dg/impure_spec_expr_1.f90 b/gcc/testsuite/gfortran.dg/impure_spec_expr_1.f90
new file mode 100644
index 0000000..8c42a57
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/impure_spec_expr_1.f90
@@ -0,0 +1,15 @@
+! { 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" } }
+