Re: [PATCH 6/7] openmp, fortran: Add Fortran support for parsing metadirectives

[Kwok Cheung Yeung <kcy@codesourcery.com>]

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

 > This patch implements metadirective parsing in the Fortran frontend.

This patch (to be applied on top of the current set of metadirective 
patches) implements a feature that was present in the C and C++ 
front-ends but not in Fortran - the early culling of metadirective 
variants that can be eliminated during parsing because their selectors 
are resolvable at parse-time and still do not match. This is more 
efficient, and allows code with nested metadirectives like this (which 
works on other compilers) to compile:

!$omp metadirective when (implementation={vendor("ibm")}: &
!$omp&  target teams distribute)
   !$omp metadirective when (implementation={vendor("gnu")}: parallel do)

This would currently fail because when parsing the body of the 'target 
teams distribute', the parser sees the metadirective when it is 
expecting a loop nest. If the vendor("ibm") is eliminated early though, 
it would just evaluate to '!$omp nothing' and the following 
metadirective would not be incorrect. This doesn't work for selectors 
such as 'arch' that would need to be deferred until later passes though.

As the selector matching code (omp_context_selector_matches in 
omp-general.cc) works on Generic trees, I have allowed for a limited 
translation from the GFortran AST form to tree form during parsing, 
skipping over things like expression translation that must be done later.

I have also fixed another FE issue with nested metadirectives, that 
occurs when you have something like:

program P
   !$omp metadirective
     !$omp metadirective
       !$omp metadirective
         <do statement>
end program P

When gfc_match_end is called after parsing the do statement, it needs to 
drop down multiple levels from the innermost metadirective state to that 
  of 'program P' in order to find the proper end type, and not just one 
level as it currently does.

Thanks

Kwok

[-- Attachment #2: 0001-openmp-Eliminate-non-matching-metadirective-variants.patch --]
[-- Type: text/plain, Size: 7909 bytes --]

From 5a7b109a014422a5b43e43669df1dc0d59e830cf Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Fri, 11 Feb 2022 11:20:18 +0000
Subject: [PATCH 1/2] openmp: Eliminate non-matching metadirective variants
 early in Fortran front-end

This patch checks during parsing if a metadirective selector is both
resolvable and non-matching - if so, it is removed from further
consideration.  This is both more efficient, and avoids spurious
syntax errors caused by considering combinations of selectors that
lead to invalid combinations of OpenMP directives, when that
combination would never arise in the first place.

This exposes another bug - when metadirectives that are not of the
begin-end variety are nested, we might have to drill up through
multiple layers of the state stack to reach the state for the
next statement.  This is now fixed.

2022-02-11  Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/
	* omp-general.cc (DELAY_METADIRECTIVES_AFTER_LTO): Check that cfun is
	non-null before derefencing.

	gcc/fortran/
	* decl.cc (gfc_match_end): Search for first previous state that is not
	COMP_OMP_METADIRECTIVE.
	* gfortran.h (gfc_skip_omp_metadirective_clause): Add prototype.
	* openmp.cc (match_omp_metadirective): Skip clause if
	result of gfc_skip_omp_metadirective_clause is true.
	* trans-openmp.cc (gfc_trans_omp_set_selector): Add argument and
	disable	expression conversion if false.
	(gfc_skip_omp_metadirective_clause): New.

	gcc/testsuite/
	* gfortran.dg/gomp/metadirective-8.f90: New.
---
 gcc/fortran/decl.cc                           | 21 +++++++++-
 gcc/fortran/gfortran.h                        |  4 ++
 gcc/fortran/openmp.cc                         |  7 +++-
 gcc/fortran/trans-openmp.cc                   | 38 ++++++++++++++-----
 gcc/omp-general.cc                            |  5 ++-
 .../gfortran.dg/gomp/metadirective-8.f90      | 22 +++++++++++
 6 files changed, 81 insertions(+), 16 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index e024e360c88..a77ac768175 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -8325,15 +8325,32 @@ gfc_match_end (gfc_statement *st)
 
     case COMP_CONTAINS:
     case COMP_DERIVED_CONTAINS:
-    case COMP_OMP_METADIRECTIVE:
     case COMP_OMP_BEGIN_METADIRECTIVE:
       state = gfc_state_stack->previous->state;
       block_name = gfc_state_stack->previous->sym == NULL
-		 ? NULL : gfc_state_stack->previous->sym->name;
+		   ? NULL : gfc_state_stack->previous->sym->name;
       abreviated_modproc_decl = gfc_state_stack->previous->sym
 		&& gfc_state_stack->previous->sym->abr_modproc_decl;
       break;
 
+    case COMP_OMP_METADIRECTIVE:
+      {
+	/* Metadirectives can be nested, so we need to drill down to the
+	   first state that is not COMP_OMP_METADIRECTIVE.  */
+	gfc_state_data *state_data = gfc_state_stack;
+
+	do
+	{
+	  state_data = state_data->previous;
+	  state = state_data->state;
+	  block_name = state_data->sym == NULL
+		       ? NULL : state_data->sym->name;
+	  abreviated_modproc_decl = state_data->sym
+		&& state_data->sym->abr_modproc_decl;
+	}
+	while (state == COMP_OMP_METADIRECTIVE);
+      }
+      break;
     default:
       break;
     }
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3d8c65ff1be..bdb4b0f6aa5 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3940,4 +3940,8 @@ bool gfc_is_reallocatable_lhs (gfc_expr *);
 void finish_oacc_declare (gfc_namespace *, gfc_symbol *, bool);
 void gfc_adjust_builtins (void);
 
