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.c (DELAY_METADIRECTIVES_AFTER_LTO): Check that cfun is
	non-null before derefencing.

	gcc/fortran/
	* decl.c (gfc_match_end): Search for first previous state that is not
	COMP_OMP_METADIRECTIVE.
	* gfortran.h (gfc_skip_omp_metadirective_clause): Add prototype.
	* openmp.c (match_omp_metadirective): Skip clause if
	result of gfc_skip_omp_metadirective_clause is true.
	* trans-openmp.c (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 --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index ade76f06a443bbaf37b303b6890739eae493020a..35dafbba30f0a7756cd9b3749e119920a7fe9d2c 100644 (file)
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,8 @@
+2022-02-11  Kwok Cheung Yeung  <kcy@codesourcery.com>
+
+       * omp-general.c (DELAY_METADIRECTIVES_AFTER_LTO): Check that cfun is
+       non-null before derefencing.
+
 2022-01-28  Kwok Cheung Yeung  <kcy@codesourcery.com>
 
        * gimplify.c (gimplify_omp_metadirective): Mark offloadable functions

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index a78fab44352ee59182ea7c8964aec55938f538f2..070744413db6e1c7813ebbfe2b034944bb088bf0 100644 (file)
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,14 @@
+2022-02-11  Kwok Cheung Yeung  <kcy@codesourcery.com>
+
+       * decl.c (gfc_match_end): Search for first previous state that is not
+       COMP_OMP_METADIRECTIVE.
+       * gfortran.h (gfc_skip_omp_metadirective_clause): Add prototype.
+       * openmp.c (match_omp_metadirective): Skip clause if
+       result of gfc_skip_omp_metadirective_clause is true.
+       * trans-openmp.c (gfc_trans_omp_set_selector): Add argument and
+       disable expression conversion if false.
+       (gfc_skip_omp_metadirective_clause): New.
+
 2022-01-31  Kwok Cheung Yeung  <kcy@codesourcery.com>
 
        * openmp.c (gfc_match_omp_context_selector_specification): Remove

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index eea290e74a2f39c1102ef36f6dccc506b8433aa2..db9961af0ab8730a9f5e299996d4c73b88e479c3 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -8323,15 +8323,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 df6d3f67c85712ada3a46dc050c5b77f43af3fc9..338dcad240ba52dfe38fb8cba0f1eb296884f6f2 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3921,4 +3921,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.c b/gcc/fortran/openmp.c
index 94930fed059c187e2a727f86368a0f9cd7664bdb..1f82e09f27006842bfd7f0c0bce3217a9105f277 100644 (file)
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -5081,8 +5081,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.c b/gcc/fortran/trans-openmp.c
index e4676f2382b9735b1973f1409e2ffc30d9ba184b..3bb4feb8fa55265a18919424871dcc03d30f2c01 100644 (file)
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -7343,7 +7343,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;
@@ -7364,11 +7365,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:
@@ -7404,11 +7409,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),
@@ -7599,3 +7609,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.c b/gcc/omp-general.c
index 33c2a9b514a7bf668576708250edd3799d105bc2..e8fef6e43b0576ccdc1f15a1ea5fbecc854f0f2a 100644 (file)
--- a/gcc/omp-general.c
+++ b/gcc/omp-general.c
@@ -1269,8 +1269,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 b91936e1de1f5e2aa6a62e686c561c48980a62a1..2b610c00ef3148cfde50528bfa98061491ba5a92 100644 (file)
--- 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 (file)
index 0000000..e134791
--- /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" } }