diff mbox

[fortran] PR fortran/50071 Duplicate statement labels from different scoping units rejected.

Message ID 201108161649.25326.mikael.morin@sfr.fr
State New
Headers show

Commit Message

Mikael Morin Aug. 16, 2011, 2:49 p.m. UTC 
On Sunday 14 August 2011 09:35:56 Tobias Burnus wrote:
> I think the following is valid and it is still rejected (it is accepted
> by NAG 5.1 and ifort):
> 
> 1 type t
>      integer :: i
>    end type t
> 
>    goto 1
> 1 print *, 'Hello'
> end
> 
> Related but separate issue: BLOCK also starts a new scoping unit, but
> the following is rejected:
> 
>     block
>       goto 1
>       print *, 'Hello'
> 1    continue
>     end block
> 1  continue
> end
> 
> 
> Also the following is rejected:
> 
>     block
>       goto 1
>       print *, 'Hello'
> 1  end block
> end
> 
> variant, which is rejected (note: Associate does not start a new scoping
> unit, just a new block):
> 
>    integer :: i
>    associate (j => i)
>      goto 1
>      print *, 'Hello'
> 1  end associate
> end
> 
Hem, OK; it is a can of Pandora.

I can propose the following ad-hoc fix for the two latter cases.

It uses the same hack as is used for IF, SELECT, and possibly others:
make a dummy code that will get the label.
The difference is that here, the dummy code is inserted in the nested scope 
(i.e. in the BLOCK or ASSOCIATE scope) instead of the parent one.

For consistency, I renamed EXEC_END_BLOCK to EXEC_END_NESTED_BLOCK, and reused 
EXEC_END_BLOCK for the new code.


The patch passes gfortran.dg/*goto* and gfortran.dg/*label*, and I'm doing a 
full regression test. Is that OK?



About your two former cases, the first one looks especially tricky. For the 
second one, it may be valid, but a warning would be nice IMO as one of the 
labels is masked by the other. Both cases need more investigation anyway.

Mikael.
2011-08-16  Mikael Morin  <mikael.morin@sfr.fr>

	PR fortran/50071
	* gfortran.h (gfc_exec_op): New constant EXEC_END_NESTED_BLOCK.
	* parse.c (check_statement_label): Accept ST_END_BLOCK and
	ST_END_ASSOCIATE as valid branch target.
	(accept_statement): Change EXEC_END_BLOCK to EXEC_END_NESTED_BLOCK.
	Add EXEC_END_BLOCK code in the ST_END_BLOCK and ST_END_ASSOCIATE cases.
	* resolve.c (find_reachable_labels): Change EXEC_END_BLOCK to
	EXEC_END_NESTED_BLOCK.
	(resolve_branch): Ditto.
	(resolve_code): Add EXEC_END_NESTED_BLOCK case.
	* st.c (gfc_free_statement): Ditto.
	* trans.c (trans_code): Ditto.

Comments

Tobias Burnus Aug. 16, 2011, 10:05 p.m. UTC | #1 
Mikael Morin wrote:
> On Sunday 14 August 2011 09:35:56 Tobias Burnus wrote:
[Four examples which were still mishandled]

> Hem, OK; it is a can of Pandora.

Sorry for opening it a bit more.

> I can propose the following ad-hoc fix for the two latter cases.
>
> The patch passes gfortran.dg/*goto* and gfortran.dg/*label*, and I'm doing a
> full regression test. Is that OK?

That's OK with test cases (original issue plus the two newly fixed 
ones). Nit: You have a missing tab at:

+      /* In the case of BLOCK and ASSOCIATE blocks, there cannot be more than
+         one parallel block.  Thus, we add the special code to the nested block
+	 itself, instead of the parent one.  */


Thanks for the patch!

> About your two former cases, the first one looks especially tricky. For the
> second one, it may be valid, but a warning would be nice IMO as one of the
> labels is masked by the other. Both cases need more investigation anyway.

I think those could be deferred. - If you don't work on them, one should 
fill a PR to make sure they do not get forgotten.

Tobias
diff mbox

Patch

