Fortran/openmp: Add support for 2 argument num_teams clause

Fortran part to commit r12-5146-g48d7327f2aaf65

gcc/fortran/ChangeLog:

	* gfortran.h (struct gfc_omp_clauses): Rename num_teams to
	num_teams_upper, add num_teams_upper.
	* dump-parse-tree.c (show_omp_clauses): Update to handle
	lower-bound num_teams clause.
	* frontend-passes.c (gfc_code_walker): Likewise
	* openmp.c (gfc_free_omp_clauses, gfc_match_omp_clauses,
	resolve_omp_clauses): Likewise.
	* trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses,
	gfc_trans_omp_target): Likewise.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/teams-1.f90: New test.

(cherry picked from commit 407eaad25f45ccba6e45e6f07d6c69c51cc567f3)

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 5ea9585544988aa095dba0599198eb9cd59bcafc..8ce1c3aff837f25dada522556d58f76ca39acd8d 100644 (file)
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,18 @@
+2022-02-27  Tobias Burnus  <tobias@codesourcery.com>
+
+       Backported from master:
+       2021-11-11  Tobias Burnus  <tobias@codesourcery.com>
+
+       * gfortran.h (struct gfc_omp_clauses): Rename num_teams to
+       num_teams_upper, add num_teams_upper.
+       * dump-parse-tree.c (show_omp_clauses): Update to handle
+       lower-bound num_teams clause.
+       * frontend-passes.c (gfc_code_walker): Likewise
+       * openmp.c (gfc_free_omp_clauses, gfc_match_omp_clauses,
+       resolve_omp_clauses): Likewise.
+       * trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses,
+       gfc_trans_omp_target): Likewise.
+
 2022-02-27  Tobias Burnus  <tobias@codesourcery.com>
 
        Backported from master:

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 8f1fadfd71fa9e07f5a8808ce7ea27da31187acb..dd8583a57a487f626095386f5cc38cbf41a155f6 100644 (file)
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1739,10 +1739,15 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
        }
       fprintf (dumpfile, " BIND(%s)", type);
     }
-  if (omp_clauses->num_teams)
+  if (omp_clauses->num_teams_upper)
     {
       fputs (" NUM_TEAMS(", dumpfile);
-      show_expr (omp_clauses->num_teams);
+      if (omp_clauses->num_teams_lower)
+       {
+         show_expr (omp_clauses->num_teams_lower);
+         fputc (':', dumpfile);
+       }
+      show_expr (omp_clauses->num_teams_upper);
       fputc (')', dumpfile);
     }
   if (omp_clauses->device)

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index fd46acfae2318c3f0f9ce88f5943c2646ce3cd38..8866209ec487de610b7c076b411cb554e01ad2f1 100644 (file)
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -5634,7 +5634,8 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
                  WALK_SUBEXPR (co->ext.omp_clauses->chunk_size);
                  WALK_SUBEXPR (co->ext.omp_clauses->safelen_expr);
                  WALK_SUBEXPR (co->ext.omp_clauses->simdlen_expr);
-                 WALK_SUBEXPR (co->ext.omp_clauses->num_teams);
+                 WALK_SUBEXPR (co->ext.omp_clauses->num_teams_lower);
+                 WALK_SUBEXPR (co->ext.omp_clauses->num_teams_upper);
                  WALK_SUBEXPR (co->ext.omp_clauses->device);
                  WALK_SUBEXPR (co->ext.omp_clauses->thread_limit);
                  WALK_SUBEXPR (co->ext.omp_clauses->dist_chunk_size);

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index f9b36ca5205cfebfbd669c7428f67c39b831c1ec..eeaf2e1215d1ef7472aeb185a86145bd7d9b2bf6 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1505,7 +1505,8 @@ typedef struct gfc_omp_clauses
   struct gfc_expr *chunk_size;
   struct gfc_expr *safelen_expr;
   struct gfc_expr *simdlen_expr;
-  struct gfc_expr *num_teams;
+  struct gfc_expr *num_teams_lower;
+  struct gfc_expr *num_teams_upper;
   struct gfc_expr *device;
   struct gfc_expr *thread_limit;
   struct gfc_expr *grainsize;

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 43e5be004f99f71d4a50f8eb266a011182d920df..1446d232638460fa11432900e0821ca6550ce2f2 100644 (file)
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -95,7 +95,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
   gfc_free_expr (c->chunk_size);
   gfc_free_expr (c->safelen_expr);
   gfc_free_expr (c->simdlen_expr);
-  gfc_free_expr (c->num_teams);
+  gfc_free_expr (c->num_teams_lower);
+  gfc_free_expr (c->num_teams_upper);
   gfc_free_expr (c->device);
   gfc_free_expr (c->thread_limit);
   gfc_free_expr (c->dist_chunk_size);
