[patch, fortran] Implement IANY, IALL and IPARITY for unsigned
OK for trunk?
This is based on the previous submissions. Again, this does not
generate a new library version; rather it re-uses the signed
integer version already present in the library.
OK for trunk?
Previous submissions (without which this will not work):
https://gcc.gnu.org/pipermail/fortran/2024-September/060975.html
https://gcc.gnu.org/pipermail/fortran/2024-September/060987.html
gcc/fortran/ChangeLog:
* check.cc (gfc_check_transf_bit_intrins): Handle unsigned.
* gfortran.texi: Docment IANY, IALL and IPARITY for unsigned.
* iresolve.cc (gfc_resolve_iall): Set flag to use integer
if type is BT_UNSIGNED.
(gfc_resolve_iany): Likewise.
(gfc_resolve_iparity): Likewise.
* simplify.cc (do_bit_and): Adjust asserts for BT_UNSIGNED.
(do_bit_ior): Likewise.
(do_bit_xor): Likewise
gcc/testsuite/ChangeLog:
* gfortran.dg/unsigned_29.f90: New test.
gcc/fortran/check.cc | 14 ++-
gcc/fortran/gfortran.texi | 1 +
gcc/fortran/iresolve.cc | 6 +--
gcc/fortran/simplify.cc | 51 +++
gcc/testsuite/gfortran.dg/unsigned_29.f90 | 40 ++
5 files changed, 99 insertions(+), 13 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/unsigned_29.f90
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 7c630dd73f4..533c9d7d343 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -4430,7 +4430,19 @@ gfc_check_mask (gfc_expr *i, gfc_expr *kind)
bool
gfc_check_transf_bit_intrins (gfc_actual_arglist *ap)
{
- if (ap->expr->ts.type != BT_INTEGER)
+ bt type = ap->expr->ts.type;
+
+ if (flag_unsigned)
+{
+ if (type != BT_INTEGER && type != BT_UNSIGNED)
+ {
+ gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
+"or UNSIGNED", gfc_current_intrinsic_arg[0]->name,
+gfc_current_intrinsic, &ap->expr->where);
+ return false;
+ }
+}
+ else if (ap->expr->ts.type != BT_INTEGER)
{
gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER",
gfc_current_intrinsic_arg[0]->name,
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index e5ffe67..3eb8039c09f 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -2789,6 +2789,7 @@ As of now, the following intrinsics take unsigned
arguments:
@item @code{RANGE}
@item @code{TRANSFER}
@item @code{SUM}, @code{PRODUCT}, @code{MATMUL} and @code{DOT_PRODUCT}
+@item @code{IANY}, @code{IALL} and @code{IPARITY}
@end itemize
This list will grow in the near future.
@c -
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 92a591cf6d7..58a1821ef10 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -1195,7 +1195,7 @@ gfc_resolve_hypot (gfc_expr *f, gfc_expr *x,
gfc_expr *y ATTRIBUTE_UNUSED)
void
gfc_resolve_iall (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
gfc_expr *mask)
{
- resolve_transformational ("iall", f, array, dim, mask);
+ resolve_transformational ("iall", f, array, dim, mask, true);
}
@@ -1223,7 +1223,7 @@ gfc_resolve_iand (gfc_expr *f, gfc_expr *i,
gfc_expr *j)
void
gfc_resolve_iany (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
gfc_expr *mask)
{
- resolve_transformational ("iany", f, array, dim, mask);
+ resolve_transformational ("iany", f, array, dim, mask, true);
}
@@ -1429,7 +1429,7 @@ gfc_resolve_long (gfc_expr *f, gfc_expr *a)
void
gfc_resolve_iparity (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
gfc_expr *mask)
{
- resolve_transformational ("iparity", f, array, dim, mask);
+ resolve_transformational ("iparity", f, array, dim, mask, true);
}
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index e5681c42a48..bd2f6485c95 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -3401,9 +3401,20 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
static gfc_expr *
do_bit_and (gfc_expr *result, gfc_expr *e)
{
- gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT);
- gcc_assert (result->ts.type == BT_INTEGER
- && result->expr_type == EXPR_CONSTANT);
+ if (flag_unsigned)
+{
+ gcc_assert ((e->ts.type == BT_INTEGER || e->ts.type == BT_UNSIGNED)
+ && e->expr_type == EXPR_CONSTANT);
+ gcc_assert ((result->ts.type == BT_INTEGER
+ || result->ts.type == BT_UNSIGNED)
+ && result->expr_type == EXPR_CONSTANT);
+}
+ else
+{
+ gcc_assert (e->ts.type == BT_INTEGER && e->expr_type ==
EXPR_CONSTANT);
+ gcc_assert (result->ts.type == BT_INTEGER
+ && result->expr_type == EXPR_CONSTANT);
+}
mpz_and (result->value.integer, result->value.integer,
e->value.integer);
return result;
@@ -3420,9 +3431,20 @@ gfc_simplif
[patch, fortran] Add random numbers and fix some bugs.
This patch adds random number support for UNSIGNED, plus fixes
two bugs, with array I/O where the type used to be set to BT_INTEGER,
and for division with the divisor being a constant.
Again, depends on prevous submissions.
OK for trunk?
gcc/fortran/ChangeLog:
* check.cc (gfc_check_random_number): Adjust for unsigned.
* iresolve.cc (gfc_resolve_random_number): Handle unsinged.
* trans-expr.cc (gfc_conv_expr_op): Handle BT_UNSIGNED for divide.
* trans-types.cc (gfc_get_dtype_rank_type): Handle BT_UNSIGNED.
* gfortran.texi: Add RANDOM_NUMBER for UNSIGNED.
libgfortran/ChangeLog:
* gfortran.map: Add _gfortran_random_m1, _gfortran_random_m2,
_gfortran_random_m4, _gfortran_random_m8 and _gfortran_random_m16.
* intrinsics/random.c (random_m1): New function.
(random_m2): New function.
(random_m4): New function.
(random_m8): New function.
(random_m16): New function.
(arandom_m1): New function.
(arandom_m2): New function.
(arandom_m4): New function.
(arandom_m8): New funciton.
(arandom_m16): New function.
gcc/testsuite/ChangeLog:
* gfortran.dg/unsigned_30.f90: New test.
---
gcc/fortran/check.cc | 10 +-
gcc/fortran/gfortran.texi | 1 +
gcc/fortran/iresolve.cc | 6 +-
gcc/fortran/trans-expr.cc | 4 +-
gcc/fortran/trans-types.cc| 7 +-
gcc/testsuite/gfortran.dg/unsigned_30.f90 | 63
libgfortran/gfortran.map | 10 +
libgfortran/intrinsics/random.c | 440 ++
8 files changed, 534 insertions(+), 7 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/unsigned_30.f90
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 533c9d7d343..1851cfb8d4a 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -7007,8 +7007,14 @@ gfc_check_random_init (gfc_expr *repeatable,
gfc_expr *image_distinct)
bool
gfc_check_random_number (gfc_expr *harvest)
{
- if (!type_check (harvest, 0, BT_REAL))
-return false;
+ if (flag_unsigned)
+{
+ if (!type_check2 (harvest, 0, BT_REAL, BT_UNSIGNED))
+ return false;
+}
+ else
+if (!type_check (harvest, 0, BT_REAL))
+ return false;
if (!variable_check (harvest, 0, false))
return false;
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 3eb8039c09f..a5ebadff3bb 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -2790,6 +2790,7 @@ As of now, the following intrinsics take unsigned
arguments:
@item @code{TRANSFER}
@item @code{SUM}, @code{PRODUCT}, @code{MATMUL} and @code{DOT_PRODUCT}
@item @code{IANY}, @code{IALL} and @code{IPARITY}
+@item @code{RANDOM_NUMBER}.
@end itemize
This list will grow in the near future.
@c -
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 58a1821ef10..a814c9279cf 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -3452,12 +3452,14 @@ gfc_resolve_random_number (gfc_code *c)
{
const char *name;
int kind;
+ char type;
kind = gfc_type_abi_kind (&c->ext.actual->expr->ts);
+ type = gfc_type_letter (c->ext.actual->expr->ts.type);
if (c->ext.actual->expr->rank == 0)
-name = gfc_get_string (PREFIX ("random_r%d"), kind);
+name = gfc_get_string (PREFIX ("random_%c%d"), type, kind);
else
-name = gfc_get_string (PREFIX ("arandom_r%d"), kind);
+name = gfc_get_string (PREFIX ("arandom_%c%d"), type, kind);
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
}
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index f1dfac4a2be..b39b4450997 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -3982,9 +3982,9 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
case INTRINSIC_DIVIDE:
/* If expr is a real or complex expr, use an RDIV_EXPR. If op1 is
- an integer, we must round towards zero, so we use a
+an integer or unsigned, we must round towards zero, so we use a
TRUNC_DIV_EXPR. */
- if (expr->ts.type == BT_INTEGER)
+ if (expr->ts.type == BT_INTEGER || expr->ts.type == BT_UNSIGNED)
code = TRUNC_DIV_EXPR;
else
code = RDIV_EXPR;
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 3a1ff98b33c..ce7d3027f1b 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1651,7 +1651,12 @@ gfc_get_dtype_rank_type (int rank, tree etype)
&& TYPE_STRING_FLAG (ptype))
n = BT_CHARACTER;
else
- n = BT_INTEGER;
+ {
+ if (TYPE_UNSIGNED (etype))
+ n = BT_UNSIGNED;
+ else
+ n = BT_INTEGER;
+ }
break;
case BOOLEAN_TYPE:
diff --git a/gcc/testsuite/gfortran.dg/unsigned_30.f90
b/gcc/testsuite/gfortran.dg/unsigned_3
Re: [Ping, Fortran, Patch, PR85002, v1] Fix deep-copy of alloc. comps. in coarrays ICEing and crashing w/ lib.
Am 18.09.24 um 12:31 schrieb Andre Vehreschild: Regtested ok on x86_64-pc-linux-gnu / F39. Ok for mainline? OK. Thanks for the patch! Best regards Thomas
Re: [Fortran, Patch, PR106606, v1] Fortran: Break recursion building recursive types. [PR106606]
Hi Andre, Regtested ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline? Extremely minor nit: In the commit message and ChangeLog entry, Build a derived type component's type only, when it is not already being build and the component uses pointer semantics. I believe that should be "being built". In the ChangeLog entry derived types as component's types when they are not yet build. s/build/built/ OK for trunk. Thanks for the patch! Best regards Thomas
Re: [Ping*2, Patch, Fortran, 77871, v1] Allow for class typed coarray parameter as dummy [PR77871]
Hi all,
back from my holidays and still no review. PING PING!
Rebased to current mainline.
Regtested ok on x86_64-pc-linux-gnu / F39. Ok for mainline?
Regards,
Andre
On Wed, 21 Aug 2024 13:43:52 +0200
Andre Vehreschild wrote:
> Hi all,
>
> pinging this patch for the first time.
>
> Rebased and regtested ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
>
> - Andre
>
> On Thu, 15 Aug 2024 14:39:25 +0200
> Andre Vehreschild wrote:
>
> > Hi all,
> >
> > attached patch fixes another regression on coarrays. This time for class
> > typed coarrays as dummys.
> >
> > Regtested ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
> >
> > Regards,
> > Andre
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 0e5b1a132c250fd7d823aa8a16da80e850ae4350 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild
Date: Thu, 15 Aug 2024 13:49:49 +0200
Subject: [PATCH] [Fortran] Allow for class type coarray parameters. [PR77871]
gcc/fortran/ChangeLog:
PR fortran/77871
* trans-expr.cc (gfc_conv_derived_to_class): Assign token when
converting a coarray to class.
(gfc_get_tree_for_caf_expr): For classes get the caf decl from
the saved descriptor.
(gfc_get_caf_token_offset):Assert that coarray=lib is set and
cover more cases where the tree having the coarray token can be.
* trans-intrinsic.cc (gfc_conv_intrinsic_caf_get): Use unified
test for pointers.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/dummy_3.f90: New test.
---
gcc/fortran/trans-expr.cc | 36 ---
gcc/fortran/trans-intrinsic.cc| 2 +-
gcc/testsuite/gfortran.dg/coarray/dummy_3.f90 | 33 +
3 files changed, 58 insertions(+), 13 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/dummy_3.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 07e28a9f7a8..d626d80ba51 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -810,6 +810,16 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym,
/* Now set the data field. */
ctree = gfc_class_data_get (var);
+ if (flag_coarray == GFC_FCOARRAY_LIB && CLASS_DATA (fsym)->attr.codimension)
+{
+ tree token;
+ tmp = gfc_get_tree_for_caf_expr (e);
+ if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+ tmp = build_fold_indirect_ref (tmp);
+ gfc_get_caf_token_offset (parmse, &token, nullptr, tmp, NULL_TREE, e);
+ gfc_add_modify (&parmse->pre, gfc_conv_descriptor_token (ctree), token);
+}
+
if (optional)
cond_optional = gfc_conv_expr_present (e->symtree->n.sym);
@@ -2344,6 +2354,10 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr)
if (expr->symtree->n.sym->ts.type == BT_CLASS)
{
+ if (DECL_P (caf_decl) && DECL_LANG_SPECIFIC (caf_decl)
+ && GFC_DECL_SAVED_DESCRIPTOR (caf_decl))
+ caf_decl = GFC_DECL_SAVED_DESCRIPTOR (caf_decl);
+
if (expr->ref && expr->ref->type == REF_ARRAY)
{
caf_decl = gfc_class_data_get (caf_decl);
@@ -2408,16 +2422,12 @@ gfc_get_caf_token_offset (gfc_se *se, tree *token, tree *offset, tree caf_decl,
{
tree tmp;
+ gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
+
/* Coarray token. */
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
-{
- gcc_assert (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl))
- == GFC_ARRAY_ALLOCATABLE
- || expr->symtree->n.sym->attr.select_type_temporary
- || expr->symtree->n.sym->assoc);
*token = gfc_conv_descriptor_token (caf_decl);
-}
- else if (DECL_LANG_SPECIFIC (caf_decl)
+ else if (DECL_P (caf_decl) && DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_TOKEN (caf_decl) != NULL_TREE)
*token = GFC_DECL_TOKEN (caf_decl);
else
@@ -2435,7 +2445,7 @@ gfc_get_caf_token_offset (gfc_se *se, tree *token, tree *offset, tree caf_decl,
&& (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl)) == GFC_ARRAY_ALLOCATABLE
|| GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl)) == GFC_ARRAY_POINTER))
*offset = build_int_cst (gfc_array_index_type, 0);
- else if (DECL_LANG_SPECIFIC (caf_decl)
+ else if (DECL_P (caf_decl) && DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_CAF_OFFSET (caf_decl) != NULL_TREE)
*offset = GFC_DECL_CAF_OFFSET (caf_decl);
else if (GFC_TYPE_ARRAY_CAF_OFFSET (TREE_TYPE (caf_decl)) != NULL_TREE)
@@ -2502,11 +2512,13 @@ gfc_get_caf_token_offset (gfc_se *se, tree *token, tree *offset, tree caf_decl,
}
else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
tmp = gfc_conv_descriptor_data_get (caf_decl);
+ else if (INDIRECT_REF_P (caf_decl))
+tmp = TREE_OPERAND (caf_decl, 0);
else
- {
- gcc_assert (POINTER_TYPE_P (TREE_TYPE (caf_decl)));
- tmp = caf_decl;
- }
+{
+ gcc_assert (POINTER_TYPE_P (TREE_TYPE (caf_decl)));
+ tmp = caf_decl;
+}
*offset = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
fold_c
Re: [Ping, Fortran, Patch, PR85002, v1] Fix deep-copy of alloc. comps. in coarrays ICEing and crashing w/ lib.
Hi all,
pinging this patch.
Regtested ok on x86_64-pc-linux-gnu / F39. Ok for mainline?
Regards,
Andre
On Fri, 23 Aug 2024 11:19:59 +0200
Andre Vehreschild wrote:
> Hi all,
>
> attached patch fixes an ICE during trans-phase when allocatable components in
> derived typed coarrays were nested. I am nearly convinced, that the ICE is
> mostly fixed by pr86468, because I get a slightly different ICE. Nevertheless
> was the executable crashing with -fcoarray=lib because the deep copy was not
> inserted in the coarray case, which is fixed by this patch now. Furthermore
> did I correct a comment, that was describing the inverse of the code
> following.
>
> Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
>
> Regards,
> Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
--
Andre Vehreschild * Email: vehre ad gmx dot de
From eb81bce1c905f52643454e3b663e458a94a1bb75 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild
Date: Fri, 23 Aug 2024 09:07:09 +0200
Subject: [PATCH] [Fortran] Fix deep copy allocatable components in coarrays.
[PR85002]
Fix code for deep copy of allocatable components in derived type nested
structures generated, but not inserted when the copy had to be done in
a coarray. Additionally fix a comment.
gcc/fortran/ChangeLog:
PR fortran/85002
* trans-array.cc (duplicate_allocatable_coarray): Allow adding
of deep copy code in the when-allocated case. Add bounds
computation before condition, because coarrays need the bounds
also when not allocated.
(structure_alloc_comps): Duplication in the coarray case is done
already, omit it. Add the deep-code when duplication a coarray.
* trans-expr.cc (gfc_trans_structure_assign): Fix comment.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/alloc_comp_9.f90: New test.
---
gcc/fortran/trans-array.cc| 16 ++---
gcc/fortran/trans-expr.cc | 2 +-
.../gfortran.dg/coarray/alloc_comp_9.f90 | 23 +++
3 files changed, 32 insertions(+), 9 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/alloc_comp_9.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8c35926436d..838b6d3da80 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9417,10 +9417,9 @@ gfc_duplicate_allocatable_nocopy (tree dest, tree src, tree type, int rank)
NULL_TREE, NULL_TREE);
}
-
static tree
-duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src,
- tree type, int rank)
+duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src, tree type,
+ int rank, tree add_when_allocated)
{
tree tmp;
tree size;
@@ -9474,7 +9473,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src,
gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp), rank));
if (rank)
- nelems = gfc_full_array_size (&block, src, rank);
+ nelems = gfc_full_array_size (&globalblock, src, rank);
else
nelems = integer_one_node;
@@ -9505,7 +9504,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src,
fold_convert (size_type_node, size));
gfc_add_expr_to_block (&block, tmp);
}
-
+ gfc_add_expr_to_block (&block, add_when_allocated);
tmp = gfc_finish_block (&block);
/* Null the destination if the source is null; otherwise do
@@ -9684,7 +9683,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
gfc_duplicate_allocatable (), where the deep copy code is just added
into the if's body, by adding tmp (the deep copy code) as last
argument to gfc_duplicate_allocatable (). */
- if (purpose == COPY_ALLOC_COMP
+ if (purpose == COPY_ALLOC_COMP && caf_mode == 0
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
tmp = gfc_duplicate_allocatable (dest, decl, decl_type, rank,
tmp);
@@ -10414,8 +10413,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
c->caf_token,
NULL_TREE);
}
- tmp = duplicate_allocatable_coarray (dcmp, dst_tok, comp,
- ctype, rank);
+ tmp
+ = duplicate_allocatable_coarray (dcmp, dst_tok, comp, ctype,
+ rank, add_when_allocated);
}
else
tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank,
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d626d80ba51..54901c33139 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9657,7 +9657,7 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray)
/* Register the component with the caf-lib before it is initialized.
Register only allocatable components, that are not coarray'ed
- components (%comp[*]). Only register when the constructor is not the
+ components (%comp[*]). Only register when the constructor is the
null-expression. */
if (coarray && !cm->attr.codimension
&& (cm->attr.allocatable || cm->attr.pointer)
diff --git a/gcc/testsu
[Fortran, Patch, PR106606, v1] Fortran: Break recursion building recursive types. [PR106606]
Hi all,
Paul asked me to have a look at his approach for pr106606. Now here is my
solution. I needed to break the endless recursion of a derived type referencing
itself in a component (like in a linked list). I accomplished this by checking,
if a type is in the build (i.e. if its size has not been computed; checking if
no FIELD_DECLs are present, lead to errors when in the middle of constructing a
type). So, when now a derived type uses itself (directly or implicitly) using
a pointer style component (pointer, allocatable...) then it is not build again,
but only the address to the incomplete type is used (a POINTER_TYPE tree is
created). This is sufficient to layout the type and later on the RECORD_TYPE
will be completed and everything is fine.
Regtested ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 3ed3a61ea37d5e6d3a5aba64d8176ac8bbdb3f92 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild
Date: Fri, 23 Aug 2024 16:28:38 +0200
Subject: [PATCH] Fortran: Break recursion building recursive types. [PR106606]
Build a derived type component's type only, when it is not already being
build and the component uses pointer semantics.
gcc/fortran/ChangeLog:
PR fortran/106606
* trans-types.cc (gfc_get_derived_type): Only build non-pointer
derived types as component's types when they are not yet build.
gcc/testsuite/ChangeLog:
* gfortran.dg/recursive_alloc_comp_5.f90: New test.
---
gcc/fortran/trans-types.cc| 20 +++---
.../gfortran.dg/recursive_alloc_comp_5.f90| 37 +++
2 files changed, 51 insertions(+), 6 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/recursive_alloc_comp_5.f90
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 3a1ff98b33c..96ef8b49fbe 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2905,18 +2905,26 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
will be built and so we can return the type. */
for (c = derived->components; c; c = c->next)
{
- bool same_alloc_type = c->attr.allocatable
- && derived == c->ts.u.derived;
-
if (c->ts.type == BT_UNION && c->ts.u.derived->backend_decl == NULL)
c->ts.u.derived->backend_decl = gfc_get_union_type (c->ts.u.derived);
if (c->ts.type != BT_DERIVED && c->ts.type != BT_CLASS)
continue;
- if ((!c->attr.pointer && !c->attr.proc_pointer
- && !same_alloc_type)
- || c->ts.u.derived->backend_decl == NULL)
+ const bool incomplete_type
+ = c->ts.u.derived->backend_decl
+ && TREE_CODE (c->ts.u.derived->backend_decl) == RECORD_TYPE
+ && !(TYPE_LANG_SPECIFIC (c->ts.u.derived->backend_decl)
+ && TYPE_LANG_SPECIFIC (c->ts.u.derived->backend_decl)->size);
+ const bool pointer_component
+ = c->attr.pointer || c->attr.allocatable || c->attr.proc_pointer;
+
+ /* Prevent endless recursion on recursive types (i.e. types that reference
+ themself in a component. Break the recursion by not building pointers
+ to incomplete types again, aka types that are already in the build. */
+ if (c->ts.u.derived->backend_decl == NULL
+ || (c->attr.codimension && c->as->corank != codimen)
+ || !(incomplete_type && pointer_component))
{
int local_codim = c->attr.codimension ? c->as->corank: codimen;
c->ts.u.derived->backend_decl = gfc_get_derived_type (c->ts.u.derived,
diff --git a/gcc/testsuite/gfortran.dg/recursive_alloc_comp_5.f90 b/gcc/testsuite/gfortran.dg/recursive_alloc_comp_5.f90
new file mode 100644
index 000..f26d6a8da38
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_alloc_comp_5.f90
@@ -0,0 +1,37 @@
+!{ dg-do run }
+
+! Check that PR106606 is fixed.
+
+! Contributed by Ron Shepard
+
+module bst_base_mod
+
+ ! Binary Search Tree Module
+
+ implicit none
+
+ public
+
+ type, abstract :: bst_base_node_type
+class(bst_base_node_type), allocatable :: left
+class(bst_base_node_type), allocatable :: right
+ end type bst_base_node_type
+
+ type, extends (bst_base_node_type) :: bst_base
+integer :: bst_base_value
+ end type bst_base
+
+end module bst_base_mod
+
+ use bst_base_mod
+
+ class (bst_base), allocatable :: root
+
+ allocate (root, source = bst_base (NULL(), NULL(), 0))
+ root%left = bst_base (NULL(), NULL(), 1)
+ root%right = bst_base (NULL(), NULL(), 2)
+
+ if (.not. allocated(root%left)) stop 1
+ if (.not. allocated(root%right)) stop 2
+end
+
--
2.46.0