diff --git a/gfortran.h b/gfortran.h
index 34afae4..bbccc08 100644
--- a/gfortran.h
+++ b/gfortran.h
@@ -2048,8 +2048,8 @@  gfc_association_list;
 /* Executable statements that fill gfc_code structures.  */
 typedef enum
 {
-  EXEC_NOP = 1, EXEC_END_BLOCK, EXEC_ASSIGN, EXEC_LABEL_ASSIGN,
-  EXEC_POINTER_ASSIGN, EXEC_CRITICAL, EXEC_ERROR_STOP,
+  EXEC_NOP = 1, EXEC_END_NESTED_BLOCK, EXEC_END_BLOCK, EXEC_ASSIGN,
+  EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN, EXEC_CRITICAL, EXEC_ERROR_STOP,
   EXEC_GOTO, EXEC_CALL, EXEC_COMPCALL, EXEC_ASSIGN_CALL, EXEC_RETURN,
   EXEC_ENTRY, EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN,
   EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT, EXEC_BLOCK,
diff --git a/parse.c b/parse.c
index 2910ab5..b894ee8 100644
--- a/parse.c
+++ b/parse.c
@@ -1115,6 +1115,8 @@  check_statement_label (gfc_statement st)
     case ST_ENDIF:
     case ST_END_SELECT:
     case ST_END_CRITICAL:
+    case ST_END_BLOCK:
+    case ST_END_ASSOCIATE:
     case_executable:
     case_exec_markers:
       type = ST_LABEL_TARGET;
@@ -1627,6 +1629,18 @@  accept_statement (gfc_statement st)
     case ST_END_CRITICAL:
       if (gfc_statement_label != NULL)
 	{
+	  new_st.op = EXEC_END_NESTED_BLOCK;
+	  add_statement ();
+	}
+      break;
+
+      /* In the case of BLOCK and ASSOCIATE blocks, there cannot be more than
+         one parallel block.  Thus, we add the special code to the nested block
+	 itself, instead of the parent one.  */
+    case ST_END_BLOCK:
+    case ST_END_ASSOCIATE:
+      if (gfc_statement_label != NULL)
+	{
 	  new_st.op = EXEC_END_BLOCK;
 	  add_statement ();
 	}
diff --git a/resolve.c b/resolve.c
index b8a8ebb..fcb5083 100644
--- a/resolve.c
+++ b/resolve.c
@@ -8202,7 +8202,7 @@  find_reachable_labels (gfc_code *block)
      up through the code_stack.  */
   for (c = block; c; c = c->next)
     {
-      if (c->here && c->op != EXEC_END_BLOCK)
+      if (c->here && c->op != EXEC_END_NESTED_BLOCK)
 	bitmap_set_bit (cs_base->reachable_labels, c->here->value);
     }
 
@@ -8382,7 +8382,7 @@  resolve_branch (gfc_st_label *label, gfc_code *code)
 
   if (stack)
     {
-      gcc_assert (stack->current->next->op == EXEC_END_BLOCK);
+      gcc_assert (stack->current->next->op == EXEC_END_NESTED_BLOCK);
       return;
     }
 
@@ -9118,6 +9118,7 @@  resolve_code (gfc_code *code, gfc_namespace *ns)
 	{
 	case EXEC_NOP:
 	case EXEC_END_BLOCK:
+	case EXEC_END_NESTED_BLOCK:
 	case EXEC_CYCLE:
 	case EXEC_PAUSE:
 	case EXEC_STOP:
diff --git a/st.c b/st.c
index c051d6a..572baaf 100644
--- a/st.c
+++ b/st.c
@@ -89,6 +89,7 @@  gfc_free_statement (gfc_code *p)
     {
     case EXEC_NOP:
     case EXEC_END_BLOCK:
+    case EXEC_END_NESTED_BLOCK:
     case EXEC_ASSIGN:
     case EXEC_INIT_ASSIGN:
     case EXEC_GOTO:
diff --git a/trans.c b/trans.c
index 4c97cfd..4a71c43 100644
--- a/trans.c
+++ b/trans.c
@@ -1188,6 +1188,7 @@  trans_code (gfc_code * code, tree cond)
 	{
 	case EXEC_NOP:
 	case EXEC_END_BLOCK:
+	case EXEC_END_NESTED_BLOCK:
 	case EXEC_END_PROCEDURE:
 	  res = NULL_TREE;
 	  break;