aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog46
-rw-r--r--gcc/fortran/array.cc3
-rw-r--r--gcc/fortran/decl.cc22
-rw-r--r--gcc/fortran/expr.cc8
-rw-r--r--gcc/fortran/module.cc14
-rw-r--r--gcc/fortran/primary.cc40
-rw-r--r--gcc/fortran/resolve.cc5
7 files changed, 136 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c221955..724da5b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,49 @@
+2025-12-06 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/122693
+ * array.cc (gfc_match_array_constructor): Stash and restore
+ gfc_current_ns after the call to 'gfc_match_type_spec'.
+
+2025-12-06 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/122670
+ * decl.cc (gfc_get_pdt_instance): Ensure that, in an interface
+ body, PDT instances imported implicitly if the template has
+ been explicitly imported.
+ * module.cc (read_module): If a PDT template appears in a use
+ only statement, implicitly add the instances as well.
+
+2025-12-06 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/122669
+ * resolve.cc (resolve_allocate_deallocate): Mold expressions
+ with an array reference and a constant size must be resolved
+ for each allocate object.
+
+2025-12-06 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/122578
+ * primary.cc (gfc_match_varspec): Try to resolve a typebound
+ generic procedure selector expression to provide the associate
+ name with a type. Also, resolve component calls. In both cases,
+ make a copy of the selector expression to guard against changes
+ made by gfc_resolve_expr.
+
+2025-12-05 Harald Anlauf <anlauf@gmx.de>
+
+ PR fortran/122977
+ * expr.cc (gfc_is_simply_contiguous): For an associate variable
+ check whether the associate target is contiguous.
+ * resolve.cc (resolve_symbol): Skip array type check for an
+ associate variable when the target has the contiguous attribute.
+
+2025-12-05 Tobias Burnus <tburnus@baylibre.com>
+
+ * openmp.cc (resolve_omp_clauses): Permit zero with
+ DYN_GROUPPRIVATE clause.
+ * trans-openmp.cc (fallback): Generate TREE code
+ for DYN_GROUPPRIVATE and remove 'sorry'.
+
2025-12-03 Paul Thomas <pault@gcc.gnu.org>
PR fortran/103371
diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 359d743..471f0cb 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -1344,6 +1344,7 @@ gfc_match_array_constructor (gfc_expr **result)
match m;
const char *end_delim;
bool seen_ts;
+ gfc_namespace *old_ns = gfc_current_ns;
head = NULL;
seen_ts = false;
@@ -1368,6 +1369,8 @@ gfc_match_array_constructor (gfc_expr **result)
/* Try to match an optional "type-spec ::" */
gfc_clear_ts (&ts);
m = gfc_match_type_spec (&ts);
+ gfc_current_ns = old_ns;
+
if (m == MATCH_YES)
{
seen_ts = (gfc_match (" ::") == MATCH_YES);
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 20260ec..dfedb96 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -3969,6 +3969,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
gfc_expr *kind_expr;
gfc_component *c1, *c2;
match m;
+ gfc_symtree *s = NULL;
type_param_spec_list = NULL;
@@ -4178,10 +4179,29 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
goto error_return;
}
+ /* If we are in an interface body, the instance will not have been imported.
+ Make sure that it is imported implicitly. */
+ s = gfc_find_symtree (gfc_current_ns->sym_root, pdt->name);
+ if (gfc_current_ns->proc_name
+ && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
+ && s && s->import_only && pdt->attr.imported)
+ {
+ s = gfc_find_symtree (gfc_current_ns->sym_root, instance->name);
+ if (!s)
+ {
+ gfc_get_sym_tree (instance->name, gfc_current_ns, &s, false,
+ &gfc_current_locus);
+ s->n.sym = instance;
+ }
+ s->n.sym->attr.imported = 1;
+ s->import_only = 1;
+ }
+
m = MATCH_YES;
if (instance->attr.flavor == FL_DERIVED
- && instance->attr.pdt_type)
+ && instance->attr.pdt_type
+ && instance->components)
{
instance->refs++;
if (ext_param_list)
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 00abd9e..054276e 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -6406,6 +6406,14 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element)
|| (sym->as && sym->as->type == AS_ASSUMED_SHAPE))))
return false;
+ /* An associate variable may point to a non-contiguous target. */
+ if (ar && ar->type == AR_FULL
+ && sym->attr.associate_var && !sym->attr.contiguous
+ && sym->assoc
+ && sym->assoc->target)
+ return gfc_is_simply_contiguous (sym->assoc->target, strict,
+ permit_element);
+
if (!ar || ar->type == AR_FULL)
return true;
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index 262f72b..9b845b5 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -5842,6 +5842,20 @@ read_module (void)
|| startswith (name, "__vtype_")))
p = name;
+ /* Include pdt_types if their associated pdt_template is in a
+ USE, ONLY list. */
+ if (p == NULL && name[0] == 'P'
+ && startswith (name, "Pdt")
+ && module_list)
+ {
+ gfc_use_list *ml = module_list;
+ for (; ml; ml = ml->next)
+ if (ml->rename
+ && !strncmp (&name[3], ml->rename->use_name,
+ strlen (ml->rename->use_name)))
+ p = name;
+ }
+
/* Skip symtree nodes not in an ONLY clause, unless there
is an existing symtree loaded from another USE statement. */
if (p == NULL)
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 729e3b5..e5e84e8 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2261,6 +2261,32 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
&& !sym->attr.select_rank_temporary)
inferred_type = true;
+ /* Try to resolve a typebound generic procedure so that the associate name
+ has a chance to get a type before being used in a second, nested associate
+ statement. Note that a copy is used for resolution so that failure does
+ not result in a mutilated selector expression further down the line. */
+ if (tgt_expr && !sym->assoc->dangling
+ && tgt_expr->ts.type == BT_UNKNOWN
+ && tgt_expr->symtree
+ && tgt_expr->symtree->n.sym
+ && gfc_expr_attr (tgt_expr).generic
+ && ((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.pdt_template)
+ || (sym->ts.type == BT_CLASS
+ && CLASS_DATA (sym)->ts.u.derived->attr.pdt_template)))
+ {
+ gfc_expr *cpy = gfc_copy_expr (tgt_expr);
+ if (gfc_resolve_expr (cpy)
+ && cpy->ts.type != BT_UNKNOWN)
+ {
+ gfc_replace_expr (tgt_expr, cpy);
+ sym->ts = tgt_expr->ts;
+ }
+ else
+ gfc_free_expr (cpy);
+ if (gfc_expr_attr (tgt_expr).generic)
+ inferred_type = true;
+ }
+
/* For associate names, we may not yet know whether they are arrays or not.
If the selector expression is unambiguously an array; eg. a full array
or an array section, then the associate name must be an array and we can
@@ -2493,6 +2519,20 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
&& !gfc_find_derived_types (sym, gfc_current_ns, name))
primary->ts.type = BT_UNKNOWN;
+ /* Otherwise try resolving a copy of a component call. If it succeeds,
+ use that for the selector expression. */
+ else if (tgt_expr && tgt_expr->expr_type == EXPR_COMPCALL)
+ {
+ gfc_expr *cpy = gfc_copy_expr (tgt_expr);
+ if (gfc_resolve_expr (cpy))
+ {
+ gfc_replace_expr (tgt_expr, cpy);
+ sym->ts = tgt_expr->ts;
+ }
+ else
+ gfc_free_expr (cpy);
+ }
+
/* An inquiry reference might determine the type, otherwise we have an
error. */
if (sym->ts.type == BT_UNKNOWN && !inquiry)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 9f3ce1d..db6b52f 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -9799,8 +9799,10 @@ done_errmsg:
/* Resolving the expr3 in the loop over all objects to allocate would
execute loop invariant code for each loop item. Therefore do it just
once here. */
+ mpz_t nelem;
if (code->expr3 && code->expr3->mold
- && code->expr3->ts.type == BT_DERIVED)
+ && code->expr3->ts.type == BT_DERIVED
+ && !(code->expr3->ref && gfc_array_size (code->expr3, &nelem)))
{
/* Default initialization via MOLD (non-polymorphic). */
gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts);
@@ -18143,6 +18145,7 @@ skip_interfaces:
/* F2008, C530. */
if (sym->attr.contiguous
+ && !sym->attr.associate_var
&& (!class_attr.dimension
|| (as->type != AS_ASSUMED_SHAPE && as->type != AS_ASSUMED_RANK
&& !class_attr.pointer)))
generated by cgit v1.1 at 2025-12-07 03:56:39 +0000