diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 27 | ||||
| -rw-r--r-- | gcc/fortran/decl.cc | 199 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 16 | ||||
| -rw-r--r-- | gcc/fortran/invoke.texi | 4 | ||||
| -rw-r--r-- | gcc/fortran/openmp.cc | 30 | ||||
| -rw-r--r-- | gcc/fortran/parse.cc | 5 | ||||
| -rw-r--r-- | gcc/fortran/resolve.cc | 165 | ||||
| -rw-r--r-- | gcc/fortran/trans-openmp.cc | 13 |
8 files changed, 434 insertions, 25 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 168c475..b4fadac 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,30 @@ +2025-07-11 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/106135 + * decl.cc (build_sym): Emit an error if a symbol associated by + an IMPORT, ONLY or IMPORT, all statement is being redeclared. + (gfc_match_import): Parse and check the F2018 versions of the + IMPORT statement. For scopes other than and interface body, if + the symbol cannot be found in the host scope, generate it and + set it up such that gfc_fixup_sibling_symbols can transfer its + 'imported attribute' if it turnes out to be a not yet parsed + procedure. Test for violations of C897-8100. + * gfortran.h : Add 'import_only' to the gfc_symtree structure. + Add the enum, 'importstate', which is used for values the new + field 'import_state' in gfc_namespace. + * parse.cc (gfc_fixup_sibling_symbols): Transfer the attribute + 'imported' to the new symbol. + * resolve.cc (check_sym_import_status, check_import_status): + New functions to test symbols and expressions for violations of + F2018:C8102. + (resolve_call): Test the 'resolved_sym' against C8102 by a call + to 'check_sym_import_status'. + (gfc_resolve_expr): If the expression is OK and an IMPORT + statement has been registered in the current scope, test C102 + by calling 'check_import_status'. + (resolve_select_type): Test the declared derived type in TYPE + IS and CLASS IS statements. + 2025-07-08 Andre Vehreschild <vehre@gcc.gnu.org> PR fortran/120637 diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 69acd2d..111ebc5 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -1723,13 +1723,17 @@ build_sym (const char *name, int elem, gfc_charlen *cl, bool cl_deferred, symbol_attribute attr; gfc_symbol *sym; int upper; - gfc_symtree *st; + gfc_symtree *st, *host_st = NULL; /* Symbols in a submodule are host associated from the parent module or submodules. Therefore, they can be overridden by declarations in the submodule scope. Deal with this by attaching the existing symbol to a new symtree and recycling the old symtree with a new symbol... */ st = gfc_find_symtree (gfc_current_ns->sym_root, name); + if (((st && st->import_only) || (gfc_current_ns->import_state == IMPORT_ALL)) + && gfc_current_ns->parent) + host_st = gfc_find_symtree (gfc_current_ns->parent->sym_root, name); + if (st != NULL && gfc_state_stack->state == COMP_SUBMODULE && st->n.sym != NULL && st->n.sym->attr.host_assoc && st->n.sym->attr.used_in_submodule) @@ -1742,6 +1746,20 @@ build_sym (const char *name, int elem, gfc_charlen *cl, bool cl_deferred, sym->refs++; gfc_set_sym_referenced (sym); } + /* ...Check that F2018 IMPORT, ONLY and IMPORT, ALL statements, within the + current scope are not violated by local redeclarations. Note that there is + no need to guard for std >= F2018 because import_only and IMPORT_ALL are + only set for these standards. */ + else if (host_st && host_st->n.sym + && host_st->n.sym != gfc_current_ns->proc_name + && !(st && st->n.sym + && (st->n.sym->attr.dummy || st->n.sym->attr.result))) + { + gfc_error ("F2018: C8102 %s at %L is already imported by an %s " + "statement and must not be re-declared", name, var_locus, + (st && st->import_only) ? "IMPORT, ONLY" : "IMPORT, ALL"); + return false; + } /* ...Otherwise generate a new symtree and new symbol. */ else if (gfc_get_symbol (name, NULL, &sym, var_locus)) return false; @@ -5100,6 +5118,54 @@ error: } +/* Match the IMPORT statement. IMPORT was added to F2003 as + + R1209 import-stmt is IMPORT [[ :: ] import-name-list ] + + C1210 (R1209) The IMPORT statement is allowed only in an interface-body. + + C1211 (R1209) Each import-name shall be the name of an entity in the + host scoping unit. + + under the description of an interface block. Under F2008, IMPORT was + split out of the interface block description to 12.4.3.3 and C1210 + became + + C1210 (R1209) The IMPORT statement is allowed only in an interface-body + that is not a module procedure interface body. + + Finally, F2018, section 8.8, has changed the IMPORT statement to + + R867 import-stmt is IMPORT [[ :: ] import-name-list ] + or IMPORT, ONLY : import-name-list + or IMPORT, NONE + or IMPORT, ALL + + C896 (R867) An IMPORT statement shall not appear in the scoping unit of + a main-program, external-subprogram, module, or block-data. + + C897 (R867) Each import-name shall be the name of an entity in the host + scoping unit. + + C898 If any IMPORT statement in a scoping unit has an ONLY specifier, + all IMPORT statements in that scoping unit shall have an ONLY + specifier. + + C899 IMPORT, NONE shall not appear in the scoping unit of a submodule. + + C8100 If an IMPORT, NONE or IMPORT, ALL statement appears in a scoping + unit, no other IMPORT statement shall appear in that scoping unit. + + C8101 Within an interface body, an entity that is accessed by host + association shall be accessible by host or use association within + the host scoping unit, or explicitly declared prior to the interface + body. + + C8102 An entity whose name appears as an import-name or which is made + accessible by an IMPORT, ALL statement shall not appear in any + context described in 19.5.1.4 that would cause the host entity + of that name to be inaccessible. */ + match gfc_match_import (void) { @@ -5107,16 +5173,28 @@ gfc_match_import (void) match m; gfc_symbol *sym; gfc_symtree *st; + bool f2018_allowed = gfc_option.allow_std & ~GFC_STD_OPT_F08;; + importstate current_import_state = gfc_current_ns->import_state; - if (gfc_current_ns->proc_name == NULL - || gfc_current_ns->proc_name->attr.if_source != IFSRC_IFBODY) + if (!f2018_allowed + && (gfc_current_ns->proc_name == NULL + || gfc_current_ns->proc_name->attr.if_source != IFSRC_IFBODY)) { gfc_error ("IMPORT statement at %C only permitted in " "an INTERFACE body"); return MATCH_ERROR; } + else if (f2018_allowed + && (!gfc_current_ns->parent || gfc_current_ns->is_block_data)) + goto C897; + + if (f2018_allowed + && (current_import_state == IMPORT_ALL + || current_import_state == IMPORT_NONE)) + goto C8100; - if (gfc_current_ns->proc_name->attr.module_procedure) + if (gfc_current_ns->proc_name + && gfc_current_ns->proc_name->attr.module_procedure) { gfc_error ("F2008: C1210 IMPORT statement at %C is not permitted " "in a module procedure interface body"); @@ -5126,20 +5204,65 @@ gfc_match_import (void) if (!gfc_notify_std (GFC_STD_F2003, "IMPORT statement at %C")) return MATCH_ERROR; + gfc_current_ns->import_state = IMPORT_NOT_SET; + if (f2018_allowed) + { + if (gfc_match (" , none") == MATCH_YES) + { + if (current_import_state == IMPORT_ONLY) + goto C898; + if (gfc_current_state () == COMP_SUBMODULE) + goto C899; + gfc_current_ns->import_state = IMPORT_NONE; + } + else if (gfc_match (" , only :") == MATCH_YES) + { + if (current_import_state != IMPORT_NOT_SET + && current_import_state != IMPORT_ONLY) + goto C898; + gfc_current_ns->import_state = IMPORT_ONLY; + } + else if (gfc_match (" , all") == MATCH_YES) + { + if (current_import_state == IMPORT_ONLY) + goto C898; + gfc_current_ns->import_state = IMPORT_ALL; + } + + if (current_import_state != IMPORT_NOT_SET + && (gfc_current_ns->import_state == IMPORT_NONE + || gfc_current_ns->import_state == IMPORT_ALL)) + goto C8100; + } + + /* F2008 IMPORT<eos> is distinct from F2018 IMPORT, ALL. */ if (gfc_match_eos () == MATCH_YES) { - /* All host variables should be imported. */ - gfc_current_ns->has_import_set = 1; + /* This is the F2008 variant. */ + if (gfc_current_ns->import_state == IMPORT_NOT_SET) + { + if (current_import_state == IMPORT_ONLY) + goto C898; + gfc_current_ns->import_state = IMPORT_F2008; + } + + /* Host variables should be imported. */ + if (gfc_current_ns->import_state != IMPORT_NONE) + gfc_current_ns->has_import_set = 1; return MATCH_YES; } - if (gfc_match (" ::") == MATCH_YES) + if (gfc_match (" ::") == MATCH_YES + && gfc_current_ns->import_state != IMPORT_ONLY) { if (gfc_match_eos () == MATCH_YES) - { - gfc_error ("Expecting list of named entities at %C"); - return MATCH_ERROR; - } + goto expecting_list; + gfc_current_ns->import_state = IMPORT_F2008; + } + else if (gfc_current_ns->import_state == IMPORT_ONLY) + { + if (gfc_match_eos () == MATCH_YES) + goto expecting_list; } for(;;) @@ -5166,12 +5289,28 @@ gfc_match_import (void) if (sym == NULL) { - gfc_error ("Cannot IMPORT %qs from host scoping unit " - "at %C - does not exist.", name); - return MATCH_ERROR; + if (gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY) + { + gfc_error ("Cannot IMPORT %qs from host scoping unit " + "at %C - does not exist.", name); + return MATCH_ERROR; + } + else + { + /* This might be a procedure that has not yet been parsed. If + so gfc_fixup_sibling_symbols will replace this symbol with + that of the procedure. */ + gfc_get_sym_tree (name, gfc_current_ns, &st, false, + &gfc_current_locus); + st->n.sym->refs++; + st->n.sym->attr.imported = 1; + st->import_only = 1; + goto next_item; + } } - if (gfc_find_symtree (gfc_current_ns->sym_root, name)) + st = gfc_find_symtree (gfc_current_ns->sym_root, name); + if (st && st->n.sym && st->n.sym->attr.imported) { gfc_warning (0, "%qs is already IMPORTed from host scoping unit " "at %C", name); @@ -5182,6 +5321,7 @@ gfc_match_import (void) st->n.sym = sym; sym->refs++; sym->attr.imported = 1; + st->import_only = 1; if (sym->attr.generic && (sym = gfc_find_dt_in_generic (sym))) { @@ -5193,6 +5333,7 @@ gfc_match_import (void) st->n.sym = sym; sym->refs++; sym->attr.imported = 1; + st->import_only = 1; } goto next_item; @@ -5216,6 +5357,34 @@ gfc_match_import (void) syntax: gfc_error ("Syntax error in IMPORT statement at %C"); return MATCH_ERROR; + +C897: + gfc_error ("F2018: C897 IMPORT statement at %C cannot appear in a main " + "program, an external subprogram, a module or block data"); + return MATCH_ERROR; + +C898: + gfc_error ("F2018: C898 IMPORT statement at %C is not permitted because " + "a scoping unit has an ONLY specifier, can only have IMPORT " + "with an ONLY specifier"); + return MATCH_ERROR; + +C899: + gfc_error ("F2018: C899 IMPORT, NONE shall not appear in the scoping unit" + " of a submodule as at %C"); + return MATCH_ERROR; + +C8100: + gfc_error ("F2018: C8100 IMPORT statement at %C is not permitted because " + "%s has already been declared, which must be unique in the " + "scoping unit", + gfc_current_ns->import_state == IMPORT_ALL ? "IMPORT, ALL" : + "IMPORT, NONE"); + return MATCH_ERROR; + +expecting_list: + gfc_error ("Expecting list of named entities at %C"); + return MATCH_ERROR; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6848bd1..4c85548 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2188,6 +2188,7 @@ typedef struct gfc_symtree gfc_omp_udr *omp_udr; } n; + unsigned import_only:1; } gfc_symtree; @@ -2215,6 +2216,17 @@ typedef struct gfc_was_finalized { } gfc_was_finalized; + + /* Flag F2018 import status */ +enum importstate +{ IMPORT_NOT_SET = 0, /* Default condition. */ + IMPORT_F2008, /* Old style IMPORT. */ + IMPORT_ONLY, /* Import list used. */ + IMPORT_NONE, /* No host association. Unique in scoping unit. */ + IMPORT_ALL /* Must be unique in the scoping unit. */ +}; + + /* A namespace describes the contents of procedure, module, interface block or BLOCK construct. */ /* ??? Anything else use these? */ @@ -2328,6 +2340,10 @@ typedef struct gfc_namespace /* Set to 1 if namespace is an interface body with "IMPORT" used. */ unsigned has_import_set:1; + /* Flag F2018 import status */ + ENUM_BITFIELD (importstate) import_state :3; + + /* Set to 1 if the namespace uses "IMPLICIT NONE (export)". */ unsigned has_implicit_none_export:1; diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index da085d1..0b893e8 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -1170,6 +1170,10 @@ A @code{CHARACTER} variable is declared with negative length. With @option{-fopenmp}, for fixed-form source code, when an @code{omx} vendor-extension sentinel is encountered. (The equivalent @code{ompx}, used in free-form source code, is diagnosed by default.) + +@item +With @option{-fopenacc}, when using named constances with clauses that +take a variable as doing so has no effect. @end itemize @opindex Wtabs diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index fe0a47a..f1acc00 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -8895,15 +8895,21 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, if (list == OMP_LIST_MAP && n->sym->attr.flavor == FL_PARAMETER) { + /* OpenACC since 3.4 permits for Fortran named constants, but + permits removing then as optimization is not needed and such + ignore them. Likewise below for FIRSTPRIVATE. */ if (openacc) - gfc_error ("Object %qs is not a variable at %L; parameters" - " cannot be and need not be copied", n->sym->name, - &n->where); + gfc_warning (OPT_Wsurprising, "Clause for object %qs at %L is " + "ignored as parameters need not be copied", + n->sym->name, &n->where); else gfc_error ("Object %qs is not a variable at %L; parameters" " cannot be and need not be mapped", n->sym->name, &n->where); } + else if (openacc && n->sym->attr.flavor == FL_PARAMETER) + gfc_warning (OPT_Wsurprising, "Clause for object %qs at %L is ignored" + " as it is a parameter", n->sym->name, &n->where); else if (list != OMP_LIST_USES_ALLOCATORS) gfc_error ("Object %qs is not a variable at %L", n->sym->name, &n->where); @@ -12756,9 +12762,21 @@ gfc_resolve_oacc_declare (gfc_namespace *ns) && (n->sym->attr.flavor != FL_PROCEDURE || n->sym->result != n->sym)) { - gfc_error ("Object %qs is not a variable at %L", - n->sym->name, &oc->loc); - continue; + if (n->sym->attr.flavor != FL_PARAMETER) + { + gfc_error ("Object %qs is not a variable at %L", + n->sym->name, &oc->loc); + continue; + } + /* Note that OpenACC 3.4 permits name constants, but the + implementation is permitted to ignore the clause; + as semantically, device_resident kind of makes sense + (and the wording with it is a bit odd), the warning + is suppressed. */ + if (list != OMP_LIST_DEVICE_RESIDENT) + gfc_warning (OPT_Wsurprising, "Object %qs at %L is ignored as" + " parameters need not be copied", n->sym->name, + &oc->loc); } if (n->expr && n->expr->ref->type == REF_ARRAY) diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index 8d4ca39..847ff37 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -6793,6 +6793,7 @@ gfc_fixup_sibling_symbols (gfc_symbol *sym, gfc_namespace *siblings) gfc_namespace *ns; gfc_symtree *st; gfc_symbol *old_sym; + bool imported; for (ns = siblings; ns; ns = ns->sibling) { @@ -6808,6 +6809,7 @@ gfc_fixup_sibling_symbols (gfc_symbol *sym, gfc_namespace *siblings) goto fixup_contained; old_sym = st->n.sym; + imported = old_sym->attr.imported == 1; if (old_sym->ns == ns && !old_sym->attr.contained @@ -6834,7 +6836,8 @@ gfc_fixup_sibling_symbols (gfc_symbol *sym, gfc_namespace *siblings) /* Replace it with the symbol from the parent namespace. */ st->n.sym = sym; sym->refs++; - + if (imported) + sym->attr.imported = 1; gfc_release_symbol (old_sym); } diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 4a6e951..93df5d0 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -3919,10 +3919,153 @@ found: } + +static bool +check_sym_import_status (gfc_symbol *sym, gfc_symtree *s, gfc_expr *e, + gfc_code *c, gfc_namespace *ns) +{ + locus *here; + + /* If the type has been imported then its vtype functions are OK. */ + if (e && e->expr_type == EXPR_FUNCTION && sym->attr.vtype) + return true; + + if (e) + here = &e->where; + else + here = &c->loc; + + if (s && !s->import_only) + s = gfc_find_symtree (ns->sym_root, sym->name); + + if (ns->import_state == IMPORT_ONLY + && sym->ns != ns + && (!s || !s->import_only)) + { + gfc_error ("F2018: C8102 %qs at %L is host associated but does not " + "appear in an IMPORT or IMPORT, ONLY list", sym->name, here); + return false; + } + else if (ns->import_state == IMPORT_NONE + && sym->ns != ns) + { + gfc_error ("F2018: C8102 %qs at %L is host associated in a scope that " + "has IMPORT, NONE", sym->name, here); + return false; + } + return true; +} + + +static bool +check_import_status (gfc_expr *e) +{ + gfc_symtree *st; + gfc_ref *ref; + gfc_symbol *sym, *der; + gfc_namespace *ns = gfc_current_ns; + + switch (e->expr_type) + { + case EXPR_VARIABLE: + case EXPR_FUNCTION: + case EXPR_SUBSTRING: + sym = e->symtree ? e->symtree->n.sym : NULL; + + /* Check the symbol itself. */ + if (sym + && !(ns->proc_name + && (sym == ns->proc_name)) + && !check_sym_import_status (sym, e->symtree, e, NULL, ns)) + return false; + + /* Check the declared derived type. */ + if (sym->ts.type == BT_DERIVED) + { + der = sym->ts.u.derived; + st = gfc_find_symtree (ns->sym_root, der->name); + + if (!check_sym_import_status (der, st, e, NULL, ns)) + return false; + } + else if (sym->ts.type == BT_CLASS && !UNLIMITED_POLY (sym)) + { + der = CLASS_DATA (sym) ? CLASS_DATA (sym)->ts.u.derived + : sym->ts.u.derived; + st = gfc_find_symtree (ns->sym_root, der->name); + + if (!check_sym_import_status (der, st, e, NULL, ns)) + return false; + } + + /* Check the declared derived types of component references. */ + for (ref = e->ref; ref; ref = ref->next) + if (ref->type == REF_COMPONENT) + { + gfc_component *c = ref->u.c.component; + if (c->ts.type == BT_DERIVED) + { + der = c->ts.u.derived; + st = gfc_find_symtree (ns->sym_root, der->name); + if (!check_sym_import_status (der, st, e, NULL, ns)) + return false; + } + else if (c->ts.type == BT_CLASS && !UNLIMITED_POLY (c)) + { + der = CLASS_DATA (c) ? CLASS_DATA (c)->ts.u.derived + : c->ts.u.derived; + st = gfc_find_symtree (ns->sym_root, der->name); + if (!check_sym_import_status (der, st, e, NULL, ns)) + return false; + } + } + + break; + + case EXPR_ARRAY: + case EXPR_STRUCTURE: + /* Check the declared derived type. */ + if (e->ts.type == BT_DERIVED) + { + der = e->ts.u.derived; + st = gfc_find_symtree (ns->sym_root, der->name); + + if (!check_sym_import_status (der, st, e, NULL, ns)) + return false; + } + else if (e->ts.type == BT_CLASS && !UNLIMITED_POLY (e)) + { + der = CLASS_DATA (e) ? CLASS_DATA (e)->ts.u.derived + : e->ts.u.derived; + st = gfc_find_symtree (ns->sym_root, der->name); + + if (!check_sym_import_status (der, st, e, NULL, ns)) + return false; + } + + break; + +/* Either not applicable or resolved away + case EXPR_OP: + case EXPR_UNKNOWN: + case EXPR_CONSTANT: + case EXPR_NULL: + case EXPR_COMPCALL: + case EXPR_PPC: */ + + default: + break; + } + + return true; +} + + /* Resolve a subroutine call. Although it was tempting to use the same code for functions, subroutines and functions are stored differently and this makes things awkward. */ + static bool resolve_call (gfc_code *c) { @@ -4080,6 +4223,11 @@ resolve_call (gfc_code *c) "Using subroutine %qs at %L is deprecated", c->resolved_sym->name, &c->loc); + csym = c->resolved_sym ? c->resolved_sym : csym; + if (t && gfc_current_ns->import_state != IMPORT_NOT_SET && !c->resolved_isym + && csym != gfc_current_ns->proc_name) + return check_sym_import_status (csym, c->symtree, NULL, c, gfc_current_ns); + return t; } @@ -7792,6 +7940,7 @@ fixup_unique_dummy (gfc_expr *e) e->symtree = st; } + /* Resolve an expression. That is, make sure that types of operands agree with their operators, intrinsic operators are converted to function calls for overloaded types and unresolved function references are resolved. */ @@ -7919,6 +8068,9 @@ gfc_resolve_expr (gfc_expr *e) && UNLIMITED_POLY (e->symtree->n.sym)) e->do_not_resolve_again = 1; + if (t && gfc_current_ns->import_state != IMPORT_NOT_SET) + t = check_import_status (e); + return t; } @@ -10572,6 +10724,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) int rank = 0, corank = 0; gfc_ref* ref = NULL; gfc_expr *selector_expr = NULL; + gfc_code *old_code = code; ns = code->ext.block.ns; if (code->expr2) @@ -10860,6 +11013,18 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) when this case is actually true, so build a new ASSOCIATE that does precisely this here (instead of using the 'global' one). */ + + /* First check the derived type import status. */ + if (gfc_current_ns->import_state != IMPORT_NOT_SET + && (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)) + { + st = gfc_find_symtree (gfc_current_ns->sym_root, + c->ts.u.derived->name); + if (!check_sym_import_status (c->ts.u.derived, st, NULL, old_code, + gfc_current_ns)) + error++; + } + const char * var_name = gfc_var_name_for_select_type_temp (orig_expr1); if (c->ts.type == BT_CLASS) snprintf (name, sizeof (name), "__tmp_class_%s_%s", diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index a2e70fc..f3d7cd4 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -2792,8 +2792,13 @@ gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_omp_namelist *namelist, tree list, bool declare_simd) { + /* PARAMETER (named constants) are excluded as OpenACC 3.4 permits them now + as 'var' but permits compilers to ignore them. In expressions, it should + have been replaced by the value (and this function should not be called + anyway) and for var-using clauses, they should just be skipped. */ for (; namelist != NULL; namelist = namelist->next) - if (namelist->sym->attr.referenced || declare_simd) + if ((namelist->sym->attr.referenced || declare_simd) + && namelist->sym->attr.flavor != FL_PARAMETER) { tree t = gfc_trans_omp_variable (namelist->sym, declare_simd); if (t != error_mark_node) @@ -4029,7 +4034,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_LIST_MAP: for (; n != NULL; n = n->next) { - if (!n->sym->attr.referenced) + if (!n->sym->attr.referenced + || n->sym->attr.flavor == FL_PARAMETER) continue; location_t map_loc = gfc_get_location (&n->where); @@ -4986,7 +4992,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_LIST_CACHE: for (; n != NULL; n = n->next) { - if (!n->sym->attr.referenced) + if (!n->sym->attr.referenced + && n->sym->attr.flavor != FL_PARAMETER) continue; switch (list) |