public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH, OpenMP 5.1, Fortran] Strictly-structured block support for OpenMP directives
@ 2021-10-07 13:59 Chung-Lin Tang
  2021-10-07 16:33 ` Tobias Burnus
  2021-10-07 17:09 ` Jakub Jelinek
  0 siblings, 2 replies; 12+ messages in thread
From: Chung-Lin Tang @ 2021-10-07 13:59 UTC (permalink / raw)
  To: gcc-patches, Fortran List, Tobias Burnus, Catherine Moore, Jakub Jelinek

[-- Attachment #1: Type: text/plain, Size: 1587 bytes --]

Hi all,
this patch add support for "strictly-structured blocks" introduced in OpenMP 5.1,
basically allowing BLOCK constructs to serve as the body for directives:

!$omp target
block
   ...
end block
[!$omp end target]  !! end directive is optional

!$omp parallel
block
   ...
end block
...
!$omp end parallel  !! error, considered as not match to above parallel directive

The parsing loop in parse_omp_structured_block() has been modified to allow
a BLOCK construct after the first statement has been detected to be ST_BLOCK.
This is done by a hard modification of the state into (the new) COMP_OMP_STRICTLY_STRUCTURED_BLOCK
after the statement is known (I'm not sure if there's a way to 'peek' the next
statement/token in the Fortran FE, open to suggestions on how to better write this)

Tested with no regressions on trunk, is this okay to commit?

Thanks,
Chung-Lin

2021-10-07  Chung-Lin Tang  <cltang@codesourcery.com>

gcc/fortran/ChangeLog:

	* decl.c (gfc_match_end): Add COMP_OMP_STRICTLY_STRUCTURED_BLOCK case
	together with COMP_BLOCK.
	* parse.c (parse_omp_structured_block): Adjust declaration, add
	'bool strictly_structured_block' default true parameter, add handling
	for strictly-structured block case, adjust recursive calls to
	parse_omp_structured_block.
	(parse_executable): Adjust calls to parse_omp_structured_block.
	* parse.h (enum gfc_compile_state): Add
	COMP_OMP_STRICTLY_STRUCTURED_BLOCK.
	* trans-openmp.c (gfc_trans_omp_workshare): Add EXEC_BLOCK case
	handling.

gcc/testsuite/ChangeLog:

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

[-- Attachment #2: fortran-omp51-strictly-structured-block.patch --]
[-- Type: text/plain, Size: 11179 bytes --]

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index b3c65b7175b..ff66d1f9475 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -8445,6 +8445,7 @@ gfc_match_end (gfc_statement *st)
       break;
 
     case COMP_BLOCK:
+    case COMP_OMP_STRICTLY_STRUCTURED_BLOCK:
       *st = ST_END_BLOCK;
       target = " block";
       eos_ok = 0;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 7d765a0866d..d78bf9b8fa5 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -5451,8 +5451,9 @@ parse_oacc_loop (gfc_statement acc_st)
 
 /* Parse the statements of an OpenMP structured block.  */
 
-static void
-parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
+static gfc_statement
+parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only,
+			    bool strictly_structured_block = true)
 {
   gfc_statement st, omp_end_st;
   gfc_code *cp, *np;
@@ -5538,6 +5539,32 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
       gcc_unreachable ();
     }
 
+  bool block_construct = false;
+  gfc_namespace* my_ns = NULL;
+  gfc_namespace* my_parent = NULL;
+
+  st = next_statement ();
+
+  if (strictly_structured_block && st == ST_BLOCK)
+    {
+      /* Adjust state to a strictly-structured block, now that we found that
+	 the body starts with a BLOCK construct.  */
+      s.state = COMP_OMP_STRICTLY_STRUCTURED_BLOCK;
+
+      block_construct = true;
+      gfc_notify_std (GFC_STD_F2008, "BLOCK construct at %C");
+
+      my_ns = gfc_build_block_ns (gfc_current_ns);
+      gfc_current_ns = my_ns;
+      my_parent = my_ns->parent;
+
+      new_st.op = EXEC_BLOCK;
+      new_st.ext.block.ns = my_ns;
+      new_st.ext.block.assoc = NULL;
+      accept_statement (ST_BLOCK);
+      st = parse_spec (ST_NONE);
+    }
+
   do
     {
       if (workshare_stmts_only)
@@ -5554,7 +5581,6 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
 	     restrictions apply recursively.  */
 	  bool cycle = true;
 
-	  st = next_statement ();
 	  for (;;)
 	    {
 	      switch (st)
@@ -5576,17 +5602,20 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
 		  parse_forall_block ();
 		  break;
 
+		case ST_OMP_PARALLEL_SECTIONS:
+		  st = parse_omp_structured_block (st, false, false);
+		  continue;
+
 		case ST_OMP_PARALLEL:
 		case ST_OMP_PARALLEL_MASKED:
 		case ST_OMP_PARALLEL_MASTER:
-		case ST_OMP_PARALLEL_SECTIONS:
-		  parse_omp_structured_block (st, false);
-		  break;
+		  st = parse_omp_structured_block (st, false);
+		  continue;
 
 		case ST_OMP_PARALLEL_WORKSHARE:
 		case ST_OMP_CRITICAL:
-		  parse_omp_structured_block (st, true);
-		  break;
+		  st = parse_omp_structured_block (st, true);
+		  continue;
 
 		case ST_OMP_PARALLEL_DO:
 		case ST_OMP_PARALLEL_DO_SIMD:
@@ -5609,7 +5638,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
 	    }
 	}
       else
-	st = parse_executable (ST_NONE);
+	st = parse_executable (st);
       if (st == ST_NONE)
 	unexpected_eof ();
       else if (st == ST_OMP_SECTION
@@ -5619,9 +5648,27 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
 	  np = new_level (np);
 	  np->op = cp->op;
 	  np->block = NULL;
+	  st = next_statement ();
+	}
+      else if (block_construct && st == ST_END_BLOCK)
+	{
+	  accept_statement (st);
+	  gfc_current_ns = my_parent;
+	  pop_state ();
+
+	  st = next_statement ();
+	  if (st == omp_end_st)
+	    {
+	      accept_statement (st);
+	      st = next_statement ();
+	    }
+	  return st;
 	}
       else if (st != omp_end_st)
-	unexpected_statement (st);
+	{
+	  unexpected_statement (st);
+	  st = next_statement ();
+	}
     }
   while (st != omp_end_st);
 
