[Patch, Fortran] PR fortran/41403: Fix miscompilation of assigned goto

[Daniel Kraft <d at domob dot eu>]

Hi all,

the attached patch fixes PR 41403 which is about miscompilation of
assigned goto statements.  It's one of the two remaining gfortran
regressions that Tobias mentioned in his recent post, so only one (about
inefficient zero'ing) remains.

Assigned goto has the form:

GOTO variable [, label-list]

with an optional label-list.  If the list is present, the label assigned
to variable must be one of its elements; so the list does not really
change the semantics for already valid code (it is only a further
restriction that could be checked at run-time or maybe used to output
simpler code).

The existing implementation of assigned goto with label-list was to
compare label-addresses, which may fail with optimization as Richard
pointed out in the PR.  If no label-list is present, this comparison
does not happen and the stored label-address is simply jumped to, which
should be ok in any case.

This patch is somewhat a "bogus solution" in that I simply disregard a
label-list after parsing and syntax checking.  As I understand assigned
goto and pointed out above, this does not change the semantics of the
statement for valid code, and it gets rid of the fragile label address
comparison and fixes the PR thus.

The side-effect is that there's no longer a runtime error if a label is
targetted that does not appear in the list; I could add an additional
runtime check here, but as this is a legacy feature and the check would
also add a runtime-overhead, I think it should be ok to just go without
it.  BTW, the generated code is slightly simpler now than before,
because we just jump to the saved address without a series of
if-constructs that was generated before.  Do you think it is ok to
simply get rid of the check?

As a side-note:  It seems to me that we could maybe implement assigned
goto in some cleaner and better way overall if we want (if we want to
re-inforce the runtime check for a correct label-list, we would have to
do some refactoring here for a solid implementation).  Additionally,
computed goto is currently done as a switch but could be implemented
with an array as in Richard's comment in the PR.  But as both of them
are somewhat questionable legacy features, I don't think it will be of
much use to do so.

So in my opinion this patch is what we should do, rather than some
substantial rework of the implementation of these legacy gotos (that are
a deleted feature in Fortran 95).  But if you don't agree on this, I've
some ideas and volunteer to do the goto rework otherwise.

No regressions on GNU/Linux-x86-32.  Ok for trunk and 4.4 (and 4.3?)
after some delay?  (And of course after trunk is re-opened.)  The most
reduced test-case is added to the test-suite with my patch, the original
NIST test as well as the other reduced code both succeed with my patch
(and optimization).

Yours,
Daniel

--
Done:  Arc-Bar-Cav-Ran-Rog-Sam-Tou-Val-Wiz
To go: Hea-Kni-Mon-Pri





2009-10-03  Daniel Kraft  <d@domob.eu>

	PR fortran/41403
	* match.c (gfc_match_goto): Only parse statement label list in
	assigned goto but disregard it.
	* trans-stmt.c (gfc_trans_goto): No need to handle statement label list
	in assigned goto any more.

2009-10-03  Daniel Kraft  <d@domob.eu>

	PR fortran/41403
	* gfortran.dg/goto_6.f: New test.





Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(revision 152407)
+++ gcc/fortran/trans-stmt.c	(working copy)
@@ -159,31 +159,13 @@ gfc_trans_goto (gfc_code * code)
 
   assigned_goto = GFC_DECL_ASSIGN_ADDR (se.expr);
 
-  code = code->block;
-  if (code == NULL)
-    {
-      target = fold_build1 (GOTO_EXPR, void_type_node, assigned_goto);
-      gfc_add_expr_to_block (&se.pre, target);
-      return gfc_finish_block (&se.pre);
-    }
-
-  /* Check the label list.  */
-  do
-    {
-      target = gfc_get_label_decl (code->label1);
-      tmp = gfc_build_addr_expr (pvoid_type_node, target);
-      tmp = fold_build2 (EQ_EXPR, boolean_type_node, tmp, assigned_goto);
-      tmp = build3_v (COND_EXPR, tmp,
-		      fold_build1 (GOTO_EXPR, void_type_node, target),
-		      build_empty_stmt (input_location));
-      gfc_add_expr_to_block (&se.pre, tmp);
-      code = code->block;
-    }
-  while (code != NULL);
-  gfc_trans_runtime_check (true, false, boolean_true_node, &se.pre, &loc,
-			   "Assigned label is not in the list");
+  /* There shouldn't be a label list as this is stripped away by the parser
+     as unnecessary information.  */
+  gcc_assert (!code->block);
 
-  return gfc_finish_block (&se.pre); 
+  target = fold_build1 (GOTO_EXPR, void_type_node, assigned_goto);
+  gfc_add_expr_to_block (&se.pre, target);
+  return gfc_finish_block (&se.pre);
 }
 
 
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 152407)
+++ gcc/fortran/match.c	(working copy)
@@ -2097,6 +2097,8 @@ gfc_match_goto (void)
 
   /* The assigned GO TO statement.  */ 
 
