Re: [patch, fortran] PR31306 ICE with implicit character variables

[Jerry DeLisle <jvdelisle at verizon dot net>]

Jerry DeLisle wrote:
> :ADDPATCH fortran:
>
> Hi all,
>
> The attached patch fixes this ICE by checking for a conflicting 
> attribute in the function argument to LEN().  There may be additional 
> checks that could be added here, but for now this resolves the 
> segmentation fault.
>
> Regression tested on x86-64-Gnu-linux.
>
> New test case provided.
>
> OK for trunk?

Here is an updated version of the patch and an additional test case to verify 
that gfortran does not reject it.

Regression tested on x86-64-Gnu-linux

OK to commit?

Jerry

Index: decl.c
===================================================================
--- decl.c	(revision 129496)
+++ decl.c	(working copy)
@@ -572,13 +572,39 @@ match_intent_spec (void)
 static match
 char_len_param_value (gfc_expr **expr)
 {
+  match m;
+
   if (gfc_match_char ('*') == MATCH_YES)
     {
       *expr = NULL;
       return MATCH_YES;
     }
 
-  return gfc_match_expr (expr);
+  m = gfc_match_expr (expr);
+  if (m == MATCH_YES && (*expr)->expr_type == EXPR_FUNCTION)
+    {
+      if ((*expr)->value.function.actual
+	  && (*expr)->value.function.actual->expr->symtree)
+	{
+	  gfc_expr *e;
+	  e = (*expr)->value.function.actual->expr;
+	  if (e->symtree->n.sym->attr.flavor == FL_PROCEDURE
+	      && e->expr_type == EXPR_VARIABLE)
+	    {
+	      if (e->symtree->n.sym->ts.type == BT_UNKNOWN)
+		goto syntax;
+	      if (e->symtree->n.sym->ts.type == BT_CHARACTER
+		  && e->symtree->n.sym->ts.cl
+		  && e->symtree->n.sym->ts.cl->length->ts.type == BT_UNKNOWN)
+	        goto syntax;
+	    }
+	}
+    }
+  return m;
+
+syntax:
+  gfc_error ("Conflict in attributes of function argument at %C");
+  return MATCH_ERROR;
 }
 
 

! { dg-do run }
! PR31306 ICE with implicit character variables
! Test case from PR and prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
module cyclic
 implicit none
 contains
   character(10) function ouch(x,y)
     implicit character(len(ouch)) (x)
     implicit character(len(x)+1) (y)
     intent(in) x,y
     integer i
     do i = 1, len(ouch)
        ouch(i:i) = achar(ieor(iachar(x(i:i)),iachar(y(i:i))))
     end do
   end function ouch
end module cyclic

program test
  use cyclic
  implicit none
  character(10) astr
  integer i
  write(astr,'(a)') ouch('YOW!      ','jerry      ')
  if (astr(1:5) /= "3*%SY") call abort
  do i=6,10
    if (astr(i:i) /= achar(0)) call abort
  end do    
end program test
! { dg-final { cleanup-modules "cyclic" } }