@@ -5657,6 +5704,8 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
   gfc_commit_symbols ();
   gfc_warning_check ();
   pop_state ();
+  st = next_statement ();
+  return st;
 }
 
 
@@ -5779,16 +5828,19 @@ parse_executable (gfc_statement st)
 	  parse_oacc_structured_block (st);
 	  break;
 
+	case ST_OMP_PARALLEL_SECTIONS:
+	case ST_OMP_SECTIONS:
+	  st = parse_omp_structured_block (st, false, false);
+	  continue;
+
 	case ST_OMP_PARALLEL:
 	case ST_OMP_PARALLEL_MASKED:
 	case ST_OMP_PARALLEL_MASTER:
-	case ST_OMP_PARALLEL_SECTIONS:
 	case ST_OMP_ORDERED:
 	case ST_OMP_CRITICAL:
 	case ST_OMP_MASKED:
 	case ST_OMP_MASTER:
 	case ST_OMP_SCOPE:
-	case ST_OMP_SECTIONS:
 	case ST_OMP_SINGLE:
 	case ST_OMP_TARGET:
 	case ST_OMP_TARGET_DATA:
@@ -5797,13 +5849,13 @@ parse_executable (gfc_statement st)
 	case ST_OMP_TEAMS:
 	case ST_OMP_TASK:
 	case ST_OMP_TASKGROUP:
