This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

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


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" } }

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]