Fortran/OpenMP: Add parsing support for allocators/allocate directive gcc/fortran/ChangeLog: * dump-parse-tree.cc (show_omp_namelist): Update allocator, fix align dump. (show_omp_node, show_code_node): Handle EXEC_OMP_ALLOCATE. * gfortran.h (enum gfc_statement): Add ST_OMP_ALLOCATE and ..._EXEC. (enum gfc_exec_op): Add EXEC_OMP_ALLOCATE. (struct gfc_omp_namelist): Add 'allocator' to 'u2' union. (struct gfc_namespace): Add omp_allocate. (gfc_resolve_omp_allocate): New. * match.cc (gfc_free_omp_namelist): Free 'u2.allocator'. * match.h (gfc_match_omp_allocate, gfc_match_omp_allocators): New. * openmp.cc (gfc_omp_directives): Uncomment allocate/allocators. (gfc_match_omp_variable_list): Add bool arg for rejecting listening common-block vars separately. (gfc_match_omp_clauses): Update for u2.allocators. (OMP_ALLOCATORS_CLAUSES, gfc_match_omp_allocate, gfc_match_omp_allocators, is_predefined_allocator, gfc_resolve_omp_allocate): New. (resolve_omp_clauses): Update 'allocate' clause checks. (omp_code_to_statement, gfc_resolve_omp_directive): Handle OMP ALLOCATE/ALLOCATORS. * parse.cc (in_exec_part): New global var. (check_omp_allocate_stmt, parse_openmp_allocate_block): New. (decode_omp_directive, case_exec_markers, case_omp_decl, gfc_ascii_statement, parse_omp_structured_block): Handle OMP allocate/allocators. (verify_st_order, parse_executable): Set in_exec_part. * resolve.cc (gfc_resolve_blocks, resolve_codes): Handle allocate/allocators. * st.cc (gfc_free_statement): Likewise. * trans.cc (trans_code):) Likewise. * trans-openmp.cc (gfc_trans_omp_directive): Likewise. (gfc_trans_omp_clauses, gfc_split_omp_clauses): Update for u2.allocator, fix for u.align. libgomp/ChangeLog: * testsuite/libgomp.fortran/allocate-3.f90: Update dg-error. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-2.f90: Update dg-error. * gfortran.dg/gomp/allocate-4.f90: New test. * gfortran.dg/gomp/allocate-5.f90: New test. * gfortran.dg/gomp/allocate-6.f90: New test. * gfortran.dg/gomp/allocate-7.f90: New test. * gfortran.dg/gomp/allocators-1.f90: New test. * gfortran.dg/gomp/allocators-2.f90: New test. gcc/fortran/dump-parse-tree.cc | 8 +- gcc/fortran/gfortran.h | 9 +- gcc/fortran/match.cc | 7 +- gcc/fortran/match.h | 2 + gcc/fortran/openmp.cc | 328 +++++++++++++++++++++-- gcc/fortran/parse.cc | 184 ++++++++++++- gcc/fortran/resolve.cc | 6 + gcc/fortran/st.cc | 2 + gcc/fortran/trans-openmp.cc | 14 +- gcc/fortran/trans.cc | 2 + gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 | 4 +- gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 | 54 ++++ gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 | 93 +++++++ gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 | 103 +++++++ gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 | 230 ++++++++++++++++ gcc/testsuite/gfortran.dg/gomp/allocators-1.f90 | 28 ++ gcc/testsuite/gfortran.dg/gomp/allocators-2.f90 | 22 ++ libgomp/testsuite/libgomp.fortran/allocate-3.f90 | 2 +- 18 files changed, 1062 insertions(+), 36 deletions(-) diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 5ae72dc1cac..440fb461f46 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -1362,14 +1362,14 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) 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); } @@ -2081,6 +2081,8 @@ show_omp_node (int level, gfc_code *c) case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break; 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; @@ -3409,6 +3411,8 @@ show_code_node (int level, gfc_code *c) 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_ATOMIC: case EXEC_OMP_CANCEL: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 219ef8c7612..490c977287e 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -318,6 +318,8 @@ enum gfc_statement ST_OMP_END_MASKED_TASKLOOP, ST_OMP_MASKED_TASKLOOP_SIMD, ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_OMP_SCOPE, ST_OMP_END_SCOPE, 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 }; @@ -1362,6 +1364,7 @@ typedef struct gfc_omp_namelist { struct gfc_omp_namelist_udr *udr; gfc_namespace *ns; + gfc_expr *allocator; } u2; struct gfc_omp_namelist *next; locus where; @@ -2174,8 +2177,9 @@ typedef struct gfc_namespace /* 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. */ @@ -2971,7 +2975,7 @@ enum gfc_exec_op 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_ERROR + EXEC_OMP_ERROR, EXEC_OMP_ALLOCATE, EXEC_OMP_ALLOCATORS }; typedef struct gfc_code @@ -3607,6 +3611,7 @@ void gfc_free_omp_declare_simd (gfc_omp_declare_simd *); void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *); void gfc_free_omp_udr (gfc_omp_udr *); 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 *); void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *); void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *, bool); diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index 89fb115c0f6..dce72c91bde 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -5524,17 +5524,20 @@ gfc_free_namelist (gfc_namelist *name) /* Free an OpenMP namelist structure. */ void -gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns, bool free_align) +gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns, + bool free_align_allocator) { gfc_omp_namelist *n; for (; name; name = n) { gfc_free_expr (name->expr); - if (free_align) + if (free_align_allocator) gfc_free_expr (name->u.align); if (free_ns) gfc_free_namespace (name->u2.ns); + else if (free_align_allocator) + gfc_free_expr (name->u2.allocator); else if (name->u2.udr) { if (name->u2.udr->combiner) diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 2a805815d9c..488958b439c 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -149,6 +149,8 @@ match gfc_match_oacc_routine (void); /* 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); diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index b71ee467c01..39f3d98caf8 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -54,8 +54,8 @@ struct gfc_omp_directive { 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}, @@ -394,7 +394,8 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, 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; @@ -482,6 +483,15 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, 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 % 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; @@ -1895,7 +1905,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, 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); @@ -4270,6 +4281,8 @@ cleanup: (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) static match @@ -4284,6 +4297,112 @@ match_omp (gfc_exec_op op, const omp_mask mask) return MATCH_YES; } +/* Handles both declarative and (deprecated) executable ALLOCATE directive; + accepts optional list (for executable) and common blocks. + No namelist is denotes by a namelist with 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 (an accidental change). See also + the comment on the 'omp allocators' directive below. + + FIXME: Structure elements are rejected for now to make resolving + OMP_LIST_ALLOCATE simpler (check for duplicates, same symbol in Fortran + allocate stmt) - depending also on the development of the OpenMP spec. */ + +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, false, true); + 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; +} + +/* Note that structure components are not permitted; but see note above for the + 'omp allocate' directive above. */ + +match +gfc_match_omp_allocators (void) +{ + return match_omp (EXEC_OMP_ALLOCATORS, OMP_ALLOCATORS_CLAUSES); +} + match gfc_match_omp_assume (void) @@ -6903,6 +7022,128 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns, 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 mapping. */ + +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 % 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 " + "% 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. */ @@ -7374,25 +7615,28 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, { 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 " "% 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) { - gfc_error ("ALIGN modifier requires a scalar positive " + gfc_error ("ALIGN requires a scalar positive " "constant integer alignment expression at %L", &n->u.align->where); break; @@ -7404,15 +7648,21 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, 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 % " - "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) @@ -7457,6 +7707,28 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "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; + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + { + if (n->sym == NULL) + 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 % at %L but not " + "in the associated ALLOCATE statement", + n->sym->name, &n->where); + } + } + } /* OpenACC reductions. */ @@ -7560,15 +7832,13 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, 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); } } @@ -7932,6 +8202,12 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, 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 @@ -9626,6 +9902,10 @@ omp_code_to_statement (gfc_code *code) 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: @@ -10147,6 +10427,8 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_TEAMS_LOOP: resolve_omp_do (code); break; + case EXEC_OMP_ALLOCATE: + case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: case EXEC_OMP_CANCEL: case EXEC_OMP_ERROR: diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index bc2b2188eea..f8e4c4bcf2b 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -39,6 +39,7 @@ static jmp_buf eof_buf; gfc_state_data *gfc_state_stack; static bool last_was_use_stmt = false; +bool in_exec_part; /* TODO: Re-order functions to kill these forward decls. */ static void check_statement_label (gfc_statement); @@ -745,6 +746,82 @@ decode_oacc_directive (void) 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 woulc 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) \ @@ -885,6 +962,11 @@ decode_omp_directive (void) 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); matcho ("assumes", gfc_match_omp_assumes, ST_OMP_ASSUMES); matchs ("assume", gfc_match_omp_assume, ST_OMP_ASSUME); matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC); @@ -915,6 +997,7 @@ decode_omp_directive (void) break; case 'e': matcho ("error", gfc_match_omp_error, ST_OMP_ERROR); + matcho ("end allocators", gfc_match_omp_eos_error, ST_OMP_END_ALLOCATORS); matchs ("end assume", gfc_match_omp_eos_error, ST_OMP_END_ASSUME); matcho ("end atomic", gfc_match_omp_eos_error, ST_OMP_END_ATOMIC); matcho ("end critical", gfc_match_omp_end_critical, ST_OMP_END_CRITICAL); @@ -1171,6 +1254,9 @@ decode_omp_directive (void) 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. @@ -1720,7 +1806,7 @@ next_statement (void) 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_CRITICAL: \ case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \ case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \ @@ -1738,7 +1824,7 @@ next_statement (void) #define case_omp_decl case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \ case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \ - case ST_OMP_DECLARE_VARIANT: case ST_OMP_ASSUMES: \ + case ST_OMP_DECLARE_VARIANT: case ST_OMP_ALLOCATE: case ST_OMP_ASSUMES: \ case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE /* Block end statements. Errors associated with interchanging these @@ -2359,6 +2445,13 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel) 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; @@ -2413,6 +2506,9 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel) 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; @@ -2980,6 +3076,7 @@ verify_st_order (st_state *p, gfc_statement st, bool silent) { case ST_NONE: p->state = ORDER_START; + in_exec_part = false; break; case ST_USE: @@ -3053,6 +3150,7 @@ verify_st_order (st_state *p, gfc_statement st, bool silent) case_exec_markers: if (p->state < ORDER_EXEC) p->state = ORDER_EXEC; + in_exec_part = true; break; default: @@ -5526,6 +5624,77 @@ parse_oacc_loop (gfc_statement acc_st) } +/* 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 @@ -5681,6 +5850,11 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) 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: @@ -5813,6 +5987,7 @@ static gfc_statement parse_executable (gfc_statement st) { int close_flag; + in_exec_part = true; if (st == ST_NONE) st = next_statement (); @@ -5923,6 +6098,11 @@ parse_executable (gfc_statement st) parse_oacc_structured_block (st); 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: diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 0f5f1d277e4..759fcacf7e8 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -10909,6 +10909,8 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) 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: @@ -12384,6 +12386,8 @@ start: gfc_resolve_oacc_directive (code, ns); break; + case EXEC_OMP_ALLOCATE: + case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: @@ -17626,6 +17630,8 @@ resolve_codes (gfc_namespace *ns) 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); diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc index 8b4ca5ec2ea..978ac0569bb 100644 --- a/gcc/fortran/st.cc +++ b/gcc/fortran/st.cc @@ -214,6 +214,8 @@ gfc_free_statement (gfc_code *p) 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_ATOMIC: case EXEC_OMP_CANCEL: diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 395bcc98e00..f9ee107bfcf 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -2716,11 +2716,11 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, tree node = build_omp_clause (input_location, OMP_CLAUSE_ALLOCATE); OMP_CLAUSE_DECL (node) = t; - if (n->expr) + if (n->u2.allocator) { tree allocator_; 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_; } @@ -6518,6 +6518,8 @@ gfc_split_omp_clauses (gfc_code *code, 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) { @@ -7569,6 +7571,14 @@ gfc_trans_omp_directive (gfc_code *code) { switch (code->op) { + case EXEC_OMP_ALLOCATE: + case EXEC_OMP_ALLOCATORS: + /* Note that the allocate-stmt associated OMP ALLOCATE (but not + OMP ALLOCATORS) permits structure elements; however, those are + currently rejected directly after parsing. */ + sorry ("% not yet supported", + code->op == EXEC_OMP_ALLOCATE ? "ALLOCATE" : "ALLOCATORS"); + return NULL_TREE; case EXEC_OMP_ASSUME: return gfc_trans_omp_assume (code); case EXEC_OMP_ATOMIC: diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index 8a64882ea9e..9b4fb575572 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -2174,6 +2174,8 @@ trans_code (gfc_code * code, tree cond) res = gfc_trans_dt_end (code); break; + case EXEC_OMP_ALLOCATE: + case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 index 657ff44d023..cc83b5edbce 100644 --- a/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 @@ -25,11 +25,11 @@ subroutine foo(x) 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 diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 new file mode 100644 index 00000000000..a2dcf105ee1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 @@ -0,0 +1,54 @@ +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 diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 new file mode 100644 index 00000000000..bf9c781dcc5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 @@ -0,0 +1,93 @@ +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 :: a + end type t +end module my_omp_lib + +subroutine zero() + !$omp assumes absent (allocators) + + !$omp assume absent (allocators) + !$omp end assume +end + +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 flush ! some executable statement + !$omp allocate(a) ! { dg-message "not yet supported" } + allocate(a,b(4),c(3,4)) + deallocate(a,b,c) + + !$omp allocate(x1,y1,x2,y2) ! { dg-message "not yet supported" } + allocate(x1,y1,x2(5),y2(5)) + deallocate(x1,y1,x2,y2) + + !$omp allocate(b,a) align ( 128 ) ! { dg-message "not yet supported" } + !$omp allocate align ( 64 ) + allocate(a,b(4),c(3,4)) + deallocate(a,b,c) +end + +subroutine three(c) + use my_omp_lib + implicit none + integer :: q + integer, allocatable :: a, b(:), c(:,:) + + call foo() ! executable stmt + !$omp allocate allocator( omp_large_cap_mem_alloc ) , align(64) ! { dg-message "not yet supported" } + !$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) + + block + q = 5 ! executable stmt + !$omp allocate(a) align(64) ! { dg-message "not yet supported" } + !$omp allocate(b) allocator( omp_high_bw_mem_alloc ), align(32) + !$omp allocate(c) allocator( omp_thread_mem_alloc ) + 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) ! { dg-message "not yet supported" } + !$omp allocate(b) allocator( omp_high_bw_mem_alloc ), align(32) + !$omp allocate(c) allocator( omp_thread_mem_alloc ) + allocate(a,b(4),c(3,4)) + deallocate(a,b,c) + end subroutine inner +end diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 new file mode 100644 index 00000000000..73e5bbcf71b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 @@ -0,0 +1,103 @@ +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 + +subroutine alloc(c,x2,y2) + use my_omp_lib + implicit none + 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 +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 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(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(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(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 diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 new file mode 100644 index 00000000000..c46899d8752 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 @@ -0,0 +1,230 @@ +! { 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 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,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." } +allocate(qq) +!$omp allocate (rr) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1." } +allocate(rr) +!$omp allocate (ss) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1." } +allocate(ss) +!$omp allocate (tt) align(32.0) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1." } +allocate(tt) + +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) + + !$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 diff --git a/gcc/testsuite/gfortran.dg/gomp/allocators-1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocators-1.f90 new file mode 100644 index 00000000000..b39f6d272c1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocators-1.f90 @@ -0,0 +1,28 @@ +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 diff --git a/gcc/testsuite/gfortran.dg/gomp/allocators-2.f90 b/gcc/testsuite/gfortran.dg/gomp/allocators-2.f90 new file mode 100644 index 00000000000..6fb80879ef7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocators-2.f90 @@ -0,0 +1,22 @@ +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 diff --git a/libgomp/testsuite/libgomp.fortran/allocate-3.f90 b/libgomp/testsuite/libgomp.fortran/allocate-3.f90 index a39819164d6..2e2bc33a726 100644 --- a/libgomp/testsuite/libgomp.fortran/allocate-3.f90 +++ b/libgomp/testsuite/libgomp.fortran/allocate-3.f90 @@ -23,6 +23,6 @@ integer :: q, x,y,z ! { dg-error "Object 'omp_high_bw_mem_alloc' is not a variable" "" { target *-*-* } .-1 } !$omp end parallel -!$omp parallel allocate( align(q) : x) firstprivate(x) ! { dg-error "31:ALIGN modifier requires a scalar positive constant integer alignment expression at" } +!$omp parallel allocate( align(q) : x) firstprivate(x) ! { dg-error "31:ALIGN requires a scalar positive constant integer alignment expression at" } !$omp end parallel end