@@ -2442,11 +2443,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
              continue;
            }
          if ((mask & OMP_CLAUSE_NUM_TEAMS)
-             && (m = gfc_match_dupl_check (!c->num_teams, "num_teams", true,
-                                           &c->num_teams)) != MATCH_NO)
+             && (m = gfc_match_dupl_check (!c->num_teams_upper, "num_teams",
+                                           true)) != MATCH_NO)
            {
              if (m == MATCH_ERROR)
                goto error;
+             if (gfc_match ("%e ", &c->num_teams_upper) != MATCH_YES)
+               goto error;
+             if (gfc_peek_ascii_char () == ':')
+               {
+                 c->num_teams_lower = c->num_teams_upper;
+                 c->num_teams_upper = NULL;
+                 if (gfc_match (": %e ", &c->num_teams_upper) != MATCH_YES)
+                   goto error;
+               }
+             if (gfc_match (") ") != MATCH_YES)
+               goto error;
              continue;
            }
          if ((mask & OMP_CLAUSE_NUM_THREADS)
@@ -7466,8 +7478,18 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
     resolve_positive_int_expr (omp_clauses->safelen_expr, "SAFELEN");
   if (omp_clauses->simdlen_expr)
     resolve_positive_int_expr (omp_clauses->simdlen_expr, "SIMDLEN");
-  if (omp_clauses->num_teams)
-    resolve_positive_int_expr (omp_clauses->num_teams, "NUM_TEAMS");
+  if (omp_clauses->num_teams_lower)
+    resolve_positive_int_expr (omp_clauses->num_teams_lower, "NUM_TEAMS");
+  if (omp_clauses->num_teams_upper)
+    resolve_positive_int_expr (omp_clauses->num_teams_upper, "NUM_TEAMS");
+  if (omp_clauses->num_teams_lower
+      && omp_clauses->num_teams_lower->expr_type == EXPR_CONSTANT
+      && omp_clauses->num_teams_upper->expr_type == EXPR_CONSTANT
+      && mpz_cmp (omp_clauses->num_teams_lower->value.integer,
+                 omp_clauses->num_teams_upper->value.integer) > 0)
+    gfc_warning (0, "NUM_TEAMS lower bound at %L larger than upper bound at %L",
+                &omp_clauses->num_teams_lower->where,
+                &omp_clauses->num_teams_upper->where);
   if (omp_clauses->device)
     resolve_nonnegative_int_expr (omp_clauses->device, "DEVICE");
   if (omp_clauses->filter)

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 4dd53f0bb1256c919539899523c3af3ade40a2f9..3c2e17c689155da75e36cf8c593d6fc5f35c2784 100644 (file)
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -3947,18 +3947,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
        }
     }
 
