aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog44
-rw-r--r--gcc/fortran/decl.cc36
-rw-r--r--gcc/fortran/openmp.cc2
-rw-r--r--gcc/fortran/options.cc1
-rw-r--r--gcc/fortran/primary.cc17
-rw-r--r--gcc/fortran/resolve.cc8
-rw-r--r--gcc/fortran/simplify.cc16
-rw-r--r--gcc/fortran/trans-const.cc4
-rw-r--r--gcc/fortran/trans-expr.cc24
-rw-r--r--gcc/fortran/trans-intrinsic.cc22
-rw-r--r--gcc/fortran/trans-stmt.cc16
11 files changed, 159 insertions, 31 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7ca0cb0..c0a5710 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,47 @@
+2025-10-27 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/922290
+ PR fortran/95541
+ * resolve.cc (resolve_typebound_intrinsic_op): Add pdt_template
+ to the list of preemted specifics.
+ * trans-stmt.cc (trans_associate_var): PDT array and string
+ components are separately allocated for each element of a PDT
+ array, so copy in and copy out the selector expression.
+
+2025-10-27 Richard Biener <rguenther@suse.de>
+
+ PR middle-end/122325
+ * options.cc (gfc_init_options_struct): Set flag_complex_method
+ to fortran rules.
+
+2025-10-26 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/122290
+ * decl.cc (variable_decl): Matching component initializer
+ expressions in PDT templates should be done with gfc_match_expr
+ to avoid reduction too early. If the expression type is unknown
+ copy the component typespec.
+ (gfc_get_pdt_instance): Change comment from a TODO to an
+ explanation. Insert parameter values in initializers. For
+ components that are not marked with PDT attributes, do the
+ full reduction for init expressions.
+ * primary.cc (gfc_match_actual_arglist): Convert PDT kind exprs
+ using the component initializer.
+ * resolve.cc (resolve_typebound_intrinsic_op): Preempt
+ gfc_check_new_interface for pdt_types as well as entities used
+ in submodules.
+ * simplify.cc (get_kind): Remove PDT kind conversion.
+
+2025-10-25 Harald Anlauf <anlauf@gmx.de>
+
+ PR fortran/114023
+ * trans-expr.cc (gfc_trans_pointer_assignment): Always set dtype
+ when remapping a pointer. For unlimited polymorphic LHS use
+ elem_len from RHS.
+ * trans-intrinsic.cc (gfc_conv_is_contiguous_expr): Extend inline
+ generated code for IS_CONTIGUOUS for pointer arguments to detect
+ when span differs from the element size.
+
2025-10-24 Harald Anlauf <anlauf@gmx.de>
PR fortran/122386
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 5da3c26..569786a 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -3101,7 +3101,16 @@ variable_decl (int elem)
goto cleanup;
}
- m = gfc_match_init_expr (&initializer);
+ if (gfc_comp_struct (gfc_current_state ())
+ && gfc_current_block ()->attr.pdt_template)
+ {
+ m = gfc_match_expr (&initializer);
+ if (initializer && initializer->ts.type == BT_UNKNOWN)
+ initializer->ts = current_ts;
+ }
+ else
+ m = gfc_match_init_expr (&initializer);
+
if (m == MATCH_NO)
{
gfc_error ("Expected an initialization expression at %C");
@@ -3179,7 +3188,7 @@ variable_decl (int elem)
gfc_error ("BOZ literal constant at %L cannot appear as an "
"initializer", &initializer->where);
m = MATCH_ERROR;
- goto cleanup;
+ goto cleanup;
}
param->value = gfc_copy_expr (initializer);
}
@@ -4035,8 +4044,8 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
gfc_insert_parameter_exprs (kind_expr, type_param_spec_list);
ok = gfc_simplify_expr (kind_expr, 1);
- /* Variable expressions seem to default to BT_PROCEDURE.
- TODO find out why this is and fix it. */
+ /* Variable expressions default to BT_PROCEDURE in the absence of an
+ initializer so allow for this. */
if (kind_expr->ts.type != BT_INTEGER
&& kind_expr->ts.type != BT_PROCEDURE)
{
@@ -4271,6 +4280,9 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
if (!c2->initializer && c1->initializer)
c2->initializer = gfc_copy_expr (c1->initializer);
+
+ if (c2->initializer)
+ gfc_insert_parameter_exprs (c2->initializer, type_param_spec_list);
}
/* Copy the array spec. */
@@ -4374,7 +4386,21 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
}
else if (!(c2->attr.pdt_kind || c2->attr.pdt_len || c2->attr.pdt_string
|| c2->attr.pdt_array) && c1->initializer)
- c2->initializer = gfc_copy_expr (c1->initializer);
+ {
+ c2->initializer = gfc_copy_expr (c1->initializer);
+ if (c2->initializer->ts.type == BT_UNKNOWN)
+ c2->initializer->ts = c2->ts;
+ gfc_insert_parameter_exprs (c2->initializer, type_param_spec_list);
+ /* The template initializers are parsed using gfc_match_expr rather
+ than gfc_match_init_expr. Apply the missing reduction to the
+ PDT instance initializers. */
+ if (!gfc_reduce_init_expr (c2->initializer))
+ {
+ gfc_free_expr (c2->initializer);
+ goto error_return;
+ }
+ gfc_simplify_expr (c2->initializer, 1);
+ }
}
if (alloc_seen)
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 357e6a7f..f5db9a8 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -12236,6 +12236,8 @@ gfc_resolve_omp_context_selector (gfc_omp_set_selector *oss,
}
}
+ if (os->code == OMP_TRAIT_INVALID)
+ break;
enum omp_tp_type property_kind = omp_ts_map[os->code].tp_type;
gfc_omp_trait_property *otp = os->properties;
diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc
index 21839ef..59c6462 100644
--- a/gcc/fortran/options.cc
+++ b/gcc/fortran/options.cc
@@ -133,6 +133,7 @@ gfc_init_options_struct (struct gcc_options *opts)
opts->frontend_set_flag_errno_math = true;
opts->x_flag_associative_math = -1;
opts->frontend_set_flag_associative_math = true;
+ opts->x_flag_complex_method = 1;
}
/* Get ready for options handling. Keep in sync with
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index cba4208..2d2c664 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2071,6 +2071,23 @@ gfc_match_actual_arglist (int sub_flag, gfc_actual_arglist **argp, bool pdt)
}
}
+ /* PDT kind expressions are acceptable as initialization expressions.
+ However, intrinsics with a KIND argument reject them. Convert the
+ expression now by use of the component initializer. */
+ if (tail->expr
+ && tail->expr->expr_type == EXPR_VARIABLE
+ && gfc_expr_attr (tail->expr).pdt_kind)
+ {
+ gfc_ref *ref;
+ gfc_expr *tmp = NULL;
+ for (ref = tail->expr->ref; ref; ref = ref->next)
+ if (!ref->next && ref->type == REF_COMPONENT
+ && ref->u.c.component->attr.pdt_kind
+ && ref->u.c.component->initializer)
+ tmp = gfc_copy_expr (ref->u.c.component->initializer);
+ if (tmp)
+ gfc_replace_expr (tail->expr, tmp);
+ }
next:
if (gfc_match_char (')') == MATCH_YES)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 1c49ccf..117a51c 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -16077,10 +16077,14 @@ resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op,
/* Preempt 'gfc_check_new_interface' for submodules, where the
mechanism for handling module procedures winds up resolving
- operator interfaces twice and would otherwise cause an error. */
+ operator interfaces twice and would otherwise cause an error.
+ Likewise, new instances of PDTs can cause the operator inter-
+ faces to be resolved multiple times. */
for (intr = derived->ns->op[op]; intr; intr = intr->next)
if (intr->sym == target_proc
- && target_proc->attr.used_in_submodule)
+ && (target_proc->attr.used_in_submodule
+ || derived->attr.pdt_type
+ || derived->attr.pdt_template))
return true;
if (!gfc_check_new_interface (derived->ns->op[op],
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 00b02f3..b25cd2c 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -120,26 +120,10 @@ static int
get_kind (bt type, gfc_expr *k, const char *name, int default_kind)
{
int kind;
- gfc_expr *tmp;
if (k == NULL)
return default_kind;
- if (k->expr_type == EXPR_VARIABLE
- && k->symtree->n.sym->ts.type == BT_DERIVED
- && k->symtree->n.sym->ts.u.derived->attr.pdt_type)
- {
- gfc_ref *ref;
- for (ref = k->ref; ref; ref = ref->next)
- if (!ref->next && ref->type == REF_COMPONENT
- && ref->u.c.component->attr.pdt_kind
- && ref->u.c.component->initializer)
- {
- tmp = gfc_copy_expr (ref->u.c.component->initializer);
- gfc_replace_expr (k, tmp);
- }
- }
-
if (k->expr_type != EXPR_CONSTANT)
{
gfc_error ("KIND parameter of %s at %L must be an initialization "
diff --git a/gcc/fortran/trans-const.cc b/gcc/fortran/trans-const.cc
index f70f362..b1bf567 100644
--- a/gcc/fortran/trans-const.cc
+++ b/gcc/fortran/trans-const.cc
@@ -444,6 +444,8 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr)
if (expr->ts.type == BT_CHARACTER)
gfc_conv_string_parameter (se);
else
- se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
+ se->expr
+ = gfc_build_addr_expr (NULL_TREE,
+ gfc_trans_force_lval (&se->pre, se->expr));
}
}
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 21f256b..67b60c7 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11344,21 +11344,33 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
int dim;
gcc_assert (remap->u.ar.dimen == expr1->rank);
+ /* Always set dtype. */
+ tree dtype = gfc_conv_descriptor_dtype (desc);
+ tmp = gfc_get_dtype (TREE_TYPE (desc));
+ gfc_add_modify (&block, dtype, tmp);
+
+ /* For unlimited polymorphic LHS use elem_len from RHS. */
+ if (UNLIMITED_POLY (expr1) && expr2->ts.type != BT_CLASS)
+ {
+ tree elem_len;
+ tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&expr2->ts));
+ elem_len = fold_convert (gfc_array_index_type, tmp);
+ elem_len = gfc_evaluate_now (elem_len, &block);
+ tmp = gfc_conv_descriptor_elem_len (desc);
+ gfc_add_modify (&block, tmp,
+ fold_convert (TREE_TYPE (tmp), elem_len));
+ }
+
if (rank_remap)
{
/* Do rank remapping. We already have the RHS's descriptor
converted in rse and now have to build the correct LHS
descriptor for it. */
- tree dtype, data, span;
+ tree data, span;
tree offs, stride;
tree lbound, ubound;
- /* Set dtype. */
- dtype = gfc_conv_descriptor_dtype (desc);
- tmp = gfc_get_dtype (TREE_TYPE (desc));
- gfc_add_modify (&block, dtype, tmp);
-
/* Copy data pointer. */
data = gfc_conv_descriptor_data_get (rse.expr);
gfc_conv_descriptor_data_set (&block, desc, data);
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 05017d0..89a03d8 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2316,10 +2316,14 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
int i;
tree fncall0;
gfc_array_spec *as;
+ gfc_symbol *sym = NULL;
if (arg->ts.type == BT_CLASS)
gfc_add_class_array_ref (arg);
+ if (arg->expr_type == EXPR_VARIABLE)
+ sym = arg->symtree->n.sym;
+
ss = gfc_walk_expr (arg);
gcc_assert (ss != gfc_ss_terminator);
gfc_init_se (&argse, NULL);
@@ -2342,7 +2346,7 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
fncall0 = build_call_expr_loc (input_location,
gfor_fndecl_is_contiguous0, 1, desc);
se->expr = fncall0;
- se->expr = convert (logical_type_node, se->expr);
+ se->expr = convert (boolean_type_node, se->expr);
}
else
{
@@ -2374,6 +2378,22 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
}
se->expr = cond;
}
+
+ /* A pointer that does not have the CONTIGUOUS attribute needs to be checked
+ if it points to an array whose span differs from the element size. */
+ if (as && sym && IS_POINTER(sym) && !sym->attr.contiguous)
+ {
+ tree span = gfc_conv_descriptor_span_get (desc);
+ tmp = fold_convert (TREE_TYPE (span),
+ gfc_conv_descriptor_elem_len (desc));
+ cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+ span, tmp);
+ se->expr = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+ boolean_type_node, cond,
+ convert (boolean_type_node, se->expr));
+ }
+
+ gfc_free_ss_chain (ss);
}
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index f25335d..0e82d2a 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2092,6 +2092,22 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
gfc_free_expr (expr1);
gfc_free_expr (expr2);
}
+ /* PDT array and string components are separately allocated for each element
+ of a PDT array. Therefore, there is no choice but to copy in and copy out
+ the target expression. */
+ else if (e && is_subref_array (e)
+ && (gfc_expr_attr (e).pdt_array || gfc_expr_attr (e).pdt_string))
+ {
+ gfc_se init;
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl)));
+ gfc_init_se (&init, NULL);
+ gfc_conv_subref_array_arg (&init, e, false, INTENT_INOUT,
+ sym && sym->attr.pointer);
+ init.expr = build_fold_indirect_ref_loc (input_location, init.expr);
+ gfc_add_modify (&init.pre, sym->backend_decl, init.expr);
+ gfc_add_init_cleanup (block, gfc_finish_block (&init.pre),
+ gfc_finish_block (&init.post));
+ }
else if ((sym->attr.dimension || sym->attr.codimension) && !class_target
&& (sym->as->type == AS_DEFERRED || sym->assoc->variable))
{
generated by cgit v1.1 at 2025-10-28 19:39:27 +0000