[gcc/devel/omp/gcc-12] openmp: Eliminate non-matching metadirective variants early in Fortran front-end

[Kwok Yeung <kcy@gcc.gnu.org>]

https://gcc.gnu.org/g:e0d1e49413d82cec351217dbf8496034f6d1dfc7

commit e0d1e49413d82cec351217dbf8496034f6d1dfc7
Author: Kwok Cheung Yeung <kcy@codesourcery.com>
Date:   Fri Feb 11 11:20:18 2022 +0000

    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.

Diff:
---
 gcc/ChangeLog.omp                                  |  5 +++
 gcc/fortran/ChangeLog.omp                          | 11 +++++++
 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 +--
 gcc/testsuite/ChangeLog.omp                        |  4 +++
 gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90 | 22 +++++++++++++
 9 files changed, 101 insertions(+), 16 deletions(-)

diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index abcdb020357..d093c79efc6 100644
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,8 @@
+2022-02-11  Kwok Cheung Yeung  <kcy@codesourcery.com>
+
+	* omp-general.cc (DELAY_METADIRECTIVES_AFTER_LTO): Check that cfun is
+	non-null before derefencing.
+
 2022-01-28  Kwok Cheung Yeung  <kcy@codesourcery.com>
 
 	* gimplify.cc (gimplify_omp_metadirective): Mark offloadable functions
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index e7262204266..180a54b17dc 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,14 @@
+2022-02-11  Kwok Cheung Yeung  <kcy@codesourcery.com>
+
+	* 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.ccc (gfc_trans_omp_set_selector): Add argument and
+	disable expression conversion if false.
+	(gfc_skip_omp_metadirective_clause): New.
+
 2022-01-25  Kwok Cheung Yeung  <kcy@codesourcery.com>
 
 	* openmp.cc (omp_target_device_selectors): New.
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 d4ad9027f46..edc45ca09ee 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3950,4 +3950,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 0fc7e64dfa5..3661271d4a9 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 1b18e93dbc6..a0f213937a4 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -7627,7 +7627,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;
@@ -7648,11 +7649,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:
@@ -7688,11 +7693,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),
@@ -7883,3 +7893,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 05b960ea983..c044d808afc 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -1271,8 +1271,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/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 162cbc58b27..2fc0f1d9b7d 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,7 @@
+2022-02-11  Kwok Cheung Yeung  <kcy@codesourcery.com>
+
+	* gfortran.dg/gomp/metadirective-8.f90: New.
+
 2022-01-28  Kwok Cheung Yeung  <kcy@codesourcery.com>
 
 	* c-c++-common/gomp/metadirective-4.c (main): Add expected warning.
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" } }