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 --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index abcdb0203576948a81c5e904cc57fa54acc1dbc0..d093c79efc66803f783db37f5651a2876d036e4e 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.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 e72622042662362be1c324259453eec1fd9708a5..180a54b17dc97f25b3e388f40d7bfdfb843a1d3b 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.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 e024e360c88ac2150fa7bb4b594487dbfce22d37..a77ac76817540e5bb9b3078a804af2d17fb6b161 100644 (file)
--- 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 d4ad9027f469c41e32d503ca8aadb178e8ec6f18..edc45ca09eed89e5d163d79a797f95ea2d7493f1 100644 (file)
--- 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 0fc7e64dfa5ca46ec35017cf2e185cc6f68937ab..3661271d4a986422cd6976ea9ced7864deddf92b 100644 (file)
--- 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 1b18e93dbc6a38c3d2611682be20f9e5c701a408..a0f213937a443dd23eed3f7c1e2c251d8869be6e 100644 (file)
--- 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 05b960ea983019c0df40308c02b4ac6275f0449c..c044d808afcf2790830780c8c41b08886d8f9241 100644 (file)
--- 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 162cbc58b2778dad6301d7ad1d8a693f0487dca9..2fc0f1d9b7d0cca940da0d4887207567113365af 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" } }