-  if (clauses->num_teams)
+  if (clauses->num_teams_upper)
     {
-      tree num_teams;
+      tree num_teams_lower = NULL_TREE, num_teams_upper;
 
       gfc_init_se (&se, NULL);
-      gfc_conv_expr (&se, clauses->num_teams);
+      gfc_conv_expr (&se, clauses->num_teams_upper);
       gfc_add_block_to_block (block, &se.pre);
-      num_teams = gfc_evaluate_now (se.expr, block);
+      num_teams_upper = gfc_evaluate_now (se.expr, block);
       gfc_add_block_to_block (block, &se.post);
 
+      if (clauses->num_teams_lower)
+       {
+         gfc_init_se (&se, NULL);
+         gfc_conv_expr (&se, clauses->num_teams_lower);
+         gfc_add_block_to_block (block, &se.pre);
+         num_teams_lower = gfc_evaluate_now (se.expr, block);
+         gfc_add_block_to_block (block, &se.post);
+       }
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TEAMS);
-      OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (c) = num_teams;
+      OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR (c) = num_teams_lower;
+      OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (c) = num_teams_upper;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
@@ -5905,8 +5914,10 @@ gfc_split_omp_clauses (gfc_code *code,
       if (mask & GFC_OMP_MASK_TEAMS)
        {
          /* First the clauses that are unique to some constructs.  */
-         clausesa[GFC_OMP_SPLIT_TEAMS].num_teams
-           = code->ext.omp_clauses->num_teams;
+         clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower
+           = code->ext.omp_clauses->num_teams_lower;
+         clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper
+           = code->ext.omp_clauses->num_teams_upper;
          clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit
            = code->ext.omp_clauses->thread_limit;
          /* Shared and default clauses are allowed on parallel, teams
@@ -6683,7 +6694,7 @@ gfc_trans_omp_target (gfc_code *code)
       break;
     default:
       if (flag_openmp
-         && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams
+         && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper
              || clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit))
        {
          gfc_omp_clauses clausesb;
@@ -6692,9 +6703,13 @@ gfc_trans_omp_target (gfc_code *code)
             thread_limit clauses are evaluated before entering the
             target construct.  */
          memset (&clausesb, '\0', sizeof (clausesb));
-         clausesb.num_teams = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams;
+         clausesb.num_teams_lower
+           = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower;
+         clausesb.num_teams_upper
+           = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper;
          clausesb.thread_limit = clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit;
-         clausesa[GFC_OMP_SPLIT_TEAMS].num_teams = NULL;
+         clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower = NULL;
+         clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper = NULL;
          clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = NULL;
          teams_clauses
            = gfc_trans_omp_clauses (&block, &clausesb, code->loc);

diff --git a/gcc/testsuite/gfortran.dg/gomp/num-teams-1.f90 b/gcc/testsuite/gfortran.dg/gomp/num-teams-1.f90
new file mode 100644 (file)
index 0000000..df31cc7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/num-teams-1.f90
@@ -0,0 +1,53 @@
+module m
+  implicit none (type, external)
+
+  interface
+  integer function fn(i); integer :: i; end
+  end interface
+
+contains
+
+subroutine foo
+  !$omp teams num_teams (4 : 6)
+  !$omp end teams
+
+  !$omp teams num_teams (7)
+  !$omp end teams
+end 
+
+subroutine bar
+  !$omp target teams num_teams (5 : 19)
+  !$omp end target teams
+
+  !$omp target teams num_teams (21)
+  !$omp end target teams
+end
+
+subroutine baz
+  !$omp teams num_teams (fn (1) : fn (2))
+  !$omp end teams
+
+  !$omp teams num_teams (fn (3))
+  !$omp end teams
+end
+
+subroutine qux
+  !$omp target teams num_teams (fn (4) : fn (5))
+  !$omp end target teams
+
+  !$omp target teams num_teams (fn (6))
+  !$omp end target teams
+end
+
+subroutine corge
+  !$omp target
+    !$omp teams num_teams (fn (7) : fn (8))
+    !$omp end teams
+  !$omp end target
+
+  !$omp target
+    !$omp teams num_teams (fn (9))
+    !$omp end teams
+  !$omp end target
+end
+end module m

diff --git a/gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90 b/gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90
new file mode 100644 (file)
index 0000000..e7814a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90
@@ -0,0 +1,37 @@
+module m
+  implicit none (type, external)
+
+contains
+
+subroutine foo (i)
+  integer :: i
+
+  !$omp teams num_teams (6 : 4)                ! { dg-warning "NUM_TEAMS lower bound at .1. larger than upper bound at .2." }
+  !$omp end teams
+
+  !$omp teams num_teams (-7)           ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
+  !$omp end teams
+
+  !$omp teams num_teams (i : -7)               ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
+  !$omp end teams
+
+  !$omp teams num_teams (-7 : 8)               ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
+  !$omp end teams
+end
+
+subroutine bar (i)
+  integer :: i
+
+  !$omp target teams num_teams (6 : 4) ! { dg-warning "NUM_TEAMS lower bound at .1. larger than upper bound at .2." }
+  !$omp end target teams
+
+  !$omp target teams num_teams (-7)    ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
+  !$omp end target teams
+
+  !$omp target teams num_teams (i : -7)        ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
+  !$omp end target teams
+
+  !$omp target teams num_teams (-7 : 8)        ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
+  !$omp end target teams
+end
+end module

diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index e8304a09a69e5bc559dcd13e9a9d507170e31f5a..569c14676bd62f4bac659d526057e3783c4991d6 100644 (file)
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,10 @@
+2022-02-27  Tobias Burnus  <tobias@codesourcery.com>
+
+       Backported from master:
+       2021-11-11  Tobias Burnus  <tobias@codesourcery.com>
+
+       * testsuite/libgomp.fortran/teams-1.f90: New test.
+
 2022-02-27  Tobias Burnus  <tobias@codesourcery.com>
 
        Backported from master:

diff --git a/libgomp/testsuite/libgomp.fortran/teams-1.f90 b/libgomp/testsuite/libgomp.fortran/teams-1.f90
new file mode 100644 (file)
index 0000000..9969fe4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/teams-1.f90
@@ -0,0 +1,22 @@
+program main
+  use omp_lib
+  implicit none (type, external)
+  integer :: i
+
+  !$omp teams num_teams (5)
+    if (omp_get_num_teams () /= 5) stop 1
+    !$omp distribute dist_schedule(static,1)
+    do i = 0, 4
+      if (omp_get_team_num () /= i) stop 2
+    end do
+  !$omp end teams
+
+  !$omp teams num_teams (7 : 9)
+    if (omp_get_num_teams () < 7 .or. omp_get_num_teams () > 9) &
+      stop 3
+    !$omp distribute dist_schedule(static,1)
+    do i = 0, omp_get_num_teams () - 1
+      if (omp_get_team_num () /= i) stop 4
+    end do
+  !$omp end teams
+end program main