[Fortran, Patch, PR77872, v1] Fix ICE when getting caf-token from abstract class type.
Hi all,
attached patches fix a 12-regression, when a caf token is requested from an
abstract class-typed dummy. The token was not looked up in the correct spot.
Due the class typed object getting an artificial variable for direct derived
type access, the get_caf_decl was looking at the wrong decl.
This patch consists of two parts, the first is just some code complexity
reduction, where an existing attr is now used instead of checking for BT_CLASS
type and branching.
Regtests ok on x86_64-pc-linux-gnu / F41. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 9b7aeeef184b1e7afbc771e4ef723e4367e8f832 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild
Date: Mon, 3 Mar 2025 14:42:28 +0100
Subject: [PATCH 2/2] Fortran: Prevent ICE when getting caf-token from abstract
type [PR77872]
PR fortran/77872
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_get_tree_for_caf_expr): Pick up token from
decl when it is present there for class types.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/class_1.f90: New test.
---
gcc/fortran/trans-expr.cc | 5 +
gcc/testsuite/gfortran.dg/coarray/class_1.f90 | 16
2 files changed, 21 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/class_1.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 7c0b17428cd..0d790b63f95 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2394,6 +2394,11 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr)
if (CLASS_DATA (expr->symtree->n.sym)->attr.codimension)
return caf_decl;
}
+ else if (DECL_P (caf_decl) && DECL_LANG_SPECIFIC (caf_decl)
+ && GFC_DECL_TOKEN (caf_decl)
+ && CLASS_DATA (expr->symtree->n.sym)->attr.codimension)
+ return caf_decl;
+
for (ref = expr->ref; ref; ref = ref->next)
{
if (ref->type == REF_COMPONENT
diff --git a/gcc/testsuite/gfortran.dg/coarray/class_1.f90 b/gcc/testsuite/gfortran.dg/coarray/class_1.f90
new file mode 100644
index 000..fa70b1d6162
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/class_1.f90
@@ -0,0 +1,16 @@
+!{ dg-do compile }
+!
+! Compiling the call x%f() ICEd. Check it's fixed.
+! Contributed by Gerhard Steinmetz
+
+module pr77872_abs
+ type, abstract :: t
+ contains
+ procedure(s), pass, deferred :: f
+ end type
+contains
+ subroutine s(x)
+ class(t) :: x[*]
+ call x%f()
+ end
+end module pr77872_abs
--
2.48.1
From 504b6270f535bf41ba5943d87e6bbbf7fc1df62a Mon Sep 17 00:00:00 2001
From: Andre Vehreschild
Date: Mon, 3 Mar 2025 10:41:05 +0100
Subject: [PATCH 1/2] Fortran: Reduce code complexity [PR77872]
PR fortran/77872
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Use attr instead of
doing type check and branching for BT_CLASS.
---
gcc/fortran/trans-expr.cc | 14 +++---
1 file changed, 3 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e619013f261..7c0b17428cd 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -8216,23 +8216,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* For descriptorless coarrays and assumed-shape coarray dummies, we
pass the token and the offset as additional arguments. */
if (fsym && e == NULL && flag_coarray == GFC_FCOARRAY_LIB
- && ((fsym->ts.type != BT_CLASS && fsym->attr.codimension
- && !fsym->attr.allocatable)
- || (fsym->ts.type == BT_CLASS
- && CLASS_DATA (fsym)->attr.codimension
- && !CLASS_DATA (fsym)->attr.allocatable)))
+ && attr->codimension && !attr->allocatable)
{
/* Token and offset. */
vec_safe_push (stringargs, null_pointer_node);
vec_safe_push (stringargs, build_int_cst (gfc_array_index_type, 0));
gcc_assert (fsym->attr.optional);
}
- else if (fsym && flag_coarray == GFC_FCOARRAY_LIB
- && ((fsym->ts.type != BT_CLASS && fsym->attr.codimension
- && !fsym->attr.allocatable)
- || (fsym->ts.type == BT_CLASS
- && CLASS_DATA (fsym)->attr.codimension
- && !CLASS_DATA (fsym)->attr.allocatable)))
+ else if (fsym && flag_coarray == GFC_FCOARRAY_LIB && attr->codimension
+ && !attr->allocatable)
{
tree caf_decl, caf_type, caf_desc = NULL_TREE;
tree offset, tmp2;
--
2.48.1
Re: [Fortran, Patch, PR118747, v1] Prevent double free alloc. comp. in derived type function results
Hi Paul,
thanks for the review. Committed as gcc-15-7789-g43c11931acc.
The regression is tagged as 15-regression only and was caused by PR
fortran/90068. At least the change in trans-array.cc:2000-.. is one of
major causes for that regression.
Thanks again,
Andre
On Sat, 1 Mar 2025 08:09:46 +
Paul Richard Thomas wrote:
> Hi Andre,
>
> This looks fine to me. You say that this is a regression. How far back does
> it go?
>
> OK for mainline and, if required, for backporting.
>
> Thanks for the patch.
>
> Paul
>
>
> On Fri, 28 Feb 2025 at 15:54, Andre Vehreschild wrote:
>
> > Hi all,
> >
> > on this regression I had to chew a longer time. Assume this Fortran:
> >
> > type T
> >integer, allocatable:: a
> > end type T
> >
> > result(type T) function bar()
> > allocate(bar%a)
> > end function
> >
> > call foo([bar()])
> >
> > That Fortran fragment was translated to something like (pseudo code):
> >
> > T temp;
> > T arr[];
> > temp = bar();
> > arr[0]= temp;
> > foo(arr);
> > if (temp.a) { free(temp.a); temp.a= NULL;}
> > for (i in size(arr))
> > if (arr[i].a) { free(arr[i].a]; <-- double free here
> > arr[i].a = NULL;
> > }
> >
> > I.e., when the derived type result of a function was used in an array
> > constructor that was used a function argument, then the temporary used to
> > evaluate the function only ones was declared to be of value. When the
> > derived
> > type now had allocatable components, freeing those would be done on the
> > value
> > typed temporary (here temp). But later on the array would also be freed.
> > Now a
> > doulbe free occured, because the temporary variable was already freed. The
> > patch fixes this, by preventing the temporary when not necessary, or using
> > a
> > temporary that is reference into the array, i.e., the memory freed (and
> > marked
> > as such) is stored at the same location.
> >
> > So after the patch this looks like this:
> >
> > T *temp; // Now a pointer!
> > T arr[];
> > arr[0] = bar();
> > temp = &arr[0];
> > ... Now we're safe, because freeing temp->a sets arr[0].a to NULL and the
> > following loop is safe.
> >
> > Regtests ok on x86_64-pc-linux-gnu / F41. Ok for mainline?
> >
> > Regards,
> > Andre
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
> >
--
Andre Vehreschild * Email: vehre ad gmx dot de
Re: F2018 REDUCE intrinsic
Hi Paul,
what do want us to do with it?
Let me give an early review:
In gfc_resolve_reduce, I think you duplicate the test for the function having
optional formal arguments. Ones in this block:
+ if (formal->sym->attr.allocatable || formal->sym->attr.allocatable
+ || formal->sym->attr.pointer || formal->sym->attr.pointer
+ || formal->sym->attr.optional || formal->sym->attr.optional
+ || formal->sym->ts.type == BT_CLASS || formal->sym->ts.type == BT_CLASS)
+{
+ gfc_error ("Each argument of OPERATION at %L shall be a scalar, "
+"non-allocatable, non-pointer, non-polymorphic and "
+"nonoptional", &operation->where);
+ return false;
+}
and then again (in the third next if) in:
+ if (formal->sym->attr.optional || formal->next->sym->attr.optional)
+{
+ gfc_error ("The function passed as OPERATION at %L shall not have the "
+"OPTIONAL attribute for either of the arguments",
+&operation->where);
+ return false;
+}
Testing ones should be enough, right?
I don't like the code repetition in
+ if (array->ts.type == BT_CHARACTER)
+{
+ gfc_charlen *cl;
+ unsigned long actual_size, formal_size1, formal_size2, result_size;
+
+ cl = array->ts.u.cl;
+ actual_size = cl && cl->length && cl->length->expr_type == EXPR_CONSTANT
+? mpz_get_ui (cl->length->value.integer) : 0;
+
+ cl = formal->sym->ts.u.cl;
+ formal_size1 = cl && cl->length && cl->length->expr_type == EXPR_CONSTANT
+? mpz_get_ui (cl->length->value.integer) : 0;
+
+ cl = formal->next->sym->ts.u.cl;
+ formal_size2 = cl && cl->length && cl->length->expr_type == EXPR_CONSTANT
+? mpz_get_ui (cl->length->value.integer) : 0;
+
+ cl = sym->ts.u.cl;
+ result_size = cl && cl->length && cl->length->expr_type == EXPR_CONSTANT
+ ? mpz_get_ui (cl->length->value.integer) : 0;
+
either use function for evaluating the constant cl or how about this modern C++:
+ if (array->ts.type == BT_CHARACTER)
+{
+ unsigned long actual_size, formal_size1, formal_size2, result_size;
+ auto get_cst_cl = [](const gfc_charlen *cl) -> unsigned log {
+ return cl && cl->length && cl->length->expr_type == EXPR_CONSTANT
+? mpz_get_ui (cl->length->value.integer) : 0;
+ };
+
+ actual_size = get_cst_cl (array->ts.u.cl);
+
+ formal_size1 = get_cst_cl (formal->sym->ts.u.cl);
+
+ formal_size2 = get_cst_cl (formal->next->sym->ts.u.cl);
+
+ result_size = get_cst_cl (sym->ts.u.cl);
I think the above is easier to maintain and read. Whether you use the lambda or
a dedicated function I leave to your liking.
In
+static gfc_symtree *
+generate_reduce_op_wrapper (gfc_expr *op)
+{
+ gfc_symbol *operation = op->symtree->n.sym;
+ gfc_symbol *wrapper, *a, *b, *c;
+ gfc_symtree *st;
+ char tname[GFC_MAX_SYMBOL_LEN+1];
+ char *name;
+ gfc_namespace *ns;
+// gfc_gsymbol *gsym = NULL;
^^^ Is this needed?
@@ -8785,6 +8801,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_add_expr_to_block (&se->pre, tmp);
}
}
+ else if (scalar_reduce)
+{
+ gfc_add_expr_to_block (&se->pre, se->expr);
+ se->expr = result;
+// gfc_add_block_to_block (&se->post, &post);
^^^ I'd rather uncomment it to be safe in the future, if something is in post.
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -4250,6 +4250,20 @@ gfc_get_symbol_for_expr (gfc_expr * expr, bool
ignore_optional) sym->attr.proc = PROC_INTRINSIC;
sym->attr.flavor = FL_PROCEDURE;
sym->result = sym;
+#if 0
+ if (expr->value.function.isym
+ && expr->value.function.isym->id == GFC_ISYM_REDUCE)
+{
+ if (expr->value.function.actual
+ && expr->value.function.actual->next
+ && expr->value.function.actual->next->next
+ && expr->value.function.actual->next->next->expr == NULL)
+ expr->rank = 0;
+ else if (expr->value.function.actual
+ && expr->value.function.actual->expr)
+ expr->rank = expr->value.function.actual->expr->rank - 1;
+}
+#endif
Er?
Typo in Change.Logs
s/discription/description/
That Changelog looks non-standard.
Ok, I hope this first feedback is valuable to you.
One other question: How does REDUCE() relate to CO_REDUCE()?
Regards,
Andre
On Sun, 2 Mar 2025 20:41:55 +
Paul Richard Thomas wrote:
> Hi All,
>
> This is very much an early version of the F2018 REDUCE intrinsic. I am
> posting it now because I have totally forgotten how to include new
> functions in libgfortran.so. -static-libfortran works fine and the results
> are the same as the other brands.
>
> At present, it produces several of link warnings.
> test_reduce.f90:23:2: warning: type of ‘_gfortran_reduce_scalar’ does not
> match original declaration [-Wlto-type-mismatch]
>23 | pure func
Re: [PATCH] Fortran: reject empty derived type with bind(C) attribute [PR101577]
Hi Harald, in +++ b/gcc/fortran/symbol.cc @@ -4624,12 +4624,28 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) there is + else if (!pedantic) + gfc_warning (0, "Derive ... To me the "not pedantic" is counter-intuitive. In pedantic mode I would have expected this to be at least a warning (if not an error). Why is it not flagged at all? May be I expect something wrong from "pedantic". Besides that: Looks good to me. Regards, Andre On Sun, 2 Mar 2025 22:35:47 +0100 Harald Anlauf wrote: > Dear all, > > due to an oversight in the Fortran standard before 2018, > empty derived types with bind(C) attribute were explicitly > (deliberately?) accepted by gfortran, giving a warning that > the companion processor might not provide an interoperating > entity. > > In the PR, Tobias pointed to a discussion on the J3 ML that > there was a defect in older standards. The attached patch > now generates an error when -std=f20xx is specified, and > continues to generate a warning otherwise. > > Regtested on x86_64-pc-linux-gnu. OK for mainline? > > Thanks, > Harald > -- Andre Vehreschild * Email: vehre ad gmx dot de
Re: [Fortran, Patch, PR77872, v1] Fix ICE when getting caf-token from abstract class type.
On Mon, Mar 03, 2025 at 03:58:24PM +0100, Andre Vehreschild wrote: > > attached patches fix a 12-regression, when a caf token is requested from an > abstract class-typed dummy. The token was not looked up in the correct spot. > Due the class typed object getting an artificial variable for direct derived > type access, the get_caf_decl was looking at the wrong decl. > > This patch consists of two parts, the first is just some code complexity > reduction, where an existing attr is now used instead of checking for BT_CLASS > type and branching. > > Regtests ok on x86_64-pc-linux-gnu / F41. Ok for mainline? > Thanks. OK to commit. -- steve
[patch, Fortran] Fix PR 119049 and 119074, external prototypes with different arglists
Hello world,
this patch is a bit more complicated than originally envisioned.
The problem was that we were not handling external dummy arguments
with -fc-prototypes-external. In looking at this, I found that we
were not warning about external procedures with different argument
lists. This can actually be legal (see the two test cases) but
creates a problem for the C prototypes: If we have something like
subroutine foo(a,n)
external a
if (n == 1) call a(1)
if (n == 2) call a(2,3)
end subroutine foo
then, pre-C23, we could just have written out the prototype as
void foo_ (void (*a) (), int *n);
but this is illegal in C23. What to do? I finally chose to warn
about the argument mismatch, with a new option. Warn only because the
code above is legal, but include in -Wall because such code seems highly
suspect. This option is also implied in -fc-prototypes-external. I also
put a warning in the generated header file in that case, so users
have a chance to see what is going on (especially since gcc now
defaults to C23).
Regression-tested.
Comments? Suggestions for better wordings? Is -Wall too strong,
should this be -Wextra (but then nobody would see it, probably...)?
OK for trunk?
Best regards
Thomas
gcc/fortran/ChangeLog:
PR fortran/119049
PR fortran/119074
* dump-parse-tree.cc (seen_conflict): New static varaible.
(gfc_dump_external_c_prototypes): Initialize it. If it was
set, write out a warning that -std=c23 will not work.
(write_proc): Move the work of actually writing out the
formal arglist to...
(write_formal_arglist): New function. Handle external dummy
parameters and their argument lists. If there were mismatched
arguments, output an empty argument list in pre-C23 style.
* gfortran.h (struct gfc_symbol): Add ext_dummy_arglist_mismatch
flag and formal_at.
* invoke.texi: Document -Wexternal-argument-mismatch.
* lang.opt: Put it in.
* resolve.cc (resolve_function): If warning about external
argument mismatches, build a formal from actual arglist the
first time around, and later compare and warn.
(resolve_call): Likewise
gcc/testsuite/ChangeLog:
PR fortran/119049
PR fortran/119074
* gfortran.dg/interface_55.f90: New test.
* gfortran.dg/interface_56.f90: New test.
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 7726b708ad8..1a15757b57b 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -4108,6 +4108,8 @@ gfc_dump_c_prototypes (FILE *file)
/* Loop over all external symbols, writing out their declarations. */
+static bool seen_conflict;
+
void
gfc_dump_external_c_prototypes (FILE * file)
{
@@ -4119,6 +4121,7 @@ gfc_dump_external_c_prototypes (FILE * file)
return;
dumpfile = file;
+ seen_conflict = false;
fprintf (dumpfile,
_("/* Prototypes for external procedures generated from %s\n"
" by GNU Fortran %s%s.\n\n"
@@ -4130,6 +4133,11 @@ gfc_dump_external_c_prototypes (FILE * file)
return;
gfc_traverse_gsymbol (gfc_gsym_root, show_external_symbol, (void *) &bind_c);
+ if (seen_conflict)
+fprintf (dumpfile,
+ _("\n\n/* WARNING: Because of differing arguments to an external\n"
+ " procedure, this header file is not compatible with -std=c23."
+ "\n\n Use another -std option to compile. */\n"));
}
/* Callback function for dumping external symbols, be they BIND(C) or
@@ -4406,52 +4414,35 @@ write_variable (gfc_symbol *sym)
fputs (";\n", dumpfile);
}
-
-/* Write out a procedure, including its arguments. */
static void
-write_proc (gfc_symbol *sym, bool bind_c)
+write_formal_arglist (gfc_symbol *sym, bool bind_c)
{
- const char *pre, *type_name, *post;
- bool asterisk;
- enum type_return rok;
gfc_formal_arglist *f;
- const char *sym_name;
- const char *intent_in;
- bool external_character;
-
- external_character = sym->ts.type == BT_CHARACTER && !bind_c;
-
- if (sym->binding_label)
-sym_name = sym->binding_label;
- else
-sym_name = sym->name;
-
- if (sym->ts.type == BT_UNKNOWN || external_character)
-{
- fprintf (dumpfile, "void ");
- fputs (sym_name, dumpfile);
-}
- else
-write_decl (&(sym->ts), sym->as, sym_name, true, &sym->declared_at, bind_c);
-
- if (!bind_c)
-fputs ("_", dumpfile);
- fputs (" (", dumpfile);
- if (external_character)
-{
- fprintf (dumpfile, "char *result_%s, size_t result_%s_len",
- sym_name, sym_name);
- if (sym->formal)
- fputs (", ", dumpfile);
-}
-
- for (f = sym->formal; f; f = f->next)
+ for (f = sym->formal; f != NULL; f = f->next)
{
+ enum type_return rok;
+ const char *intent_in;
gfc_symbol *s;
+ const char *pre, *type_name, *post;
+ bool asterisk;
+
s = f->sym;
rok = get_c_type_name (&(s->ts), s->as, &pre,
Re: [PATCH] Fortran: reject empty derived type with bind(C) attribute [PR101577]
Hi Andre, Am 03.03.25 um 10:08 schrieb Andre Vehreschild: Hi Harald, in +++ b/gcc/fortran/symbol.cc @@ -4624,12 +4624,28 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) there is + else if (!pedantic) + gfc_warning (0, "Derive ... To me the "not pedantic" is counter-intuitive. In pedantic mode I would have expected this to be at least a warning (if not an error). Why is it not flagged at all? May be I expect something wrong from "pedantic". it is actually flagged, but one would get the warning *twice* without the above. The reason is the following in gfc_post_options: /* If -pedantic, warn about the use of GNU extensions. */ if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0) gfc_option.warn_std |= GFC_STD_GNU; /* -std=legacy -pedantic is effectively -std=gnu. */ if (pedantic && (gfc_option.allow_std & GFC_STD_LEGACY) != 0) gfc_option.warn_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_LEGACY; Therefore gfc_notify_std always warns for -std=gnu and -std=legacy when -pedantic is given, unless it generates an error. I've added a comment and pushed as r15-7798-gf9f16b9f74b767 . Thanks for the review! Harald Besides that: Looks good to me. Regards, Andre On Sun, 2 Mar 2025 22:35:47 +0100 Harald Anlauf wrote: Dear all, due to an oversight in the Fortran standard before 2018, empty derived types with bind(C) attribute were explicitly (deliberately?) accepted by gfortran, giving a warning that the companion processor might not provide an interoperating entity. In the PR, Tobias pointed to a discussion on the J3 ML that there was a defect in older standards. The attached patch now generates an error when -std=f20xx is specified, and continues to generate a warning otherwise. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald -- Andre Vehreschild * Email: vehre ad gmx dot de
