Fortran/OpenMP: Fix strictly structured blocks parsing

Message ID df662940-94b2-1b68-9884-b75cde55d385@codesourcery.com
State New, archived
Headers
Series Fortran/OpenMP: Fix strictly structured blocks parsing |

Commit Message

Tobias Burnus Aug. 24, 2022, 5:47 p.m. UTC
  This patch is about error diagnostic + an ICE for invalid code.

Before the patch, gfortran/f951 showed:

...
Error: 'ancestor' device modifier not preceded by 'requires' directive with 'reverse_offload' clause
   18 | end block
      |   1
Error: Expecting END PROGRAM statement at (1)
gfortran: internal compiler error: Segmentation fault signal terminated program f951

* The first error is for a user error and fine.
* A follow-up error is expected (due to the now dangling '!$omp end target'),
  but the error location and wording is misleading
* And the ICE is plainly wrong.


With the patch, there is no ICE and the the second error reads:

   16 |   !$omp end target
Error: Unexpected !$OMP END TARGET statement at (1)


The problem was due to nesting '!$omp target' (= same directive),
where the outer one was a strictly structured block - and parsing
the inner '!$omp target' failed with MATCH_ERROR, which ignored that
line - while '!$omp end target' remained.

(So far, so good, but then the parsing-code did run into a bug.)

For the blocks, the following applies. OpenMP permits either
* strictly structured blocks (with optional END_ST == 'end target')
  !$omp target
    block
      ...
    end block
  !$omp end target  ! << this line is optional
* loosely structured block
  !$omp target
     ... ! may not start with 'block' (and hence cannot end with 'end block')
  !$omp end target  ! << required


The parsing issue is in the following code,
which first takes care of the 'strictly':  'end block' + optional 'end target'
and then of the 'loosely structured' case with just:  'end target':

      else if (block_construct && st == ST_END_BLOCK)
        ...
          st = next_statement ();
          if (st == omp_end_st)
              accept_statement (st);
        ...
      else if (st != omp_end_st)
        {
          unexpected_statement (st);
          st = next_statement ();
        }

The fix is to change the second if condition to:
      else if (st != omp_end_st || (block_construct && st == omp_end_st))

or rather to the following equivalent code:
      else if (st != omp_end_st || block_construct)


OK for mainline and GCC 12?*

Tobias

*strictly structured blocks were added in r12-4592.


-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
  

Comments

Harald Anlauf Aug. 24, 2022, 6:50 p.m. UTC | #1
Hi Tobias,

Am 24.08.22 um 19:47 schrieb Tobias Burnus:
> This patch is about error diagnostic + an ICE for invalid code.
[...]
> (So far, so good, but then the parsing-code did run into a bug.)
>
> For the blocks, the following applies. OpenMP permits either
> * strictly structured blocks (with optional END_ST == 'end target')
>   !$omp target
>     block
>       ...
>     end block
>   !$omp end target  ! << this line is optional
> * loosely structured block
>   !$omp target
>      ... ! may not start with 'block' (and hence cannot end with 'end
> block')
>   !$omp end target  ! << required
>
>
> The parsing issue is in the following code,
> which first takes care of the 'strictly':  'end block' + optional 'end
> target'
> and then of the 'loosely structured' case with just:  'end target':
>
>       else if (block_construct && st == ST_END_BLOCK)
>         ...
>           st = next_statement ();
>           if (st == omp_end_st)
>               accept_statement (st);
>         ...
>       else if (st != omp_end_st)
>         {
>           unexpected_statement (st);
>           st = next_statement ();
>         }
>
> The fix is to change the second if condition to:
>       else if (st != omp_end_st || (block_construct && st == omp_end_st))
>
> or rather to the following equivalent code:
>       else if (st != omp_end_st || block_construct)

LGTM.

> OK for mainline and GCC 12?*

Yes for both.

Thanks for the patch!

Harald

> Tobias
>
> *strictly structured blocks were added in r12-4592.
>
>
> -----------------
> Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201,
> 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer:
> Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München;
> Registergericht München, HRB 106955
  

Patch

Fortran/OpenMP: Fix strictly structured blocks parsing

gcc/fortran/ChangeLog:

	* parse.cc (parse_omp_structured_block): When parsin strictly
	structured blocks, issue an error if the end-directive comes
	before the 'end block'.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/strictly-structured-block-4.f90: New test.

 gcc/fortran/parse.cc                                |  2 +-
 .../gomp/strictly-structured-block-4.f90            | 21 +++++++++++++++++++++
 2 files changed, 22 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 0b4c596996c..80492c952aa 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -5709,7 +5709,7 @@  parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
 	    }
 	  return st;
 	}
-      else if (st != omp_end_st)
+      else if (st != omp_end_st || block_construct)
 	{
 	  unexpected_statement (st);
 	  st = next_statement ();
diff --git a/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-4.f90 b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-4.f90
new file mode 100644
index 00000000000..66cf0a3925e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-4.f90
@@ -0,0 +1,21 @@ 
+! { dg-do compile }
+implicit none
+integer ::x,z
+x = 42
+print '(*(z16:" "))', loc(x)
+!$omp target map(x, z)
+block
+  integer :: y
+  x = 123
+  y = 99
+  !$omp target device(ancestor:1) map(always,tofrom:x) map(y) ! { dg-error "'ancestor' device modifier not preceded by 'requires' directive with 'reverse_offload' clause" }
+    print '(*(z16:" "))', loc(x), loc(y)
+    print * ,x, y
+    x = -x
+    y = -y
+  !$omp end target ! { dg-error "Unexpected ..OMP END TARGET statement" }
+  z = y
+end block
+    print * ,x !, z
+end
+