Hi Thomas,
Thomas Koenig wrote:
>> Comments, remarks, suggestions?
> I assume you regression-tested (you didn't say).
Yes, it was build with a bootstrapping configuration (with a
non-offloading compiler, but it shouldn't matter here) on
x86_64-gnu-linux and I did run "make check-fortran" in the
main build directory, which covers gcc/testsuite/gfortran*/
and libgomp/testsuite/*fortran/.
Otherwise, I wouldn't have found the the issue in the
OpenACC testcase and patched it. :-)
* * *
>> Otherwise, I regard the common Fortran code as obvious - and
>> the OpenMP part covered by my (co)maintainership.
>
> Regarding the Fortran part:
>
> - fndecl = build_decl (input_location,
> + fndecl = build_decl (gfc_get_location (&sym->declared_at),
> FUNCTION_DECL, name, type);
>
> Does that have any effect on non-OMP code, and if so, what is it?
>
> If so, could you also add a test case checking for it?
Regarding the first question:
Yes, it affects any (external) procedure declaration at gimple 'tree',
i.e. that code affects most code:
Therefore, if you put a check there — like
gfc_warning_now_at (input_location, 0,
"I was called for %qs, declared at %L", sym->name, &sym->declared_at);
— it will trigger very often.
And the effect is, obviously, to set the location to where the
procedure was declared - instead of using the location the
compiler decided to generate the declaration (which is usually
near the place where it was used for or in a procedure call
or proc-pointer assignment or similar).
* * *
Thus, it affects a lot of code/all code - in principle, but in
practical terms, the effect is small:
* (Nearly) all gfortran front-end diagnostic is done directly on
gfc_{symbol,expr,code} using 'locus', i.e. s->declared_at, e->where
and c->loc.
* It only affects the location of the *declaration* of a procedure
(INTERFACE, EXTERNAL, 'USE' for procedures in a module, when there
is no gsym entry for it)
* After parsing and resolution, nearly every diagnostic in the
compiler - and debugging code - relate to the executable code,
and, possibly, to function definitions or the enclosing function.
But that's unaffected by change.
Obviously, there is some effect - and as the two test cases (one old
for OpenACC and one included in the patch) have, a typical pattern is:
error_at / warning_at (loc, " … some message involving function %qD", fndecl);
inform (DECL_SOURCE_LOCATION(fndecl), "%qD was declared here", fndecl)
[where %qD prints (for Fortran/C) the name of the function (declaration 'D')
in quotes 'q'. - BTW: the %qD can also be used in gfc_error/gfc_warning.]
* * *
To come to your second question:
* Nearly all existing code runs through that line, i.e. it is somehow
tested for.
* As no regression showed up, seemingly only the existing OpenACC and
the new OpenMP code actually checked for this type of diagnostic.
* As OpenACC is not OpenMP and as both are tested for by default,
I don't see the point for trying to find a new testcase.
* * *
If you are looking for a testcase, I suggest playing with
-fanalyzer as that has output of the form:
You did this here, but that one over here was such and,
by the way, it was declared as such over there.
(However, actually looking at it, analyzer/ is probably not
using the declaration, except for file descriptors and
attribute "access", which is not the case for Fortran. But
maybe in the future it will do?)
Just doing some grepping:
* DECL_SOURCE_LOCATION is used 7 times in gcc/fortran/
(when building a decl or folding (+ 2 on the LHS of an assignment),
My feeling is that none of them is affected by this change.
* DECL_SOURCE_LOCATION is used 287 times in gcc/*.cc and 30 times in
gcc/analyzer/.
Actually, I found a new candidate in tree.cc:
"%qD is deprecated"
which is followed by:
inform (DECL_SOURCE_LOCATION (node), "declared here"); As gfortran uses
EXT_ATTR_DEPRECATED that might be a candidate, but the at least the
existing test cases did not trigger.
Thanks,
Tobias
Fortran: Fix location_t in gfc_get_extern_function_decl; support 'omp dispatch interop'
The declaration created by gfc_get_extern_function_decl used input_location
as DECL_SOURCE_LOCATION, which gave rather odd results with 'declared here'
diagnostic. - It is much more useful to use the gfc_symbol's declated_at,
which this commit now dows.
Additionally, it adds support for the 'interop' clause of OpenMP's
'dispatch' directive. As the argument order matters,
gfc_match_omp_variable_list gained a 'reverse_order' flag to use the
same order as the C/C++ parser.
gcc/fortran/ChangeLog:
* gfortran.h: Add OMP_LIST_INTEROP to the unnamed OMP_LIST_ enum.
* openmp.cc (gfc_match_omp_variable_list): Add reverse_order
boolean argument, defaulting to false.
(enum omp_mask2, OMP_DISPATCH_CLAUSES): Add OMP_CLAUSE_INTEROP.
(gfc_match_omp_clauses, resolve_omp_clauses): Handle dispatch's
'interop' clause.
* trans-decl.cc (gfc_get_extern_function_decl): Use sym->declared_at
instead input_location as DECL_SOURCE_LOCATION.
* trans-openmp.cc (gfc_trans_omp_clauses): Handle OMP_LIST_INTEROP.
gcc/testsuite/ChangeLog:
* gfortran.dg/goacc/routine-external-level-of-parallelism-2.f: Update
xfail'ed 'dg-bogus' for the better 'declared here' location.
* gfortran.dg/gomp/dispatch-11.f90: New test.
* gfortran.dg/gomp/dispatch-12.f90: New test.
gcc/fortran/gfortran.h | 1 +
gcc/fortran/openmp.cc | 53 +++++++++++---
gcc/fortran/trans-decl.cc | 2 +-
gcc/fortran/trans-openmp.cc | 3 +
.../routine-external-level-of-parallelism-2.f | 28 +++----
gcc/testsuite/gfortran.dg/gomp/dispatch-11.f90 | 85 ++++++++++++++++++++++
gcc/testsuite/gfortran.dg/gomp/dispatch-12.f90 | 49 +++++++++++++
7 files changed, 195 insertions(+), 26 deletions(-)
@@ -1467,6 +1467,7 @@ enum
OMP_LIST_INIT,
OMP_LIST_USE,
OMP_LIST_DESTROY,
+ OMP_LIST_INTEROP,
OMP_LIST_ADJUST_ARGS,
OMP_LIST_NUM /* Must be the last. */
};
@@ -408,7 +408,8 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
bool allow_sections = false,
bool allow_derived = false,
bool *has_all_memory = NULL,
- bool reject_common_vars = false)
+ bool reject_common_vars = false,
+ bool reverse_order = false)
{
gfc_omp_namelist *head, *tail, *p;
locus old_loc, cur_loc;
@@ -492,15 +493,20 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
p = gfc_get_omp_namelist ();
if (head == NULL)
head = tail = p;
+ else if (reverse_order)
+ {
+ p->next = head;
+ head = p;
+ }
else
{
tail->next = p;
tail = tail->next;
}
- tail->sym = sym;
- tail->expr = expr;
- tail->where = gfc_get_location_range (NULL, 0, &cur_loc, 1,
- &gfc_current_locus);
+ p->sym = sym;
+ p->expr = expr;
+ p->where = gfc_get_location_range (NULL, 0, &cur_loc, 1,
+ &gfc_current_locus);
if (reject_common_vars && sym->attr.in_common)
{
gcc_assert (allow_common);
@@ -540,13 +546,18 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
p = gfc_get_omp_namelist ();
if (head == NULL)
head = tail = p;
+ else if (reverse_order)
+ {
+ p->next = head;
+ head = p;
+ }
else
{
tail->next = p;
tail = tail->next;
}
- tail->sym = sym;
- tail->where = cur_loc;
+ p->sym = sym;
+ p->where = cur_loc;
}
next_item:
@@ -1128,6 +1139,7 @@ enum omp_mask2
OMP_CLAUSE_USE, /* OpenMP 5.1. */
OMP_CLAUSE_NOVARIANTS, /* OpenMP 5.1 */
OMP_CLAUSE_NOCONTEXT, /* OpenMP 5.1 */
+ OMP_CLAUSE_INTEROP, /* OpenMP 5.1 */
/* This must come last. */
OMP_MASK2_LAST
};
@@ -3255,6 +3267,21 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
goto error;
}
+ if ((mask & OMP_CLAUSE_INTEROP)
+ && (m = gfc_match_dupl_check (!c->lists[OMP_LIST_INTEROP],
+ "interop", true)) != MATCH_NO)
+ {
+ /* Note: the interop objects are saved in reverse order to match
+ the order in C/C++. */
+ if (m == MATCH_YES
+ && (gfc_match_omp_variable_list ("",
+ &c->lists[OMP_LIST_INTEROP],
+ false, NULL, NULL, false,
+ false, NULL, false, true)
+ == MATCH_YES))
+ continue;
+ goto error;
+ }
if ((mask & OMP_CLAUSE_IS_DEVICE_PTR)
&& gfc_match_omp_variable_list
("is_device_ptr (",
@@ -5019,7 +5046,7 @@ cleanup:
#define OMP_DISPATCH_CLAUSES \
(omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOVARIANTS \
| OMP_CLAUSE_NOCONTEXT | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_NOWAIT \
- | OMP_CLAUSE_HAS_DEVICE_ADDR)
+ | OMP_CLAUSE_HAS_DEVICE_ADDR | OMP_CLAUSE_INTEROP)
static match
@@ -8128,7 +8155,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"DEVICE_RESIDENT", "LINK", "USE_DEVICE",
"CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
"NONTEMPORAL", "ALLOCATE", "HAS_DEVICE_ADDR", "ENTER",
- "USES_ALLOCATORS", "INIT", "USE", "DESTROY", "ADJUST_ARGS" };
+ "USES_ALLOCATORS", "INIT", "USE", "DESTROY", "INTEROP", "ADJUST_ARGS" };
STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
if (omp_clauses == NULL)
@@ -8455,6 +8482,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
&& list != OMP_LIST_DEPEND
&& list != OMP_LIST_FROM
&& list != OMP_LIST_TO
+ && list != OMP_LIST_INTEROP
&& (list != OMP_LIST_REDUCTION || !openacc)
&& list != OMP_LIST_ALLOCATE)
for (n = omp_clauses->lists[list]; n; n = n->next)
@@ -8553,8 +8581,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
break;
}
}
- if (code && code->op == EXEC_OMP_INTEROP)
- for (list = OMP_LIST_INIT; list <= OMP_LIST_DESTROY; list++)
+ if (code && (code->op == EXEC_OMP_INTEROP || code->op == EXEC_OMP_DISPATCH))
+ for (list = OMP_LIST_INIT; list <= OMP_LIST_INTEROP; list++)
for (n = omp_clauses->lists[list]; n; n = n->next)
{
if (n->sym->ts.type != BT_INTEGER
@@ -8564,7 +8592,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
gfc_error ("%qs at %L in %qs clause must be a scalar integer "
"variable of %<omp_interop_kind%> kind", n->sym->name,
&n->where, clause_names[list]);
- if (list != OMP_LIST_USE && n->sym->attr.intent == INTENT_IN)
+ if (list != OMP_LIST_USE && list != OMP_LIST_INTEROP
+ && n->sym->attr.intent == INTENT_IN)
gfc_error ("%qs at %L in %qs clause must be definable",
n->sym->name, &n->where, clause_names[list]);
}
@@ -2412,7 +2412,7 @@ module_sym:
type = gfc_get_function_type (sym, actual_args, fnspec);
- fndecl = build_decl (input_location,
+ fndecl = build_decl (gfc_get_location (&sym->declared_at),
FUNCTION_DECL, name, type);
/* Initialize DECL_EXTERNAL and TREE_PUBLIC before calling decl_attributes;
@@ -2780,6 +2780,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_LIST_DESTROY:
clause_code = OMP_CLAUSE_DESTROY;
goto add_clause;
+ case OMP_LIST_INTEROP:
+ clause_code = OMP_CLAUSE_INTEROP;
+ goto add_clause;
add_clause:
omp_clauses
@@ -7,6 +7,13 @@
integer, parameter :: n = 100
integer :: a(n), i, j
external :: gangr, workerr, vectorr, seqr
+! { dg-bogus "note: routine 'gangr' declared here" "TODO1" { xfail { ! offloading_enabled } } .-1 }
+! { dg-bogus "note: routine 'gangr_' declared here" "TODO2" { xfail offloading_enabled } .-2 }
+! { dg-bogus "note: routine 'workerr' declared here" "TODO1" { xfail { ! offloading_enabled } } .-3 }
+! { dg-bogus "note: routine 'workerr_' declared here" "TODO2" { xfail offloading_enabled } .-4 }
+! { dg-bogus "note: routine 'vectorr' declared here" "TODO1" { xfail { ! offloading_enabled } } .-5 }
+! { dg-bogus "note: routine 'vectorr_' declared here" "TODO2" { xfail offloading_enabled } .-6 }
+
!$acc routine (gangr) gang
!$acc routine (workerr) worker
!$acc routine (vectorr) vector
@@ -22,8 +29,6 @@
! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 }
do j = 1, n
call workerr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" }
-! { dg-bogus "note: routine 'workerr' declared here" "TODO1" { xfail { ! offloading_enabled } } .-1 }
-! { dg-bogus "note: routine 'workerr_' declared here" "TODO2" { xfail offloading_enabled } .-2 }
end do
end do
!$acc end parallel loop
@@ -36,8 +41,6 @@
do j = 1, n
call gangr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" }
! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 }
-! { dg-bogus "note: routine 'gangr' declared here" "TODO1" { xfail { ! offloading_enabled } } .-2 }
-! { dg-bogus "note: routine 'gangr_' declared here" "TODO2" { xfail offloading_enabled } .-3 }
end do
end do
!$acc end parallel loop
@@ -162,8 +165,6 @@
!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang worker loop parallelism" }
do i = 1, n
call vectorr (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" }
-! { dg-bogus "note: routine 'vectorr' declared here" "TODO1" { xfail { ! offloading_enabled } } .-1 }
-! { dg-bogus "note: routine 'vectorr_' declared here" "TODO2" { xfail offloading_enabled } .-2 }
end do
!$acc end parallel loop
@@ -199,6 +200,13 @@
integer, parameter :: n = 100
integer :: a(n), i, j
integer, external :: gangf, workerf, vectorf, seqf
+! { dg-bogus "note: routine 'gangf' declared here" "TODO1" { xfail { ! offloading_enabled } } .-1 }
+! { dg-bogus "note: routine 'gangf_' declared here" "TODO2" { xfail offloading_enabled } .-2 }
+! { dg-bogus "note: routine 'workerf' declared here" "TODO1" { xfail { ! offloading_enabled } } .-3 }
+! { dg-bogus "note: routine 'workerf_' declared here" "TODO2" { xfail offloading_enabled } .-4 }
+! { dg-bogus "note: routine 'vectorf' declared here" "TODO1" { xfail { ! offloading_enabled } } .-5 }
+! { dg-bogus "note: routine 'vectorf_' declared here" "TODO2" { xfail offloading_enabled } .-6 }
+
!$acc routine (gangf) gang
!$acc routine (workerf) worker
!$acc routine (vectorf) vector
@@ -214,8 +222,6 @@
! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 }
do j = 1, n
a(i) = workerf (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" }
-! { dg-bogus "note: routine 'workerf' declared here" "TODO1" { xfail { ! offloading_enabled } } .-1 }
-! { dg-bogus "note: routine 'workerf_' declared here" "TODO2" { xfail offloading_enabled } .-2 }
end do
end do
!$acc end parallel loop
@@ -228,9 +234,7 @@
do j = 1, n
a(i) = gangf (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" }
! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 }
-! { dg-bogus "note: routine 'gangf' declared here" "TODO1" { xfail { ! offloading_enabled } } .-2 }
-! { dg-bogus "note: routine 'gangf_' declared here" "TODO2" { xfail offloading_enabled } .-3 }
- end do
+ end do
end do
!$acc end parallel loop
@@ -354,8 +358,6 @@
!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang worker loop parallelism" }
do i = 1, n
a(i) = vectorf (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" }
-! { dg-bogus "note: routine 'vectorf' declared here" "TODO1" { xfail { ! offloading_enabled } } .-1 }
-! { dg-bogus "note: routine 'vectorf_' declared here" "TODO2" { xfail offloading_enabled } .-2 }
end do
!$acc end parallel loop
new file mode 100644
@@ -0,0 +1,85 @@
+! { dg-additional-options "-fdump-tree-original" }
+
+! The following definitions are in omp_lib, which cannot be included
+! in gcc/testsuite/
+
+module m
+ use iso_c_binding
+ implicit none (type, external)
+
+ integer, parameter :: omp_interop_kind = c_intptr_t
+ integer, parameter :: omp_interop_none = 0_omp_interop_kind
+
+ interface
+ real function repl1(); end ! { dg-note "'declare variant' candidate 'repl1' declared here" }
+
+ real function base1()
+! { dg-note "'base1' declared here" "" { target *-*-* } .-1 }
+ !$omp declare variant(repl1) match(construct={dispatch})
+ end
+
+ subroutine repl2 (x1, x2) ! { dg-note "'declare variant' candidate 'repl2' declared here" }
+ import
+ type(c_ptr), value :: x1, x2
+ end
+ subroutine base2 (x, y)
+! { dg-note "'base2' declared here" "" { target *-*-* } .-1 }
+ import
+ type(c_ptr), value :: x, y
+ !$omp declare variant(repl2) match(construct={dispatch}) adjust_args(need_device_ptr : y)
+ end
+ end interface
+
+contains
+
+real function dupl (a, b)
+ type(c_ptr), value :: a, b
+ integer(omp_interop_kind) :: obj1, obj2
+ real :: x
+
+ !$omp dispatch interop ( obj1, obj2) device(2)
+ x = base1 ()
+ ! { dg-error "number of list items in 'interop' clause \\(2\\) exceeds the number of 'append_args' items \\(0\\) for 'declare variant' candidate 'repl1'" "" { target *-*-* } .-1 }
+
+ !$omp dispatch device(9) interop ( obj1, obj2) nocontext(.true.)
+ call base2 (a, b)
+ ! { dg-error "unexpected 'interop' clause as invoked procedure 'base2' is not variant substituted" "" { target *-*-* } .-1 }
+ dupl = x
+end
+
+real function test (a, b)
+ type(c_ptr), value :: a, b
+ integer(omp_interop_kind) :: obj1, obj2
+ real :: x, y
+
+ !$omp dispatch interop ( obj1 )
+ x = base1 ()
+ ! { dg-error "number of list items in 'interop' clause \\(1\\) exceeds the number of 'append_args' items \\(0\\) for 'declare variant' candidate 'repl1'" "" { target *-*-* } .-1 }
+
+ !$omp dispatch interop ( obj1, obj1 ) device(42) ! Twice the same - should be fine.
+ x = base1 ()
+ ! { dg-error "number of list items in 'interop' clause \\(2\\) exceeds the number of 'append_args' items \\(0\\) for 'declare variant' candidate 'repl1'" "" { target *-*-* } .-1 }
+
+ !$omp dispatch novariants(.true.) interop(obj2, obj1) device(0)
+ y = base1 ()
+ ! { dg-error "unexpected 'interop' clause as invoked procedure 'base1' is not variant substituted" "" { target *-*-* } .-1 }
+
+ !$omp dispatch interop(obj2, obj1) device(3)
+ call base2 (a, b)
+ ! { dg-error "number of list items in 'interop' clause \\(2\\) exceeds the number of 'append_args' items \\(0\\) for 'declare variant' candidate 'repl2'" "" { target *-*-* } .-1 }
+
+ !$omp dispatch interop(obj2) nocontext(.true.)
+ call base2 (a, b)
+ ! { dg-error "unexpected 'interop' clause as invoked procedure 'base2' is not variant substituted" "" { target *-*-* } .-1 }
+ test = x + y
+end
+end module
+
+
+! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj2\\) interop\\(obj1\\) device\\(2\\)\[\\n\\r\]" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj2\\) interop\\(obj1\\) nocontext\\(1\\) device\\(9\\)\[\\n\\r\]" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj1\\)\[\\n\\r\]" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj1\\) interop\\(obj1\\) device\\(42\\)\[\\n\\r\]" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj1\\) interop\\(obj2\\) novariants\\(1\\) device\\(0\\)\[\\n\\r\]" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj1\\) interop\\(obj2\\) device\\(3\\)\[\\n\\r\]" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp dispatch interop\\(obj2\\) nocontext\\(1\\)\[\\n\\r\]" 1 "original" } }
new file mode 100644
@@ -0,0 +1,49 @@
+! The following definitions are in omp_lib, which cannot be included
+! in gcc/testsuite/
+
+module m
+ use iso_c_binding
+ implicit none (type, external)
+
+ integer, parameter :: omp_interop_kind = c_intptr_t
+ integer, parameter :: omp_interop_none = 0_omp_interop_kind
+
+ interface
+ subroutine repl1(); end
+
+ subroutine base1()
+ !$omp declare variant(repl1) match(construct={dispatch})
+ end
+ end interface
+
+contains
+ subroutine test (obj1)
+ integer(omp_interop_kind), intent(in) :: obj1
+ integer(omp_interop_kind) :: obj2(2)
+ integer(omp_interop_kind), parameter :: obj3 = omp_interop_none
+ integer(1) :: x
+
+ !$omp dispatch interop ( obj1, obj2, obj1 ) device(2) ! { dg-error "'obj2' at .1. in 'INTEROP' clause must be a scalar integer variable of 'omp_interop_kind' kind" }
+ call base1 ()
+
+ !$omp dispatch interop ( obj1, obj1, obj1 ) device(2) ! OK
+ call base1 ()
+
+ !$omp dispatch interop ( obj3 ) ! { dg-error "Object 'obj3' is not a variable at .1." }
+ call base1 ()
+ ! { dg-error "'obj3' at .1. in 'INTEROP' clause must be a scalar integer variable of 'omp_interop_kind' kind" "" { target *-*-* } .-2 }
+
+ !$omp dispatch interop ( obj1 )
+ call base1 ()
+
+ !$omp dispatch interop ( obj2 ) ! { dg-error "'obj2' at .1. in 'INTEROP' clause must be a scalar integer variable of 'omp_interop_kind' kind" }
+ call base1 ()
+
+ !$omp dispatch interop ( x ) ! { dg-error "'x' at .1. in 'INTEROP' clause must be a scalar integer variable of 'omp_interop_kind' kind" }
+ call base1 ()
+
+ !$omp dispatch interop ( obj1) device(2) interop (obj1 ) ! { dg-error "Duplicated 'interop' clause" }
+ call base1 ()
+
+ end
+end module