aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/omp-low.c31
-rw-r--r--gcc/testsuite/c-c++-common/gomp/target-device-ancestor-3.c2
-rw-r--r--gcc/testsuite/c-c++-common/gomp/teams-3.c64
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/order-6.f902
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/teams-3.f9065
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/teams-4.f9047
6 files changed, 202 insertions, 9 deletions
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 15e4424..f58a191 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -3942,7 +3942,8 @@ omp_runtime_api_call (const_tree fndecl)
"target_memcpy",
"target_memcpy_rect",
NULL,
- /* Now omp_* calls that are available as omp_* and omp_*_. */
+ /* Now omp_* calls that are available as omp_* and omp_*_; however, the
+ DECL_NAME is always omp_* without tailing underscore. */
"capture_affinity",
"destroy_allocator",
"destroy_lock",
@@ -3994,7 +3995,8 @@ omp_runtime_api_call (const_tree fndecl)
"unset_lock",
"unset_nest_lock",
NULL,
- /* And finally calls available as omp_*, omp_*_ and omp_*_8_. */
+ /* And finally calls available as omp_*, omp_*_ and omp_*_8_; however,
+ as DECL_NAME only omp_* and omp_*_8 appear. */
"display_env",
"get_ancestor_thread_num",
"init_allocator",
@@ -4024,11 +4026,7 @@ omp_runtime_api_call (const_tree fndecl)
size_t len = strlen (omp_runtime_apis[i]);
if (strncmp (name + 4, omp_runtime_apis[i], len) == 0
&& (name[4 + len] == '\0'
- || (mode > 0
- && name[4 + len] == '_'
- && (name[4 + len + 1] == '\0'
- || (mode > 1
- && strcmp (name + 4 + len + 1, "8_") == 0)))))
+ || (mode > 1 && strcmp (name + 4 + len, "_8") == 0)))
return true;
}
return false;
@@ -4095,9 +4093,26 @@ scan_omp_1_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p,
"OpenMP runtime API call %qD in a region with "
"%<order(concurrent)%> clause", fndecl);
}
+ if (gimple_code (ctx->stmt) == GIMPLE_OMP_TEAMS
+ && omp_runtime_api_call (fndecl)
+ && ((IDENTIFIER_LENGTH (DECL_NAME (fndecl))
+ != strlen ("omp_get_num_teams"))
+ || strcmp (IDENTIFIER_POINTER (DECL_NAME (fndecl)),
+ "omp_get_num_teams") != 0)
+ && ((IDENTIFIER_LENGTH (DECL_NAME (fndecl))
+ != strlen ("omp_get_team_num"))
+ || strcmp (IDENTIFIER_POINTER (DECL_NAME (fndecl)),
+ "omp_get_team_num") != 0))
+ {
+ remove = true;
+ error_at (gimple_location (stmt),
+ "OpenMP runtime API call %qD strictly nested in a "
+ "%<teams%> region", fndecl);
+ }
if (gimple_code (ctx->stmt) == GIMPLE_OMP_TARGET
&& (gimple_omp_target_kind (ctx->stmt)
- == GF_OMP_TARGET_KIND_REGION))
+ == GF_OMP_TARGET_KIND_REGION)
+ && omp_runtime_api_call (fndecl))
{
tree tgt_clauses = gimple_omp_target_clauses (ctx->stmt);
tree c = omp_find_clause (tgt_clauses, OMP_CLAUSE_DEVICE);
diff --git a/gcc/testsuite/c-c++-common/gomp/target-device-ancestor-3.c b/gcc/testsuite/c-c++-common/gomp/target-device-ancestor-3.c
index 5e3a478..ea6e5a0 100644
--- a/gcc/testsuite/c-c++-common/gomp/target-device-ancestor-3.c
+++ b/gcc/testsuite/c-c++-common/gomp/target-device-ancestor-3.c
@@ -3,6 +3,7 @@ extern "C" {
#endif
int omp_get_num_teams (void);
+int bar (void);
#ifdef __cplusplus
}
@@ -22,6 +23,7 @@ foo (void)
#pragma omp target device (ancestor: 1)
{
+ a = bar (); /* OK */
a = omp_get_num_teams (); /* { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_teams\[^\n\r]*' in a region with 'device\\(ancestor\\)' clause" } */
}
diff --git a/gcc/testsuite/c-c++-common/gomp/teams-3.c b/gcc/testsuite/c-c++-common/gomp/teams-3.c
new file mode 100644
index 0000000..7f8b47f
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/teams-3.c
@@ -0,0 +1,64 @@
+/* PR middle-end/102972 */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* From omp.h */
+extern int omp_get_num_teams (void);
+extern void omp_set_num_teams (int);
+extern int omp_get_team_size (int);
+extern int omp_get_team_num (void);
+extern int omp_get_max_teams (void);
+extern void omp_set_teams_thread_limit (int);
+extern int omp_get_teams_thread_limit (void);
+extern int omp_is_initial_device (void);
+extern int omp_get_num_threads (void);
+
+
+#ifdef __cplusplus
+}
+#endif
+
+
+void valid ()
+{
+ #pragma omp teams
+ {
+ #pragma omp distribute
+ for (int i = 0; i < 64; i++)
+ ;
+
+ int n = omp_get_num_teams ();
+ if (n >= omp_get_team_num ())
+ __builtin_abort ();
+
+ #pragma omp parallel for
+ for (int i = 0; i < 64; i++)
+ if (!omp_is_initial_device () || omp_get_num_threads () < 0)
+ __builtin_abort ();
+
+ #pragma omp loop
+ for (int i = 0; i < 64; i++)
+ ;
+ }
+}
+
+void invalid_nest ()
+{
+ #pragma omp teams
+ {
+ #pragma distribute parallel for simd
+ for (int i = 0; i < 64; i++)
+ ;
+
+ int n = 0;
+ n += omp_get_team_size (0); /* { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_team_size\[^\n\r]*' strictly nested in a 'teams' region" } */
+ n += omp_get_num_teams ();
+ n += omp_get_team_num ();
+ omp_set_num_teams (n); /* { dg-error "OpenMP runtime API call '\[^\n\r]*omp_set_num_teams\[^\n\r]*' strictly nested in a 'teams' region" } */
+ n += omp_get_max_teams (); /* { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_max_teams\[^\n\r]*' strictly nested in a 'teams' region" } */
+ n += omp_get_teams_thread_limit (); /* { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_teams_thread_limit\[^\n\r]*' strictly nested in a 'teams' region" } */
+ omp_set_teams_thread_limit (n); /* { dg-error "OpenMP runtime API call '\[^\n\r]*omp_set_teams_thread_limit\[^\n\r]*' strictly nested in a 'teams' region" } */
+ }
+}
diff --git a/gcc/testsuite/gfortran.dg/gomp/order-6.f90 b/gcc/testsuite/gfortran.dg/gomp/order-6.f90
index c8aeecb..8d7f9c5 100644
--- a/gcc/testsuite/gfortran.dg/gomp/order-6.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/order-6.f90
@@ -8,7 +8,7 @@ module m
end
integer function omp_get_num_threads ()
end
- integer function omp_target_is_present (x, i)
+ integer function omp_target_is_present (x, i) bind(c)
import :: c_ptr
type(c_ptr) :: x
integer, value :: i
diff --git a/gcc/testsuite/gfortran.dg/gomp/teams-3.f90 b/gcc/testsuite/gfortran.dg/gomp/teams-3.f90
new file mode 100644
index 0000000..fac3393
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/teams-3.f90
@@ -0,0 +1,65 @@
+! PR middle-end/102972
+
+module m
+implicit none (type, external)
+interface
+subroutine omp_set_num_teams (num_teams); integer :: num_teams; end
+subroutine omp_set_teams_thread_limit (thread_limit); integer :: thread_limit; end
+subroutine omp_set_num_teams_8 (num_teams); integer(8) :: num_teams; end
+subroutine omp_set_num_teams_9 (num_teams); integer :: num_teams; end
+subroutine omp_set_teams_thread_limit_8 (thread_limit); integer(8) :: thread_limit; end
+integer function omp_get_num_teams (); end
+integer function omp_get_team_size (level); integer :: level; end
+integer function omp_get_team_num (); end
+integer function omp_get_max_teams (); end
+integer function omp_get_teams_thread_limit (); end
+logical function omp_is_initial_device (); end
+integer function omp_get_num_threads (); end
+end interface
+
+contains
+
+subroutine valid ()
+ integer :: i, n
+ !$omp teams
+ !$omp distribute
+ do i = 1, 64
+ end do
+
+ n = omp_get_num_teams ()
+ if (n >= omp_get_team_num ()) &
+ error stop
+
+ !$omp parallel do
+ do i = 1, 64
+ if (.not.omp_is_initial_device () .or. omp_get_num_threads () < 0) &
+ error stop
+ end do
+
+ !$omp loop
+ do i = 1, 64
+ end do
+ !$omp end teams
+end
+
+subroutine invalid_nest ()
+ integer :: i, n
+ !$omp teams
+ !$omp distribute parallel do simd
+ do i = 1, 64
+ end do
+
+ n = 0
+ n = n + omp_get_team_size (0) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_team_size\[^\n\r]*' strictly nested in a 'teams' region" }
+ n = n + omp_get_num_teams ()
+ n = n + omp_get_team_num ()
+ call omp_set_num_teams (n) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_set_num_teams\[^\n\r]*' strictly nested in a 'teams' region" }
+ call omp_set_num_teams_8 (4_8) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_set_num_teams_8\[^\n\r]*' strictly nested in a 'teams' region" }
+ call omp_set_num_teams_9 (4) ! OK - but misnamed user function
+ n = n + omp_get_max_teams () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_max_teams\[^\n\r]*' strictly nested in a 'teams' region" }
+ n = n + omp_get_teams_thread_limit () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_teams_thread_limit\[^\n\r]*' strictly nested in a 'teams' region" }
+ call omp_set_teams_thread_limit (n) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_set_teams_thread_limit'\[^\n\r]* strictly nested in a 'teams' region" }
+ call omp_set_teams_thread_limit_8 (3_8) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_set_teams_thread_limit_8'\[^\n\r]* strictly nested in a 'teams' region" }
+ !$omp end teams
+end
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/teams-4.f90 b/gcc/testsuite/gfortran.dg/gomp/teams-4.f90
new file mode 100644
index 0000000..422c2c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/teams-4.f90
@@ -0,0 +1,47 @@
+! PR middle-end/102972
+
+module m
+implicit none (type, external)
+
+! Note: Those are module functions - not an interface
+! Hence, they are internally manged to contain the module name!
+
+contains
+
+subroutine omp_set_num_teams (num_teams); integer :: num_teams; end
+subroutine omp_set_teams_thread_limit (thread_limit); integer :: thread_limit; end
+subroutine omp_set_num_teams_8 (num_teams); integer(8) :: num_teams; end
+subroutine omp_set_num_teams_9 (num_teams); integer :: num_teams; end
+subroutine omp_set_teams_thread_limit_8 (thread_limit); integer(8) :: thread_limit; end
+integer function omp_get_num_teams (); omp_get_num_teams = 0; end
+integer function omp_get_team_size (level); integer :: level; omp_get_team_size = 0; end
+integer function omp_get_team_num (); omp_get_team_num = 0; end
+integer function omp_get_max_teams (); omp_get_max_teams = 0; end
+integer function omp_get_teams_thread_limit (); omp_get_teams_thread_limit = 0; end
+logical function omp_is_initial_device (); omp_is_initial_device = .true.; end
+integer function omp_get_num_threads (); omp_get_num_threads = 0; end
+end module
+
+subroutine nest_test ()
+ use m
+ implicit none (type, external)
+
+ integer :: i, n
+ !$omp teams
+ !$omp distribute parallel do simd
+ do i = 1, 64
+ end do
+
+ n = 0
+ n = n + omp_get_team_size (0)
+ n = n + omp_get_num_teams ()
+ n = n + omp_get_team_num ()
+ call omp_set_num_teams (n)
+ call omp_set_num_teams_8 (4_8)
+ call omp_set_num_teams_9 (4)
+ n = n + omp_get_max_teams ()
+ n = n + omp_get_teams_thread_limit ()
+ call omp_set_teams_thread_limit (n)
+ call omp_set_teams_thread_limit_8 (3_8)
+ !$omp end teams
+end