+  head = tail = NULL;
+
   if (gfc_match_variable (&expr, 0) == MATCH_YES)
     {
       if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: Assigned GOTO "
@@ -2106,18 +2108,24 @@ gfc_match_goto (void)
 
       new_st.op = EXEC_GOTO;
       new_st.expr1 = expr;
+      new_st.block = NULL;
 
       if (gfc_match_eos () == MATCH_YES)
 	return MATCH_YES;
 
-      /* Match label list.  */
+      /* Match label list.
+	 We match it and check for syntax errors, but the list itself is simply
+	 disregarded as it does not really change the semantics except that
+	 we could check for an assigned label not in the list for an additional
+	 runtime-error on invalid code.  As this is a legacy feature, I think
+	 we can go without it to simplify handling here.  */
+
       gfc_match_char (',');
       if (gfc_match_char ('(') != MATCH_YES)
 	{
 	  gfc_syntax_error (ST_GOTO);
 	  return MATCH_ERROR;
 	}
-      head = tail = NULL;
 
       do
 	{
@@ -2128,29 +2136,15 @@ gfc_match_goto (void)
 	  if (gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
 	    goto cleanup;
 
-	  if (head == NULL)
-	    head = tail = gfc_get_code ();
-	  else
-	    {
-	      tail->block = gfc_get_code ();
-	      tail = tail->block;
-	    }
-
-	  tail->label1 = label;
-	  tail->op = EXEC_GOTO;
+	  /* We don't need to free the label as it is created and referenced
+	     elsewhere and just an additional pointer gets returned
+	     from gfc_match_st_label.  */
 	}
       while (gfc_match_char (',') == MATCH_YES);
 
       if (gfc_match (")%t") != MATCH_YES)
 	goto syntax;
 
-      if (head == NULL)
-	{
-	   gfc_error ("Statement label list in GOTO at %C cannot be empty");
-	   goto syntax;
-	}
-      new_st.block = head;
-
       return MATCH_YES;
     }
 
@@ -2161,7 +2155,6 @@ gfc_match_goto (void)
       return MATCH_ERROR;
     }
 
-  head = tail = NULL;
   i = 1;
 
   do
Index: gcc/testsuite/gfortran.dg/goto_6.f
===================================================================
--- gcc/testsuite/gfortran.dg/goto_6.f	(revision 0)
+++ gcc/testsuite/gfortran.dg/goto_6.f	(revision 0)
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-options "-w" }
+
+! PR fortran/41403
+! Assigned-goto with label list used to compare label addresses which
+! failed with optimization.  Check this works correctly now.
+! This is the most reduced Fortran code from the PR.
+
+      IVFAIL=0
+      ASSIGN 1263 TO I
+      GO TO I, (1262,1263,1264)
+ 1262 ICON01 = 1262
+      GO TO 1265
+ 1263 ICON01 = 1263
+      GO TO 1265
+ 1264 ICON01 = 1264
+ 1265 CONTINUE
+41260 IF ( ICON01 - 1263 )  21260, 11260, 21260
+11260 IVPASS = IVPASS + 1
+      GO TO 1271
+21260 IVFAIL = IVFAIL + 1
+ 1271 CONTINUE
+      IF (IVFAIL /= 0) CALL abort ()
+      END