+2023-10-26 Tobias Burnus <tobias@codesourcery.com>
+ Chung-Lin Tang <cltang@codesourcery.com>
+
+ * omp-low.cc (scan_sharing_clauses): Update message for directive use.
+ (lower_omp_allocate, lower_omp_1): Update for clause changes; handle
+ alignment.
+ * tree-core.h (enum omp_clause_code): Remove OMP_CLAUSE_ALLOCATOR.
+ * tree-pretty-print.cc (dump_omp_clause): Likewise.
+ * tree.cc (omp_clause_num_ops): Likewise.
+ * tree.h (OMP_ALLOCATE_DECL, OMP_ALLOCATE_ALLOCATOR): Remove.
+
2023-09-20 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
+2023-10-26 Tobias Burnus <tobias@codesourcery.com>
+ Chung-Lin Tang <cltang@codesourcery.com>
+
+ * dump-parse-tree.cc (show_omp_namelist, show_omp_node,
+ show_code_node): Dump EXEC_OMP_ALLOCATORS update for struct changes.
+ * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)ALLOCATORS.
+ (gfc_omp_namelist): Add allocator to union u2.
+ (enum): Remove OMP_LIST_ALLOCATOR.
+ (gfc_namespace): Add omp_allocate.
+ (enum gfc_exec_op): Add EXEC_OMP_ALLOCATORS.
+ (gfc_resolve_omp_allocate): New prototype.
+ * match.cc (gfc_free_omp_namelist): Free u2.allocator.
+ * match.h (gfc_match_omp_allocators): New prototype.
+ * openmp.cc (gfc_omp_directives): Enable allocate/allocator.
+ (gfc_match_omp_variable_list): Add reject_common_vars Boolean arg.
+ (enum omp_mask2): Remove OMP_CLAUSE_ALLOCATOR.
+ (gfc_match_omp_clauses): Update for struct change.
+ (OMP_ALLOCATE_CLAUSES): Remove.
+ (OMP_ALLOCATORS_CLAUSES): Add.
+ (gfc_match_omp_allocate): Replace by upstream version.
+ (gfc_match_omp_allocators, is_predefined_allocator,
+ gfc_resolve_omp_allocate): New.
+ (verify_omp_clauses_symbol_dups): Update for allocate/allocator.
+ (resolve_omp_clauses): Update from mainline.
+ (omp_code_to_statement): Add EXEC_OMP_ALLOCATORS.
+ prepare_omp_allocated_var_list_for_cleanup,
+ check_allocate_directive_restrictions, EMPTY_VAR_LIST,
+ gfc_resolve_omp_allocate): Remove.
+ (gfc_resolve_omp_directive): Add EXEC_OMP_ALLOCATORS.
+ * parse.cc (check_omp_allocate_stmt, decode_omp_directive
+ next_statement, case_omp_decl, gfc_ascii_statement,
+ verify_st_order, parse_openmp_allocate_block,
+ parse_omp_structured_block, parse_executable): Update from mainline.
+ * resolve.cc (gfc_resolve_blocks, resolve_codes): Handle allocate
+ and allocator.
+ * st.cc (gfc_free_statement): And EXEC_OMP_ALLOCATORS.
+ * trans-decl.cc (gfc_trans_deferred_vars): Use OMP_LIST_ALLOCATE
+ instead of OMP_LIST_ALLOCATOR.
+ * trans-openmp.cc (gfc_trans_omp_clauses): Remove OMP_LIST_ALLOCATOR,
+ update allocate handling.
+ (gfc_trans_omp_allocate): Renamed to ...
+ (gfc_trans_omp_allocators): ... this.
+ (gfc_split_omp_clauses, gfc_trans_omp_directive): Update.
+ * trans.cc (trans_code): Handle EXEC_OMP_ALLOCATORS.
+
2023-10-16 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
if (n->expr)
{
fputs ("allocator(", dumpfile);
- show_expr (n->expr);
+ show_expr (n->u2.allocator);
fputc (')', dumpfile);
}
if (n->expr && n->u.align)
fputc (',', dumpfile);
if (n->u.align)
{
- fputs ("allocator(", dumpfile);
+ fputs ("align(", dumpfile);
show_expr (n->u.align);
fputc (')', dumpfile);
}
case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break;
case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break;
case EXEC_OMP_ALLOCATE: name = "ALLOCATE"; break;
+ case EXEC_OMP_ALLOCATORS: name = "ALLOCATORS"; break;
case EXEC_OMP_ASSUME: name = "ASSUME"; break;
case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
case EXEC_OMP_BARRIER: name = "BARRIER"; break;
case EXEC_OACC_CACHE:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
+ case EXEC_OMP_ALLOCATE:
+ case EXEC_OMP_ALLOCATORS:
case EXEC_OMP_ASSUME:
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
|| c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
|| c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN
|| c->op == EXEC_OMP_DEPOBJ || c->op == EXEC_OMP_ERROR
- || c->op == EXEC_OMP_ALLOCATE
|| (c->op == EXEC_OMP_ORDERED && c->block == NULL))
return;
if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_ALLOCATE:
+ case EXEC_OMP_ALLOCATORS:
case EXEC_OMP_ASSUME:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CANCEL:
ST_OACC_CACHE, ST_OACC_KERNELS_LOOP, ST_OACC_END_KERNELS_LOOP,
ST_OACC_SERIAL_LOOP, ST_OACC_END_SERIAL_LOOP, ST_OACC_SERIAL,
ST_OACC_END_SERIAL, ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA, ST_OACC_ROUTINE,
- ST_OACC_ATOMIC, ST_OACC_END_ATOMIC, ST_OMP_ALLOCATE,
+ ST_OACC_ATOMIC, ST_OACC_END_ATOMIC,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_OMP_SCOPE, ST_OMP_END_SCOPE,
ST_OMP_METADIRECTIVE, ST_OMP_BEGIN_METADIRECTIVE, ST_OMP_END_METADIRECTIVE,
ST_OMP_ERROR, ST_OMP_ASSUME, ST_OMP_END_ASSUME, ST_OMP_ASSUMES,
+ ST_OMP_ALLOCATE, ST_OMP_ALLOCATE_EXEC,
+ ST_OMP_ALLOCATORS, ST_OMP_END_ALLOCATORS,
/* Note: gfc_match_omp_nothing returns ST_NONE. */
ST_OMP_NOTHING, ST_NONE,
ST_OMP_UNROLL, ST_OMP_END_UNROLL,
struct gfc_omp_namelist_udr *udr;
struct gfc_omp_namelist_udm *udm;
gfc_namespace *ns;
+ gfc_expr *allocator;
struct gfc_omp_namelist *duplicate_of;
} u2;
struct gfc_symbol *memspace_sym;
OMP_LIST_USE_DEVICE_ADDR,
OMP_LIST_NONTEMPORAL,
OMP_LIST_ALLOCATE,
- OMP_LIST_ALLOCATOR,
OMP_LIST_HAS_DEVICE_ADDR,
OMP_LIST_ENTER,
OMP_LIST_USES_ALLOCATORS,
/* Linked list of !$omp declare variant constructs. */
struct gfc_omp_declare_variant *omp_declare_variant;
- /* OpenMP assumptions. */
+ /* OpenMP assumptions and allocate for static/stack vars. */
struct gfc_omp_assumptions *omp_assumes;
+ struct gfc_omp_namelist *omp_allocate;
/* A hash set for the gfc expressions that have already
been finalized in this namespace. */
EXEC_OACC_DATA, EXEC_OACC_HOST_DATA, EXEC_OACC_LOOP, EXEC_OACC_UPDATE,
EXEC_OACC_WAIT, EXEC_OACC_CACHE, EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA,
EXEC_OACC_ATOMIC, EXEC_OACC_DECLARE,
- EXEC_OMP_ALLOCATE,
EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
EXEC_OMP_TARGET_TEAMS_LOOP, EXEC_OMP_MASKED, EXEC_OMP_PARALLEL_MASKED,
EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE,
- EXEC_OMP_METADIRECTIVE, EXEC_OMP_UNROLL, EXEC_OMP_TILE, EXEC_OMP_ERROR
+ EXEC_OMP_METADIRECTIVE, EXEC_OMP_UNROLL, EXEC_OMP_TILE, EXEC_OMP_ERROR,
+ EXEC_OMP_ALLOCATE, EXEC_OMP_ALLOCATORS
};
typedef struct gfc_code
void gfc_free_omp_metadirective_clauses (gfc_omp_metadirective_clause *);
void gfc_free_omp_udm (gfc_omp_udm *);
gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *);
+void gfc_resolve_omp_allocate (gfc_namespace *, gfc_omp_namelist *);
void gfc_resolve_omp_assumptions (gfc_omp_assumptions *);
gfc_omp_udm *gfc_omp_udm_find (gfc_symtree *, gfc_typespec *);
gfc_omp_udm *gfc_find_omp_udm (gfc_namespace *ns, const char *mapper_id,
gfc_free_namespace (name->u2.ns);
else if (free_mapper && name->u2.udm)
free (name->u2.udm);
+ else if (free_align)
+ gfc_free_expr (name->u2.allocator);
else if (!free_mapper && name->u2.udr)
{
if (name->u2.udr->combiner)
/* OpenMP directive matchers. */
match gfc_match_omp_eos_error (void);
match gfc_match_omp_allocate (void);
+match gfc_match_omp_allocators (void);
match gfc_match_omp_assume (void);
match gfc_match_omp_assumes (void);
match gfc_match_omp_atomic (void);
and "nothing". */
static const struct gfc_omp_directive gfc_omp_directives[] = {
- /* {"allocate", GFC_OMP_DIR_DECLARATIVE, ST_OMP_ALLOCATE}, */
- /* {"allocators", GFC_OMP_DIR_EXECUTABLE, ST_OMP_ALLOCATORS}, */
+ {"allocate", GFC_OMP_DIR_DECLARATIVE, ST_OMP_ALLOCATE},
+ {"allocators", GFC_OMP_DIR_EXECUTABLE, ST_OMP_ALLOCATORS},
{"assumes", GFC_OMP_DIR_INFORMATIONAL, ST_OMP_ASSUMES},
{"assume", GFC_OMP_DIR_INFORMATIONAL, ST_OMP_ASSUME},
{"atomic", GFC_OMP_DIR_EXECUTABLE, ST_OMP_ATOMIC},
gfc_omp_namelist ***headp = NULL,
bool allow_sections = false,
bool allow_derived = false,
- bool *has_all_memory = NULL)
+ bool *has_all_memory = NULL,
+ bool reject_common_vars = false)
{
gfc_omp_namelist *head, *tail, *p;
locus old_loc, cur_loc;
tail->sym = sym;
tail->expr = expr;
tail->where = cur_loc;
+ if (reject_common_vars && sym->attr.in_common)
+ {
+ gcc_assert (allow_common);
+ gfc_error ("%qs at %L is part of the common block %</%s/%> and "
+ "may only be specificed implicitly via the named "
+ "common block", sym->name, &cur_loc,
+ sym->common_head->name);
+ goto cleanup;
+ }
goto next_item;
case MATCH_NO:
break;
OMP_CLAUSE_FINALIZE,
OMP_CLAUSE_ATTACH,
OMP_CLAUSE_NOHOST,
- OMP_CLAUSE_ALLOCATOR,
OMP_CLAUSE_HAS_DEVICE_ADDR, /* OpenMP 5.1 */
OMP_CLAUSE_ENTER, /* OpenMP 5.2 */
OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */
for (gfc_omp_namelist *n = *head; n; n = n->next)
{
- n->expr = (allocator) ? gfc_copy_expr (allocator) : NULL;
+ n->u2.allocator = ((allocator)
+ ? gfc_copy_expr (allocator) : NULL);
n->u.align = (align) ? gfc_copy_expr (align) : NULL;
}
gfc_free_expr (allocator);
}
-#define OMP_ALLOCATE_CLAUSES (omp_mask (OMP_CLAUSE_ALLOCATOR))
#define OMP_PARALLEL_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \
(omp_mask (OMP_CLAUSE_AT) | OMP_CLAUSE_MESSAGE | OMP_CLAUSE_SEVERITY)
#define OMP_WORKSHARE_CLAUSES \
omp_mask (OMP_CLAUSE_NOWAIT)
+#define OMP_ALLOCATORS_CLAUSES \
+ omp_mask (OMP_CLAUSE_ALLOCATE)
#define OMP_UNROLL_CLAUSES \
(omp_mask (OMP_CLAUSE_UNROLL_FULL) | OMP_CLAUSE_UNROLL_PARTIAL)
#define OMP_TILE_CLAUSES \
return MATCH_YES;
}
+/* Handles both declarative and (deprecated) executable ALLOCATE directive;
+ accepts optional list (for executable) and common blocks.
+ If no variables have been provided, the single omp namelist has sym == NULL.
+
+ Note that the executable ALLOCATE directive permits structure elements only
+ in OpenMP 5.0 and 5.1 but not longer in 5.2. See also the comment on the
+ 'omp allocators' directive below. The accidental change was reverted for
+ OpenMP TR12, permitting them again. See also gfc_match_omp_allocators.
+
+ Hence, structure elements are rejected for now, also to make resolving
+ OMP_LIST_ALLOCATE simpler (check for duplicates, same symbol in
+ Fortran allocate stmt). TODO: Permit structure elements. */
+
+match
+gfc_match_omp_allocate (void)
+{
+ match m;
+ bool first = true;
+ gfc_omp_namelist *vars = NULL;
+ gfc_expr *align = NULL;
+ gfc_expr *allocator = NULL;
+ locus loc = gfc_current_locus;
+
+ m = gfc_match_omp_variable_list (" (", &vars, true, NULL, NULL, true, true,
+ NULL, true);
+
+ if (m == MATCH_ERROR)
+ return m;
+
+ while (true)
+ {
+ gfc_gobble_whitespace ();
+ if (gfc_match_omp_eos () == MATCH_YES)
+ break;
+ if (!first)
+ gfc_match (", ");
+ first = false;
+ if ((m = gfc_match_dupl_check (!align, "align", true, &align))
+ != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
+ if ((m = gfc_match_dupl_check (!allocator, "allocator",
+ true, &allocator)) != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
+ gfc_error ("Expected ALIGN or ALLOCATOR clause at %C");
+ return MATCH_ERROR;
+ }
+ for (gfc_omp_namelist *n = vars; n; n = n->next)
+ if (n->expr)
+ {
+ if ((n->expr->ref && n->expr->ref->type == REF_COMPONENT)
+ || (n->expr->ref->next && n->expr->ref->type == REF_COMPONENT))
+ gfc_error ("Sorry, structure-element list item at %L in ALLOCATE "
+ "directive is not yet supported", &n->expr->where);
+ else
+ gfc_error ("Unexpected expression as list item at %L in ALLOCATE "
+ "directive", &n->expr->where);
+
+ gfc_free_omp_namelist (vars, OMP_LIST_ALLOCATE);
+ goto error;
+ }
+
+ new_st.op = EXEC_OMP_ALLOCATE;
+ new_st.ext.omp_clauses = gfc_get_omp_clauses ();
+ if (vars == NULL)
+ {
+ vars = gfc_get_omp_namelist ();
+ vars->where = loc;
+ vars->u.align = align;
+ vars->u2.allocator = allocator;
+ new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE] = vars;
+ }
+ else
+ {
+ new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE] = vars;
+ for (; vars; vars = vars->next)
+ {
+ vars->u.align = (align) ? gfc_copy_expr (align) : NULL;
+ vars->u2.allocator = ((allocator) ? gfc_copy_expr (allocator) : NULL);
+ }
+ gfc_free_expr (allocator);
+ gfc_free_expr (align);
+ }
+ return MATCH_YES;
+
+error:
+ gfc_free_expr (align);
+ gfc_free_expr (allocator);
+ return MATCH_ERROR;
+}
+
+/* In line with OpenMP 5.2 derived-type components are rejected.
+ See also comment before gfc_match_omp_allocate. */
+
+match
+gfc_match_omp_allocators (void)
+{
+ return match_omp (EXEC_OMP_ALLOCATORS, OMP_ALLOCATORS_CLAUSES);
+}
+
match
gfc_match_omp_assume (void)
return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DOACROSS));
}
-/* omp allocate (list) [clause-list]
- - clause-list: allocator
-*/
-
-match
-gfc_match_omp_allocate (void)
-{
- gfc_omp_clauses *c = gfc_get_omp_clauses ();
- gfc_expr *allocator = NULL;
- match m;
-
- m = gfc_match (" (");
- if (m == MATCH_YES)
- {
- m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATOR],
- true, NULL);
-
- if (m != MATCH_YES)
- {
- /* If the list was empty, we must find closing ')'. */
- m = gfc_match (")");
- if (m != MATCH_YES)
- return m;
- }
- }
-
- if (gfc_match (" allocator ( ") == MATCH_YES)
- {
- m = gfc_match_expr (&allocator);
- if (m != MATCH_YES)
- {
- gfc_error ("Expected allocator at %C");
- return MATCH_ERROR;
- }
- if (gfc_match (" ) ") != MATCH_YES)
- {
- gfc_error ("Expected ')' at %C");
- gfc_free_expr (allocator);
- return MATCH_ERROR;
- }
- }
-
- if (gfc_match_omp_eos () != MATCH_YES)
- {
- gfc_free_expr (allocator);
- gfc_error ("Unexpected junk after $OMP allocate at %C");
- return MATCH_ERROR;
- }
- gfc_omp_namelist *n;
- for (n = c->lists[OMP_LIST_ALLOCATOR]; n; n = n->next)
- n->expr = gfc_copy_expr (allocator);
-
- new_st.op = EXEC_OMP_ALLOCATE;
- new_st.ext.omp_clauses = c;
- new_st.resolved_sym = NULL;
- gfc_free_expr (allocator);
- return MATCH_YES;
-}
-
-
/* omp atomic [clause-list]
- atomic-clause: read | write | update
- capture
return copy;
}
+/* Assume that a constant expression in the range 1 (omp_default_mem_alloc)
+ to 8 (omp_thread_mem_alloc) range is fine. The original symbol name is
+ already lost during matching via gfc_match_expr. */
+bool
+is_predefined_allocator (gfc_expr *expr)
+{
+ return (gfc_resolve_expr (expr)
+ && expr->rank == 0
+ && expr->ts.type == BT_INTEGER
+ && expr->ts.kind == gfc_c_intptr_kind
+ && expr->expr_type == EXPR_CONSTANT
+ && mpz_sgn (expr->value.integer) > 0
+ && mpz_cmp_si (expr->value.integer, 8) <= 0);
+}
+
+/* Resolve declarative ALLOCATE statement. Note: Common block vars only appear
+ as /block/ not individual, which is ensured during parsing. */
+
+void
+gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list)
+{
+ for (gfc_omp_namelist *n = list; n; n = n->next)
+ n->sym->mark = 0;
+ for (gfc_omp_namelist *n = list; n; n = n->next)
+ {
+ if (n->sym->attr.flavor != FL_VARIABLE)
+ {
+ gfc_error ("Argument %qs at %L to declarative !$OMP ALLOCATE "
+ "directive must be a variable", n->sym->name,
+ &n->where);
+ continue;
+ }
+ if (ns != n->sym->ns || n->sym->attr.use_assoc
+ || n->sym->attr.host_assoc || n->sym->attr.imported)
+ {
+ gfc_error ("Argument %qs at %L to declarative !$OMP ALLOCATE shall be"
+ " in the same scope as the variable declaration",
+ n->sym->name, &n->where);
+ continue;
+ }
+ if (n->sym->attr.dummy)
+ {
+ gfc_error ("Unexpected dummy argument %qs as argument at %L to "
+ "declarative !$OMP ALLOCATE", n->sym->name, &n->where);
+ continue;
+ }
+ if (n->sym->mark)
+ {
+ if (n->sym->attr.in_common)
+ {
+ gfc_error ("Duplicated common block %</%s/%> in !$OMP ALLOCATE "
+ "at %L", n->sym->common_head->name, &n->where);
+ while (n->next && n->next->sym
+ && n->sym->common_head == n->next->sym->common_head)
+ n = n->next;
+ }
+ else
+ gfc_error ("Duplicated variable %qs in !$OMP ALLOCATE at %L",
+ n->sym->name, &n->where);
+ continue;
+ }
+ n->sym->mark = 1;
+ if ((n->sym->ts.type == BT_CLASS && n->sym->attr.class_ok
+ && CLASS_DATA (n->sym)->attr.allocatable)
+ || (n->sym->ts.type != BT_CLASS && n->sym->attr.allocatable))
+ gfc_error ("Unexpected allocatable variable %qs at %L in declarative "
+ "!$OMP ALLOCATE directive", n->sym->name, &n->where);
+ else if ((n->sym->ts.type == BT_CLASS && n->sym->attr.class_ok
+ && CLASS_DATA (n->sym)->attr.class_pointer)
+ || (n->sym->ts.type != BT_CLASS && n->sym->attr.pointer))
+ gfc_error ("Unexpected pointer variable %qs at %L in declarative "
+ "!$OMP ALLOCATE directive", n->sym->name, &n->where);
+ HOST_WIDE_INT alignment = 0;
+ if (n->u.align
+ && (!gfc_resolve_expr (n->u.align)
+ || n->u.align->ts.type != BT_INTEGER
+ || n->u.align->rank != 0
+ || n->u.align->expr_type != EXPR_CONSTANT
+ || gfc_extract_hwi (n->u.align, &alignment)
+ || !pow2p_hwi (alignment)))
+ {
+ gfc_error ("ALIGN requires a scalar positive constant integer "
+ "alignment expression at %L that is a power of two",
+ &n->u.align->where);
+ while (n->sym->attr.in_common && n->next && n->next->sym
+ && n->sym->common_head == n->next->sym->common_head)
+ n = n->next;
+ continue;
+ }
+ if (n->sym->attr.in_common || n->sym->attr.save || n->sym->ns->save_all
+ || (n->sym->ns->proc_name
+ && (n->sym->ns->proc_name->attr.flavor == FL_PROGRAM
+ || n->sym->ns->proc_name->attr.flavor == FL_MODULE)))
+ {
+ bool com = n->sym->attr.in_common;
+ if (!n->u2.allocator)
+ gfc_error ("An ALLOCATOR clause is required as the list item "
+ "%<%s%s%s%> at %L has the SAVE attribute", com ? "/" : "",
+ com ? n->sym->common_head->name : n->sym->name,
+ com ? "/" : "", &n->where);
+ else if (!is_predefined_allocator (n->u2.allocator))
+ gfc_error ("Predefined allocator required in ALLOCATOR clause at %L"
+ " as the list item %<%s%s%s%> at %L has the SAVE attribute",
+ &n->u2.allocator->where, com ? "/" : "",
+ com ? n->sym->common_head->name : n->sym->name,
+ com ? "/" : "", &n->where);
+ while (n->sym->attr.in_common && n->next && n->next->sym
+ && n->sym->common_head == n->next->sym->common_head)
+ n = n->next;
+ }
+ else if (n->u2.allocator
+ && (!gfc_resolve_expr (n->u2.allocator)
+ || n->u2.allocator->ts.type != BT_INTEGER
+ || n->u2.allocator->rank != 0
+ || n->u2.allocator->ts.kind != gfc_c_intptr_kind))
+ gfc_error ("Expected integer expression of the "
+ "%<omp_allocator_handle_kind%> kind at %L",
+ &n->u2.allocator->where);
+ }
+ gfc_error ("Sorry, declarative !$OMP ALLOCATE at %L not yet supported",
+ &list->where);
+}
/* Resolve ASSUME's and ASSUMES' assumption clauses. Note that absent/contains
is handled during parse time in omp_verify_merge_absent_contains. */
{
for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
{
- if (n->expr && (!gfc_resolve_expr (n->expr)
- || n->expr->ts.type != BT_INTEGER
- || n->expr->ts.kind != gfc_c_intptr_kind))
+ if (n->u2.allocator
+ && (!gfc_resolve_expr (n->u2.allocator)
+ || n->u2.allocator->ts.type != BT_INTEGER
+ || n->u2.allocator->rank != 0
+ || n->u2.allocator->ts.kind != gfc_c_intptr_kind))
{
gfc_error ("Expected integer expression of the "
"%<omp_allocator_handle_kind%> kind at %L",
- &n->expr->where);
+ &n->u2.allocator->where);
break;
}
if (!n->u.align)
continue;
- int alignment = 0;
+ HOST_WIDE_INT alignment = 0;
if (!gfc_resolve_expr (n->u.align)
|| n->u.align->ts.type != BT_INTEGER
|| n->u.align->rank != 0
- || gfc_extract_int (n->u.align, &alignment)
+ || n->u.align->expr_type != EXPR_CONSTANT
+ || gfc_extract_hwi (n->u.align, &alignment)
|| alignment <= 0
|| !pow2p_hwi (alignment))
{
- gfc_error ("ALIGN modifier requires at %L a scalar positive "
- "constant integer alignment expression that is a "
- "power of two", &n->u.align->where);
+ gfc_error ("ALIGN requires a scalar positive constant integer "
+ "alignment expression at %L that is a power of two",
+ &n->u.align->where);
break;
}
}
2. Variable in allocate clause are also present in some
privatization clase (non-composite case). */
for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
- n->sym->mark = 0;
+ if (n->sym)
+ n->sym->mark = 0;
gfc_omp_namelist *prev = NULL;
- for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;)
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; )
{
+ if (n->sym == NULL)
+ {
+ n = n->next;
+ continue;
+ }
if (n->sym->mark == 1)
{
gfc_warning (0, "%qs appears more than once in %<allocate%> "
- "clauses at %L" , n->sym->name, &n->where);
+ "at %L" , n->sym->name, &n->where);
/* We have already seen this variable so it is a duplicate.
Remove it. */
if (prev != NULL && prev->next == n)
"in an explicit privatization clause", n->sym->name,
&n->where);
}
+ if (code
+ && (code->op == EXEC_OMP_ALLOCATORS || code->op == EXEC_OMP_ALLOCATE)
+ && code->block
+ && code->block->next
+ && code->block->next->op == EXEC_ALLOCATE)
+ {
+ gfc_alloc *a;
+ gfc_omp_namelist *n_null = NULL;
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+ {
+ if (n->sym == NULL)
+ {
+ n_null = n;
+ continue;
+ }
+ for (a = code->block->next->ext.alloc.list; a; a = a->next)
+ if (a->expr->expr_type == EXPR_VARIABLE
+ && a->expr->symtree->n.sym == n->sym)
+ break;
+ if (a == NULL)
+ gfc_error ("%qs specified in %<allocate%> at %L but not "
+ "in the associated ALLOCATE statement",
+ n->sym->name, &n->where);
+ }
+ /* If there is an ALLOCATE directive without list argument, a
+ namelist with its allocator/align clauses and n->sym = NULL is
+ created during parsing; here, we add all not otherwise specified
+ items from the Fortran allocate to that list.
+ For an ALLOCATORS directive, not listed items use the normal
+ Fortran way.
+ The behavior of an ALLOCATE directive that does not list all
+ arguments but there is no directive without list argument is not
+ well specified. Thus, we reject such code below. In OpenMP 5.2
+ the executable ALLOCATE directive is deprecated and in 6.0
+ deleted such that no spec clarification is to be expected. */
+ gfc_alloc *a_prev = NULL;
+ gfc_alloc *extra_alloc = NULL, *extra_alloc_last = NULL;
+ for (a = code->block->next->ext.alloc.list; a; )
+ {
+ if (a->expr->expr_type == EXPR_VARIABLE)
+ {
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+ if (a->expr->symtree->n.sym == n->sym)
+ break;
+ if (n == NULL && n_null == NULL)
+ {
+ if (!extra_alloc)
+ extra_alloc = extra_alloc_last = a;
+ else
+ {
+ extra_alloc_last->next = a;
+ extra_alloc_last = a;
+ }
+ a = a->next;
+ if (code->block->next->ext.alloc.list == extra_alloc_last)
+ code->block->next->ext.alloc.list = a;
+ else
+ a_prev->next = a;
+ extra_alloc_last->next = NULL;
+ continue;
+ }
+ if (n == NULL)
+ {
+ if (a->expr->symtree->n.sym->attr.codimension)
+ gfc_error ("Unexpected coarray %qs in %<allocate%> at "
+ "%L, implicitly listed in %<!$OMP ALLOCATE%>"
+ " at %L", a->expr->symtree->n.sym->name,
+ &a->expr->where, &n_null->where);
+ if (n_null->sym == NULL)
+ n_null->sym = a->expr->symtree->n.sym;
+ else
+ {
+ n = n_null->next;
+ n_null->next = gfc_get_omp_namelist ();
+ n_null->next->next = n;
+ n_null->next->sym = a->expr->symtree->n.sym;
+ n_null->next->u2.allocator = n_null->u2.allocator;
+ n_null->next->u.align
+ = gfc_copy_expr (n_null->u.align);
+ n_null->next->where = n_null->where;
+ n_null = n_null->next;
+ }
+ }
+ }
+ a_prev = a;
+ a = a->next;
+ }
+ if (n_null && n_null->sym == NULL)
+ {
+ if (n_null == omp_clauses->lists[OMP_LIST_ALLOCATE])
+ omp_clauses->lists[OMP_LIST_ALLOCATE] = n_null->next;
+ else
+ {
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;
+ n = n->next)
+ if (n->next == n_null)
+ break;
+ n->next = n_null->next;
+ n_null->next = NULL;
+ gfc_free_omp_namelist (n_null, OMP_LIST_ALLOCATE);
+ }
+ }
+ if (extra_alloc)
+ {
+ /* Unspecified whether that should use the default allocator
+ of OpenMP or the Fortran allocator. Thus, just reject it. */
+ if (code->op == EXEC_OMP_ALLOCATE)
+ gfc_error ("%qs listed in %<allocate%> statement at %L but "
+ "it is neither explicitly in listed in the "
+ "%<!$OMP ALLOCATE%> directive nor exists a directive"
+ " without argument list",
+ extra_alloc->expr->symtree->n.sym->name,
+ &extra_alloc->expr->where);
+ gfc_code *c = code->block->next;
+ gcc_assert (c->op == EXEC_ALLOCATE && c->next == NULL);
+ gfc_code *cn = code->next;
+ code->next = gfc_get_code (c->op);
+ code->next->next = cn;
+ cn = code->next;
+ cn->loc = c->loc;
+ cn->expr1 = gfc_copy_expr (cn->expr1);
+ cn->expr2 = gfc_copy_expr (cn->expr2);
+ cn->expr3 = gfc_copy_expr (cn->expr3);
+ cn->ext.alloc.ts = cn->ext.alloc.ts;
+ cn->ext.alloc.list = extra_alloc;
+ cn->ext.alloc.arr_spec_from_expr3
+ = c->ext.alloc.arr_spec_from_expr3;
+ cn->ext.alloc.expr3_not_explicit
+ = c->ext.alloc.expr3_not_explicit;
+ }
+ /* The current implementation requires that an EXEC_OMP_ALLOCATE is
+ added with OMP_ALLOCATE_KIND_FREE set at the end of the scope;
+ cf. trans-decl.cc's gfc_trans_deferred_vars and
+ gfc_trans_omp_allocate. */
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+ if (n->sym
+ && n->sym->attr.allocatable
+ && !n->sym->attr.save
+ && !n->sym->attr.result
+ && !n->sym->ns->proc_name->attr.is_main_program)
+ {
+ if (ns != n->sym->ns)
+ gfc_error ("Sorry, allocation of allocatable %qs with "
+ "%<!$omp allocators%> or %<!$omp allocate%> at %L "
+ "is only suppored in the scope where it has been "
+ "declared, unless it has the SAVE attribute",
+ n->sym->name, &code->loc);
+ gfc_symbol *proc = n->sym->ns->proc_name;
+ gfc_omp_namelist *p = gfc_get_omp_namelist ();
+ p->sym = n->sym;
+ p->expr = gfc_copy_expr (n->expr);
+ p->where = code->loc;
+ p->next = NULL;
+ if (proc->omp_allocated == NULL)
+ proc->omp_allocated_end = proc->omp_allocated = p;
+ else
+ {
+ proc->omp_allocated_end->next = p;
+ proc->omp_allocated_end = p;
+ }
+ }
+ }
}
for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next)
n->sym->mark = 0;
"IN_REDUCTION", "TASK_REDUCTION",
"DEVICE_RESIDENT", "LINK", "USE_DEVICE",
"CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
- "NONTEMPORAL", "ALLOCATE", "HAS_DEVICE_ADDR", "ENTER", "ALLOCATOR",
+ "NONTEMPORAL", "ALLOCATE", "HAS_DEVICE_ADDR", "ENTER",
"USES_ALLOCATORS" };
STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
n->sym->name, &n->where);
else if (n->expr)
{
- gfc_expr *expr = n->expr;
- int alignment = 0;
- if (!gfc_resolve_expr (expr)
- || expr->ts.type != BT_INTEGER
- || expr->rank != 0
- || gfc_extract_int (expr, &alignment)
- || alignment <= 0)
- gfc_error ("%qs in ALIGNED clause at %L requires a scalar "
- "positive constant integer alignment "
+ if (!gfc_resolve_expr (n->expr)
+ || n->expr->ts.type != BT_INTEGER
+ || n->expr->rank != 0
+ || n->expr->expr_type != EXPR_CONSTANT
+ || mpz_sgn (n->expr->value.integer) <= 0)
+ gfc_error ("%qs in ALIGNED clause at %L requires a scalar"
+ " positive constant integer alignment "
"expression", n->sym->name, &n->where);
}
}
default:
for (; n != NULL; n = n->next)
{
+ if (n->sym == NULL)
+ {
+ gcc_assert (code->op == EXEC_OMP_ALLOCATORS
+ || code->op == EXEC_OMP_ALLOCATE);
+ continue;
+ }
bool bad = false;
bool is_reduction = (list == OMP_LIST_REDUCTION
|| list == OMP_LIST_REDUCTION_INSCAN
{
switch (code->op)
{
- case EXEC_OMP_ALLOCATE:
- return ST_OMP_ALLOCATE;
case EXEC_OMP_PARALLEL:
return ST_OMP_PARALLEL;
case EXEC_OMP_PARALLEL_MASKED:
return ST_OMP_DO;
case EXEC_OMP_LOOP:
return ST_OMP_LOOP;
+ case EXEC_OMP_ALLOCATE:
+ return ST_OMP_ALLOCATE_EXEC;
+ case EXEC_OMP_ALLOCATORS:
+ return ST_OMP_ALLOCATORS;
case EXEC_OMP_ASSUME:
return ST_OMP_ASSUME;
case EXEC_OMP_ATOMIC:
}
}
-static void
-prepare_omp_allocated_var_list_for_cleanup (gfc_omp_namelist *cn, locus loc)
-{
- gfc_symbol *proc = cn->sym->ns->proc_name;
- gfc_omp_namelist *p, *n;
-
- for (n = cn; n; n = n->next)
- {
- if (n->sym->attr.allocatable && !n->sym->attr.save
- && !n->sym->attr.result && !proc->attr.is_main_program)
- {
- p = gfc_get_omp_namelist ();
- p->sym = n->sym;
- p->expr = gfc_copy_expr (n->expr);
- p->where = loc;
- p->next = NULL;
- if (proc->omp_allocated == NULL)
- proc->omp_allocated_end = proc->omp_allocated = p;
- else
- {
- proc->omp_allocated_end->next = p;
- proc->omp_allocated_end = p;
- }
-
- }
- }
-}
-
-static void
-check_allocate_directive_restrictions (gfc_symbol *sym, gfc_expr *omp_al,
- gfc_namespace *ns, locus loc)
-{
- if (sym->attr.save != SAVE_NONE || sym->attr.in_common == 1
- || sym->module != NULL)
- {
- int tmp;
- /* Assumption here is that we can extract an integer then
- it is a predefined thing. */
- if (!omp_al || gfc_extract_int (omp_al, &tmp))
- gfc_error ("%qs should use predefined allocator at %L", sym->name,
- &loc);
- }
- if (ns != sym->ns)
- gfc_error ("%qs is not in the same scope as %<allocate%>"
- " directive at %L", sym->name, &loc);
-}
-
-#define EMPTY_VAR_LIST(node) \
- (node->ext.omp_clauses->lists[OMP_LIST_ALLOCATOR] == NULL)
-
-static void
-gfc_resolve_omp_allocate (gfc_code *code, gfc_namespace *ns)
-{
- gfc_alloc *al;
- gfc_omp_namelist *n = NULL;
- gfc_omp_namelist *cn = NULL;
- gfc_omp_namelist *p, *tail = NULL;
- gfc_code *cur;
- hash_set<gfc_symbol*> vars;
-
- gfc_omp_clauses *clauses = code->ext.omp_clauses;
- gcc_assert (clauses);
- cn = clauses->lists[OMP_LIST_ALLOCATOR];
- gfc_expr *omp_al = cn ? cn->expr : NULL;
-
- if (omp_al && (omp_al->ts.type != BT_INTEGER
- || omp_al->ts.kind != gfc_c_intptr_kind))
- gfc_error ("Expected integer expression of the "
- "%<omp_allocator_handle_kind%> kind at %L", &omp_al->where);
-
- /* Check that variables in this allocate directive are not duplicated
- in this directive or others coming directly after it. */
- for (cur = code; cur != NULL && cur->op == EXEC_OMP_ALLOCATE;
- cur = cur->next)
- {
- gfc_omp_clauses *c = cur->ext.omp_clauses;
- gcc_assert (c);
- for (n = c->lists[OMP_LIST_ALLOCATOR]; n; n = n->next)
- {
- if (vars.contains (n->sym))
- gfc_error ("%qs is used in multiple %<allocate%> "
- "directives at %L", n->sym->name, &cur->loc);
- /* This helps us avoid duplicate error messages. */
- if (cur == code)
- vars.add (n->sym);
- }
- }
-
- if (cur == NULL || cur->op != EXEC_ALLOCATE)
- {
- /* There is no allocate statement right after allocate directive.
- We don't support this case at the moment. */
- for (n = cn; n != NULL; n = n->next)
- {
- gfc_symbol *sym = n->sym;
- if (sym->attr.allocatable == 1)
- gfc_error ("%qs with ALLOCATABLE attribute is not allowed in "
- "%<allocate%> directive at %L as this directive is not"
- " associated with an %<allocate%> statement.",
- sym->name, &code->loc);
- }
- sorry_at (code->loc.lb->location, "%<allocate%> directive that is "
- "not associated with an %<allocate%> statement is not "
- "supported.");
- return;
- }
-
- /* If there is another allocate directive right after this one, check
- that none of them is empty. Doing it this way, we can check this
- thing even when multiple directives are together and generate
- error at right location. */
- if (code->next && code->next->op == EXEC_OMP_ALLOCATE
- && (EMPTY_VAR_LIST (code) || EMPTY_VAR_LIST (code->next)))
- gfc_error ("Empty variable list is not allowed at %L when multiple "
- "%<allocate%> directives are associated with an "
- "%<allocate%> statement.",
- EMPTY_VAR_LIST (code) ? &code->loc : &code->next->loc);
-
- if (EMPTY_VAR_LIST (code))
- {
- /* Empty namelist means allocate directive applies to all
- variables in allocate statement. 'cur' points to associated
- allocate statement. */
- for (al = cur->ext.alloc.list; al != NULL; al = al->next)
- if (al->expr && al->expr->symtree && al->expr->symtree->n.sym)
- {
- check_allocate_directive_restrictions (al->expr->symtree->n.sym,
- omp_al, ns, code->loc);
- p = gfc_get_omp_namelist ();
- p->sym = al->expr->symtree->n.sym;
- p->expr = omp_al;
- p->where = code->loc;
- if (cn == NULL)
- cn = tail = p;
- else
- {
- tail->next = p;
- tail = tail->next;
- }
- }
- clauses->lists[OMP_LIST_ALLOCATOR]= cn;
- }
- else
- {
- for (n = cn; n != NULL; n = n->next)
- {
- for (al = cur->ext.alloc.list; al != NULL; al = al->next)
- if (al->expr && al->expr->symtree && al->expr->symtree->n.sym
- && al->expr->symtree->n.sym == n->sym)
- break;
- if (al == NULL)
- gfc_error ("%qs in %<allocate%> directive at %L is not present "
- "in associated %<allocate%> statement.",
- n->sym->name, &code->loc);
- check_allocate_directive_restrictions (n->sym, omp_al, ns,
- code->loc);
- }
- }
- prepare_omp_allocated_var_list_for_cleanup (cn, code->loc);
-}
-
-
void
gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
{
case EXEC_OMP_TARGET:
resolve_omp_target (code);
gcc_fallthrough ();
+ case EXEC_OMP_ALLOCATE:
+ case EXEC_OMP_ALLOCATORS:
case EXEC_OMP_ASSUME:
case EXEC_OMP_CANCEL:
case EXEC_OMP_ERROR:
case EXEC_OMP_METADIRECTIVE:
resolve_omp_metadirective (code, ns);
break;
- case EXEC_OMP_ALLOCATE:
- gfc_resolve_omp_allocate (code, ns);
- break;
default:
break;
}
gfc_state_data *gfc_state_stack;
static bool last_was_use_stmt = false;
+bool in_exec_part;
bool gfc_matching_omp_context_selector;
bool gfc_in_metadirective_body;
return ST_GET_FCN_CHARACTERISTICS;
}
+/* Checks for the ST_OMP_ALLOCATE. First, check whether all list items
+ are allocatables/pointers - and if so, assume it is associated with a Fortran
+ ALLOCATE stmt. If not, do some initial parsing-related checks and append
+ namelist to namespace.
+ The check follows OpenMP 5.1 by requiring an executable stmt or OpenMP
+ construct before a directive associated with an allocate statement
+ (-> ST_OMP_ALLOCATE_EXEC); instead of showing an error, conversion of
+ ST_OMP_ALLOCATE -> ST_OMP_ALLOCATE_EXEC would be an alternative. */
+
+bool
+check_omp_allocate_stmt (locus *loc)
+{
+ gfc_omp_namelist *n;
+
+ if (new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE]->sym == NULL)
+ {
+ gfc_error ("%qs directive at %L must either have a variable argument or, "
+ "if associated with an ALLOCATE stmt, must be preceded by an "
+ "executable statement or OpenMP construct",
+ gfc_ascii_statement (ST_OMP_ALLOCATE), loc);
+ return false;
+ }
+ bool has_allocatable = false;
+ bool has_non_allocatable = false;
+ for (n = new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+ {
+ if (n->expr)
+ {
+ gfc_error ("Structure-component expression at %L in %qs directive not"
+ " permitted in declarative directive; as directive "
+ "associated with an ALLOCATE stmt it must be preceded by "
+ "an executable statement or OpenMP construct",
+ &n->expr->where, gfc_ascii_statement (ST_OMP_ALLOCATE));
+ return false;
+ }
+ bool alloc_ptr;
+ if (n->sym->ts.type == BT_CLASS && n->sym->attr.class_ok)
+ alloc_ptr = (CLASS_DATA (n->sym)->attr.allocatable
+ || CLASS_DATA (n->sym)->attr.class_pointer);
+ else
+ alloc_ptr = (n->sym->attr.allocatable || n->sym->attr.pointer
+ || n->sym->attr.proc_pointer);
+ if (alloc_ptr
+ || (n->sym->ns && n->sym->ns->proc_name
+ && (n->sym->ns->proc_name->attr.allocatable
+ || n->sym->ns->proc_name->attr.pointer
+ || n->sym->ns->proc_name->attr.proc_pointer)))
+ has_allocatable = true;
+ else
+ has_non_allocatable = true;
+ }
+ /* All allocatables - assume it is allocated with an ALLOCATE stmt. */
+ if (has_allocatable && !has_non_allocatable)
+ {
+ gfc_error ("%qs directive at %L associated with an ALLOCATE stmt must be "
+ "preceded by an executable statement or OpenMP construct; "
+ "note the variables in the list all have the allocatable or "
+ "pointer attribute", gfc_ascii_statement (ST_OMP_ALLOCATE),
+ loc);
+ return false;
+ }
+ if (!gfc_current_ns->omp_allocate)
+ gfc_current_ns->omp_allocate
+ = new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
+ else
+ {
+ for (n = gfc_current_ns->omp_allocate; n->next; n = n->next)
+ ;
+ n->next = new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
+ }
+ new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE] = NULL;
+ gfc_free_omp_clauses (new_st.ext.omp_clauses);
+ return true;
+}
+
+
/* Like match, but set a flag simd_matched if keyword matched
and if spec_only, goto do_spec_only without actually matching. */
#define matchs(keyword, subr, st) \
switch (c)
{
case 'a':
+ if (in_exec_part)
+ matcho ("allocate", gfc_match_omp_allocate, ST_OMP_ALLOCATE_EXEC);
+ else
+ matcho ("allocate", gfc_match_omp_allocate, ST_OMP_ALLOCATE);
+ matcho ("allocators", gfc_match_omp_allocators, ST_OMP_ALLOCATORS);
/* For -fopenmp-simd, ignore 'assumes'; note no clause starts with 's'. */
if (!flag_openmp && gfc_match ("assumes") == MATCH_YES)
break;
break;
case 'e':
matchs ("end assume", gfc_match_omp_eos_error, ST_OMP_END_ASSUME);
+ matcho ("end allocators", gfc_match_omp_eos_error, ST_OMP_END_ALLOCATORS);
matcho ("end metadirective", gfc_match_omp_eos_error,
ST_OMP_END_METADIRECTIVE);
matchs ("end simd", gfc_match_omp_eos_error, ST_OMP_END_SIMD);
{
case 'a':
matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC);
- matcho ("allocate", gfc_match_omp_allocate, ST_OMP_ALLOCATE);
break;
case 'b':
matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER);
return ST_NONE;
}
}
+ if (ret == ST_OMP_ALLOCATE && !check_omp_allocate_stmt (&old_locus))
+ goto error_handling;
+
switch (ret)
{
/* Set omp_target_seen; exclude ST_OMP_DECLARE_TARGET.
case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \
case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case ST_OMP_ERROR: \
- case ST_OMP_ALLOCATE: case ST_ERROR_STOP: case ST_OMP_SCAN: \
- case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: \
- case ST_UNLOCK: case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
+ case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \
+ case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
+ case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
case ST_END_TEAM: case ST_SYNC_TEAM: \
case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \
case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \
case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \
case ST_OMP_LOOP: case ST_OMP_PARALLEL_LOOP: case ST_OMP_TEAMS_LOOP: \
case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_TEAMS_LOOP: \
- case ST_OMP_ASSUME: \
+ case ST_OMP_ALLOCATE_EXEC: case ST_OMP_ALLOCATORS: case ST_OMP_ASSUME: \
case ST_OMP_UNROLL: \
case ST_OMP_TILE: \
case ST_CRITICAL: \
#define case_omp_decl case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \
case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_MAPPER: \
case ST_OMP_DECLARE_REDUCTION: case ST_OMP_DECLARE_VARIANT: \
- case ST_OMP_ASSUMES: case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: \
- case ST_OACC_DECLARE
+ case ST_OMP_ALLOCATE: case ST_OMP_ASSUMES: case ST_OMP_REQUIRES: \
+ case ST_OACC_ROUTINE: case ST_OACC_DECLARE
/* OpenMP statements that are followed by a structured block. */
case ST_OACC_END_ATOMIC:
p = "!$ACC END ATOMIC";
break;
+ case ST_OMP_ALLOCATE:
+ case ST_OMP_ALLOCATE_EXEC:
+ p = "!$OMP ALLOCATE";
+ break;
+ case ST_OMP_ALLOCATORS:
+ p = "!$OMP ALLOCATORS";
+ break;
case ST_OMP_ASSUME:
p = "!$OMP ASSUME";
break;
case ST_OMP_ASSUMES:
p = "!$OMP ASSUMES";
break;
- case ST_OMP_ALLOCATE:
- p = "!$OMP ALLOCATE";
- break;
case ST_OMP_ATOMIC:
p = "!$OMP ATOMIC";
break;
case ST_OMP_DO_SIMD:
p = "!$OMP DO SIMD";
break;
+ case ST_OMP_END_ALLOCATORS:
+ p = "!$OMP END ALLOCATORS";
+ break;
case ST_OMP_END_ASSUME:
p = "!$OMP END ASSUME";
break;
{
case ST_NONE:
p->state = ORDER_START;
+ in_exec_part = false;
break;
case ST_USE:
case_exec_markers:
if (p->state < ORDER_EXEC)
p->state = ORDER_EXEC;
+ in_exec_part = true;
break;
default:
}
+/* Parse an OpenMP allocate block, including optional ALLOCATORS
+ end directive. */
+
+static gfc_statement
+parse_openmp_allocate_block (gfc_statement omp_st)
+{
+ gfc_statement st;
+ gfc_code *cp, *np;
+ gfc_state_data s;
+ bool empty_list = false;
+ locus empty_list_loc;
+ gfc_omp_namelist *n_first = new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
+
+ if (omp_st == ST_OMP_ALLOCATE_EXEC
+ && new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE]->sym == NULL)
+ {
+ empty_list = true;
+ empty_list_loc = new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE]->where;
+ }
+
+ accept_statement (omp_st);
+
+ cp = gfc_state_stack->tail;
+ push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
+ np = new_level (cp);
+ np->op = cp->op;
+ np->block = NULL;
+
+ st = next_statement ();
+ while (omp_st == ST_OMP_ALLOCATE_EXEC && st == ST_OMP_ALLOCATE_EXEC)
+ {
+ if (empty_list && !new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE]->sym)
+ {
+ locus *loc = &new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE]->where;
+ gfc_error_now ("%s statements at %L and %L have both no list item but"
+ " only one may", gfc_ascii_statement (st),
+ &empty_list_loc, loc);
+ empty_list = false;
+ }
+ if (!new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE]->sym)
+ {
+ empty_list = true;
+ empty_list_loc = new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE]->where;
+ }
+ for ( ; n_first->next; n_first = n_first->next)
+ ;
+ n_first->next = new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
+ new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE] = NULL;
+ gfc_free_omp_clauses (new_st.ext.omp_clauses);
+
+ accept_statement (ST_NONE);
+ st = next_statement ();
+ }
+ if (st != ST_ALLOCATE && omp_st == ST_OMP_ALLOCATE_EXEC)
+ gfc_error_now ("Unexpected %s at %C; expected ALLOCATE or %s statement",
+ gfc_ascii_statement (st), gfc_ascii_statement (omp_st));
+ else if (st != ST_ALLOCATE)
+ gfc_error_now ("Unexpected %s at %C; expected ALLOCATE statement after %s",
+ gfc_ascii_statement (st), gfc_ascii_statement (omp_st));
+ accept_statement (st);
+ pop_state ();
+ st = next_statement ();
+ if (omp_st == ST_OMP_ALLOCATORS && st == ST_OMP_END_ALLOCATORS)
+ {
+ accept_statement (st);
+ st = next_statement ();
+ }
+ return st;
+}
+
+
/* Parse the statements of an OpenMP structured block. */
static gfc_statement
parse_forall_block ();
break;
+ case ST_OMP_ALLOCATE_EXEC:
+ case ST_OMP_ALLOCATORS:
+ st = parse_openmp_allocate_block (st);
+ continue;
+
case ST_OMP_ASSUME:
case ST_OMP_PARALLEL:
case ST_OMP_PARALLEL_MASKED:
{
int close_flag;
bool one_stmt_p = false;
+ in_exec_part = true;
if (st == ST_NONE)
st = next_statement ();
parse_oacc_structured_block (st);
break;
+ case ST_OMP_ALLOCATE_EXEC:
+ case ST_OMP_ALLOCATORS:
+ st = parse_openmp_allocate_block (st);
+ continue;
+
case_omp_structured_block:
st = parse_omp_structured_block (st,
st == ST_OMP_WORKSHARE
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ROUTINE:
+ case EXEC_OMP_ALLOCATE:
+ case EXEC_OMP_ALLOCATORS:
case EXEC_OMP_ASSUME:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_DISTRIBUTE:
break;
case EXEC_OMP_ALLOCATE:
+ case EXEC_OMP_ALLOCATORS:
case EXEC_OMP_ASSUME:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
gfc_resolve_oacc_declare (ns);
gfc_resolve_oacc_routines (ns);
gfc_resolve_omp_local_vars (ns);
+ if (ns->omp_allocate)
+ gfc_resolve_omp_allocate (ns, ns->omp_allocate);
gfc_resolve_code (ns->code, ns);
bitmap_obstack_release (&labels_obstack);
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ROUTINE:
case EXEC_OMP_ALLOCATE:
+ case EXEC_OMP_ALLOCATORS:
case EXEC_OMP_ASSUME:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CANCEL:
gfc_clear_new_st ();
new_st.op = EXEC_OMP_ALLOCATE;
gfc_omp_clauses *c = gfc_get_omp_clauses ();
- c->lists[OMP_LIST_ALLOCATOR] = proc_sym->omp_allocated;
+ c->lists[OMP_LIST_ALLOCATE] = proc_sym->omp_allocated;
new_st.ext.omp_clauses = c;
/* This is just a hacky way to convey to handler that we are
dealing with cleanup here. Saves us from using another field
tree node = build_omp_clause (input_location,
OMP_CLAUSE_ALLOCATE);
OMP_CLAUSE_DECL (node) = t;
- if (n->expr)
+ if (n->u2.allocator)
{
tree allocator_;
- if (n->expr->expr_type == EXPR_VARIABLE)
- allocator_
- = gfc_trans_omp_variable (n->expr->symtree->n.sym,
- false);
+ if (n->u2.allocator->expr_type == EXPR_VARIABLE)
+ {
+ allocator_
+ = gfc_trans_omp_variable (n->u2.allocator->symtree->n.sym,
+ false);
+ if (POINTER_TYPE_P (TREE_TYPE (allocator_)))
+ {
+ allocator_ = build_fold_indirect_ref (allocator_);
+ allocator_ = gfc_evaluate_now (allocator_, block);
+ }
+ }
else
{
gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, n->expr);
+ gfc_conv_expr (&se, n->u2.allocator);
allocator_ = gfc_evaluate_now (se.expr, block);
}
OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_;
}
}
break;
- case OMP_LIST_ALLOCATOR:
- for (; n != NULL; n = n->next)
- if (n->sym->attr.referenced)
- {
- tree t = gfc_trans_omp_variable (n->sym, false);
- if (t != error_mark_node)
- {
- tree node = build_omp_clause (input_location,
- OMP_CLAUSE_ALLOCATOR);
- OMP_ALLOCATE_DECL (node) = t;
- if (n->expr)
- {
- tree allocator_;
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, n->expr);
- allocator_ = gfc_evaluate_now (se.expr, block);
- OMP_ALLOCATE_ALLOCATOR (node) = allocator_;
- }
- omp_clauses = gfc_trans_add_clause (node, omp_clauses);
- }
- }
- break;
case OMP_LIST_LINEAR:
{
gfc_expr *last_step_expr = NULL;
}
static tree
-gfc_trans_omp_allocate (gfc_code *code)
+gfc_trans_omp_allocators (gfc_code *code)
{
stmtblock_t block;
tree stmt;
&& code->resolved_sym != NULL)
OMP_ALLOCATE_KIND_FREE (stmt) = 1;
else
- OMP_ALLOCATE_KIND_ALLOCATE (stmt) = 1;
+ {
+ OMP_ALLOCATE_KIND_ALLOCATE (stmt) = 1;
+ gfc_add_expr_to_block (&block, stmt);
+ stmt = gfc_trans_allocate (code->block->next);
+ }
gfc_add_expr_to_block (&block, stmt);
gfc_merge_block_scope (&block);
p = gfc_get_omp_namelist ();
p->sym = alloc_nl->sym;
p->expr = alloc_nl->expr;
+ p->u.align = alloc_nl->u.align;
+ p->u2.allocator = alloc_nl->u2.allocator;
p->where = alloc_nl->where;
if (clausesa[i].lists[OMP_LIST_ALLOCATE] == NULL)
{
switch (code->op)
{
case EXEC_OMP_ALLOCATE:
- return gfc_trans_omp_allocate (code);
+ case EXEC_OMP_ALLOCATORS:
+ return gfc_trans_omp_allocators (code);
case EXEC_OMP_ASSUME:
return gfc_trans_omp_assume (code);
case EXEC_OMP_ATOMIC:
break;
case EXEC_OMP_ALLOCATE:
- case EXEC_OMP_ASSUME:
+ case EXEC_OMP_ALLOCATORS:
+ case EXEC_OMP_ASSUME:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CANCEL:
#include "stringpool.h"
#include "attribs.h"
#include "omp-offload.h"
+#include "intl.h"
/* Lowering of OMP parallel and workshare constructs proceeds in two
phases. The first phase scans the function looking for OMP statements
if (OMP_CLAUSE_ALLOCATE_ALLOCATOR (c) == NULL_TREE
&& ((omp_requires_mask & OMP_REQUIRES_DYNAMIC_ALLOCATORS) == 0)
&& omp_maybe_offloaded_ctx (ctx))
- error_at (OMP_CLAUSE_LOCATION (c), "%<allocate%> clause must"
- " specify an allocator here");
+ error_at (OMP_CLAUSE_LOCATION (c),
+ gimple_code (ctx->stmt) == GIMPLE_OMP_ALLOCATE
+ ? G_("%<allocate%> directive must specify an allocator "
+ "here")
+ : G_("%<allocate%> clause must specify an allocator here"));
if (ctx->allocate_map == NULL)
ctx->allocate_map = new hash_map<tree, tree>;
tree val = integer_zero_node;
case OMP_CLAUSE_FINALIZE:
case OMP_CLAUSE_TASK_REDUCTION:
case OMP_CLAUSE_ALLOCATE:
- case OMP_CLAUSE_ALLOCATOR:
case OMP_CLAUSE__OMPACC_:
break;
case OMP_CLAUSE_FINALIZE:
case OMP_CLAUSE_FILTER:
case OMP_CLAUSE__CONDTEMP_:
- case OMP_CLAUSE_ALLOCATOR:
case OMP_CLAUSE__OMPACC_:
break;
}
static void
-lower_omp_allocate (gimple_stmt_iterator *gsi_p, omp_context *ctx)
+lower_omp_allocate (gimple_stmt_iterator *gsi_p)
{
gomp_allocate *st = as_a <gomp_allocate *> (gsi_stmt (*gsi_p));
tree clauses = gimple_omp_allocate_clauses (st);
int kind = gimple_omp_allocate_kind (st);
gcc_assert (kind == GF_OMP_ALLOCATE_KIND_ALLOCATE
|| kind == GF_OMP_ALLOCATE_KIND_FREE);
-
for (tree c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
{
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_ALLOCATOR)
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_ALLOCATE)
continue;
bool allocate = (kind == GF_OMP_ALLOCATE_KIND_ALLOCATE);
- /* The allocate directives that appear in a target region must specify
- an allocator clause unless a requires directive with the
- dynamic_allocators clause is present in the same compilation unit. */
- if (OMP_ALLOCATE_ALLOCATOR (c) == NULL_TREE
- && ((omp_requires_mask & OMP_REQUIRES_DYNAMIC_ALLOCATORS) == 0)
- && omp_maybe_offloaded_ctx (ctx))
- error_at (OMP_CLAUSE_LOCATION (c), "%<allocate%> directive must"
- " specify an allocator here");
-
- tree var = OMP_ALLOCATE_DECL (c);
-
+ tree var = OMP_CLAUSE_DECL (c);
gimple_stmt_iterator gsi = *gsi_p;
for (gsi_next (&gsi); !gsi_end_p (gsi); gsi_next (&gsi))
{
|| (!allocate && gimple_call_fndecl (stmt)
!= builtin_decl_explicit (BUILT_IN_FREE)))
continue;
+
const gcall *gs = as_a <const gcall *> (stmt);
- tree allocator = OMP_ALLOCATE_ALLOCATOR (c)
- ? OMP_ALLOCATE_ALLOCATOR (c)
- : integer_zero_node;
+ tree allocator = OMP_CLAUSE_ALLOCATE_ALLOCATOR (c)
+ ? OMP_CLAUSE_ALLOCATE_ALLOCATOR (c)
+ : build_zero_cst (ptr_type_node);
if (allocate)
{
tree lhs = gimple_call_lhs (gs);
if (lhs == var)
{
unsigned HOST_WIDE_INT ialign = 0;
- tree align;
+ tree align = OMP_CLAUSE_ALLOCATE_ALIGN (c);
if (TYPE_P (var))
ialign = TYPE_ALIGN_UNIT (var);
else
ialign = DECL_ALIGN_UNIT (var);
- align = build_int_cst (size_type_node, ialign);
+ if (align == NULL_TREE)
+ align = build_int_cst (size_type_node, ialign);
+ else
+ align = build_int_cst (size_type_node,
+ MAX (tree_to_uhwi (align),
+ ialign));
tree repl = builtin_decl_explicit (BUILT_IN_GOMP_ALLOC);
tree size = gimple_call_arg (gs, 0);
gimple *g = gimple_build_call (repl, 3, align, size,
case GIMPLE_OMP_ALLOCATE:
ctx = maybe_lookup_ctx (stmt);
gcc_assert (ctx);
- lower_omp_allocate (gsi_p, ctx);
+ lower_omp_allocate (gsi_p);
break;
case GIMPLE_OMP_SINGLE:
ctx = maybe_lookup_ctx (stmt);
+2023-10-26 Tobias Burnus <tobias@codesourcery.com>
+ Chung-Lin Tang <cltang@codesourcery.com>
+
+ * gfortran.dg/gomp/allocate-2.f90: Update dg-warning.
+ * gfortran.dg/gomp/allocate-4.f90: New upstream test.
+ * gfortran.dg/gomp/allocate-5.f90: New upstream test.
+ * gfortran.dg/gomp/allocate-6.f90: New upstream test.
+ * gfortran.dg/gomp/allocate-7.f90: New upstream test.
+ * gfortran.dg/gomp/allocate-4a.f90: Renamed from allocate-4.f90
+ * gfortran.dg/gomp/allocate-6a.f90: Renamed from allocate-6.f90
+ * gfortran.dg/gomp/allocate-7a.f90: Renamed from allocate-7.f90
+ * gfortran.dg/gomp/allocate-9a.f90: New test.
+ * gfortran.dg/gomp/allocators-1.f90: New upstream test.
+ * gfortran.dg/gomp/allocators-2.f90: New upstream test.
+
2023-09-20 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
x=3
!$omp end parallel
- !$omp parallel private (x) allocate (x) allocate (x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." }
+ !$omp parallel private (x) allocate (x) allocate (x) ! { dg-warning "'x' appears more than once in 'allocate' at .1." }
x=4
!$omp end parallel
- !$omp parallel private (x) allocate (x, x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." }
+ !$omp parallel private (x) allocate (x, x) ! { dg-warning "'x' appears more than once in 'allocate' at .1." }
x=5
!$omp end parallel
--- /dev/null
+module my_omp_lib
+ use iso_c_binding, only: c_intptr_t
+ !use omp_lib
+ implicit none
+ integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_null_allocator = 0
+
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_default_mem_alloc = 1
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_large_cap_mem_alloc = 2
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_const_mem_alloc = 3
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_high_bw_mem_alloc = 4
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_low_lat_mem_alloc = 5
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_cgroup_mem_alloc = 6
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_pteam_mem_alloc = 7
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_thread_mem_alloc = 8
+end module my_omp_lib
+
+subroutine one(n, my_alloc)
+ use my_omp_lib
+ implicit none
+integer :: n
+integer(kind=omp_allocator_handle_kind), intent(in) :: my_alloc
+
+!stack variables:
+integer :: a,b,c(n),d(5),e(2)
+!$omp allocate(a) ! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" }
+!$omp allocate ( b , c ) align ( 32) allocator (my_alloc)
+!$omp allocate (d) align( 128 )
+!$omp allocate( e ) allocator( omp_high_bw_mem_alloc )
+
+!saved vars
+integer, save :: k,l,m(5),r(2)
+!$omp allocate(k) align(16) , allocator (omp_large_cap_mem_alloc)
+!$omp allocate ( l ) allocator (omp_large_cap_mem_alloc) , align ( 32)
+!$omp allocate (m) align( 128 ),allocator( omp_high_bw_mem_alloc )
+!$omp allocate( r ) allocator( omp_high_bw_mem_alloc )
+
+!common /block/
+integer :: q,x,y(2),z(5)
+common /com1/ q,x
+common /com2/ y,z
+!$omp allocate ( / com1/) align( 128 ) allocator( omp_high_bw_mem_alloc )
+!$omp allocate(/com2 / ) allocator( omp_high_bw_mem_alloc )
+end
--- /dev/null
+module my_omp_lib
+ use iso_c_binding, only: c_intptr_t
+ !use omp_lib
+ implicit none
+ integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_null_allocator = 0
+
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_default_mem_alloc = 1
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_large_cap_mem_alloc = 2
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_const_mem_alloc = 3
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_high_bw_mem_alloc = 4
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_low_lat_mem_alloc = 5
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_cgroup_mem_alloc = 6
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_pteam_mem_alloc = 7
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_thread_mem_alloc = 8
+end module my_omp_lib
+
+subroutine one(n, my_alloc)
+ use my_omp_lib
+ implicit none
+integer :: n
+integer(kind=omp_allocator_handle_kind), intent(in) :: my_alloc
+
+!stack variables:
+integer :: a,b,c(n),d(5),e(2)
+!$omp allocate(a) ! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" }
+!$omp allocate ( b , c ) align ( 32) allocator (my_alloc)
+!$omp allocate (d) align( 128 )
+!$omp allocate( e ) allocator( omp_high_bw_mem_alloc )
+
+!saved vars
+integer, save :: k,l,m(5),r(2)
+!$omp allocate(k) align(16) , allocator (omp_large_cap_mem_alloc)
+!$omp allocate ( l ) allocator (omp_large_cap_mem_alloc) , align ( 32)
+!$omp allocate (m) align( 128 ),allocator( omp_high_bw_mem_alloc )
+!$omp allocate( r ) allocator( omp_high_bw_mem_alloc )
+
+!common /block/
+integer :: q,x,y(2),z(5)
+common /com1/ q,x
+common /com2/ y,z
+!$omp allocate ( / com1/) align( 128 ) allocator( omp_high_bw_mem_alloc )
+!$omp allocate(/com2 / ) allocator( omp_high_bw_mem_alloc )
+end
-! { dg-do compile }
-
-module omp_lib_kinds
- use iso_c_binding, only: c_int, c_intptr_t
+module my_omp_lib
+ use iso_c_binding, only: c_intptr_t
+ !use omp_lib
implicit none
- private :: c_int, c_intptr_t
- integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+ integer, parameter :: omp_allocator_handle_kind = c_intptr_t
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_null_allocator = 0
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_default_mem_alloc = 1
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_large_cap_mem_alloc = 2
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_const_mem_alloc = 3
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_high_bw_mem_alloc = 4
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_low_lat_mem_alloc = 5
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_cgroup_mem_alloc = 6
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_pteam_mem_alloc = 7
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_thread_mem_alloc = 8
-end module
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_null_allocator = 0
-subroutine foo(x, y)
- use omp_lib_kinds
- implicit none
- integer :: x
- integer :: y
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_default_mem_alloc = 1
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_large_cap_mem_alloc = 2
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_const_mem_alloc = 3
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_high_bw_mem_alloc = 4
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_low_lat_mem_alloc = 5
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_cgroup_mem_alloc = 6
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_pteam_mem_alloc = 7
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_thread_mem_alloc = 8
+ type t
+ integer :: a
+ end type t
+end module my_omp_lib
- integer, allocatable :: var1(:)
- integer, allocatable :: var2(:)
- integer, allocatable :: var3(:)
- integer, allocatable :: var4(:,:)
- integer, allocatable :: var5(:)
- integer, allocatable :: var6(:)
- integer, allocatable :: var7(:)
- integer, allocatable :: var8(:)
- integer, allocatable :: var9(:)
- integer, allocatable :: var10(:)
- integer, allocatable :: var11(:)
- integer, allocatable :: var12(:)
+subroutine zero()
+ !$omp assumes absent (allocators)
- !$omp allocate (var1) allocator(omp_default_mem_alloc)
- allocate (var1(x))
-
- !$omp allocate (var2)
- allocate (var2(x))
+ !$omp assume absent (allocators)
+ !$omp end assume
+end
- !$omp allocate (var3, var4) allocator(omp_large_cap_mem_alloc)
- allocate (var3(x),var4(x,y))
+subroutine two(c,x2,y2)
+ use my_omp_lib
+ implicit none
+ integer, allocatable :: a, b(:), c(:,:)
+ type(t), allocatable :: x1
+ type(t), pointer :: x2(:)
+ class(t), allocatable :: y1
+ class(t), pointer :: y2(:)
- !$omp allocate()
- allocate (var5(x))
+ !$omp flush ! some executable statement
+ !$omp allocate(a)
+ allocate(a)
+ deallocate(a)
- !$omp allocate
- allocate (var6(x))
+ !$omp allocate(x1,y1,x2,y2)
+ allocate(x1,y1,x2(5),y2(5))
+ deallocate(x1,y1,x2,y2)
- !$omp allocate () allocator(omp_default_mem_alloc)
- allocate (var7(x))
+ !$omp allocate(b,a) align ( 128 )
+ !$omp allocate align ( 64 )
+ allocate(a,b(4),c(3,4))
+ deallocate(a,b,c)
+end
- !$omp allocate allocator(omp_default_mem_alloc)
- allocate (var8(x))
+subroutine three(c)
+ use my_omp_lib
+ implicit none
+ integer :: q
+ integer, allocatable :: a, b(:), c(:,:)
- !$omp allocate (var9) allocator(omp_default_mem_alloc)
- !$omp allocate (var10) allocator(omp_large_cap_mem_alloc)
- allocate (var9(x), var10(x))
+ call foo() ! executable stmt
+ !$omp allocate allocator( omp_large_cap_mem_alloc ) , align(64)
+ !$omp allocate(b) allocator( omp_high_bw_mem_alloc )
+ !$omp allocate(c) allocator( omp_high_bw_mem_alloc )
+ allocate(a,b(4),c(3,4))
+ deallocate(a,b,c)
-end subroutine
+ block
+ q = 5 ! executable stmt
+ !$omp allocate(a) align(64)
+ !$omp allocate(b) allocator( omp_high_bw_mem_alloc ), align(32)
+ !$omp allocate(c) allocator( omp_thread_mem_alloc )
+ ! { dg-error "Sorry, allocation of allocatable 'a' with '!.omp allocators' or '!.omp allocate' at .1. is only suppored in the scope where it has been declared, unless it has the SAVE attribute" "" { target *-*-* } .-3 }
+ ! { dg-error "Sorry, allocation of allocatable 'b' with '!.omp allocators' or '!.omp allocate' at .1. is only suppored in the scope where it has been declared, unless it has the SAVE attribute" "" { target *-*-* } .-4 }
+ ! { dg-error "Sorry, allocation of allocatable 'c' with '!.omp allocators' or '!.omp allocate' at .1. is only suppored in the scope where it has been declared, unless it has the SAVE attribute" "" { target *-*-* } .-5 }
+ allocate(a,b(4),c(3,4))
+ deallocate(a,b,c)
+ end block
+ call inner
+contains
+ subroutine inner
+ call foo() ! executable stmt
+ !$omp allocate(a) align(64)
+ !$omp allocate(b) allocator( omp_high_bw_mem_alloc ), align(32)
+ !$omp allocate(c) allocator( omp_thread_mem_alloc )
+ ! { dg-error "Sorry, allocation of allocatable 'a' with '!.omp allocators' or '!.omp allocate' at .1. is only suppored in the scope where it has been declared, unless it has the SAVE attribute" "" { target *-*-* } .-3 }
+ ! { dg-error "Sorry, allocation of allocatable 'b' with '!.omp allocators' or '!.omp allocate' at .1. is only suppored in the scope where it has been declared, unless it has the SAVE attribute" "" { target *-*-* } .-4 }
+ ! { dg-error "Sorry, allocation of allocatable 'c' with '!.omp allocators' or '!.omp allocate' at .1. is only suppored in the scope where it has been declared, unless it has the SAVE attribute" "" { target *-*-* } .-5 }
+ allocate(a,b(4),c(3,4))
+ deallocate(a,b,c)
+ end subroutine inner
+end
-! { dg-do compile }
-! { dg-additional-options "-fdump-tree-original -fdump-tree-gimple" }
-! { dg-additional-options "-fdump-tree-omplower" }
+module my_omp_lib
+ use iso_c_binding, only: c_intptr_t
+ !use omp_lib
+ implicit none
+ integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_null_allocator = 0
+
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_default_mem_alloc = 1
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_large_cap_mem_alloc = 2
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_const_mem_alloc = 3
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_high_bw_mem_alloc = 4
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_low_lat_mem_alloc = 5
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_cgroup_mem_alloc = 6
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_pteam_mem_alloc = 7
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_thread_mem_alloc = 8
+ type t
+ integer,allocatable :: a
+ integer,pointer :: b(:,:)
+ end type t
+end module my_omp_lib
+
+subroutine zero()
+ !$omp assumes absent (allocate) ! { dg-error "Invalid 'ALLOCATE' directive at .1. in ABSENT clause: declarative, informational and meta directives not permitted" }
+
+ !$omp assume absent (allocate) ! { dg-error "Invalid 'ALLOCATE' directive at .1. in ABSENT clause: declarative, informational and meta directives not permitted" }
+ !!$omp end assume
+end
-module omp_lib_kinds
- use iso_c_binding, only: c_int, c_intptr_t
+subroutine alloc(c,x2,y2)
+ use my_omp_lib
implicit none
- private :: c_int, c_intptr_t
- integer, parameter :: omp_allocator_handle_kind = c_intptr_t
-
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_null_allocator = 0
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_default_mem_alloc = 1
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_large_cap_mem_alloc = 2
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_const_mem_alloc = 3
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_high_bw_mem_alloc = 4
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_low_lat_mem_alloc = 5
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_cgroup_mem_alloc = 6
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_pteam_mem_alloc = 7
- integer (kind=omp_allocator_handle_kind), &
- parameter :: omp_thread_mem_alloc = 8
-end module
-
-
-subroutine foo(x, y, al)
- use omp_lib_kinds
+ integer, allocatable :: a, b(:), c(:,:)
+ type(t) :: x1,x2
+ class(t) :: y1,y2
+ allocatable :: x1, y1
+
+ !$omp flush ! some executable statement
+
+ !$omp allocate(x2%a,x2%b,y2%a,y2%b) allocator(omp_pteam_mem_alloc) align(64) ! { dg-error "Sorry, structure-element list item at .1. in ALLOCATE directive is not yet supported" }
+ allocate(x2%a,x2%b(3,4),y2%a,y2%b(3,4))
+
+ !$omp allocate(b(3)) align ( 64 ) ! { dg-error "Unexpected expression as list item at .1. in ALLOCATE directive" }
+ allocate(b(3))
+end
+
+subroutine one(n, my_alloc)
+ use my_omp_lib
implicit none
-
-type :: my_type
- integer :: i
- integer :: j
- real :: x
-end type
-
- integer :: x
- integer :: y
- integer (kind=omp_allocator_handle_kind) :: al
-
- integer, allocatable :: var1
- integer, allocatable :: var2
- real, allocatable :: var3(:,:)
- type (my_type), allocatable :: var4
- integer, pointer :: pii, parr(:)
- integer, allocatable :: var
-
- character, allocatable :: str1a, str1aarr(:)
- character(len=5), allocatable :: str5a, str5aarr(:)
-
- !$omp allocate
- allocate(str1a, str1aarr(10), str5a, str5aarr(10))
+integer :: n
+integer(kind=omp_allocator_handle_kind), intent(in) :: my_alloc
+
+integer :: a,b,c(n),d(5),e(2)
+integer, save :: k,l,m(5),r(2)
+integer :: q,x,y(2),z(5)
+common /com1/ q,x
+common /com2/ y,z
+integer, allocatable :: alloc
+integer, pointer :: ptr
+
+!$omp allocate(q) ! { dg-error "'q' at .1. is part of the common block '/com1/' and may only be specificed implicitly via the named common block" }
+
+!$omp allocate(d(:)) ! { dg-error "Unexpected expression as list item at .1. in ALLOCATE directive" }
+!$omp allocate(a) align(4), align(4) ! { dg-error "Duplicated 'align' clause" }
+!$omp allocate( e ) allocator( omp_high_bw_mem_alloc ), align(32),allocator( omp_high_bw_mem_alloc ) ! { dg-error "Duplicated 'allocator' clause" }
- !$omp allocate (var1) allocator(omp_default_mem_alloc)
- !$omp allocate (var2) allocator(omp_large_cap_mem_alloc)
- allocate (var1, var2)
+!$omp allocate align(32) ! { dg-error "'!.OMP ALLOCATE' directive at .1. must either have a variable argument or, if associated with an ALLOCATE stmt, must be preceded by an executable statement or OpenMP construct" }
- !$omp allocate (var4) allocator(omp_low_lat_mem_alloc)
- allocate (var4)
- var4%i = 5
+!$omp allocate(alloc) align(128) ! { dg-error "'!.OMP ALLOCATE' directive at .1. associated with an ALLOCATE stmt must be preceded by an executable statement or OpenMP construct; note the variables in the list all have the allocatable or pointer attribute" }
+!$omp allocate(ptr) align(128) ! { dg-error "'!.OMP ALLOCATE' directive at .1. associated with an ALLOCATE stmt must be preceded by an executable statement or OpenMP construct; note the variables in the list all have the allocatable or pointer attribute" }
- !$omp allocate (var3) allocator(omp_low_lat_mem_alloc)
- allocate (var3(x,y))
+!$omp allocate(e) allocate(omp_thread_mem_alloc) ! { dg-error "Expected ALIGN or ALLOCATOR clause" }
+end
+
+subroutine two()
+ integer, allocatable :: a,b,c
+
+ call foo()
+ !$omp allocate(a)
+ a = 5 ! { dg-error "Unexpected assignment at .1.; expected ALLOCATE or !.OMP ALLOCATE statement" }
+
+ !$omp allocate ! { dg-error "!.OMP ALLOCATE statements at .1. and .2. have both no list item but only one may" }
+ !$omp allocate(b)
+ !$omp allocate ! { dg-error "!.OMP ALLOCATE statements at .1. and .2. have both no list item but only one may" }
+ allocate(a,b,c)
!$omp allocate
- allocate(pii, parr(5))
-
- ! allocate statement not associated with an allocate directive
- allocate(var)
-end subroutine
-
-! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)" 6 "original" } }
-! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)" 6 "gimple" } }
-! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "gimple" } }
-! { dg-final { scan-tree-dump-times "builtin_malloc" 11 "original" } }
-! { dg-final { scan-tree-dump-times "builtin_free" 9 "original" } }
-! { dg-final { scan-tree-dump-times "GOMP_alloc" 10 "omplower" } }
-! { dg-final { scan-tree-dump-times "GOMP_free" 8 "omplower" } }
+ allocate(a,b,c) ! allocate is no block construct, hence:
+ !$omp end allocate ! { dg-error "Unclassifiable OpenMP directive" }
+
+ !$omp allocators allocate(align(64) : a, b)
+ !$omp allocators allocate(align(128) : c) ! { dg-error "Unexpected !.OMP ALLOCATORS at .1.; expected ALLOCATE statement after !.OMP ALLOCATORS" }
+ allocate(a,b,c)
+end
--- /dev/null
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original -fdump-tree-gimple" }
+! { dg-additional-options "-fdump-tree-omplower" }
+
+module omp_lib_kinds
+ use iso_c_binding, only: c_int, c_intptr_t
+ implicit none
+ private :: c_int, c_intptr_t
+ integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_null_allocator = 0
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_default_mem_alloc = 1
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_large_cap_mem_alloc = 2
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_const_mem_alloc = 3
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_high_bw_mem_alloc = 4
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_low_lat_mem_alloc = 5
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_cgroup_mem_alloc = 6
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_pteam_mem_alloc = 7
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_thread_mem_alloc = 8
+end module
+
+
+subroutine foo(x, y, al)
+ use omp_lib_kinds
+ implicit none
+
+type :: my_type
+ integer :: i
+ integer :: j
+ real :: x
+end type
+
+ integer :: x
+ integer :: y
+ integer (kind=omp_allocator_handle_kind) :: al
+
+ integer, allocatable :: var1
+ integer, allocatable :: var2
+ real, allocatable :: var3(:,:)
+ type (my_type), allocatable :: var4
+ integer, pointer :: pii, parr(:)
+ integer, allocatable :: var
+
+ character, allocatable :: str1a, str1aarr(:)
+ character(len=5), allocatable :: str5a, str5aarr(:)
+
+ x = 5 ! Some executable stmt
+ !$omp allocate
+ allocate(str1a, str1aarr(10), str5a, str5aarr(10))
+
+ !$omp allocate (var1) allocator(omp_default_mem_alloc)
+ !$omp allocate (var2) allocator(omp_large_cap_mem_alloc)
+ allocate (var1, var2)
+
+ !$omp allocate (var4) allocator(omp_low_lat_mem_alloc)
+ allocate (var4)
+ var4%i = 5
+
+ !$omp allocate (var3) allocator(omp_low_lat_mem_alloc)
+ allocate (var3(x,y))
+
+ !$omp allocate
+ allocate(pii, parr(5))
+
+ ! allocate statement not associated with an allocate directive
+ allocate(var)
+end subroutine
+
+! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)" 5 "original" } }
+! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)" 5 "gimple" } }
+! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "gimple" } }
+! { dg-final { scan-tree-dump-times "builtin_malloc" 11 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_free" 9 "original" } }
+! { dg-final { scan-tree-dump-times "GOMP_alloc" 10 "omplower" } }
+! { dg-final { scan-tree-dump-times "GOMP_free" 8 "omplower" } }
-! { dg-do compile }
+! { dg-additional-options "-fmax-errors=1000" }
+module my_omp_lib
+ use iso_c_binding, only: c_intptr_t
+ !use omp_lib
+ implicit none
+ integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_null_allocator = 0
+
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_default_mem_alloc = 1
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_large_cap_mem_alloc = 2
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_const_mem_alloc = 3
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_high_bw_mem_alloc = 4
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_low_lat_mem_alloc = 5
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_cgroup_mem_alloc = 6
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_pteam_mem_alloc = 7
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_thread_mem_alloc = 8
+ type t
+ integer,allocatable :: a
+ integer,pointer :: b(:,:)
+ end type t
+ integer :: used
+end module my_omp_lib
+
+subroutine one(n, my_alloc)
+ use my_omp_lib
+ implicit none
+integer :: n
+integer(kind=omp_allocator_handle_kind), intent(in) :: my_alloc
+
+integer :: a,b,c(n),d(5),e(2)
+integer, save :: k,l,m(5),r(2)
+integer :: q,x,y(2),z(5)
+common /com1/ q,x
+common /com2/ y,z
+integer, allocatable :: alloc
+integer, pointer :: ptr
+integer, parameter :: prm=5
+
+!$omp allocate(prm) align(64) ! { dg-error "Argument 'prm' at .1. to declarative !.OMP ALLOCATE directive must be a variable" }
+! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
+
+!$omp allocate(used) allocator(omp_pteam_mem_alloc) ! { dg-error "Argument 'used' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
+!$omp allocate(n) allocator(omp_pteam_mem_alloc) ! { dg-error "Unexpected dummy argument 'n' as argument at .1. to declarative !.OMP ALLOCATE" }
+
+!$omp allocate (x) align(128) ! { dg-error "'x' at .1. is part of the common block '/com1/' and may only be specificed implicitly via the named common block" }
+
+!$omp allocate (a, b, a) allocator (omp_pteam_mem_alloc) ! { dg-error "Duplicated variable 'a' in !.OMP ALLOCATE" }
+contains
+
+ subroutine inner
+ !$omp allocate(a) allocator(omp_pteam_mem_alloc) ! { dg-error "Argument 'a' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
+! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
+ end
+end
+
+subroutine three(n)
+ use my_omp_lib
+ implicit none
+integer,value :: n
+integer :: a,b,c(n),d(5),e(2)
+integer, save :: k,l,m(5)
+integer :: q,x,y(2),z(5),r
+common /com4/ y,z
+allocatable :: q
+pointer :: b
+!$omp allocate (c, d) allocator (omp_pteam_mem_alloc)
+! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
+!$omp allocate (/com4/) allocator (omp_pteam_mem_alloc)
+!$omp allocate (c) allocator (omp_pteam_mem_alloc) ! { dg-error "Duplicated variable 'c' in !.OMP ALLOCATE" }
+!$omp allocate (/com4/) allocator (omp_pteam_mem_alloc) ! { dg-error "Duplicated common block '/com4/' in !.OMP ALLOCATE" }
+
+!$omp allocate(q,x) ! { dg-error "Unexpected allocatable variable 'q' at .1. in declarative !.OMP ALLOCATE directive" }
+!$omp allocate(b,e) ! { dg-error "Unexpected pointer variable 'b' at .1. in declarative !.OMP ALLOCATE directive" }
+end
+
+subroutine four(n)
+ integer :: qq, rr, ss, tt, uu, vv,n
+!$omp allocate (qq) align(3+n) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
+! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
+!$omp allocate (rr) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
+!$omp allocate (ss) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
+!$omp allocate (tt) align(32.0) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
+!$omp allocate (uu) align(31) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
+end
+
+subroutine five(n,my_alloc)
+ use my_omp_lib
+ implicit none
+ integer :: qq, rr, ss, tt, uu, vv,n
+ integer(omp_allocator_handle_kind) :: my_alloc
+!$omp allocate (qq) allocator(3.0) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
+! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
+!$omp allocate (rr) allocator(3_2) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
+!$omp allocate (ss) allocator([omp_pteam_mem_alloc]) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
+!$omp allocate (tt) allocator(my_alloc) ! OK
+end
+
+
+subroutine five_SaveAll(n,my_alloc)
+ use my_omp_lib
+ implicit none
+ save
+ integer :: qq, rr, ss, tt, uu, vv,n
+ integer(omp_allocator_handle_kind) :: my_alloc
+!$omp allocate (qq) allocator(3.0) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" }
+! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
+!$omp allocate (rr) allocator(3_2) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" }
+!$omp allocate (ss) allocator([omp_pteam_mem_alloc]) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" }
+!$omp allocate (tt) allocator(my_alloc) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" }
+end
-subroutine bar(a)
+
+subroutine five_Save(n,my_alloc)
+ use my_omp_lib
+ implicit none
+ integer :: n
+ integer, save :: qq, rr, ss, tt, uu, vv
+ integer(omp_allocator_handle_kind) :: my_alloc
+!$omp allocate (qq) allocator(3.0) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" }
+! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
+!$omp allocate (rr) allocator(3_2) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" }
+!$omp allocate (ss) allocator([omp_pteam_mem_alloc]) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" }
+!$omp allocate (tt) allocator(my_alloc) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" }
+end
+
+module five_Module
+ use my_omp_lib
+ implicit none
+ integer, save :: qq, rr, ss, tt, uu, vv,n
+ integer(omp_allocator_handle_kind) :: my_alloc
+!$omp allocate (qq) allocator(3.0) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" }
+! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
+!$omp allocate (rr) allocator(3_2) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" }
+!$omp allocate (ss) allocator([omp_pteam_mem_alloc]) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" }
+!$omp allocate (tt) allocator(my_alloc) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" }
+end module
+
+program five_program
+ use my_omp_lib
+ implicit none
+ integer, save :: qq, rr, ss, tt, uu, vv,n
+ integer(omp_allocator_handle_kind) :: my_alloc
+!$omp allocate (qq) allocator(3.0) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" }
+! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
+!$omp allocate (rr) allocator(3_2) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" }
+!$omp allocate (ss) allocator([omp_pteam_mem_alloc]) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" }
+!$omp allocate (tt) allocator(my_alloc) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" }
+end program
+
+
+
+subroutine six(n,my_alloc)
+ use my_omp_lib
+ implicit none
+ integer :: qq, rr, ss, tt, uu, vv,n
+ common /com6qq/ qq
+ common /com6rr/ rr
+ common /com6ss/ ss
+ common /com6tt/ tt
+ integer(omp_allocator_handle_kind) :: my_alloc
+
+!$omp allocate (/com6qq/) allocator(3.0) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6qq/' at .2. has the SAVE attribute" }
+! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
+!$omp allocate (/com6rr/) allocator(3_2) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6rr/' at .2. has the SAVE attribute" }
+!$omp allocate (/com6ss/) allocator([omp_pteam_mem_alloc]) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6ss/' at .2. has the SAVE attribute" }
+!$omp allocate (/com6tt/) allocator(my_alloc) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6tt/' at .2. has the SAVE attribute" }
+end
+
+
+subroutine two()
+ use my_omp_lib
+ implicit none
+ integer,allocatable :: qq, rr, ss, tt, uu, vv,n
+ integer(omp_allocator_handle_kind) :: my_alloc
+
+ call foo()
+!$omp allocate (qq) allocator(3.0) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
+allocate(qq)
+!$omp allocate (rr) allocator(3_2) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
+allocate(rr)
+!$omp allocate (ss) allocator([omp_pteam_mem_alloc]) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
+allocate(ss)
+!$omp allocate (tt) allocator(my_alloc) ! OK
+allocate(tt)
+end
+
+subroutine two_ptr()
+ use my_omp_lib
implicit none
- integer :: a
- integer, allocatable :: var
-!$omp target
- !$omp allocate (var) ! { dg-error "'allocate' directive must specify an allocator here" }
- allocate (var)
-!$omp end target
+ integer,pointer :: qq, rr, ss, tt, uu, vv,n
+ integer(omp_allocator_handle_kind) :: my_alloc
+
+ call foo()
+!$omp allocate (qq) align(3+n) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
+allocate(qq)
+!$omp allocate (rr) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
+allocate(rr)
+!$omp allocate (ss) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
+allocate(ss)
+!$omp allocate (tt) align(32.0) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
+allocate(tt)
+!$omp allocate (uu) align(31) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
+allocate(uu)
+end
+
+subroutine next()
+ use my_omp_lib
+ implicit none
+ integer,allocatable :: qq, rr, ss, tt, uu, vv,n
+ integer(omp_allocator_handle_kind) :: my_alloc
+
+ !$omp allocate(qq) ! { dg-error "'!.OMP ALLOCATE' directive at .1. associated with an ALLOCATE stmt must be preceded by an executable statement or OpenMP construct; note the variables in the list all have the allocatable or pointer attribute" }
+ allocate(qq,rr)
-end subroutine
+ !$omp allocate(uu,tt)
+ !$omp allocate(tt) ! { dg-warning "'tt' appears more than once in 'allocate" }
+ allocate(uu,tt)
+ !$omp allocate(uu,vv) ! { dg-error "'uu' specified in 'allocate' at .1. but not in the associated ALLOCATE statement" }
+ allocate(vv)
+end
--- /dev/null
+! { dg-do compile }
+
+subroutine bar(a)
+ implicit none
+ integer :: a
+ integer, allocatable :: var
+!$omp target
+ !$omp allocate (var) ! { dg-error "'allocate' directive must specify an allocator here" }
+ allocate (var)
+!$omp end target
+
+end subroutine
+
--- /dev/null
+! { dg-additional-options "-fdump-tree-omplower" }
+subroutine f()
+ integer, allocatable :: A, B
+
+ !$omp allocators allocate(align(128): A)
+ allocate(A)
+
+ !$omp allocate(B) align(256)
+ allocate(B)
+end
+
+! { dg-final { scan-tree-dump "a = __builtin_GOMP_alloc \\(128, 4, 0B\\);" "omplower" } }
+! { dg-final { scan-tree-dump "b = __builtin_GOMP_alloc \\(256, 4, 0B\\);" "omplower" } }
+! { dg-final { scan-tree-dump "__builtin_GOMP_free \\(b, 0B\\);" "omplower" } }
+! { dg-final { scan-tree-dump "__builtin_GOMP_free \\(a, 0B\\);" "omplower" } }
--- /dev/null
+implicit none
+integer, allocatable :: a, b
+integer :: q
+integer :: arr(2)
+
+!$omp allocators allocate(align(64): a)
+block ! { dg-error "expected ALLOCATE statement after !.OMP ALLOCATORS" }
+end block ! { dg-error "Expecting END PROGRAM statement" }
+
+
+!$omp allocators allocate(align(64): a)
+ allocate(a, b) ! OK
+!$omp end allocators
+
+!$omp allocators allocate(align(128): b)
+ allocate(a, b) ! OK (assuming not allocated)
+
+
+!$omp allocators allocate(align(64): a)
+ allocate(a, b, stat=arr) ! { dg-error "Stat-variable at .1. must be a scalar INTEGER variable" }
+!$omp end allocators
+
+
+!$omp allocators allocate(align(64): a)
+ allocate(q) ! { dg-error "is neither a data pointer nor an allocatable variable" }
+!$omp end allocators ! { dg-error "Unexpected !.OMP END ALLOCATORS" }
+
+end
--- /dev/null
+implicit none
+integer, allocatable :: a, b
+integer :: q
+integer :: arr(2)
+
+!$omp allocators allocate(align(64): a)
+ allocate(a, b) ! OK
+!$omp end allocators
+
+!$omp allocators allocate(align(128): b)
+ allocate(a, b) ! OK (assuming not allocated)
+
+
+!$omp allocators allocate(align(62.0): a) ! { dg-error "a scalar positive constant integer alignment expression" }
+ allocate(a)
+
+
+!$omp allocators allocate(align(64): a, b) ! { dg-error "'b' specified in 'allocate' at \\(1\\) but not in the associated ALLOCATE statement" }
+ allocate(a)
+!$omp end allocators
+
+end
/* OpenACC clause: nohost. */
OMP_CLAUSE_NOHOST,
- /* OpenMP clause: allocator. */
- OMP_CLAUSE_ALLOCATOR,
-
/* OpenMP clause: uses_allocators. */
OMP_CLAUSE_USES_ALLOCATORS,
pp_right_paren (pp);
break;
- case OMP_CLAUSE_ALLOCATOR:
- pp_string (pp, "(");
- dump_generic_node (pp, OMP_ALLOCATE_DECL (clause),
- spc, flags, false);
- if (OMP_ALLOCATE_ALLOCATOR (clause))
- {
- pp_string (pp, ":allocator(");
- dump_generic_node (pp, OMP_ALLOCATE_ALLOCATOR (clause),
- spc, flags, false);
- pp_right_paren (pp);
- }
- pp_right_paren (pp);
- break;
-
case OMP_CLAUSE_ALLOCATE:
pp_string (pp, "allocate(");
if (OMP_CLAUSE_ALLOCATE_ALLOCATOR (clause))
0, /* OMP_CLAUSE_IF_PRESENT */
0, /* OMP_CLAUSE_FINALIZE */
0, /* OMP_CLAUSE_NOHOST */
- 2, /* OMP_CLAUSE_ALLOCATOR */
3, /* OMP_CLAUSE_USES_ALLOCATORS */
1, /* OMP_CLAUSE_UNROLL_FULL */
1, /* OMP_CLAUSE_UNROLL_NONE */
#define OMP_CLAUSE_ALLOCATE_ALIGN(NODE) \
OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATE), 2)
-/* May be we can use OMP_CLAUSE_DECL but the I am not sure where to place
- OMP_CLAUSE_ALLOCATOR in omp_clause_code. */
-
-#define OMP_ALLOCATE_DECL(NODE) \
- OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATOR), 0)
-
-#define OMP_ALLOCATE_ALLOCATOR(NODE) \
- OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATOR), 1)
-
/* True if an ALLOCATE clause was present on a combined or composite
construct and the code for splitting the clauses has already performed
checking if the listed variable has explicit privatization on the
+2023-10-26 Tobias Burnus <tobias@codesourcery.com>
+ Chung-Lin Tang <cltang@codesourcery.com>
+
+ * testsuite/libgomp.fortran/allocate-2a.f90: Add exec stmt.
+ * testsuite/libgomp.fortran/allocate-4.f90: Update dg-error
+ * testsuite/libgomp.fortran/allocate-5.f90: Likewise; add exec stmt.
+
2023-09-20 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
integer (kind=omp_allocator_handle_kind) :: h
integer, allocatable :: var1
+ !$omp flush ! executable statement before '!$omp allocate'
!$omp allocate (var1) allocator(h)
allocate (var1)
!$omp parallel allocate( allocator (omp_high_bw_mem_alloc) : x) firstprivate(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
!$omp end parallel
-!$omp parallel allocate( align (q) : x) firstprivate(x) ! { dg-error "32:ALIGN modifier requires at \\(1\\) a scalar positive constant integer alignment expression that is a power of two" }
+!$omp parallel allocate( align (q) : x) firstprivate(x) ! { dg-error "32:ALIGN requires a scalar positive constant integer alignment expression at \\(1\\) that is a power of two" }
!$omp end parallel
!$omp parallel allocate( align (32) : x) firstprivate(x) ! OK
!$omp end parallel
-!$omp parallel allocate( align(q) : x) firstprivate(x) ! { dg-error "31:ALIGN modifier requires at \\(1\\) a scalar positive constant integer alignment expression that is a power of two" }
+!$omp parallel allocate( align(q) : x) firstprivate(x) ! { dg-error "31:ALIGN requires a scalar positive constant integer alignment expression at \\(1\\) that is a power of two" }
!$omp end parallel
!$omp parallel allocate( align(cnst(1)) : x ) firstprivate(x) ! OK
!$omp end parallel
-!$omp parallel allocate( align(cnst(2)) : x) firstprivate(x) ! { dg-error "31:ALIGN modifier requires at \\(1\\) a scalar positive constant integer alignment expression that is a power of two" }
+!$omp parallel allocate( align(cnst(2)) : x) firstprivate(x) ! { dg-error "31:ALIGN requires a scalar positive constant integer alignment expression at \\(1\\) that is a power of two" }
!$omp end parallel
-!$omp parallel allocate( align( 31) :x) firstprivate(x) ! { dg-error "32:ALIGN modifier requires at \\(1\\) a scalar positive constant integer alignment expression that is a power of two" }
+!$omp parallel allocate( align( 31) :x) firstprivate(x) ! { dg-error "32:ALIGN requires a scalar positive constant integer alignment expression at \\(1\\) that is a power of two" }
!$omp end parallel
-!$omp parallel allocate( align (32.0): x) firstprivate(x) ! { dg-error "32:ALIGN modifier requires at \\(1\\) a scalar positive constant integer alignment expression that is a power of two" }
+!$omp parallel allocate( align (32.0): x) firstprivate(x) ! { dg-error "32:ALIGN requires a scalar positive constant integer alignment expression at \\(1\\) that is a power of two" }
!$omp end parallel
-!$omp parallel allocate( align(cnst ) : x ) firstprivate(x) ! { dg-error "31:ALIGN modifier requires at \\(1\\) a scalar positive constant integer alignment expression that is a power of two" }
+!$omp parallel allocate( align(cnst ) : x ) firstprivate(x) ! { dg-error "31:ALIGN requires a scalar positive constant integer alignment expression at \\(1\\) that is a power of two" }
!$omp end parallel
end
integer, allocatable :: var8(:)
integer, allocatable :: var9(:)
+ x = 1 ! executable statement before '!$omp allocate'
+
! Don't use a hard-coded value (..., but it does pass the checks).
!$omp allocate (var1) allocator(10_omp_allocator_handle_kind) ! { dg-bogus "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
allocate (var1(x))
!$omp allocate (var1) allocator(10_1) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
allocate (var1(x))
- !$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
- allocate (var3(x))
+ !$omp allocate (var2) ! { dg-error "'var2' specified in 'allocate' at .1. but not in the associated ALLOCATE statement" }
+ allocate (var3(x)) ! { dg-error "'var3' listed in 'allocate' statement at .1. but it is neither explicitly in listed in the '!.OMP ALLOCATE' directive nor exists a directive without argument list" }
- !$omp allocate (x) ! { dg-message "sorry, unimplemented: 'allocate' directive that is not associated with an 'allocate' statement is not supported." }
- x = 2
+ !$omp allocate (x)
+ x = 2 ! { dg-error "Unexpected assignment at .1.; expected ALLOCATE or !.OMP ALLOCATE statement" }
- !$omp allocate (var4) ! { dg-error "'var4' with ALLOCATABLE attribute is not allowed in 'allocate' directive at .1. as this directive is not associated with an 'allocate' statement." }
- ! { dg-message "sorry, unimplemented: 'allocate' directive that is not associated with an 'allocate' statement is not supported." "" { target *-*-* } .-1 }
- y = 2
+ !$omp allocate (var4)
+ y = 2 ! { dg-error "Unexpected assignment at .1.; expected ALLOCATE or !.OMP ALLOCATE statement" }
!$omp allocate (var5)
- !$omp allocate ! { dg-error "Empty variable list is not allowed at .1. when multiple 'allocate' directives are associated with an 'allocate' statement." }
+ !$omp allocate
allocate (var5(x))
!$omp allocate (var6)
- !$omp allocate (var7) ! { dg-error "'var7' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
- !$omp allocate (var8) ! { dg-error "'var8' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
+ !$omp allocate (var7) ! { dg-error "'var7' specified in 'allocate' at .1. but not in the associated ALLOCATE statement" }
+ !$omp allocate (var8) ! { dg-error "'var8' specified in 'allocate' at .1. but not in the associated ALLOCATE statement" }
allocate (var6(x))
!$omp allocate (var9)
- !$omp allocate (var9) ! { dg-error "'var9' is used in multiple 'allocate' directives at .1." }
+ !$omp allocate (var9) ! { dg-warning "var9' appears more than once in 'allocate'" }
allocate (var9(x))
end subroutine
integer :: x
integer, allocatable :: var2
- !$omp allocate (var1, var2) ! { dg-error "'var1' is not in the same scope as 'allocate' directive at .1." }
+ x = 1 ! executable statement before '!$omp allocate'
+
+ !$omp allocate (var1, var2) ! { dg-error "Sorry, allocation of allocatable 'var1' with '!.omp allocators' or '!.omp allocate' at .1. is only suppored in the scope where it has been declared, unless it has the SAVE attribute" }
allocate (var1, var2)
inner = x + 10
a = omp_init_allocator (omp_default_mem_space, 3, traits)
if (a == omp_null_allocator) stop 1
- !$omp allocate (mvar1) allocator(a) ! { dg-error "'mvar1' should use predefined allocator at .1." }
+ !$omp allocate (mvar1) allocator(a)
allocate (mvar1)
- !$omp allocate (mvar2) ! { dg-error "'mvar2' should use predefined allocator at .1." }
+ !$omp allocate (mvar2)
allocate (mvar2)
!$omp allocate (mvar3) allocator(omp_low_lat_mem_alloc)
allocate (mvar3)
- !$omp allocate (svar1) allocator(a) ! { dg-error "'svar1' should use predefined allocator at .1." }
+ !$omp allocate (svar1) allocator(a)
allocate (svar1)
- !$omp allocate (svar2) ! { dg-error "'svar2' should use predefined allocator at .1." }
+ !$omp allocate (svar2)
allocate (svar2)
!$omp allocate (svar3) allocator(omp_low_lat_mem_alloc)
allocate (svar3)
end subroutine
-
projects / thirdparty / gcc.git / commitdiff
