Hi!
I've committed following patch to implement OpenMP 4.5 declare target
construct.
In addition, I've fixed omp declare simd handling, where it would in free
form incorrectly accept free form
SUBROUTINE FOO(A)
!$OMP DECLARE SIMDLINEAR(A)
INTEGER :: A
END SUBROUTINE
(no space between SIMD and following clause name).
Tested on x86_64-linux, committed to gomp-4_5-branch.
2016-06-08 Jakub Jelinek <ja...@redhat.com>
* gfortran.h (symbol_attribute): Add omp_declare_target_link bitfield.
(struct gfc_omp_namelist): Add u.common field.
(struct gfc_common_head): Change omp_declare_target into bitfield.
Add omp_declare_target_link bitfield.
(gfc_add_omp_declare_target_link): New prototype.
* openmp.c (gfc_match_omp_to_link): New function.
(gfc_match_omp_clauses): Use it for to and link clauses in declare
target construct.
(OMP_DECLARE_TARGET_CLAUSES): Define.
(gfc_match_omp_declare_target): Rewritten for OpenMP 4.5.
* symbol.c (check_conflict): Handle omp_declare_target_link.
(gfc_add_omp_declare_target_link): New function.
(gfc_copy_attr): Copy omp_declare_target_link.
* module.c (enum ab_attribute): Add AB_OMP_DECLARE_TARGET_LINK.
(attr_bits): Add AB_OMP_DECLARE_TARGET_LINK entry.
(mio_symbol_attribute): Save and restore omp_declare_target_link bit.
* f95-lang.c (gfc_attribute_table): Add "omp declare target link".
* trans-decl.c (add_attributes_to_decl): Add "omp declare target link"
instead of "omp declare target" for omp_declare_target_link.
* trans-common.c (build_common_decl): Likewise.
* openmp.c (gfc_match_omp_declare_simd): If not using the form with
(proc-name), require space before first clause.
testsuite/
* gfortran.dg/gomp/declare-target-1.f90: New test.
* gfortran.dg/gomp/declare-target-2.f90: New test.
--- gcc/fortran/gfortran.h.jj 2016-05-25 18:23:54.000000000 +0200
+++ gcc/fortran/gfortran.h 2016-06-07 15:29:18.170184003 +0200
@@ -849,6 +849,7 @@ typedef struct
/* Mentioned in OMP DECLARE TARGET. */
unsigned omp_declare_target:1;
+ unsigned omp_declare_target_link:1;
/* Mentioned in OACC DECLARE. */
unsigned oacc_declare_create:1;
@@ -1157,6 +1158,7 @@ typedef struct gfc_omp_namelist
gfc_omp_depend_op depend_op;
gfc_omp_map_op map_op;
gfc_omp_linear_op linear_op;
+ struct gfc_common_head *common;
} u;
struct gfc_omp_namelist_udr *udr;
struct gfc_omp_namelist *next;
@@ -1561,7 +1563,9 @@ struct gfc_undo_change_set
typedef struct gfc_common_head
{
locus where;
- char use_assoc, saved, threadprivate, omp_declare_target;
+ char use_assoc, saved, threadprivate;
+ unsigned char omp_declare_target : 1;
+ unsigned char omp_declare_target_link : 1;
char name[GFC_MAX_SYMBOL_LEN + 1];
struct gfc_symbol *head;
const char* binding_label;
@@ -2840,6 +2844,8 @@ bool gfc_add_result (symbol_attribute *,
bool gfc_add_save (symbol_attribute *, save_state, const char *, locus *);
bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
bool gfc_add_omp_declare_target (symbol_attribute *, const char *, locus *);
+bool gfc_add_omp_declare_target_link (symbol_attribute *, const char *,
+ locus *);
bool gfc_add_saved_common (symbol_attribute *, locus *);
bool gfc_add_target (symbol_attribute *, locus *);
bool gfc_add_dummy (symbol_attribute *, const char *, locus *);
--- gcc/fortran/openmp.c.jj 2016-05-31 19:33:55.000000000 +0200
+++ gcc/fortran/openmp.c 2016-06-08 16:10:55.309586149 +0200
@@ -340,6 +340,96 @@ cleanup:
return MATCH_ERROR;
}
+/* Match a variable/procedure/common block list and construct a namelist
+ from it. */
+
+static match
+gfc_match_omp_to_link (const char *str, gfc_omp_namelist **list)
+{
+ gfc_omp_namelist *head, *tail, *p;
+ locus old_loc, cur_loc;
+ char n[GFC_MAX_SYMBOL_LEN+1];
+ gfc_symbol *sym;
+ match m;
+ gfc_symtree *st;
+
+ head = tail = NULL;
+
+ old_loc = gfc_current_locus;
+
+ m = gfc_match (str);
+ if (m != MATCH_YES)
+ return m;
+
+ for (;;)
+ {
+ cur_loc = gfc_current_locus;
+ m = gfc_match_symbol (&sym, 1);
+ switch (m)
+ {
+ case MATCH_YES:
+ p = gfc_get_omp_namelist ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ tail->sym = sym;
+ tail->where = cur_loc;
+ goto next_item;
+ case MATCH_NO:
+ break;
+ case MATCH_ERROR:
+ goto cleanup;
+ }
+
+ m = gfc_match (" / %n /", n);
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ if (m == MATCH_NO)
+ goto syntax;
+
+ st = gfc_find_symtree (gfc_current_ns->common_root, n);
+ if (st == NULL)
+ {
+ gfc_error ("COMMON block /%s/ not found at %C", n);
+ goto cleanup;
+ }
+ p = gfc_get_omp_namelist ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ tail->u.common = st->n.common;
+ tail->where = cur_loc;
+
+ next_item:
+ if (gfc_match_char (')') == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ while (*list)
+ list = &(*list)->next;
+
+ *list = head;
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in OpenMP variable list at %C");
+
+cleanup:
+ gfc_free_omp_namelist (head);
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+}
+
/* Match depend(sink : ...) construct a namelist from it. */
static match
@@ -1249,6 +1339,12 @@ gfc_match_omp_clauses (gfc_omp_clauses *
&c->lists[OMP_LIST_LINK])
== MATCH_YES))
continue;
+ else if ((mask & OMP_CLAUSE_LINK)
+ && !openacc
+ && (gfc_match_omp_to_link ("link (",
+ &c->lists[OMP_LIST_LINK])
+ == MATCH_YES))
+ continue;
break;
case 'm':
if ((mask & OMP_CLAUSE_MAP)
@@ -1688,7 +1784,13 @@ gfc_match_omp_clauses (gfc_omp_clauses *
&& match_oacc_expr_list ("tile (", &c->tile_list,
true) == MATCH_YES)
continue;
- if ((mask & OMP_CLAUSE_TO)
+ if ((mask & OMP_CLAUSE_TO) && (mask & OMP_CLAUSE_LINK))
+ {
+ if (gfc_match_omp_to_link ("to (", &c->lists[OMP_LIST_TO])
+ == MATCH_YES)
+ continue;
+ }
+ else if ((mask & OMP_CLAUSE_TO)
&& gfc_match_omp_variable_list ("to (",
&c->lists[OMP_LIST_TO], false,
NULL, &head, true) == MATCH_YES)
@@ -2324,6 +2426,8 @@ cleanup:
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE)
#define OMP_ORDERED_CLAUSES \
(omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD)
+#define OMP_DECLARE_TARGET_CLAUSES \
+ (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK)
static match
@@ -2457,16 +2561,17 @@ gfc_match_omp_declare_simd (void)
gfc_symbol *proc_name;
gfc_omp_clauses *c;
gfc_omp_declare_simd *ods;
+ bool needs_space = false;
switch (gfc_match (" ( %s ) ", &proc_name))
{
case MATCH_YES: break;
- case MATCH_NO: proc_name = NULL; break;
+ case MATCH_NO: proc_name = NULL; needs_space = true; break;
case MATCH_ERROR: return MATCH_ERROR;
}
if (gfc_match_omp_clauses (&c, OMP_DECLARE_SIMD_CLAUSES, true,
- false) != MATCH_YES)
+ needs_space) != MATCH_YES)
return MATCH_ERROR;
ods = gfc_get_omp_declare_simd ();
@@ -2874,26 +2979,15 @@ match
gfc_match_omp_declare_target (void)
{
locus old_loc;
- char n[GFC_MAX_SYMBOL_LEN+1];
- gfc_symbol *sym;
match m;
- gfc_symtree *st;
+ gfc_omp_clauses *c = NULL;
+ int list;
+ gfc_omp_namelist *n;
+ gfc_symbol *s;
old_loc = gfc_current_locus;
- m = gfc_match (" (");
-
if (gfc_current_ns->proc_name
- && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
- && m == MATCH_YES)
- {
- gfc_error ("Only the !$OMP DECLARE TARGET form without "
- "list is allowed in interface block at %C");
- goto cleanup;
- }
-
- if (m == MATCH_NO
- && gfc_current_ns->proc_name
&& gfc_match_omp_eos () == MATCH_YES)
{
if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
@@ -2903,58 +2997,111 @@ gfc_match_omp_declare_target (void)
return MATCH_YES;
}
- if (m != MATCH_YES)
- return m;
+ if (gfc_current_ns->proc_name
+ && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY)
+ {
+ gfc_error ("Only the !$OMP DECLARE TARGET form without "
+ "clauses is allowed in interface block at %C");
+ goto cleanup;
+ }
- for (;;)
+ m = gfc_match (" (");
+ if (m == MATCH_YES)
{
- m = gfc_match_symbol (&sym, 0);
- switch (m)
+ c = gfc_get_omp_clauses ();
+ gfc_current_locus = old_loc;
+ m = gfc_match_omp_to_link (" (", &c->lists[OMP_LIST_TO]);
+ if (m != MATCH_YES)
+ goto syntax;
+ if (gfc_match_omp_eos () != MATCH_YES)
{
- case MATCH_YES:
- if (sym->attr.in_common)
- gfc_error_now ("OMP DECLARE TARGET on a variable at %C is an "
- "element of a COMMON block");
- else if (!gfc_add_omp_declare_target (&sym->attr, sym->name,
- &sym->declared_at))
- goto cleanup;
- goto next_item;
- case MATCH_NO:
- break;
- case MATCH_ERROR:
+ gfc_error ("Unexpected junk after !$OMP DECLARE TARGET at %C");
goto cleanup;
}
+ }
+ else if (gfc_match_omp_clauses (&c, OMP_DECLARE_TARGET_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
- m = gfc_match (" / %n /", n);
- if (m == MATCH_ERROR)
- goto cleanup;
- if (m == MATCH_NO || n[0] == '\0')
- goto syntax;
+ gfc_buffer_error (false);
- st = gfc_find_symtree (gfc_current_ns->common_root, n);
- if (st == NULL)
+ for (list = OMP_LIST_TO; list != OMP_LIST_NUM;
+ list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM))
+ for (n = c->lists[list]; n; n = n->next)
+ if (n->sym)
+ n->sym->mark = 0;
+ else if (n->u.common->head)
+ n->u.common->head->mark = 0;
+
+ for (list = OMP_LIST_TO; list != OMP_LIST_NUM;
+ list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM))
+ for (n = c->lists[list]; n; n = n->next)
+ if (n->sym)
+ {
+ if (n->sym->attr.in_common)
+ gfc_error_now ("OMP DECLARE TARGET variable at %L is an "
+ "element of a COMMON block", &n->where);
+ else if (n->sym->attr.omp_declare_target
+ && n->sym->attr.omp_declare_target_link
+ && list != OMP_LIST_LINK)
+ gfc_error_now ("OMP DECLARE TARGET variable at %L previously "
+ "mentioned in LINK clause and later in TO clause",
+ &n->where);
+ else if (n->sym->attr.omp_declare_target
+ && !n->sym->attr.omp_declare_target_link
+ && list == OMP_LIST_LINK)
+ gfc_error_now ("OMP DECLARE TARGET variable at %L previously "
+ "mentioned in TO clause and later in LINK clause",
+ &n->where);
+ else if (n->sym->mark)
+ gfc_error_now ("Variable at %L mentioned multiple times in "
+ "clauses of the same OMP DECLARE TARGET directive",
+ &n->where);
+ else if (gfc_add_omp_declare_target (&n->sym->attr, n->sym->name,
+ &n->sym->declared_at))
+ {
+ if (list == OMP_LIST_LINK)
+ gfc_add_omp_declare_target_link (&n->sym->attr, n->sym->name,
+ &n->sym->declared_at);
+ }
+ n->sym->mark = 1;
+ }
+ else if (n->u.common->omp_declare_target
+ && n->u.common->omp_declare_target_link
+ && list != OMP_LIST_LINK)
+ gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously "
+ "mentioned in LINK clause and later in TO clause",
+ &n->where);
+ else if (n->u.common->omp_declare_target
+ && !n->u.common->omp_declare_target_link
+ && list == OMP_LIST_LINK)
+ gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously "
+ "mentioned in TO clause and later in LINK clause",
+ &n->where);
+ else if (n->u.common->head && n->u.common->head->mark)
+ gfc_error_now ("COMMON at %L mentioned multiple times in "
+ "clauses of the same OMP DECLARE TARGET directive",
+ &n->where);
+ else
{
- gfc_error ("COMMON block /%s/ not found at %C", n);
- goto cleanup;
+ n->u.common->omp_declare_target = 1;
+ n->u.common->omp_declare_target_link = (list == OMP_LIST_LINK);
+ for (s = n->u.common->head; s; s = s->common_next)
+ {
+ s->mark = 1;
+ if (gfc_add_omp_declare_target (&s->attr, s->name,
+ &s->declared_at))
+ {
+ if (list == OMP_LIST_LINK)
+ gfc_add_omp_declare_target_link (&s->attr, s->name,
+ &s->declared_at);
+ }
+ }
}
- st->n.common->omp_declare_target = 1;
- for (sym = st->n.common->head; sym; sym = sym->common_next)
- if (!gfc_add_omp_declare_target (&sym->attr, sym->name,
- &sym->declared_at))
- goto cleanup;
- next_item:
- if (gfc_match_char (')') == MATCH_YES)
- break;
- if (gfc_match_char (',') != MATCH_YES)
- goto syntax;
- }
+ gfc_buffer_error (true);
- if (gfc_match_omp_eos () != MATCH_YES)
- {
- gfc_error ("Unexpected junk after !$OMP DECLARE TARGET at %C");
- goto cleanup;
- }
+ if (c)
+ gfc_free_omp_clauses (c);
return MATCH_YES;
syntax:
@@ -2962,6 +3109,8 @@ syntax:
cleanup:
gfc_current_locus = old_loc;
+ if (c)
+ gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
--- gcc/fortran/symbol.c.jj 2016-05-04 18:37:23.000000000 +0200
+++ gcc/fortran/symbol.c 2016-06-07 15:39:07.098546711 +0200
@@ -375,6 +375,7 @@ check_conflict (symbol_attribute *attr,
*contiguous = "CONTIGUOUS", *generic = "GENERIC";
static const char *threadprivate = "THREADPRIVATE";
static const char *omp_declare_target = "OMP DECLARE TARGET";
+ static const char *omp_declare_target_link = "OMP DECLARE TARGET LINK";
static const char *oacc_declare_copyin = "OACC DECLARE COPYIN";
static const char *oacc_declare_create = "OACC DECLARE CREATE";
static const char *oacc_declare_deviceptr = "OACC DECLARE DEVICEPTR";
@@ -472,6 +473,7 @@ check_conflict (symbol_attribute *attr,
conf (dummy, intrinsic);
conf (dummy, threadprivate);
conf (dummy, omp_declare_target);
+ conf (dummy, omp_declare_target_link);
conf (pointer, target);
conf (pointer, intrinsic);
conf (pointer, elemental);
@@ -516,6 +518,7 @@ check_conflict (symbol_attribute *attr,
conf (in_equivalence, allocatable);
conf (in_equivalence, threadprivate);
conf (in_equivalence, omp_declare_target);
+ conf (in_equivalence, omp_declare_target_link);
conf (in_equivalence, oacc_declare_create);
conf (in_equivalence, oacc_declare_copyin);
conf (in_equivalence, oacc_declare_deviceptr);
@@ -524,6 +527,8 @@ check_conflict (symbol_attribute *attr,
conf (dummy, result);
conf (entry, result);
conf (generic, result);
+ conf (generic, omp_declare_target);
+ conf (generic, omp_declare_target_link);
conf (function, subroutine);
@@ -569,6 +574,7 @@ check_conflict (symbol_attribute *attr,
conf (cray_pointee, in_equivalence);
conf (cray_pointee, threadprivate);
conf (cray_pointee, omp_declare_target);
+ conf (cray_pointee, omp_declare_target_link);
conf (cray_pointee, oacc_declare_create);
conf (cray_pointee, oacc_declare_copyin);
conf (cray_pointee, oacc_declare_deviceptr);
@@ -625,8 +631,11 @@ check_conflict (symbol_attribute *attr,
conf (procedure, entry)
conf (proc_pointer, abstract)
+ conf (proc_pointer, omp_declare_target)
+ conf (proc_pointer, omp_declare_target_link)
conf (entry, omp_declare_target)
+ conf (entry, omp_declare_target_link)
conf (entry, oacc_declare_create)
conf (entry, oacc_declare_copyin)
conf (entry, oacc_declare_deviceptr)
@@ -668,6 +677,7 @@ check_conflict (symbol_attribute *attr,
conf2 (subroutine);
conf2 (threadprivate);
conf2 (omp_declare_target);
+ conf2 (omp_declare_target_link);
conf2 (oacc_declare_create);
conf2 (oacc_declare_copyin);
conf2 (oacc_declare_deviceptr);
@@ -718,6 +728,8 @@ check_conflict (symbol_attribute *attr,
if (!attr->proc_pointer)
conf2 (in_common);
+ conf2 (omp_declare_target_link);
+
switch (attr->proc)
{
case PROC_ST_FUNCTION:
@@ -754,6 +766,7 @@ check_conflict (symbol_attribute *attr,
conf2 (threadprivate);
conf2 (result);
conf2 (omp_declare_target);
+ conf2 (omp_declare_target_link);
conf2 (oacc_declare_create);
conf2 (oacc_declare_copyin);
conf2 (oacc_declare_deviceptr);
@@ -1269,6 +1282,22 @@ gfc_add_omp_declare_target (symbol_attri
bool
+gfc_add_omp_declare_target_link (symbol_attribute *attr, const char *name,
+ locus *where)
+{
+
+ if (check_used (attr, name, where))
+ return false;
+
+ if (attr->omp_declare_target_link)
+ return true;
+
+ attr->omp_declare_target_link = 1;
+ return check_conflict (attr, name, where);
+}
+
+
+bool
gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name,
locus *where)
{
@@ -1905,6 +1934,9 @@ gfc_copy_attr (symbol_attribute *dest, s
if (src->omp_declare_target
&& !gfc_add_omp_declare_target (dest, NULL, where))
goto fail;
+ if (src->omp_declare_target_link
+ && !gfc_add_omp_declare_target_link (dest, NULL, where))
+ goto fail;
if (src->oacc_declare_create
&& !gfc_add_oacc_declare_create (dest, NULL, where))
goto fail;
--- gcc/fortran/module.c.jj 2016-05-04 18:37:30.000000000 +0200
+++ gcc/fortran/module.c 2016-06-08 12:35:22.606491558 +0200
@@ -1988,7 +1988,8 @@ enum ab_attribute
AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET,
AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE,
AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR,
- AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK
+ AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK,
+ AB_OMP_DECLARE_TARGET_LINK
};
static const mstring attr_bits[] =
@@ -2051,6 +2052,7 @@ static const mstring attr_bits[] =
minit ("OACC_DECLARE_DEVICEPTR", AB_OACC_DECLARE_DEVICEPTR),
minit ("OACC_DECLARE_DEVICE_RESIDENT", AB_OACC_DECLARE_DEVICE_RESIDENT),
minit ("OACC_DECLARE_LINK", AB_OACC_DECLARE_LINK),
+ minit ("OMP_DECLARE_TARGET_LINK", AB_OMP_DECLARE_TARGET_LINK),
minit (NULL, -1)
};
@@ -2250,6 +2252,8 @@ mio_symbol_attribute (symbol_attribute *
MIO_NAME (ab_attribute) (AB_OACC_DECLARE_DEVICE_RESIDENT, attr_bits);
if (attr->oacc_declare_link)
MIO_NAME (ab_attribute) (AB_OACC_DECLARE_LINK, attr_bits);
+ if (attr->omp_declare_target_link)
+ MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET_LINK, attr_bits);
mio_rparen ();
@@ -2419,6 +2423,9 @@ mio_symbol_attribute (symbol_attribute *
case AB_OMP_DECLARE_TARGET:
attr->omp_declare_target = 1;
break;
+ case AB_OMP_DECLARE_TARGET_LINK:
+ attr->omp_declare_target_link = 1;
+ break;
case AB_ARRAY_OUTER_DEPENDENCY:
attr->array_outer_dependency =1;
break;
--- gcc/fortran/f95-lang.c.jj 2016-05-19 18:26:41.000000000 +0200
+++ gcc/fortran/f95-lang.c 2016-06-08 14:12:39.153003811 +0200
@@ -93,6 +93,8 @@ static const struct attribute_spec gfc_a
affects_type_identity } */
{ "omp declare target", 0, 0, true, false, false,
gfc_handle_omp_declare_target_attribute, false },
+ { "omp declare target link", 0, 0, true, false, false,
+ gfc_handle_omp_declare_target_attribute, false },
{ "oacc function", 0, -1, true, false, false,
gfc_handle_omp_declare_target_attribute, false },
{ NULL, 0, 0, false, false, false, NULL, false }
--- gcc/fortran/trans-decl.c.jj 2016-05-04 18:37:33.000000000 +0200
+++ gcc/fortran/trans-decl.c 2016-06-07 16:40:01.086039305 +0200
@@ -1306,7 +1306,10 @@ add_attributes_to_decl (symbol_attribute
list = chainon (list, attr);
}
- if (sym_attr.omp_declare_target)
+ if (sym_attr.omp_declare_target_link)
+ list = tree_cons (get_identifier ("omp declare target link"),
+ NULL_TREE, list);
+ else if (sym_attr.omp_declare_target)
list = tree_cons (get_identifier ("omp declare target"),
NULL_TREE, list);
--- gcc/fortran/trans-common.c.jj 2016-05-04 18:37:25.000000000 +0200
+++ gcc/fortran/trans-common.c 2016-06-07 15:50:38.401564413 +0200
@@ -457,7 +457,11 @@ build_common_decl (gfc_common_head *com,
if (com->threadprivate)
set_decl_tls_model (decl, decl_default_tls_model (decl));
- if (com->omp_declare_target)
+ if (com->omp_declare_target_link)
+ DECL_ATTRIBUTES (decl)
+ = tree_cons (get_identifier ("omp declare target link"),
+ NULL_TREE, DECL_ATTRIBUTES (decl));
+ else if (com->omp_declare_target)
DECL_ATTRIBUTES (decl)
= tree_cons (get_identifier ("omp declare target"),
NULL_TREE, DECL_ATTRIBUTES (decl));
--- gcc/testsuite/gfortran.dg/gomp/declare-target-1.f90.jj 2016-06-08
14:24:47.821457897 +0200
+++ gcc/testsuite/gfortran.dg/gomp/declare-target-1.f90 2016-06-08
14:27:32.000000000 +0200
@@ -0,0 +1,27 @@
+! { dg-do compile }
+
+module declare_target_1
+ !$omp declare target to (var_1, var_4) link (var_2, var_3) &
+ !$omp & link (var_5) to (var_6)
+ integer :: var_1, var_2, var_3, var_4, var_5, var_6
+ interface
+ subroutine foo
+ !$omp declare target
+ end subroutine
+ end interface
+end
+subroutine bar
+ !$omp declare target
+ integer, save :: var_9
+ !$omp declare target link (var_8) to (baz, var_7) link (var_9) to (var_10)
+ integer, save :: var_7, var_8, var_10
+ integer :: var_11, var_12, var_13, var_14
+ common /c1/ var_11, var_12
+ common /c2/ var_13
+ common /c3/ var_14
+ !$omp declare target (baz, var_7, var_10, /c1/)
+ !$omp declare target to (/c2/)
+ !$omp declare target link (/c3/)
+ !$omp declare target (bar)
+ call baz
+end subroutine
--- gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90.jj 2016-06-08
15:39:59.901462888 +0200
+++ gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90 2016-06-08
15:48:01.000000000 +0200
@@ -0,0 +1,51 @@
+! { dg-do compile }
+
+module declare_target_2
+ !$omp declare target to (a) link (a) ! { dg-error "TO clause and later in
LINK" }
+ !$omp declare target (b)
+ !$omp declare target link (b) ! { dg-error "TO clause and
later in LINK" }
+ !$omp declare target link (f)
+ !$omp declare target to (f) ! { dg-error "LINK clause and later in
TO" }
+ !$omp declare target(c, c) ! { dg-error "mentioned multiple times
in clauses of the same" }
+ !$omp declare target to (d) to (d) ! { dg-error "mentioned multiple times
in clauses of the same" }
+ !$omp declare target link (e, e) ! { dg-error "mentioned multiple times
in clauses of the same" }
+ integer, save :: a, b, c, d, e, f
+ interface
+ integer function f1 (a)
+ !$omp declare target (f1) ! { dg-error "form without
clauses is allowed in interface block" }
+ integer :: a
+ end function
+ end interface
+ interface
+ integer function f2 (a)
+ !$omp declare target to (f2) ! { dg-error "form without clauses is
allowed in interface block" }
+ integer :: a
+ end function
+ end interface
+end
+subroutine bar
+ !$omp declare target link (baz) ! { dg-error "isn.t SAVEd" }
+ call baz ! { dg-error "attribute conflicts" }
+end subroutine
+subroutine foo ! { dg-error "attribute conflicts" }
+ integer :: g, h, i, j, k, l, m, n, o, p, q
+ common /c1/ g, h
+ common /c2/ i, j
+ common /c3/ k, l
+ common /c4/ m, n
+ common /c5/ o, p, q
+ !$omp declare target to (g) ! { dg-error "is an element of a COMMON
block" }
+ !$omp declare target link (foo)
+ !$omp declare target to (/c2/)
+ !$omp declare target (/c2/)
+ !$omp declare target to(/c2/)
+ !$omp declare target link(/c2/) ! { dg-error "TO clause and later in
LINK" }
+ !$omp declare target link(/c3/)
+ !$omp declare target (/c3/) ! { dg-error "LINK clause and later in
TO" }
+ !$omp declare target (/c4/, /c4/) ! { dg-error "mentioned multiple times
in clauses of the same" }
+ !$omp declare target to (/c4/) to(/c4/) ! { dg-error "mentioned multiple
times in clauses of the same" }
+ !$omp declare target link (/c5/)
+ !$omp declare target link (/c5/)
+ !$omp declare target link(/c5/)link(/c5/) ! { dg-error "mentioned multiple
times in clauses of the same" }
+ !$omp declare target link(/c5/,/c5/) ! { dg-error "mentioned multiple times
in clauses of the same" }
+end subroutine
Jakub
