[semi-PATCH] fortran/25072 -- fix ICE involving free_expr0

[Steve Kargl]

The attached patch has been regression tested on i386-*-freebsd.
There were no new regressions.  The patch only fixes the "Internal
Error" as noted in PR 25072:

FORALL(I=1:10,T(I)) A(I)=I
              1
 Internal Error at (1):
 free_expr0(): Bad expr type

This patch does not fix the underlying issue that the PR raises.
The problem is that gfortran does not build an interface for the
contained function T(I) so that it can be checked whether it is
pure or not.

I intend to commit the attach patch sometime tomorrow.  One problem
at a time!


2006-01-15  Steven G. Kargl  <kargls@comcast.net>

	PR fortran/25072
	* match.c (match_forall_header): Fix internal error caused by bogus
	gfc_epxr pointers.

-- 
Steve
-------------- next part --------------
Index: match.c
===================================================================
--- match.c	(revision 109696)
+++ match.c	(working copy)
@@ -3346,12 +3346,13 @@ static match
 match_forall_header (gfc_forall_iterator ** phead, gfc_expr ** mask)
 {
   gfc_forall_iterator *head, *tail, *new;
+  gfc_expr *msk;
   match m;
 
   gfc_gobble_whitespace ();
 
   head = tail = NULL;
-  *mask = NULL;
+  msk = NULL;
 
   if (gfc_match_char ('(') != MATCH_YES)
     return MATCH_NO;
@@ -3372,6 +3373,7 @@ match_forall_header (gfc_forall_iterator
       m = match_forall_iterator (&new);
       if (m == MATCH_ERROR)
 	goto cleanup;
+
       if (m == MATCH_YES)
 	{
 	  tail->next = new;
@@ -3381,7 +3383,7 @@ match_forall_header (gfc_forall_iterator
 
       /* Have to have a mask expression */
 
-      m = gfc_match_expr (mask);
+      m = gfc_match_expr (&msk);
       if (m == MATCH_NO)
 	goto syntax;
       if (m == MATCH_ERROR)
@@ -3394,13 +3396,14 @@ match_forall_header (gfc_forall_iterator
     goto syntax;
 
   *phead = head;
+  *mask = msk;
   return MATCH_YES;
 
 syntax:
   gfc_syntax_error (ST_FORALL);
 
 cleanup:
-  gfc_free_expr (*mask);
+  gfc_free_expr (msk);
   gfc_free_forall_iterator (head);
 
   return MATCH_ERROR;