-	  parse_omp_structured_block (st, false);
-	  break;
+	  st = parse_omp_structured_block (st, false);
+	  continue;
 
 	case ST_OMP_WORKSHARE:
 	case ST_OMP_PARALLEL_WORKSHARE:
-	  parse_omp_structured_block (st, true);
-	  break;
+	  st = parse_omp_structured_block (st, true);
+	  continue;
 
 	case ST_OMP_DISTRIBUTE:
 	case ST_OMP_DISTRIBUTE_PARALLEL_DO:
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index 55f02299304..66b275de89b 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -31,7 +31,7 @@ enum gfc_compile_state
   COMP_STRUCTURE, COMP_UNION, COMP_MAP,
   COMP_DO, COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM,
   COMP_SELECT_TYPE, COMP_SELECT_RANK, COMP_OMP_STRUCTURED_BLOCK, COMP_CRITICAL,
-  COMP_DO_CONCURRENT
+  COMP_DO_CONCURRENT, COMP_OMP_STRICTLY_STRUCTURED_BLOCK
 };
 
 /* Stack element for the current compilation state.  These structures
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d234d1b070f..9fdea8c67fd 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -6993,7 +6993,11 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
 	  res = gfc_trans_omp_directive (code);
 	  ompws_flags = saved_ompws_flags;
 	  break;
-	
+
+	case EXEC_BLOCK:
+	  res = gfc_trans_block_construct (code);
+	  break;
+
 	default:
 	  gfc_internal_error ("gfc_trans_omp_workshare(): Bad statement code");
 	}
diff --git a/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-1.f90 b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-1.f90
new file mode 100644
index 00000000000..bc798c1c218
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-1.f90
@@ -0,0 +1,295 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program main
+  integer :: x
+
+  !$omp parallel
+  block
+    x = x + 1
+  end block
+
+  !$omp parallel
+  block
+    x = x + 1
+  end block
+  !$omp end parallel
+
+  !$omp parallel
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end parallel ! { dg-error "Unexpected !.OMP END PARALLEL statement" }
+
+  !$omp teams
+  block
+    x = x + 1
+  end block
+
+  !$omp teams
+  block
+    x = x + 1
+  end block
+  !$omp end teams
+
+  !$omp teams
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end teams ! { dg-error "Unexpected !.OMP END TEAMS statement" }
+
+  !$omp masked
+  block
+    x = x + 1
+  end block
+
+  !$omp masked
+  block
+    x = x + 1
+  end block
+  !$omp end masked
+
+  !$omp masked
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end masked ! { dg-error "Unexpected !.OMP END MASKED statement" }
+
+  !$omp scope
+  block
+    x = x + 1
+  end block
+
+  !$omp scope
+  block
+    x = x + 1
+  end block
+  !$omp end scope
+
+  !$omp scope
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end scope ! { dg-error "Unexpected !.OMP END SCOPE statement" }
+
+  !$omp single
+  block
+    x = x + 1
+  end block
+
+  !$omp single
+  block
+    x = x + 1
+  end block
+  !$omp end single
+
+  !$omp single
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end single ! { dg-error "Unexpected !.OMP END SINGLE statement" }
+
+  !$omp workshare
+  block
+    x = x + 1
+  end block
+
+  !$omp workshare
+  block
+    x = x + 1
+  end block
+  !$omp end workshare
+
+  !$omp workshare
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end workshare ! { dg-error "Unexpected !.OMP END WORKSHARE statement" }
+
+  !$omp task
+  block
+    x = x + 1
+  end block
+
+  !$omp task
+  block
+    x = x + 1
+  end block
+  !$omp end task
+
+  !$omp task
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end task ! { dg-error "Unexpected !.OMP END TASK statement" }
+
+  !$omp target data map(x)
+  block
+    x = x + 1
+  end block
+
+  !$omp target data map(x)
+  block
+    x = x + 1
+  end block
+  !$omp end target data
+
+  !$omp target data map(x)
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end target data ! { dg-error "Unexpected !.OMP END TARGET DATA statement" }
+
+  !$omp target
+  block
+    x = x + 1
+  end block
+
+  !$omp target
+  block
+    x = x + 1
+  end block
+  !$omp end target
+
+  !$omp target
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end target ! { dg-error "Unexpected !.OMP END TARGET statement" }
+
+  !$omp parallel workshare
+  block
+    x = x + 1
+  end block
+
+  !$omp parallel workshare
+  block
+    x = x + 1
+  end block
+  !$omp end parallel workshare
+
+  !$omp parallel workshare
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end parallel workshare ! { dg-error "Unexpected !.OMP END PARALLEL WORKSHARE statement" }
+
+  !$omp parallel masked
+  block
+    x = x + 1
+  end block
+
+  !$omp parallel masked
+  block
+    x = x + 1
+  end block
+  !$omp end parallel masked
+
+  !$omp parallel masked
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end parallel masked ! { dg-error "Unexpected !.OMP END PARALLEL MASKED statement" }
+
+  !$omp target parallel
+  block
+    x = x + 1
+  end block
+
+  !$omp target parallel
+  block
+    x = x + 1
+  end block
+  !$omp end target parallel
+
+  !$omp target parallel
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end target parallel ! { dg-error "Unexpected !.OMP END TARGET PARALLEL statement" }
+
+  !$omp target teams
+  block
+    x = x + 1
+  end block
+
+  !$omp target teams
+  block
+    x = x + 1
+  end block
+  !$omp end target teams
+
+  !$omp target teams
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end target teams ! { dg-error "Unexpected !.OMP END TARGET TEAMS statement" }
+
+  !$omp critical
+  block
+    x = x + 1
+  end block
+
+  !$omp critical
+  block
+    x = x + 1
+  end block
+  !$omp end critical
+
+  !$omp critical
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end critical ! { dg-error "Unexpected !.OMP END CRITICAL statement" }
+
+  !$omp taskgroup
+  block
+    x = x + 1
+  end block
+
+  !$omp taskgroup
+  block
+    x = x + 1
+  end block
+  !$omp end taskgroup
+
+  !$omp taskgroup
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end taskgroup ! { dg-error "Unexpected !.OMP END TASKGROUP statement" }
+
+  !$omp ordered
+  block
+    x = x + 1
+  end block
+
+  !$omp ordered
+  block
+    x = x + 1
+  end block
+  !$omp end ordered
+
+  !$omp ordered
+  block
+    x = x + 1
+  end block
+  x = x + 1
+  !$omp end ordered ! { dg-error "Unexpected !.OMP END ORDERED statement" }
+
+end program

^ permalink raw reply	[flat|nested] 12+ messages in thread
end of thread, other threads:[~2021-10-21  9:19 UTC | newest]

Thread overview: 12+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-10-07 13:59 [PATCH, OpenMP 5.1, Fortran] Strictly-structured block support for OpenMP directives Chung-Lin Tang
2021-10-07 16:33 ` Tobias Burnus
2021-10-07 17:09 ` Jakub Jelinek
2021-10-08 16:14   ` [PATCH] openmp: Add support for OpenMP 5.1 structured-block-sequences Jakub Jelinek
2021-10-14 10:20   ` [PATCH, OpenMP 5.1, Fortran] Strictly-structured block support for OpenMP directives Jakub Jelinek
2021-10-14 11:19     ` Jakub Jelinek
2021-10-15 18:44       ` Chung-Lin Tang
2021-10-15 19:02         ` Jakub Jelinek
2021-10-20 12:30           ` [PATCH, v2, OpenMP 5.2, " Chung-Lin Tang
2021-10-20 16:15             ` Jakub Jelinek
2021-10-21  7:00               ` Chung-Lin Tang
2021-10-21  9:19                 ` [committed] testsuite: Fix up gfortran.dg/gomp/strictly*.f90 testcases Jakub Jelinek

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).