+/* trans-openmp.c */
+
+bool gfc_skip_omp_metadirective_clause (gfc_omp_metadirective_clause *);
+
 #endif /* GCC_GFORTRAN_H  */
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 1a97a62462f..5e87e18ce0d 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -5195,8 +5195,11 @@ match_omp_metadirective (bool begin_p)
 	  new_st.ext.omp_clauses = NULL;
 	}
 
-      *next_clause = omc;
-      next_clause = &omc->next;
+      if (!gfc_skip_omp_metadirective_clause (omc))
+	{
+	  *next_clause = omc;
+	  next_clause = &omc->next;
+	}
     }
 
   if (gfc_match_omp_eos () != MATCH_YES)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index a19d916d98c..84e569d2664 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -7499,7 +7499,8 @@ gfc_trans_omp_declare_simd (gfc_namespace *ns)
 }
 
 static tree
-gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
+gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where,
+			    bool conv_expr_p = true)
 {
   tree set_selectors = NULL_TREE;
   gfc_omp_set_selector *oss;
@@ -7520,11 +7521,15 @@ gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
 		case CTX_PROPERTY_USER:
 		case CTX_PROPERTY_EXPR:
 		  {
-		    gfc_se se;
-		    gfc_init_se (&se, NULL);
-		    gfc_conv_expr (&se, otp->expr);
-		    properties = tree_cons (NULL_TREE, se.expr,
-					    properties);
+		    tree expr = NULL_TREE;
+		    if (conv_expr_p)
+		      {
+			gfc_se se;
+			gfc_init_se (&se, NULL);
+			gfc_conv_expr (&se, otp->expr);
+			expr = se.expr;
+		      }
+		    properties = tree_cons (NULL_TREE, expr, properties);
 		  }
 		  break;
 		case CTX_PROPERTY_ID:
@@ -7560,11 +7565,16 @@ gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
 
 	  if (os->score)
 	    {
-	      gfc_se se;
-	      gfc_init_se (&se, NULL);
-	      gfc_conv_expr (&se, os->score);
+	      tree expr = NULL_TREE;
+	      if (conv_expr_p)
+		{
+		  gfc_se se;
+		  gfc_init_se (&se, NULL);
+		  gfc_conv_expr (&se, os->score);
+		  expr = se.expr;
+		}
 	      properties = tree_cons (get_identifier (" score"),
-				      se.expr, properties);
+				      expr, properties);
 	    }
 
 	  selectors = tree_cons (get_identifier (os->trait_selector_name),
@@ -7755,3 +7765,11 @@ gfc_trans_omp_metadirective (gfc_code *code)
 
   return metadirective_tree;
 }
+
+bool gfc_skip_omp_metadirective_clause (gfc_omp_metadirective_clause *clause)
+{
+  tree selector = gfc_trans_omp_set_selector (clause->selectors,
+					      clause->where, false);
+
+  return omp_context_selector_matches (selector, true) == 0;
+}
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 842e9fd868f..b032e1de697 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -1254,8 +1254,9 @@ omp_context_name_list_prop (tree prop)
 }
 
 #define DELAY_METADIRECTIVES_AFTER_LTO { \
-  if (metadirective_p && !(cfun->curr_properties & PROP_gimple_lomp_dev))	\
-    return -1;	\
+  if (metadirective_p \
+      && !(cfun && cfun->curr_properties & PROP_gimple_lomp_dev)) \
+    return -1; \
 }
 
 /* Return 1 if context selector matches the current OpenMP context, 0
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90
new file mode 100644
index 00000000000..e1347910332
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+program test
+  integer :: i
+  integer, parameter :: N = 100
+  integer :: sum = 0
+  
+  ! The compiler should never consider a situation where both metadirectives
+  ! match.  If it does, then the nested metadirective would be an error
+  ! as it is not a loop-nest as per the OpenMP specification.
+
+  !$omp metadirective when (implementation={vendor("ibm")}: &
+  !$omp&  target teams distribute)
+    !$omp metadirective when (implementation={vendor("gnu")}: parallel do)
+      do i = 1, N
+	sum = sum + i
+      end do
+end program
+
+! { dg-final { scan-tree-dump-not "when \\(implementation vendor \"ibm\"\\):" "original" } }
+! { dg-final { scan-tree-dump-times "when \\(implementation vendor \"gnu\"\\):" 1 "original" } }
-- 
2.25.1