I think the example is valid. ifort and sunf95 accept it.

Sorry. Of course the code is *not* valid. Section 1.2.2 of the OpenMP 3.0 specification says: "The point of exit cannot be a branch out of the structured block."

Also, an analogous example in C is correctly rejected:

void sub ()
{
  int nRead;
  #pragma omp critical
  if (nRead<3) return;
}


In function ‘sub’:
error: invalid branch to/from an OpenMP structured block


So, I guess it is a problem of the Fortran front-end, which should detect this situation and reject the code.

There is a pass 'diagnose_omp_blocks', which generates the error message for the C code. Its execution function is 'diagnose_omp_structured_block_errors' in omp-low.x, which is correctly called also for Fortran code. However, the checks in 'diagnose_sb_0' and 'diagnose_sb_2' don't seem to work for the Fortran test case.

For the C code in comment #2, the GIMPLE_RETURN branch in diagnose_sb_2 is in effect and calls diagnose_sb_0, which throws the errror. For the Fortran case this does not work, since the RETURN is translated to a GOTO. However, GOTOs jumping out of an OMP CRITICAL section should also be rejected. (I still don't see where things go wrong.)

Here are test cases in Fortran and C, which both use GOTOs. Again, the Fortran code ICEs, while the C code gives an error message:


  subroutine sub
    integer :: nRead
    !$omp critical
    if (nRead<3) goto 100
    !$omp end critical
100 nRead=4
  end subroutine


void sub ()
{
  int nRead;
  #pragma omp critical
  if (nRead<3) goto out;
out: nRead=4;
}

For the Fortran test case in comment #4, diagnose_sb_2 (omp-low.c) is called six times, with the following statements:

* GIMPLE_BIND
* GIMPLE_OMP_CRITICAL
* GIMPLE_COND
* GIMPLE_LABEL
* GIMPLE_LABEL
* GIMPLE_ASSIGN

For the C case, it is called eight times:

* GIMPLE_BIND
* GIMPLE_OMP_CRITICAL
* GIMPLE_COND
* GIMPLE_LABEL
* GIMPLE_GOTO
* GIMPLE_LABEL
* GIMPLE_LABEL
* GIMPLE_ASSIGN

The question is why GIMPLE_GOTO is missing for the Fortran case?!?

One more observation: The Fortran test case works, with return as well as goto, giving the correct error message, if one removes the 'if' statement:

  subroutine sub
    !$omp critical
    return
    !$omp end critical
  end subroutine

"error: invalid branch to/from an OpenMP structured block"

Interestingly, the test case also works when using an 'if ... then ... end if' instead of a simple 'if':

  subroutine sub
    integer :: nRead
    !$omp critical
    if (nRead<3) then
      goto 100
    end if
    !$omp end critical
100 nRead=4
  end subroutine

The reason for the failure of comment #0 and #4 is that these cases run into the following optimization in gimplify_cond_expr (gimplify.c):

  if (TREE_OPERAND (expr, 1) != NULL
      && TREE_CODE (TREE_OPERAND (expr, 1)) == GOTO_EXPR
      && TREE_CODE (GOTO_DESTINATION (TREE_OPERAND (expr, 1))) == LABEL_DECL
      && (DECL_CONTEXT (GOTO_DESTINATION (TREE_OPERAND (expr, 1)))
	  == current_function_decl)
      /* For -O0 avoid this optimization if the COND_EXPR and GOTO_EXPR
	 have different locations, otherwise we end up with incorrect
	 location information on the branches.  */
      && (optimize
	  || !EXPR_HAS_LOCATION (expr)
	  || !EXPR_HAS_LOCATION (TREE_OPERAND (expr, 1))
	  || EXPR_LOCATION (expr) == EXPR_LOCATION (TREE_OPERAND (expr, 1))))
    {
      label_true = GOTO_DESTINATION (TREE_OPERAND (expr, 1));
      have_then_clause_p = true;
    }

Note that one only runs into this, if the locations of the IF condition and the THEN clause are the same, which is the case for the simple IF in Fortran, but not for IF...THEN...END IF statements. In C, the locations always seem to be different, also for the simple one-lined case.

So, I guess the solution is to apply different locations to the simple IF statement in Fortran.

Here is a patch which fixes the ICE, and gives the correct error messages:


Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c (revision 155304)
+++ gcc/fortran/trans.c (working copy)
@@ -1043,7 +1043,9 @@ void
 gfc_set_backend_locus (locus * loc)
 {
   gfc_current_backend_file = loc->lb->file;
-  input_location = loc->lb->location;
+  /* 'loc->lb->location' only gives the location of the start of the line,
+     so we add the column number here.  */
+  input_location = loc->lb->location + loc->nextc - loc->lb->line;
 }


Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 155304)
+++ gcc/fortran/match.c (working copy)
@@ -1602,7 +1602,7 @@ got_match:
   p = gfc_get_code ();
   p->next = gfc_get_code ();
   *p->next = new_st;
-  p->next->loc = gfc_current_locus;
+  p->next->loc = old_loc2;

   p->expr1 = expr;
   p->op = EXEC_IF;

*** This bug has been marked as a duplicate of 41344 ***