[Patch, forran] PR26107 - ICE after error message

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

This is a very short fix to prevent an ICE occurring, following an error 
in resolve_function.  pure_function returns the name of the function, 
which is not made available because of the failure in the test of the 
type of the dummy argument being fed to LEN.  The patch merely adds a 
test that the name is non-null to the test for pureness.

Retested on FC3/Athlon; OK for mainline and 4.1?

Paul

2006-03-03  Paul Thomas  <pault@gcc.gnu.org>

   PR fortran/26107
   * resolve.c (resolve_function): Add name after test for pureness.

2006-03-03  Paul Thomas  <pault@gcc.gnu.org>

   PR fortran/26107
   * pure_dummy_length_1.f90: New test.

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 111642)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_function (gfc_expr * expr)
*** 1357,1363 ****
  
    need_full_assumed_size = temp;
  
!   if (!pure_function (expr, &name))
      {
        if (forall_flag)
  	{
--- 1357,1363 ----
  
    need_full_assumed_size = temp;
  
!   if (!pure_function (expr, &name) && name)
      {
        if (forall_flag)
  	{

! { dg-do compile }
! Tests fix for PR26107 in which an ICE would occur after the second
! error message below.  This resulted from a spurious attempt to
! produce the third error message, without the name of the function.
!
! This is an expanded version of the testcase in the PR.
!
   pure function equals(self, &     ! { dg-error "must be INTENT(IN)" }
                        string, ignore_case) result(same)
         character(*), intent(in) :: string
         integer(4), intent(in) :: ignore_case
         integer(4) :: same
         if (len (self) < 1) return ! { dg-error "Type of argument" }
         same = 1
   end function

   function impure(self) result(ival)
         character(*), intent(in) :: self
         ival = 1
   end function

   pure function purity(self, string, ignore_case) result(same)
         character(*), intent(in) :: self
         character(*), intent(in) :: string
         integer(4), intent(in) :: ignore_case
         integer i
         if (end > impure (self)) & ! { dg-error "non-PURE procedure" }
           return
   end function