[gcc r15-3014] Fix ICE in recompute_tree_invariant_for_addr_expr, at tree.c:4535 [PR84244]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:661acde60ef4e9ac5a9e48be18770fb3a9aeb9a5

commit r15-3014-g661acde60ef4e9ac5a9e48be18770fb3a9aeb9a5
Author: Andre Vehreschild 
Date:   Thu Jul 11 15:44:56 2024 +0200

Fix ICE in recompute_tree_invariant_for_addr_expr, at tree.c:4535 [PR84244]

Declaring an unused function with a derived type having a pointer
component and using that derived type as a coarray, lead the compiler to
ICE because the caf_token for the pointer was not linked into the
component correctly.

PR fortran/84244

gcc/fortran/ChangeLog:

* trans-types.cc (gfc_get_derived_type): When a caf_sub_token is
generated for a component, link it to the component it is
generated for (the previous one).

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/ptr_comp_5.f08: New test.

Diff:
---
 gcc/fortran/trans-types.cc   |  6 +-
 gcc/testsuite/gfortran.dg/coarray/ptr_comp_5.f08 | 19 +++
 2 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index e6da8e1a58b..bc582085f57 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2661,7 +2661,7 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
   tree *chain = NULL;
   bool got_canonical = false;
   bool unlimited_entity = false;
-  gfc_component *c;
+  gfc_component *c, *last_c = nullptr;
   gfc_namespace *ns;
   tree tmp;
   bool coarray_flag, class_coarray_flag;
@@ -2961,10 +2961,14 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
 types.  */
   if (class_coarray_flag || !c->backend_decl)
c->backend_decl = field;
+  if (c->attr.caf_token && last_c)
+   last_c->caf_token = field;
 
   if (c->attr.pointer && (c->attr.dimension || c->attr.codimension)
  && !(c->ts.type == BT_DERIVED && strcmp (c->name, "_data") == 0))
GFC_DECL_PTR_ARRAY_P (c->backend_decl) = 1;
+
+  last_c = c;
 }
 
   /* Now lay out the derived type, including the fields.  */
diff --git a/gcc/testsuite/gfortran.dg/coarray/ptr_comp_5.f08 
b/gcc/testsuite/gfortran.dg/coarray/ptr_comp_5.f08
new file mode 100644
index 000..ed3a8db13fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/ptr_comp_5.f08
@@ -0,0 +1,19 @@
+! { dg-do compile }
+
+! Check PR84244 does not ICE anymore.
+
+program ptr_comp_5
+  integer, target :: dest = 42
+  type t
+integer, pointer :: p
+  end type
+  type(t) :: o[*]
+
+  o%p => dest
+contains
+  ! This unused routine is crucial for the ICE.
+  function f(x)
+type(t), intent(in) ::x
+  end function
+end program
+

[gcc r15-3020] Allow coarrays in select type. [PR46371, PR56496]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:8871489c5162067c72a9b9ab05fe2179560e9986

commit r15-3020-g8871489c5162067c72a9b9ab05fe2179560e9986
Author: Andre Vehreschild 
Date:   Thu Aug 15 20:23:23 2024 +0200

Allow coarrays in select type. [PR46371, PR56496]

Fix ICE when scalar coarrays are used in a select type. Prevent
coindexing in associate/select type/select rank selector expression.

gcc/fortran/ChangeLog:

PR fortran/46371
PR fortran/56496

* expr.cc (gfc_is_coindexed): Detect is coindexed also when
rewritten to caf_get.
* trans-stmt.cc (trans_associate_var): Always accept a
descriptor for coarrays.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/select_type_1.f90: New test.
* gfortran.dg/coarray/select_type_2.f90: New test.
* gfortran.dg/coarray/select_type_3.f90: New test.

Diff:
---
 gcc/fortran/expr.cc|  4 +++
 gcc/fortran/trans-stmt.cc  | 10 ++-
 .../gfortran.dg/coarray/select_type_1.f90  | 34 ++
 .../gfortran.dg/coarray/select_type_2.f90  | 19 
 .../gfortran.dg/coarray/select_type_3.f90  | 23 +++
 5 files changed, 83 insertions(+), 7 deletions(-)

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index d3a1f8c0ba1..4f2d80c04f8 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5803,6 +5803,10 @@ gfc_is_coindexed (gfc_expr *e)
 {
   gfc_ref *ref;
 
+  if (e->expr_type == EXPR_FUNCTION && e->value.function.isym
+  && e->value.function.isym->id == GFC_ISYM_CAF_GET)
+e = e->value.function.actual->expr;
+
   for (ref = e->ref; ref; ref = ref->next)
 if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
   return !gfc_ref_this_image (ref);
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 3b09a139dc0..023b1739b85 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2200,16 +2200,12 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block 
*block)
  else
stmp = gfc_class_data_get (ctmp);
 
- /* Coarray scalar component expressions can emerge from
-the front end as array elements of the _data field.  */
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (stmp)))
-   stmp = gfc_conv_descriptor_data_get (stmp);
-
- if (!POINTER_TYPE_P (TREE_TYPE (stmp)))
+ if (!CLASS_DATA (sym)->attr.codimension
+ && !POINTER_TYPE_P (TREE_TYPE (stmp)))
stmp = gfc_build_addr_expr (NULL, stmp);
 
  dtmp = gfc_class_data_get (ctree);
- stmp = fold_convert (TREE_TYPE (dtmp), stmp);
+ stmp = build1 (VIEW_CONVERT_EXPR, TREE_TYPE (dtmp), stmp);
  gfc_add_modify (&se.pre, dtmp, stmp);
  stmp = gfc_class_vptr_get (ctmp);
  dtmp = gfc_class_vptr_get (ctree);
diff --git a/gcc/testsuite/gfortran.dg/coarray/select_type_1.f90 
b/gcc/testsuite/gfortran.dg/coarray/select_type_1.f90
new file mode 100644
index 000..7f12fb9aec7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/select_type_1.f90
@@ -0,0 +1,34 @@
+!{ dg-do run }
+
+! Check PR46371 is fixed.
+! Contributed by Tobias Burnus  
+
+program pr46371
+  type :: foo
+integer :: i = 0
+  end type
+
+  class(foo), allocatable :: o_foo[:]
+  integer :: j
+
+  allocate(foo :: o_foo[*])
+  if (this_image() == 1) then
+
+select type(a => o_foo)
+  type is(foo)
+  j = a[1]%i
+  a[1]%i = 3
+end select
+
+if (j /= 0) stop 1
+
+select type(o_foo)
+  type is(foo)
+  j = o_foo[1]%i
+end select
+
+if (o_foo[1]%i /= 3) stop 2
+if (j /= 3) stop 3
+  end if
+end program pr46371
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/select_type_2.f90 
b/gcc/testsuite/gfortran.dg/coarray/select_type_2.f90
new file mode 100644
index 000..1694d095708
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/select_type_2.f90
@@ -0,0 +1,19 @@
+!{ dg-do compile }
+
+! Check PR46371 is fixed.
+! Contributed by Tobias Burnus  
+
+program pr46371
+  type :: foo
+integer :: i = 0
+  end type
+
+  class(foo), allocatable :: o_foo[:]
+  integer :: j
+
+  select type(a => o_foo[2])  !{ dg-error "must not be coindexed" }
+type is(foo)
+j = a%i
+  end select
+end program pr46371
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/select_type_3.f90 
b/gcc/testsuite/gfortran.dg/coarray/select_type_3.f90
new file mode 100644
index 000..50f27893ccc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/select_type_3.f90
@@ -0,0 +1,23 @@
+!{ dg-do run }
+
+! Check pr56496 is fixed.
+! Contributed by Tobias Burnus  
+
+program pr56496
+
+  class(*), allocatable :: a[:]
+
+  allocate(integer :: a[*])
+  select type(a)
+type is (integer)
+  a= 5
+

[gcc r15-3035] Fortran: Fix [Coarray] ICE in conv_caf_send, at fortran/trans-intrinsic.c:1950 [PR84246]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:35f56012806432fd89bbae431950a8dc5f6729a3

commit r15-3035-g35f56012806432fd89bbae431950a8dc5f6729a3
Author: Andre Vehreschild 
Date:   Wed Jul 17 12:30:52 2024 +0200

Fortran: Fix [Coarray] ICE in conv_caf_send, at 
fortran/trans-intrinsic.c:1950 [PR84246]

Fix ICE caused by converted expression already being pointer by checking
for its type.  Lift rewrite to caf_send completely into resolve and
prevent more temporary arrays.

PR fortran/84246

gcc/fortran/ChangeLog:

* resolve.cc (caf_possible_reallocate): Detect arrays that may
be reallocated by caf_send.
(resolve_ordinary_assign): More reliably detect assignments
where a rewrite to caf_send is needed.
* trans-expr.cc (gfc_trans_assignment_1): Remove rewrite to
caf_send, because this is done by resolve now.
* trans-intrinsic.cc (conv_caf_send): Prevent unneeded temporary
arrays.

libgfortran/ChangeLog:

* caf/single.c (send_by_ref): Created array's lbound is now 1
and the offset set correctly.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray_allocate_7.f08: Adapt to array being
allocate by caf_send.

Diff:
---
 gcc/fortran/resolve.cc   | 18 ++
 gcc/fortran/trans-expr.cc| 23 ---
 gcc/fortran/trans-intrinsic.cc   | 17 ++---
 gcc/testsuite/gfortran.dg/coarray_allocate_7.f08 |  4 +---
 libgfortran/caf/single.c |  6 +++---
 5 files changed, 32 insertions(+), 36 deletions(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 12973c6bc85..5db327cd12b 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -11601,6 +11601,23 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 }
 }
 
+bool
+caf_possible_reallocate (gfc_expr *e)
+{
+  symbol_attribute caf_attr;
+  gfc_ref *last_arr_ref = nullptr;
+
+  caf_attr = gfc_caf_attr (e);
+  if (!caf_attr.codimension || !caf_attr.allocatable || !caf_attr.dimension)
+return false;
+
+  /* Only full array refs can indicate a needed reallocation.  */
+  for (gfc_ref *ref = e->ref; ref; ref = ref->next)
+if (ref->type == REF_ARRAY && ref->u.ar.dimen)
+  last_arr_ref = ref;
+
+  return last_arr_ref && last_arr_ref->u.ar.type == AR_FULL;
+}
 
 /* Does everything to resolve an ordinary assignment.  Returns true
if this is an interface assignment.  */
@@ -11845,6 +11862,7 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace 
*ns)
 
   bool caf_convert_to_send = flag_coarray == GFC_FCOARRAY_LIB
   && (lhs_coindexed
+ || caf_possible_reallocate (lhs)
  || (code->expr2->expr_type == EXPR_FUNCTION
  && code->expr2->value.function.isym
  && code->expr2->value.function.isym->id == GFC_ISYM_CAF_GET
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index c11abb07eb6..8801a15c3a8 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -12701,29 +12701,6 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * 
expr2, bool init_flag,
 
   expr1->must_finalize = 0;
 }
-  else if (flag_coarray == GFC_FCOARRAY_LIB
-  && lhs_caf_attr.codimension && rhs_caf_attr.codimension
-  && ((lhs_caf_attr.allocatable && lhs_refs_comp)
-  || (rhs_caf_attr.allocatable && rhs_refs_comp)))
-{
-  /* Only detour to caf_send[get][_by_ref] () when the lhs or rhs is an
-allocatable component, because those need to be accessed via the
-caf-runtime.  No need to check for coindexes here, because resolve
-has rewritten those already.  */
-  gfc_code code;
-  gfc_actual_arglist a1, a2;
-  /* Clear the structures to prevent accessing garbage.  */
-  memset (&code, '\0', sizeof (gfc_code));
-  memset (&a1, '\0', sizeof (gfc_actual_arglist));
-  memset (&a2, '\0', sizeof (gfc_actual_arglist));
-  a1.expr = expr1;
-  a1.next = &a2;
-  a2.expr = expr2;
-  a2.next = NULL;
-  code.ext.actual = &a1;
-  code.resolved_isym = gfc_intrinsic_subroutine_by_id (GFC_ISYM_CAF_SEND);
-  tmp = gfc_conv_intrinsic_subroutine (&code);
-}
   else if (!is_poly_assign && expr2->must_finalize
   && expr1->ts.type == BT_CLASS
   && expr2->ts.type == BT_CLASS)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 8e1a2b04ed4..fd2da463825 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1945,11 +1945,14 @@ conv_caf_send (gfc_code *code) {
   tree lhs_type = NULL_TREE;
   tree vec = null_pointer_node, rhs_vec = null_pointer_node;
   symbol_attribute lhs_caf_attr, rhs_caf_attr;
+  bool lhs_is_coindexed, rhs_is_coindexed;
 
   gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
 
   lhs_expr = code->ext.a

[gcc r15-3062] Fortran: Fix ICE in sizeof(coarray) [PR77518]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:515730fd65a03c5f92f9ab6438d023aee8cfbecf

commit r15-3062-g515730fd65a03c5f92f9ab6438d023aee8cfbecf
Author: Andre Vehreschild 
Date:   Thu Jul 18 14:53:31 2024 +0200

Fortran: Fix ICE in sizeof(coarray) [PR77518]

Use se's class_container where present in sizeof().

PR fortran/77518

gcc/fortran/ChangeLog:

* trans-intrinsic.cc (gfc_conv_intrinsic_sizeof): Use
class_container of se when set.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/sizeof_1.f90: New test.

Diff:
---
 gcc/fortran/trans-intrinsic.cc | 13 ++---
 gcc/testsuite/gfortran.dg/coarray/sizeof_1.f90 | 27 ++
 2 files changed, 37 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index fd2da4638252..0ecb04397783 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -8216,10 +8216,17 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
   else if (arg->rank > 0
   || (arg->rank == 0
   && arg->ref && arg->ref->type == REF_COMPONENT))
-   /* The scalarizer added an additional temp.  To get the class' vptr
-  one has to look at the original backend_decl.  */
-   byte_size = gfc_class_vtab_size_get (
+   {
+ /* The scalarizer added an additional temp.  To get the class' vptr
+one has to look at the original backend_decl.  */
+ if (argse.class_container)
+   byte_size = gfc_class_vtab_size_get (argse.class_container);
+ else if (DECL_LANG_SPECIFIC (arg->symtree->n.sym->backend_decl))
+   byte_size = gfc_class_vtab_size_get (
  GFC_DECL_SAVED_DESCRIPTOR (arg->symtree->n.sym->backend_decl));
+ else
+   gcc_unreachable ();
+   }
   else
gcc_unreachable ();
 }
diff --git a/gcc/testsuite/gfortran.dg/coarray/sizeof_1.f90 
b/gcc/testsuite/gfortran.dg/coarray/sizeof_1.f90
new file mode 100644
index ..b26f84164068
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/sizeof_1.f90
@@ -0,0 +1,27 @@
+!{ dg-do run }
+
+! Check that pr77518 is fixed.
+! Based on code by Gerhard Steinmetz  
+
+program coarray_sizeof_1
+  type t
+  end type
+  type t2
+integer :: v = 42
+  end type
+  type t3
+type(t2) :: s
+integer :: n = 1
+  end type
+
+  class(t), allocatable :: z[:]
+  class(t2), allocatable :: z2[:]
+  class(t3), allocatable :: z3[:]
+
+  if (sizeof(z) /= 0) stop 1
+  if (sizeof(z2) /= sizeof(integer)) stop 2
+  allocate(z3[*])
+  if (sizeof(z3) /= sizeof(z2) + sizeof(integer)) stop 3
+  if (sizeof(z3%s) /= sizeof(z2)) stop 4
+end
+

[gcc r15-3066] Fix coarray rank for non-coarrays in derived types. [PR86468]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:723b30bee4e4fa3feba9ef03ce7dca95501e1555

commit r15-3066-g723b30bee4e4fa3feba9ef03ce7dca95501e1555
Author: Andre Vehreschild 
Date:   Fri Aug 16 15:07:39 2024 +0200

Fix coarray rank for non-coarrays in derived types. [PR86468]

The corank was propagated to array components in derived types.  Fix
this by setting a zero corank when the array component is not a pointer.
For pointer typed array components propagate the corank of the derived
type to allow associating the component to a coarray.

gcc/fortran/ChangeLog:

PR fortran/86468

* trans-intrinsic.cc (conv_intrinsic_move_alloc): Correct
comment.
* trans-types.cc (gfc_sym_type): Pass coarray rank, not false.
(gfc_get_derived_type): Only propagate  codimension for coarrays
and pointers to array components in derived typed coarrays.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray_lib_this_image_2.f90: Fix array rank in
tree dump scan.
* gfortran.dg/coarray_lib_token_4.f90: Same.
* gfortran.dg/coarray/move_alloc_2.f90: New test.

Diff:
---
 gcc/fortran/trans-intrinsic.cc |  2 +-
 gcc/fortran/trans-types.cc | 18 ---
 gcc/testsuite/gfortran.dg/coarray/move_alloc_2.f90 | 55 ++
 .../gfortran.dg/coarray_lib_this_image_2.f90   |  2 +-
 gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90  |  4 +-
 5 files changed, 70 insertions(+), 11 deletions(-)

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 0ecb04397783..0632e3e4d2fc 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -12906,7 +12906,7 @@ conv_intrinsic_move_alloc (gfc_code *code)
   gfc_add_expr_to_block (&block, tmp);
 }
 
-  /* Move the pointer and update the array descriptor data.  */
+  /* Copy the array descriptor data.  */
   gfc_add_modify_loc (input_location, &block, to_se.expr, from_se.expr);
 
   /* Set "from" to NULL.  */
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index bc582085f57f..38e18434f7c5 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2386,7 +2386,7 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
  else if (sym->attr.allocatable)
akind = GFC_ARRAY_ALLOCATABLE;
  type = gfc_build_array_type (type, sym->as, akind, restricted,
-  sym->attr.contiguous, false);
+  sym->attr.contiguous, sym->as->corank);
}
 }
   else
@@ -2909,12 +2909,16 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
  else
akind = GFC_ARRAY_ALLOCATABLE;
  /* Pointers to arrays aren't actually pointer types.  The
-descriptors are separate, but the data is common.  */
- field_type = gfc_build_array_type (field_type, c->as, akind,
-!c->attr.target
-&& !c->attr.pointer,
-c->attr.contiguous,
-codimen);
+descriptors are separate, but the data is common.  Every
+array pointer in a coarray derived type needs to provide space
+for the coarray management, too.  Therefore treat coarrays
+and pointers to coarrays in derived types the same.  */
+ field_type = gfc_build_array_type
+   (
+ field_type, c->as, akind, !c->attr.target && !c->attr.pointer,
+ c->attr.contiguous,
+ c->attr.codimension || c->attr.pointer ? codimen : 0
+   );
}
  else
field_type = gfc_get_nodesc_array_type (field_type, c->as,
diff --git a/gcc/testsuite/gfortran.dg/coarray/move_alloc_2.f90 
b/gcc/testsuite/gfortran.dg/coarray/move_alloc_2.f90
new file mode 100644
index ..4a8e54ced6bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/move_alloc_2.f90
@@ -0,0 +1,55 @@
+!{ dg-do run }
+
+! Check gimplify with checking works. [PR86468]
+! This rather complicated code is needed to produce two "different"
+! types in the move_alloc.
+
+! Contributed by Juergen Reuter  
+
+module classes
+  implicit none
+  private
+  public :: wrapped_coarray
+  
+  type :: wrapped_point
+ integer, allocatable :: point(:)
+   contains
+ procedure :: add => wrapped_point_add
+  end type wrapped_point
+  
+  type :: wrapped_coarray
+ type(wrapped_point), allocatable :: caf(:)[:]
+  end type wrapped_coarray
+  
+contains
+  
+  subroutine wrapped_point_add(self, to_add)
+class(wrapped_point), intent(inout) :: self
+integer, intent(in) :: to_add
+integer, allocatable :: point(:)
+integer :: points_number
+

[gcc r15-3099] Remove unnecessary view_convert obsoleted by [PR86468].

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:0636de8c5202d8fe58af42afdf24dd93d1a90abd

commit r15-3099-g0636de8c5202d8fe58af42afdf24dd93d1a90abd
Author: Andre Vehreschild 
Date:   Wed Aug 21 11:22:57 2024 +0200

Remove unnecessary view_convert obsoleted by [PR86468].

This patch removes an unnecessary view_convert in trans_associate to
prevent hard to find runtime errors in the future.  The view_convert was
erroneously introduced not understanding why ranks of the arrays to
assign are different.  The ranks are fixed by PR86468 now and the
view_convert is obsolete.

gcc/fortran/ChangeLog:

PR fortran/86468

* trans-stmt.cc (trans_associate_var): Remove superfluous
view_convert.

Diff:
---
 gcc/fortran/trans-stmt.cc | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 023b1739b858..d92ca6477e4e 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2031,9 +2031,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block 
*block)
  gfc_class_data_get (GFC_DECL_SAVED_DESCRIPTOR (tmp)));
}
   else
-   gfc_add_modify (&se.pre, sym->backend_decl,
-   build1 (VIEW_CONVERT_EXPR,
-   TREE_TYPE (sym->backend_decl), se.expr));
+   gfc_add_modify (&se.pre, sym->backend_decl, se.expr);
 
   if (unlimited)
{

[gcc r15-1703] Use gfc_reset_vptr more consistently.

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:3f8ce76f53d0fd6bb871f0d85d29be96c5d10c81

commit r15-1703-g3f8ce76f53d0fd6bb871f0d85d29be96c5d10c81
Author: Andre Vehreschild 
Date:   Fri Jun 7 08:57:36 2024 +0200

Use gfc_reset_vptr more consistently.

The vptr for a class type is set in various ways in different
locations.  Refactor the use and simplify code.

gcc/fortran/ChangeLog:

* trans-array.cc (structure_alloc_comps): Use reset_vptr.
* trans-decl.cc (gfc_trans_deferred_vars): Same.
(gfc_generate_function_code): Same.
* trans-expr.cc (gfc_reset_vptr): Allow supplying the class
type.
(gfc_conv_procedure_call): Use reset_vptr.
* trans-intrinsic.cc (gfc_conv_intrinsic_transfer): Same.

Diff:
---
 gcc/fortran/trans-array.cc | 34 +
 gcc/fortran/trans-decl.cc  | 19 ++
 gcc/fortran/trans-expr.cc  | 57 +-
 gcc/fortran/trans-intrinsic.cc | 10 +---
 4 files changed, 38 insertions(+), 82 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 26237f43bec..510f429ef8e 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9885,15 +9885,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, 
tree dest,
  else
{
  /* Build the vtable address and set the vptr with it.  */
- tree vtab;
- gfc_symbol *vtable;
- vtable = gfc_find_derived_vtab (c->ts.u.derived);
- vtab = vtable->backend_decl;
- if (vtab == NULL_TREE)
-   vtab = gfc_get_symbol_decl (vtable);
- vtab = gfc_build_addr_expr (NULL, vtab);
- vtab = fold_convert (TREE_TYPE (tmp), vtab);
- gfc_add_modify (&tmpblock, tmp, vtab);
+ gfc_reset_vptr (&tmpblock, nullptr, tmp, c->ts.u.derived);
}
}
 
@@ -9924,15 +9916,13 @@ structure_alloc_comps (gfc_symbol * der_type, tree 
decl, tree dest,
  && (CLASS_DATA (c)->attr.allocatable
  || CLASS_DATA (c)->attr.class_pointer))
{
- tree vptr_decl;
+ tree class_ref;
 
  /* Allocatable CLASS components.  */
- comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
- decl, cdecl, NULL_TREE);
-
- vptr_decl = gfc_class_vptr_get (comp);
+ class_ref = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+  decl, cdecl, NULL_TREE);
 
- comp = gfc_class_data_get (comp);
+ comp = gfc_class_data_get (class_ref);
  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
gfc_conv_descriptor_data_set (&fnblock, comp,
  null_pointer_node);
@@ -9947,19 +9937,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, 
tree dest,
  /* The dynamic type of a disassociated pointer or unallocated
 allocatable variable is its declared type. An unlimited
 polymorphic entity has no declared type.  */
- if (!UNLIMITED_POLY (c))
-   {
- vtab = gfc_find_derived_vtab (c->ts.u.derived);
- if (!vtab->backend_decl)
-gfc_get_symbol_decl (vtab);
- tmp = gfc_build_addr_expr (NULL_TREE, vtab->backend_decl);
-   }
- else
-   tmp = build_int_cst (TREE_TYPE (vptr_decl), 0);
-
- tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-void_type_node, vptr_decl, tmp);
- gfc_add_expr_to_block (&fnblock, tmp);
+ gfc_reset_vptr (&fnblock, nullptr, class_ref, c->ts.u.derived);
 
  cmp_has_alloc_comps = false;
}
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 8d4f06a4e1d..11247ddc07a 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5107,26 +5107,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, 
gfc_wrapped_block * block)
  if (sym->ts.type == BT_CLASS)
{
  /* Initialize _vptr to declared type.  */
- gfc_symbol *vtab;
- tree rhs;
-
  gfc_save_backend_locus (&loc);
  gfc_set_backend_locus (&sym->declared_at);
  e = gfc_lval_expr_from_sym (sym);
- gfc_add_vptr_component (e);
- gfc_init_se (&se, NULL);
- se.want_pointer = 1;
- gfc_conv_expr (&se, e);
+ gfc_reset_vptr (&init, e);
  gfc_free_expr (e);
- if (UNLIMITED_POLY (sym))
-   rhs = build_int_cst (TREE_TYPE (se.e

[gcc r15-1704] Add gfc_class_set_vptr.

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:aa3599a10cab34104c0b9bd6951c5f0c420795d8

commit r15-1704-gaa3599a10cab34104c0b9bd6951c5f0c420795d8
Author: Andre Vehreschild 
Date:   Tue Jun 11 12:52:26 2024 +0200

Add gfc_class_set_vptr.

First step to adding a general assign all class type's data members
routine.  Having a general routine prevents forgetting to tackle the
edge cases, e.g. setting _len.

gcc/fortran/ChangeLog:

* trans-expr.cc (gfc_class_set_vptr): Add setting of _vptr
member.
* trans-intrinsic.cc (conv_intrinsic_move_alloc): First use
of gfc_class_set_vptr and refactor very similar code.
* trans.h (gfc_class_set_vptr): Declare the new function.

gcc/testsuite/ChangeLog:

* gfortran.dg/unlimited_polymorphic_11.f90: Remove unnecessary
casts in gd-final expression.

Diff:
---
 gcc/fortran/trans-expr.cc  |  48 +
 gcc/fortran/trans-intrinsic.cc | 203 ++---
 gcc/fortran/trans.h|   6 +-
 .../gfortran.dg/unlimited_polymorphic_11.f90   |   2 +-
 4 files changed, 111 insertions(+), 148 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 454b87581f5..477c2720187 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -599,6 +599,54 @@ gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree 
class_container,
 }
 
 
+/* Set the vptr of a class in to from the type given in from.  If from is NULL,
+   then reset the vptr to the default or to.  */
+
+void
+gfc_class_set_vptr (stmtblock_t *block, tree to, tree from)
+{
+  tree tmp, vptr_ref;
+
+  vptr_ref = gfc_get_vptr_from_expr (to);
+  if (POINTER_TYPE_P (TREE_TYPE (from))
+  && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_TYPE (from
+{
+  gfc_add_modify (block, vptr_ref,
+ fold_convert (TREE_TYPE (vptr_ref),
+   gfc_get_vptr_from_expr (from)));
+}
+  else if (VAR_P (from)
+  && strncmp (IDENTIFIER_POINTER (DECL_NAME (from)), "__vtab", 6) == 0)
+{
+  gfc_add_modify (block, vptr_ref,
+ gfc_build_addr_expr (TREE_TYPE (vptr_ref), from));
+}
+  else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (from)))
+  && GFC_CLASS_TYPE_P (
+TREE_TYPE (TREE_OPERAND (TREE_OPERAND (from, 0), 0
+{
+  gfc_add_modify (block, vptr_ref,
+ fold_convert (TREE_TYPE (vptr_ref),
+   gfc_get_vptr_from_expr (TREE_OPERAND (
+ TREE_OPERAND (from, 0), 0;
+}
+  else
+{
+  tree vtab;
+  gfc_symbol *type;
+  tmp = TREE_TYPE (from);
+  if (POINTER_TYPE_P (tmp))
+   tmp = TREE_TYPE (tmp);
+  gfc_find_symbol (IDENTIFIER_POINTER (TYPE_NAME (tmp)), gfc_current_ns, 1,
+  &type);
+  vtab = gfc_find_derived_vtab (type)->backend_decl;
+  gcc_assert (vtab);
+  gfc_add_modify (block, vptr_ref,
+ gfc_build_addr_expr (TREE_TYPE (vptr_ref), vtab));
+}
+}
+
+
 /* Reset the len for unlimited polymorphic objects.  */
 
 void
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index ac7fcd250d3..5ea10e84060 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -12667,10 +12667,9 @@ conv_intrinsic_move_alloc (gfc_code *code)
 {
   stmtblock_t block;
   gfc_expr *from_expr, *to_expr;
-  gfc_expr *to_expr2, *from_expr2 = NULL;
   gfc_se from_se, to_se;
-  tree tmp;
-  bool coarray;
+  tree tmp, to_tree, from_tree;
+  bool coarray, from_is_class, from_is_scalar;
 
   gfc_start_block (&block);
 
@@ -12680,178 +12679,94 @@ conv_intrinsic_move_alloc (gfc_code *code)
   gfc_init_se (&from_se, NULL);
   gfc_init_se (&to_se, NULL);
 
-  gcc_assert (from_expr->ts.type != BT_CLASS
- || to_expr->ts.type == BT_CLASS);
+  gcc_assert (from_expr->ts.type != BT_CLASS || to_expr->ts.type == BT_CLASS);
   coarray = gfc_get_corank (from_expr) != 0;
 
-  if (from_expr->rank == 0 && !coarray)
+  from_is_class = from_expr->ts.type == BT_CLASS;
+  from_is_scalar = from_expr->rank == 0 && !coarray;
+  if (to_expr->ts.type == BT_CLASS || from_is_scalar)
 {
-  if (from_expr->ts.type != BT_CLASS)
-   from_expr2 = from_expr;
+  from_se.want_pointer = 1;
+  if (from_is_scalar)
+   gfc_conv_expr (&from_se, from_expr);
   else
-   {
- from_expr2 = gfc_copy_expr (from_expr);
- gfc_add_data_component (from_expr2);
-   }
-
-  if (to_expr->ts.type != BT_CLASS)
-   to_expr2 = to_expr;
+   gfc_conv_expr_descriptor (&from_se, from_expr);
+  if (from_is_class)
+   from_tree = gfc_class_data_get (from_se.expr);
   else
{
- to_expr2 = gfc_copy_expr (to_expr);
- gfc_add_data_component (to_expr2);
+ gfc_symbol *vtab;
+  

[gcc r15-1965] Fortran: Fix rejecting class arrays of different ranks as storage association argument and add un/pa

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:e4f2f46e015acb4c1b5605116a3ff0bb8c980372

commit r15-1965-ge4f2f46e015acb4c1b5605116a3ff0bb8c980372
Author: Andre Vehreschild 
Date:   Fri Jun 28 08:31:29 2024 +0200

Fortran: Fix rejecting class arrays of different ranks as storage 
association argument and add un/pack_class. [PR96992]

Removing the assert in trans-expr, lead to initial strides not set
which is now fixed.  When the array needs repacking, this is done for
class arrays now, too.

Packing class arrays was done using the regular internal pack
function in the past.  But that does not use the vptr's copy
function and breaks OOP paradigms (e.g. deep copy).  The new
un-/pack_class functions use the vptr's copy functionality to
implement OOP paradigms correctly.

PR fortran/96992

gcc/fortran/ChangeLog:

* trans-array.cc (gfc_trans_array_bounds): Set a starting
stride, when descriptor expects a variable for the stride.
(gfc_trans_dummy_array_bias): Allow storage association for
dummy class arrays, when they are not elemental.
(gfc_conv_array_parameter): Add more general class support
and packing for classes, too.
* trans-array.h (gfc_conv_array_parameter): Add lbound shift
for class arrays.
* trans-decl.cc (gfc_build_builtin_function_decls): Add decls
for internal_un-/pack_class.
* trans-expr.cc (gfc_reset_vptr): Allow supplying a type-tree
to generate the vtab from.
(gfc_class_set_vptr): Allow supplying a class-tree to take the
vptr from.
(class_array_data_assign): Rename to gfc_class_array_data_assign
and make usable from other compile units.
(gfc_class_array_data_assign): Renamed from class_array_data_
assign.
(gfc_conv_derived_to_class): Remove assert to
allow converting derived to class type arrays with assumed
rank.  Reduce code base and use gfc_conv_array_parameter also
for classes.
(gfc_conv_class_to_class): Use gfc_class_data_assign.
(gfc_conv_procedure_call): Adapt to new signature of
gfc_conv_derived_to_class.
* trans-io.cc (transfer_expr): Same.
* trans-stmt.cc (trans_associate_var): Same.
* trans.h (gfc_conv_derived_to_class): Signature changed.
(gfc_class_array_data_assign): Made public.
(gfor_fndecl_in_pack_class): Added declaration.
(gfor_fndecl_in_unpack_class): Same.

libgfortran/ChangeLog:

* Makefile.am: Add in_un-/pack_class.c to build.
* Makefile.in: Regenerated from Makefile.am.
* gfortran.map: Added new functions and bumped ABI.
* libgfortran.h (GFC_CLASS_T): Added for generating class
representation at runtime.
* runtime/in_pack_class.c: New file.
* runtime/in_unpack_class.c: New file.

gcc/testsuite/ChangeLog:

* gfortran.dg/class_dummy_11.f90: New test.

Diff:
---
 gcc/fortran/trans-array.cc   | 204 +-
 gcc/fortran/trans-array.h|   5 +-
 gcc/fortran/trans-decl.cc|  16 +-
 gcc/fortran/trans-expr.cc| 242 +--
 gcc/fortran/trans-io.cc  |   4 +-
 gcc/fortran/trans-stmt.cc|   6 +-
 gcc/fortran/trans.h  |   7 +-
 gcc/testsuite/gfortran.dg/class_dummy_11.f90 | 194 +
 libgfortran/Makefile.am  |   4 +-
 libgfortran/Makefile.in  |  13 +-
 libgfortran/gfortran.map |   6 +
 libgfortran/libgfortran.h|  23 +++
 libgfortran/runtime/in_pack_class.c  | 152 +
 libgfortran/runtime/in_unpack_class.c| 134 +++
 14 files changed, 824 insertions(+), 186 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c7d244689393..ed0ad5429e24 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6803,6 +6803,9 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree 
* poffset,
 
   size = gfc_index_one_node;
   offset = gfc_index_zero_node;
+  stride = GFC_TYPE_ARRAY_STRIDE (type, 0);
+  if (stride && VAR_P (stride))
+gfc_add_modify (pblock, stride, gfc_index_one_node);
   for (dim = 0; dim < as->rank; dim++)
 {
   /* Evaluate non-constant array bound expressions.
@@ -7148,7 +7151,9 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree 
tmpdesc,
   || (is_classarray && CLASS_DATA (sym)->attr.allocatable))
 return;
 
-  if (!is_classarray && sym->attr.dummy && gfc_is_nodesc_array (sym))
+  if ((!is_classarray
+   || (is_classarray && CLASS_DATA (sym)->as->type == AS_EXPLICIT

[gcc r15-1971] Fix bootstrap broken by gcc-15-1965-ge4f2f46e015

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:b9513c6746bfdbbb2f5e2a52bc3504236692beeb

commit r15-1971-gb9513c6746bfdbbb2f5e2a52bc3504236692beeb
Author: Andre Vehreschild 
Date:   Thu Jul 11 11:21:04 2024 +0200

Fix bootstrap broken by gcc-15-1965-ge4f2f46e015

gcc/fortran/ChangeLog:

* trans-array.cc (gfc_conv_array_parameter): Init variable to
NULL_TREE to fix bootstrap.

Diff:
---
 gcc/fortran/trans-array.cc | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index ed0ad5429e24..140d933e45d4 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8662,7 +8662,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, 
bool g77,
   tree stmt;
   tree parent = DECL_CONTEXT (current_function_decl);
   tree ctree;
-  tree pack_attr;
+  tree pack_attr = NULL_TREE; /* Set when packing class arrays.  */
   bool full_array_var;
   bool this_array_result;
   bool contiguous;

[gcc r15-2131] Fortran: Use char* for deferred length character arrays [PR82904]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:0231b076dc98eb02e3289b21ace1757782e3917b

commit r15-2131-g0231b076dc98eb02e3289b21ace1757782e3917b
Author: Andre Vehreschild 
Date:   Wed Jul 10 14:37:37 2024 +0200

Fortran: Use char* for deferred length character arrays [PR82904]

Randomly during compiling the pass IPA: inline would ICE.  This was
caused by a saved deferred length string.  The length variable was not
set, but the variable was used in the array's declaration.  Now using a
character pointer to prevent this.

PR fortran/82904

gcc/fortran/ChangeLog:

* trans-types.cc (gfc_sym_type): Use type `char*` for saved
deferred length char arrays.
* trans.cc (get_array_span): Get `.span` also for `char*` typed
arrays, i.e. for those that have INTEGER_TYPE instead of
ARRAY_TYPE.

gcc/testsuite/ChangeLog:

* gfortran.dg/deferred_character_38.f90: New test.

Diff:
---
 gcc/fortran/trans-types.cc  |  6 --
 gcc/fortran/trans.cc|  4 +++-
 gcc/testsuite/gfortran.dg/deferred_character_38.f90 | 20 
 3 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index f7b80a9761c4..01ce54f0ac0a 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2334,8 +2334,10 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
  || ((sym->attr.result || sym->attr.value)
  && sym->ns->proc_name
  && sym->ns->proc_name->attr.is_bind_c)
- || (sym->ts.deferred && (!sym->ts.u.cl
-  || !sym->ts.u.cl->backend_decl))
+ || (sym->ts.deferred
+ && (!sym->ts.u.cl
+ || !sym->ts.u.cl->backend_decl
+ || sym->attr.save))
  || (sym->attr.dummy
  && sym->attr.value
  && gfc_length_one_character_type_p (&sym->ts
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 1067e032621b..d4c54093cbc3 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -398,7 +398,9 @@ get_array_span (tree type, tree decl)
 return gfc_conv_descriptor_span_get (decl);
 
   /* Return the span for deferred character length array references.  */
-  if (type && TREE_CODE (type) == ARRAY_TYPE && TYPE_STRING_FLAG (type))
+  if (type
+  && (TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == INTEGER_TYPE)
+  && TYPE_STRING_FLAG (type))
 {
   if (TREE_CODE (decl) == PARM_DECL)
decl = build_fold_indirect_ref_loc (input_location, decl);
diff --git a/gcc/testsuite/gfortran.dg/deferred_character_38.f90 
b/gcc/testsuite/gfortran.dg/deferred_character_38.f90
new file mode 100644
index ..d5a6c0e50136
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_character_38.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+
+! Check for PR fortran/82904
+! Contributed by G.Steinmetz  
+
+! This test checks that 'IPA pass: inline' passes.
+! The initial version of the testcase contained coarrays, which does not work
+! yet.
+
+program p
+   save
+   character(:), allocatable :: x
+   character(:), allocatable :: y
+   allocate (character(3) :: y)
+   allocate (x, source='abc')
+   y = x
+
+   if (y /= 'abc') stop 1
+end
+

[gcc r15-2137] Fortran: Fix Explicit cobounds of a procedures parameter not respected [PR78466]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:18f3b223b97011c2eab71c8e48c3a38a12ff8f65

commit r15-2137-g18f3b223b97011c2eab71c8e48c3a38a12ff8f65
Author: Andre Vehreschild 
Date:   Thu Dec 31 10:40:30 2020 +0100

Fortran: Fix Explicit cobounds of a procedures parameter not respected 
[PR78466]

Explicit cobounds of class array procedure parameters were not taken
into account.  Furthermore were different cobounds in distinct
procedure parameter lists mixed up, i.e. the last definition was taken
for all.  The bounds are now regenerated when tree's and expr's bounds
do not match.

PR fortran/78466
PR fortran/80774

gcc/fortran/ChangeLog:

* array.cc (gfc_compare_array_spec): Take cotype into account.
* class.cc (gfc_build_class_symbol): Coarrays are also arrays.
* gfortran.h (IS_CLASS_COARRAY_OR_ARRAY): New macro to detect
regular and coarray class arrays.
* interface.cc (compare_components): Take codimension into
account.
* resolve.cc (resolve_symbol): Improve error message.
* simplify.cc (simplify_bound_dim): Remove duplicate.
* trans-array.cc (gfc_trans_array_cobounds): Coarrays are also
arrays.
(gfc_trans_array_bounds): Same.
(gfc_trans_dummy_array_bias): Same.
(get_coarray_as): Get the as having a non-zero codim.
(is_explicit_coarray): Detect explicit coarrays.
(gfc_conv_expr_descriptor): Create a new descriptor for explicit
coarrays.
* trans-decl.cc (gfc_build_qualified_array): Coarrays are also
arrays.
(gfc_build_dummy_array_decl): Same.
(gfc_get_symbol_decl): Same.
(gfc_trans_deferred_vars): Same.
* trans-expr.cc (class_scalar_coarray_to_class): Get the
descriptor from the correct location.
(gfc_conv_variable): Pick up the descriptor when needed.
* trans-types.cc (gfc_is_nodesc_array): Coarrays are also
arrays.
(gfc_get_nodesc_array_type): Indentation fix only.
(cobounds_match_decl): Match a tree's bounds to the expr's
bounds and return true, when they match.
(gfc_get_derived_type): Create a new type tree/descriptor, when
the cobounds of the existing declaration and expr to not
match.  This happends for class arrays in parameter list, when
there are different cobound declarations.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/poly_run_1.f90: Activate old test code.
* gfortran.dg/coarray/poly_run_2.f90: Activate test.  It was
stopping before and passing without an error.

Diff:
---
 gcc/fortran/array.cc |  3 +
 gcc/fortran/class.cc |  8 ++-
 gcc/fortran/gfortran.h   |  5 ++
 gcc/fortran/interface.cc |  7 +++
 gcc/fortran/resolve.cc   |  3 +-
 gcc/fortran/simplify.cc  |  2 -
 gcc/fortran/trans-array.cc   | 53 -
 gcc/fortran/trans-decl.cc| 20 ---
 gcc/fortran/trans-expr.cc| 34 +++
 gcc/fortran/trans-types.cc   | 74 
 gcc/testsuite/gfortran.dg/coarray/poly_run_1.f90 | 33 +--
 gcc/testsuite/gfortran.dg/coarray/poly_run_2.f90 | 28 ++---
 12 files changed, 207 insertions(+), 63 deletions(-)

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index e9934f1491b2..79c774d59a0b 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -1017,6 +1017,9 @@ gfc_compare_array_spec (gfc_array_spec *as1, 
gfc_array_spec *as2)
   if (as1->type != as2->type)
 return 0;
 
+  if (as1->cotype != as2->cotype)
+return 0;
+
   if (as1->type == AS_EXPLICIT)
 for (i = 0; i < as1->rank + as1->corank; i++)
   {
diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index abe89630be3c..b9dcc0a3d98c 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -709,8 +709,12 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute 
*attr,
  work on the declared type. All array type other than deferred shape or
  assumed rank are added to the function namespace to ensure that they
  are properly distinguished.  */
-  if (attr->dummy && !attr->codimension && (*as)
-  && !((*as)->type == AS_DEFERRED || (*as)->type == AS_ASSUMED_RANK))
+  if (attr->dummy && (*as)
+  && ((!attr->codimension
+  && !((*as)->type == AS_DEFERRED || (*as)->type == AS_ASSUMED_RANK))
+ || (attr->codimension
+ && !((*as)->cotype == AS_DEFERRED
+  || (*as)->cotype == AS_ASSUMED_RANK
 {
   char *sname;
   ns = gfc_current_ns;
diff --git a/gcc/fortran/gfortran.h b/gcc/fo

[gcc r15-2193] Fix Rejects allocatable coarray passed as a dummy argument [88624]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:9d650e97cb76e4ea3b5d060e4a4cef38fc58

commit r15-2193-g9d650e97cb76e4ea3b5d060e4a4cef38fc58
Author: Andre Vehreschild 
Date:   Thu Jul 11 10:07:12 2024 +0200

Fix Rejects allocatable coarray passed as a dummy argument [88624]

Coarray parameters of procedures/functions need to be dereffed, because
they are references to the descriptor but the routine expected the
descriptor directly.

PR fortran/88624

gcc/fortran/ChangeLog:

* trans-expr.cc (gfc_conv_procedure_call): Treat
pointers/references (e.g. from parameters) correctly by derefing
them.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/dummy_1.f90: Add calling function trough
function.
* gfortran.dg/pr88624.f90: New test.

Diff:
---
 gcc/fortran/trans-expr.cc | 35 +++
 gcc/testsuite/gfortran.dg/coarray/dummy_1.f90 |  2 ++
 gcc/testsuite/gfortran.dg/pr88624.f90 | 21 
 3 files changed, 48 insertions(+), 10 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d9eb333abcb1..feb43fdec746 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7773,16 +7773,26 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
   && CLASS_DATA (fsym)->attr.codimension
   && !CLASS_DATA (fsym)->attr.allocatable)))
{
- tree caf_decl, caf_type;
+ tree caf_decl, caf_type, caf_desc = NULL_TREE;
  tree offset, tmp2;
 
  caf_decl = gfc_get_tree_for_caf_expr (e);
  caf_type = TREE_TYPE (caf_decl);
-
- if (GFC_DESCRIPTOR_TYPE_P (caf_type)
- && (GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE
- || GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_POINTER))
-   tmp = gfc_conv_descriptor_token (caf_decl);
+ if (POINTER_TYPE_P (caf_type)
+ && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_type)))
+   caf_desc = TREE_TYPE (caf_type);
+ else if (GFC_DESCRIPTOR_TYPE_P (caf_type))
+   caf_desc = caf_type;
+
+ if (caf_desc
+ && (GFC_TYPE_ARRAY_AKIND (caf_desc) == GFC_ARRAY_ALLOCATABLE
+ || GFC_TYPE_ARRAY_AKIND (caf_desc) == GFC_ARRAY_POINTER))
+   {
+ tmp = POINTER_TYPE_P (TREE_TYPE (caf_decl))
+ ? build_fold_indirect_ref (caf_decl)
+ : caf_decl;
+ tmp = gfc_conv_descriptor_token (tmp);
+   }
  else if (DECL_LANG_SPECIFIC (caf_decl)
   && GFC_DECL_TOKEN (caf_decl) != NULL_TREE)
tmp = GFC_DECL_TOKEN (caf_decl);
@@ -7795,8 +7805,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
  vec_safe_push (stringargs, tmp);
 
- if (GFC_DESCRIPTOR_TYPE_P (caf_type)
- && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE)
+ if (caf_desc
+ && GFC_TYPE_ARRAY_AKIND (caf_desc) == GFC_ARRAY_ALLOCATABLE)
offset = build_int_cst (gfc_array_index_type, 0);
  else if (DECL_LANG_SPECIFIC (caf_decl)
   && GFC_DECL_CAF_OFFSET (caf_decl) != NULL_TREE)
@@ -7806,8 +7816,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
  else
offset = build_int_cst (gfc_array_index_type, 0);
 
- if (GFC_DESCRIPTOR_TYPE_P (caf_type))
-   tmp = gfc_conv_descriptor_data_get (caf_decl);
+ if (caf_desc)
+   {
+ tmp = POINTER_TYPE_P (TREE_TYPE (caf_decl))
+ ? build_fold_indirect_ref (caf_decl)
+ : caf_decl;
+ tmp = gfc_conv_descriptor_data_get (tmp);
+   }
  else
{
  gcc_assert (POINTER_TYPE_P (caf_type));
diff --git a/gcc/testsuite/gfortran.dg/coarray/dummy_1.f90 
b/gcc/testsuite/gfortran.dg/coarray/dummy_1.f90
index 33e95853ad4a..c437b2a10fc4 100644
--- a/gcc/testsuite/gfortran.dg/coarray/dummy_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/dummy_1.f90
@@ -66,5 +66,7 @@
 if (lcobound(A, dim=1) /= 2) STOP 13
 if (ucobound(A, dim=1) /= 3) STOP 14
 if (lcobound(A, dim=2) /= 5) STOP 15
+
+call sub4(A)  ! Check PR88624 is fixed.
   end subroutine sub5
   end
diff --git a/gcc/testsuite/gfortran.dg/pr88624.f90 
b/gcc/testsuite/gfortran.dg/pr88624.f90
new file mode 100644
index ..e88ac907c6fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr88624.f90
@@ -0,0 +1,21 @@
+!{ dg-do compile }
+!{ dg-options "-fcoarray=lib" }
+
+! Check that PR fortran/88624 is fixed.
+! Contributed by Modrzejewski  
+! Reduced to the essence of the issue.
+
+program test 
+  implicit none 
+  integer, dimension(:), allocatable :: x[:] 
+  call g(x) 
+contains 
+  subroutine g(x) 
+integer, dimension(:), allocatable :: x[:] 
+call g2(x) 
+  

[gcc r15-2882] Fortran: Fix coarray in associate not linking [PR85510]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:8d8db21eb726b785782f4a41ad85a0d4be63068a

commit r15-2882-g8d8db21eb726b785782f4a41ad85a0d4be63068a
Author: Andre Vehreschild 
Date:   Mon Jul 22 15:31:37 2024 +0200

Fortran: Fix coarray in associate not linking [PR85510]

PR fortran/85510

gcc/fortran/ChangeLog:

* resolve.cc (resolve_variable): Mark the variable as host
associated only, when it is not in an associate block.
* trans-decl.cc (generate_coarray_init): Remove incorrect unused
flag on parameter.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/pr85510.f90: New test.

Diff:
---
 gcc/fortran/resolve.cc| 10 ++
 gcc/fortran/trans-decl.cc |  2 +-
 gcc/testsuite/gfortran.dg/coarray/pr85510.f90 | 19 +++
 3 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index eb3085a05ca2..8e88aac2fe0e 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -6114,10 +6114,12 @@ resolve_variable (gfc_expr *e)
   /* If a symbol has been host_associated mark it.  This is used latter,
  to identify if aliasing is possible via host association.  */
   if (sym->attr.flavor == FL_VARIABLE
-   && gfc_current_ns->parent
-   && (gfc_current_ns->parent == sym->ns
- || (gfc_current_ns->parent->parent
-   && gfc_current_ns->parent->parent == sym->ns)))
+  && (!sym->ns->code || sym->ns->code->op != EXEC_BLOCK
+ || !sym->ns->code->ext.block.assoc)
+  && gfc_current_ns->parent
+  && (gfc_current_ns->parent == sym->ns
+ || (gfc_current_ns->parent->parent
+ && gfc_current_ns->parent->parent == sym->ns)))
 sym->attr.host_assoc = 1;
 
   if (gfc_current_ns->proc_name
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index ca6a515a1800..6692ac7ef4c3 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5950,7 +5950,7 @@ generate_coarray_sym_init (gfc_symbol *sym)
coarrays.  */
 
 static void
-generate_coarray_init (gfc_namespace * ns __attribute((unused)))
+generate_coarray_init (gfc_namespace *ns)
 {
   tree fndecl, tmp, decl, save_fn_decl;
 
diff --git a/gcc/testsuite/gfortran.dg/coarray/pr85510.f90 
b/gcc/testsuite/gfortran.dg/coarray/pr85510.f90
new file mode 100644
index ..c6777cad6ed1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/pr85510.f90
@@ -0,0 +1,19 @@
+!{ dg-do run }
+
+! Contributed by Damian Rouson  
+! Check that PR fortran/85510 links.
+
+module foo
+contains
+  subroutine bar()
+integer, save :: i[*] = 1
+associate(n=>1)
+  if (i[1] /= 1) stop 1
+end associate
+  end subroutine
+end module
+
+use foo
+call bar()
+end
+

[gcc r15-2910] Fix ICE in build_function_decl [PR116292]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:bb2324769c5a03e275de00416659e624c97f1442

commit r15-2910-gbb2324769c5a03e275de00416659e624c97f1442
Author: Andre Vehreschild 
Date:   Fri Aug 9 16:19:23 2024 +0200

Fix ICE in build_function_decl [PR116292]

Fix ICE by getting the vtype only when a derived or class type is
prevent.  Also take care about the _len component for unlimited
polymorphics.

gcc/fortran/ChangeLog:

PR fortran/116292

* trans-intrinsic.cc (conv_intrinsic_move_alloc): Get the vtab
only for derived types and classes and adjust _len for class
types.

gcc/testsuite/ChangeLog:

* gfortran.dg/move_alloc_19.f90: New test.

Diff:
---
 gcc/fortran/trans-intrinsic.cc  | 20 ++---
 gcc/testsuite/gfortran.dg/move_alloc_19.f90 | 34 +
 2 files changed, 51 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 150cb9ff963b..84a378ef310c 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -12764,9 +12764,12 @@ conv_intrinsic_move_alloc (gfc_code *code)
  gfc_symbol *vtab;
  from_tree = from_se.expr;
 
- vtab = gfc_find_vtab (&from_expr->ts);
- gcc_assert (vtab);
- from_se.expr = gfc_get_symbol_decl (vtab);
+ if (to_expr->ts.type == BT_CLASS)
+   {
+ vtab = gfc_find_vtab (&from_expr->ts);
+ gcc_assert (vtab);
+ from_se.expr = gfc_get_symbol_decl (vtab);
+   }
}
   gfc_add_block_to_block (&block, &from_se.pre);
 
@@ -12811,6 +12814,15 @@ conv_intrinsic_move_alloc (gfc_code *code)
  gfc_class_set_vptr (&block, to_se.expr, from_se.expr);
  if (from_is_class)
gfc_reset_vptr (&block, from_expr);
+ if (UNLIMITED_POLY (to_expr))
+   {
+ tree to_len = gfc_class_len_get (to_se.class_container);
+ tmp = from_expr->ts.type == BT_CHARACTER && from_se.string_length
+ ? from_se.string_length
+ : size_zero_node;
+ gfc_add_modify_loc (input_location, &block, to_len,
+ fold_convert (TREE_TYPE (to_len), tmp));
+   }
}
 
   if (from_is_scalar)
@@ -12825,6 +12837,8 @@ conv_intrinsic_move_alloc (gfc_code *code)
  input_location, &block, from_se.string_length,
  build_int_cst (TREE_TYPE (from_se.string_length), 0));
}
+ if (UNLIMITED_POLY (from_expr))
+   gfc_reset_len (&block, from_expr);
 
  return gfc_finish_block (&block);
}
diff --git a/gcc/testsuite/gfortran.dg/move_alloc_19.f90 
b/gcc/testsuite/gfortran.dg/move_alloc_19.f90
new file mode 100644
index ..d23d9809ba11
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/move_alloc_19.f90
@@ -0,0 +1,34 @@
+!{ dg-do run }
+
+! Check PR 116292 is fixed.
+
+! Contributed by Harald Anlauf  
+!Sam James  
+
+program move_alloc_19
+  character, allocatable :: buffer, dummy, dummy2
+  class(*), allocatable :: poly
+
+  dummy = 'C'
+  dummy2 = 'A'
+  call s()
+  if (allocated (dummy)) stop 1
+  if (allocated (dummy2)) stop 2
+  if (.not. allocated (buffer)) stop 3
+  if (.not. allocated (poly)) stop 4
+  if (buffer /= 'C') stop 5
+  select type (poly)
+type is (character(*))
+  if (poly /= 'A') stop 6
+  if (len (poly) /= 1) stop 7
+class default
+  stop 8
+  end select
+  deallocate (poly, buffer)
+contains
+  subroutine s
+call move_alloc (dummy, buffer)
+call move_alloc (dummy2, poly)
+  end
+end
+

[gcc r15-2911] Prevent future proc_ptr parsing issues in associate [PR102973]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:54be14bfd6e2dee7cb4e1b3c20dc2677093ee818

commit r15-2911-g54be14bfd6e2dee7cb4e1b3c20dc2677093ee818
Author: Andre Vehreschild 
Date:   Tue Aug 13 15:06:56 2024 +0200

Prevent future proc_ptr parsing issues in associate [PR102973]

A global variable is set when proc_ptr parsing in an associate is
expected. In the case of an error, that flag was not reset, which is
fixed now.

gcc/fortran/ChangeLog:

PR fortran/102973

* match.cc (gfc_match_associate): Reset proc_ptr parsing flag on
error.

Diff:
---
 gcc/fortran/match.cc | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 1851a8f94a54..e4b60bf5f685 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -1932,6 +1932,7 @@ gfc_match_associate (void)
  gfc_matching_procptr_assignment = 1;
  if (gfc_match (" %e", &newAssoc->target) != MATCH_YES)
{
+ gfc_matching_procptr_assignment = 0;
  gfc_error ("Invalid association target at %C");
  goto assocListError;
}

[gcc r15-2934] Add corank to gfc_expr.

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:a3f1cdd8ed46f9816b31ab162ae4dac547d34ebc

commit r15-2934-ga3f1cdd8ed46f9816b31ab162ae4dac547d34ebc
Author: Andre Vehreschild 
Date:   Fri Aug 9 12:47:18 2024 +0200

Add corank to gfc_expr.

Compute the corank of an expression along side to the regular rank.
This safe costly calls to gfc_get_corank (), which consecutively has
been removed.  In some locations the code needed some adaption to model
the difference between expr.corank and gfc_get_corank correctly.  The
latter always returned the codimension of the expression and not its
current corank, i.e. the resolution of all indezes.

This commit is preparatory to fixing PR fortran/110033 and may contain
parts of that fix already.

gcc/fortran/ChangeLog:

* arith.cc (reduce_unary): Use expr.corank.
(reduce_binary_ac): Same.
(reduce_binary_ca): Same.
(reduce_binary_aa): Same.
* array.cc (gfc_match_array_ref): Same.
* check.cc (dim_corank_check): Same.
(gfc_check_move_alloc): Same.
(gfc_check_image_index): Same.
* class.cc (gfc_add_class_array_ref): Same.
(finalize_component): Same.
* data.cc (gfc_assign_data_value): Same.
* decl.cc (match_clist_expr): Same.
(add_init_expr_to_sym): Same.
* expr.cc (simplify_intrinsic_op): Same.
(simplify_parameter_variable): Same.
(gfc_check_assign_symbol): Same.
(gfc_get_variable_expr): Same.
(gfc_add_full_array_ref): Same.
(gfc_lval_expr_from_sym): Same.
(gfc_get_corank): Removed.
* frontend-passes.cc (callback_reduction): Use expr.corank.
(create_var): Same.
(combine_array_constructor): Same.
(optimize_minmaxloc): Same.
* gfortran.h (gfc_get_corank): Add corank to gfc_expr.
* intrinsic.cc (gfc_get_intrinsic_function_symbol): Use
expr.corank.
(gfc_convert_type_warn): Same.
(gfc_convert_chartype): Same.
* iresolve.cc (resolve_bound): Same.
(gfc_resolve_cshift): Same.
(gfc_resolve_eoshift): Same.
(gfc_resolve_logical): Same.
(gfc_resolve_matmul): Same.
* match.cc (copy_ts_from_selector_to_associate): Same.
* matchexp.cc (gfc_get_parentheses): Same.
* parse.cc (parse_associate): Same.
* primary.cc (gfc_match_rvalue): Same.
* resolve.cc (resolve_structure_cons): Same.
(resolve_actual_arglist): Same.
(resolve_elemental_actual): Same.
(resolve_generic_f0): Same.
(resolve_unknown_f): Same.
(resolve_operator): Same.
(gfc_expression_rank): Same and set dimen_type for coarray to
default.
(gfc_op_rank_conformable): Use expr.corank.
(add_caf_get_intrinsic): Same.
(resolve_variable): Same.
(gfc_fixup_inferred_type_refs): Same.
(check_host_association): Same.
(resolve_compcall): Same.
(resolve_expr_ppc): Same.
(resolve_assoc_var): Same.
(fixup_array_ref): Same.
(resolve_select_type): Same.
(add_comp_ref): Same.
(get_temp_from_expr): Same.
(resolve_fl_var_and_proc): Same.
(resolve_symbol): Same.
* symbol.cc (gfc_is_associate_pointer): Same.
* trans-array.cc (walk_coarray): Same.
(gfc_conv_expr_descriptor): Same.
(gfc_walk_array_ref): Same.
* trans-array.h (gfc_walk_array_ref): Same.
* trans-expr.cc (gfc_get_ultimate_alloc_ptr_comps_caf_token):
Same.
* trans-intrinsic.cc (trans_this_image): Same.
(trans_image_index): Same.
(conv_intrinsic_cobound): Same.
(gfc_walk_intrinsic_function): Same.
(conv_intrinsic_move_alloc): Same.
* trans-stmt.cc (gfc_trans_lock_unlock): Same.
(trans_associate_var): Same and adapt to slightly different
behaviour of expr.corank and gfc_get_corank.
(gfc_trans_allocate): Same.
* trans.cc (gfc_add_finalizer_call): Same.

Diff:
---
 gcc/fortran/arith.cc   |   4 +
 gcc/fortran/array.cc   |  16 ++-
 gcc/fortran/check.cc   |  18 +--
 gcc/fortran/class.cc   |   3 +
 gcc/fortran/data.cc|   1 +
 gcc/fortran/decl.cc|   2 +
 gcc/fortran/expr.cc|  51 +++--
 gcc/fortran/frontend-passes.cc |   5 +
 gcc/fortran/gfortran.h |   2 +-
 gcc/fortran/intrinsic.cc   |   3 +
 gcc/fortran/iresolve.cc|  20 +++-
 gcc/fortran/match.cc   |  30 +++--
 gcc/fortran/matchexp.cc|   1 +
 gcc/fortran/parse.cc   |  39 ---
 gcc/fortran/primary.cc

[gcc r15-2935] Fix Coarray in associate not a coarray. [PR110033]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:dbf4c574b92bc692a0380a2b5ee25028321e735f

commit r15-2935-gdbf4c574b92bc692a0380a2b5ee25028321e735f
Author: Andre Vehreschild 
Date:   Wed Jul 24 09:39:45 2024 +0200

Fix Coarray in associate not a coarray. [PR110033]

A coarray used in an associate did not become a coarray in the block of
the associate.  This patch fixes that and the same also in select type
statements.

PR fortran/110033

gcc/fortran/ChangeLog:

* class.cc (gfc_is_class_scalar_expr): Coarray refs that ref
only self, aka this image, are regarded as scalar, too.
* resolve.cc (resolve_assoc_var): Ignore this image coarray refs
and do not build a new class type.
* trans-expr.cc (gfc_get_caf_token_offset): Get the caf token
from the descriptor for associated variables.
(gfc_conv_variable): Same.
(gfc_trans_pointer_assignment): Assign token to temporary
associate variable, too.
(gfc_trans_scalar_assign): Add flag that assign is for associate
and use it to assign the token.
(is_assoc_assign): Detect that expressions are for associate
assign.
(gfc_trans_assignment_1): Treat associate assigns like pointer
assignments where possible.
* trans-stmt.cc (trans_associate_var): Set same_class only for
class-targets.
* trans.h (gfc_trans_scalar_assign): Add flag to
trans_scalar_assign for marking associate assignments.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/associate_1.f90: New test.

Diff:
---
 gcc/fortran/class.cc  | 38 +-
 gcc/fortran/resolve.cc| 40 ---
 gcc/fortran/trans-expr.cc | 87 +++
 gcc/fortran/trans-stmt.cc |  2 +-
 gcc/fortran/trans.h   |  5 +-
 gcc/testsuite/gfortran.dg/coarray/associate_1.f90 | 36 ++
 6 files changed, 163 insertions(+), 45 deletions(-)

diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index 88fbba2818a..f9e0d416e48 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -379,27 +379,33 @@ gfc_is_class_scalar_expr (gfc_expr *e)
 return false;
 
   /* Is this a class object?  */
-  if (e->symtree
-   && e->symtree->n.sym->ts.type == BT_CLASS
-   && CLASS_DATA (e->symtree->n.sym)
-   && !CLASS_DATA (e->symtree->n.sym)->attr.dimension
-   && (e->ref == NULL
-   || (e->ref->type == REF_COMPONENT
-   && strcmp (e->ref->u.c.component->name, "_data") == 0
-   && e->ref->next == NULL)))
+  if (e->symtree && e->symtree->n.sym->ts.type == BT_CLASS
+  && CLASS_DATA (e->symtree->n.sym)
+  && !CLASS_DATA (e->symtree->n.sym)->attr.dimension
+  && (e->ref == NULL
+ || (e->ref->type == REF_COMPONENT
+ && strcmp (e->ref->u.c.component->name, "_data") == 0
+ && (e->ref->next == NULL
+ || (e->ref->next->type == REF_ARRAY
+ && e->ref->next->u.ar.codimen > 0
+ && e->ref->next->u.ar.dimen == 0
+ && e->ref->next->next == NULL)
 return true;
 
   /* Or is the final reference BT_CLASS or _data?  */
   for (ref = e->ref; ref; ref = ref->next)
 {
-  if (ref->type == REF_COMPONENT
-   && ref->u.c.component->ts.type == BT_CLASS
-   && CLASS_DATA (ref->u.c.component)
-   && !CLASS_DATA (ref->u.c.component)->attr.dimension
-   && (ref->next == NULL
-   || (ref->next->type == REF_COMPONENT
-   && strcmp (ref->next->u.c.component->name, "_data") == 0
-   && ref->next->next == NULL)))
+  if (ref->type == REF_COMPONENT && ref->u.c.component->ts.type == BT_CLASS
+ && CLASS_DATA (ref->u.c.component)
+ && !CLASS_DATA (ref->u.c.component)->attr.dimension
+ && (ref->next == NULL
+ || (ref->next->type == REF_COMPONENT
+ && strcmp (ref->next->u.c.component->name, "_data") == 0
+ && (ref->next->next == NULL
+ || (ref->next->next->type == REF_ARRAY
+ && ref->next->next->u.ar.codimen > 0
+ && ref->next->next->u.ar.dimen == 0
+ && ref->next->next->next == NULL)
return true;
 }
 
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index ffc3721efbe..71312e0e415 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -9750,6 +9750,9 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 correct this now.  */
  gfc_typespec *ts = &target->ts;
  gfc_ref *ref;
+ /* Internal_ref is true, when this is ref'ing only _data and co-ref.
+  */
+ bool inter

[gcc r15-891] Fix memory leak.

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:2f97d98d174e3ef9f3a9a83c179d787abde5e066

commit r15-891-g2f97d98d174e3ef9f3a9a83c179d787abde5e066
Author: Andre Vehreschild 
Date:   Wed Jul 12 16:52:15 2023 +0200

Fix memory leak.

Prevent double call of function return class object
and free the object after copy.

gcc/fortran/ChangeLog:

PR fortran/90069
* trans-expr.cc (gfc_conv_procedure_call): Evaluate
expressions with side-effects only ones and ensure
old is freeed.

gcc/testsuite/ChangeLog:

PR fortran/90069
* gfortran.dg/class_76.f90: New test.

Diff:
---
 gcc/fortran/trans-expr.cc  | 29 +--
 gcc/testsuite/gfortran.dg/class_76.f90 | 66 ++
 2 files changed, 92 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index dfc5b8e9b4a..9f6cc8f871e 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6725,9 +6725,32 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
{
  tree efield;
 
- /* Evaluate arguments just once.  */
- if (e->expr_type != EXPR_VARIABLE)
-   parmse.expr = save_expr (parmse.expr);
+ /* Evaluate arguments just once, when they have
+side effects.  */
+ if (TREE_SIDE_EFFECTS (parmse.expr))
+   {
+ tree cldata, zero;
+
+ parmse.expr = gfc_evaluate_now (parmse.expr,
+ &parmse.pre);
+
+ /* Prevent memory leak, when old component
+was allocated already.  */
+ cldata = gfc_class_data_get (parmse.expr);
+ zero = build_int_cst (TREE_TYPE (cldata),
+   0);
+ tmp = fold_build2_loc (input_location, 
NE_EXPR,
+logical_type_node,
+cldata, zero);
+ tmp = build3_v (COND_EXPR, tmp,
+ gfc_call_free (cldata),
+ build_empty_stmt (
+   input_location));
+ gfc_add_expr_to_block (&parmse.finalblock,
+tmp);
+ gfc_add_modify (&parmse.finalblock,
+ cldata, zero);
+   }
 
  /* Set the _data field.  */
  tmp = gfc_class_data_get (var);
diff --git a/gcc/testsuite/gfortran.dg/class_76.f90 
b/gcc/testsuite/gfortran.dg/class_76.f90
new file mode 100644
index 000..1ee1e1fc25f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_76.f90
@@ -0,0 +1,66 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/90069
+!
+! Contributed by Brad Richardson  
+!
+
+program returned_memory_leak
+implicit none
+
+type, abstract :: base
+end type base
+
+type, extends(base) :: extended
+end type extended
+
+type :: container
+class(*), allocatable :: thing
+end type
+
+call run()
+contains
+subroutine run()
+type(container) :: a_container
+
+a_container = theRightWay()
+a_container = theWrongWay()
+end subroutine
+
+function theRightWay()
+type(container) :: theRightWay
+
+class(base), allocatable :: thing
+
+allocate(thing, source = newAbstract())
+theRightWay = newContainer(thing)
+end function theRightWay
+
+function theWrongWay()
+type(container) :: theWrongWay
+
+theWrongWay = newContainer(newAbstract())
+end function theWrongWay
+
+function  newAbstract()
+class(base), allocatable :: newAbstract
+
+allocate(newAbstract, source = newExtended())
+end function newAbstract
+
+function newExtended()
+type(extended) :: newExtended
+end function newExtended
+
+function newContainer(thing)
+class(*), intent(in) :: thing
+type(container) :: newContainer
+
+allocate(newContainer%thing, source = thing)
+end function newContainer
+end program returned_memory_leak
+
+! { dg-final { scan-tree-dump-times "newabstract" 14 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 8 "original" } }
+

[gcc r15-1090] Fix returned type to be allocatable for user-functions.

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:51046e46ae66ca95bf2b93ae60f0c4d6b338f8af

commit r15-1090-g51046e46ae66ca95bf2b93ae60f0c4d6b338f8af
Author: Andre Vehreschild 
Date:   Wed Jul 19 11:57:43 2023 +0200

Fix returned type to be allocatable for user-functions.

The returned type of user-defined function returning a
class object was not detected and handled correctly, which
lead to memory leaks.

PR fortran/90072

gcc/fortran/ChangeLog:

* expr.cc (gfc_is_alloc_class_scalar_function): Detect
allocatable class return types also for user-defined
functions.
* trans-expr.cc (gfc_conv_procedure_call): Same.
(trans_class_vptr_len_assignment): Compute vptr len
assignment correctly for user-defined functions.

gcc/testsuite/ChangeLog:

* gfortran.dg/class_77.f90: New test.

Diff:
---
 gcc/fortran/expr.cc| 13 --
 gcc/fortran/trans-expr.cc  | 35 +++---
 gcc/testsuite/gfortran.dg/class_77.f90 | 83 ++
 3 files changed, 109 insertions(+), 22 deletions(-)

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index a162744c719..be138d196a2 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5573,11 +5573,14 @@ bool
 gfc_is_alloc_class_scalar_function (gfc_expr *expr)
 {
   if (expr->expr_type == EXPR_FUNCTION
-  && expr->value.function.esym
-  && expr->value.function.esym->result
-  && expr->value.function.esym->result->ts.type == BT_CLASS
-  && !CLASS_DATA (expr->value.function.esym->result)->attr.dimension
-  && CLASS_DATA (expr->value.function.esym->result)->attr.allocatable)
+  && ((expr->value.function.esym
+  && expr->value.function.esym->result
+  && expr->value.function.esym->result->ts.type == BT_CLASS
+  && !CLASS_DATA (expr->value.function.esym->result)->attr.dimension
+  && CLASS_DATA (expr->value.function.esym->result)->attr.allocatable)
+ || (expr->ts.type == BT_CLASS
+ && CLASS_DATA (expr)->attr.allocatable
+ && !CLASS_DATA (expr)->attr.dimension)))
 return true;
 
   return false;
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 9f6cc8f871e..d6f4d6bfe45 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -8301,7 +8301,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
}
 
  /* Finalize the result, if necessary.  */
- attr = CLASS_DATA (expr->value.function.esym->result)->attr;
+ attr = expr->value.function.esym
+? CLASS_DATA (expr->value.function.esym->result)->attr
+: CLASS_DATA (expr)->attr;
  if (!((gfc_is_class_array_function (expr)
 || gfc_is_alloc_class_scalar_function (expr))
&& attr.pointer))
@@ -10085,27 +10087,26 @@ trans_class_vptr_len_assignment (stmtblock_t *block, 
gfc_expr * le,
   if (re->expr_type != EXPR_VARIABLE && re->expr_type != EXPR_NULL
   && rse->expr != NULL_TREE)
 {
-  if (re->ts.type == BT_CLASS && !GFC_CLASS_TYPE_P (TREE_TYPE (rse->expr)))
-   class_expr = gfc_get_class_from_expr (rse->expr);
+  if (!DECL_P (rse->expr))
+   {
+ if (re->ts.type == BT_CLASS && !GFC_CLASS_TYPE_P (TREE_TYPE 
(rse->expr)))
+   class_expr = gfc_get_class_from_expr (rse->expr);
 
-  if (rse->loop)
-   pre = &rse->loop->pre;
-  else
-   pre = &rse->pre;
+ if (rse->loop)
+   pre = &rse->loop->pre;
+ else
+   pre = &rse->pre;
 
-  if (class_expr != NULL_TREE && UNLIMITED_POLY (re))
-   {
- tmp = TREE_OPERAND (rse->expr, 0);
- tmp = gfc_create_var (TREE_TYPE (tmp), "rhs");
- gfc_add_modify (&rse->pre, tmp, TREE_OPERAND (rse->expr, 0));
+ if (class_expr != NULL_TREE && UNLIMITED_POLY (re))
+ tmp = gfc_evaluate_now (TREE_OPERAND (rse->expr, 0), &rse->pre);
+ else
+ tmp = gfc_evaluate_now (rse->expr, &rse->pre);
+
+ rse->expr = tmp;
}
   else
-   {
- tmp = gfc_create_var (TREE_TYPE (rse->expr), "rhs");
- gfc_add_modify (&rse->pre, tmp, rse->expr);
-   }
+   pre = &rse->pre;
 
-  rse->expr = tmp;
   temp_rhs = true;
 }
 
diff --git a/gcc/testsuite/gfortran.dg/class_77.f90 
b/gcc/testsuite/gfortran.dg/class_77.f90
new file mode 100644
index 000..ef38dd67743
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_77.f90
@@ -0,0 +1,83 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/90072
+!
+! Contributed by Brad Richardson  
+! 
+
+module types
+implicit none
+
+type, abstract :: base_returned
+end type base_returned
+
+type, extends(base_returned) :: first_returned
+end type first_returned
+
+type, extends(base_returned) :: second_returned
+end type secon

[gcc r15-1094] Add finalizer creation to array constructor for functions of derived type.

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:c3190756487080a11e819746f00b6e30fd0a0c2e

commit r15-1094-gc3190756487080a11e819746f00b6e30fd0a0c2e
Author: Andre Vehreschild 
Date:   Thu Jul 27 14:51:34 2023 +0200

Add finalizer creation to array constructor for functions of derived type.

PR fortran/90068

gcc/fortran/ChangeLog:

* trans-array.cc (gfc_trans_array_ctor_element): Eval non-
variable expressions once only.
(gfc_trans_array_constructor_value): Add statements of
final block.
(trans_array_constructor): Detect when final block is required.

gcc/testsuite/ChangeLog:

* gfortran.dg/finalize_57.f90: New test.

Diff:
---
 gcc/fortran/trans-array.cc| 18 -
 gcc/testsuite/gfortran.dg/finalize_57.f90 | 63 +++
 2 files changed, 80 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index eec62c296ff..cc50b961a97 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1885,6 +1885,16 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree 
desc,
 gfc_conv_descriptor_data_get (desc));
   tmp = gfc_build_array_ref (tmp, offset, NULL);
 
+  if (expr->expr_type == EXPR_FUNCTION && expr->ts.type == BT_DERIVED
+  && expr->ts.u.derived->attr.alloc_comp)
+{
+  if (!VAR_P (se->expr))
+   se->expr = gfc_evaluate_now (se->expr, &se->pre);
+  gfc_add_expr_to_block (&se->finalblock,
+gfc_deallocate_alloc_comp_no_caf (
+  expr->ts.u.derived, se->expr, expr->rank, true));
+}
+
   if (expr->ts.type == BT_CHARACTER)
 {
   int i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false);
@@ -2147,6 +2157,8 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
  *poffset = fold_build2_loc (input_location, PLUS_EXPR,
  gfc_array_index_type,
  *poffset, gfc_index_one_node);
+ if (finalblock)
+   gfc_add_block_to_block (finalblock, &se.finalblock);
}
  else
{
@@ -2795,6 +2807,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   tree neg_len;
   char *msg;
   stmtblock_t finalblock;
+  bool finalize_required;
 
   /* Save the old values for nested checking.  */
   old_first_len = first_len;
@@ -2973,8 +2986,11 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   TREE_USED (offsetvar) = 0;
 
   gfc_init_block (&finalblock);
+  finalize_required = expr->must_finalize;
+  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)
+finalize_required = true;
   gfc_trans_array_constructor_value (&outer_loop->pre,
-expr->must_finalize ? &finalblock : NULL,
+finalize_required ? &finalblock : NULL,
 type, desc, c, &offset, &offsetvar,
 dynamic);
 
diff --git a/gcc/testsuite/gfortran.dg/finalize_57.f90 
b/gcc/testsuite/gfortran.dg/finalize_57.f90
new file mode 100644
index 000..b6257357c75
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_57.f90
@@ -0,0 +1,63 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/90068
+!
+! Contributed by Brad Richardson  
+! 
+
+program array_memory_leak
+implicit none
+
+type, abstract :: base
+end type base
+
+type, extends(base) :: extended
+end type extended
+
+type :: container
+class(base), allocatable :: thing
+end type
+
+type, extends(base) :: collection
+type(container), allocatable :: stuff(:)
+end type collection
+
+call run()
+call bad()
+contains
+subroutine run()
+type(collection) :: my_thing
+type(container) :: a_container
+
+a_container = newContainer(newExtended()) ! This is fine
+my_thing = newCollection([a_container])
+end subroutine run
+
+subroutine bad()
+type(collection) :: my_thing
+
+my_thing = newCollection([newContainer(newExtended())]) ! This is a 
memory leak
+end subroutine bad
+
+function newExtended()
+type(extended) :: newExtended
+end function newExtended
+
+function newContainer(thing)
+class(base), intent(in) :: thing
+type(container) :: newContainer
+
+allocate(newContainer%thing, source = thing)
+end function newContainer
+
+function newCollection(things)
+type(container), intent(in) :: things(:)
+type(collection) :: newCollection
+
+newCollection%stuff = things
+end function newCollection
+end program array_memory_leak
+
+! { dg-final { scan-tree-dump-times "__builtin_free" 15 "original" } }
+

[gcc r15-1369] Fix ICE when compiling with -fcoarray=single, when derefing a non-array.

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:db75a6657e9de6ee7effe46cd2626d9bb946f2e6

commit r15-1369-gdb75a6657e9de6ee7effe46cd2626d9bb946f2e6
Author: Andre Vehreschild 
Date:   Tue Jun 11 15:24:55 2024 +0200

Fix ICE when compiling with -fcoarray=single, when derefing a non-array.

PR fortran/96418
PR fortran/103112

gcc/fortran/ChangeLog:

* trans.cc (gfc_deallocate_with_status): Check that object to deref
is an array, before applying array deref.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray_alloc_comp_3.f08: Moved to...
* gfortran.dg/coarray/alloc_comp_8.f90: ...here.
Should be tested for both -fcoarray=single and lib, resp.
* gfortran.dg/coarray_alloc_comp_4.f08: Fix program name.

Diff:
---
 gcc/fortran/trans.cc   | 3 ++-
 .../gfortran.dg/{coarray_alloc_comp_3.f08 => coarray/alloc_comp_8.f90} | 3 +--
 gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08 | 2 +-
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index a208afe90ab0..1335b8cc48bb 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1838,7 +1838,8 @@ gfc_deallocate_with_status (tree pointer, tree status, 
tree errmsg,
  else
caf_dereg_type = (enum gfc_coarray_deregtype) coarray_dealloc_mode;
}
-  else if (flag_coarray == GFC_FCOARRAY_SINGLE)
+  else if (flag_coarray == GFC_FCOARRAY_SINGLE
+  && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer)))
pointer = gfc_conv_descriptor_data_get (pointer);
 }
   else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer)))
diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_3.f08 
b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_8.f90
similarity index 95%
rename from gcc/testsuite/gfortran.dg/coarray_alloc_comp_3.f08
rename to gcc/testsuite/gfortran.dg/coarray/alloc_comp_8.f90
index e2037aa58093..8b1539251298 100644
--- a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_3.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_8.f90
@@ -1,12 +1,11 @@
 ! { dg-do run }
-! { dg-options "-fcoarray=lib -lcaf_single" }
 ! { dg-additional-options "-latomic" { target libatomic_available } }
 !
 ! Contributed by Andre Vehreschild
 ! Check that manually freeing components does not lead to a runtime crash,
 ! when the auto-deallocation is taking care.
 
-program coarray_alloc_comp_3
+program alloc_comp_6
   implicit none
 
   type dt
diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08 
b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08
index 6586ec651ddf..4c71a90af8fa 100644
--- a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08
+++ b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08
@@ -5,7 +5,7 @@
 ! Contributed by Andre Vehreschild
 ! Check that sub-components are caf_deregistered and not freed.
 
-program coarray_alloc_comp_3
+program coarray_alloc_comp_4
   implicit none
 
   type dt

[gcc r15-1434] Fortran: Set the vptr of a class typed result.

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:dbb718175d7df89b957b316ba2f5fbea5d21b2b1

commit r15-1434-gdbb718175d7df89b957b316ba2f5fbea5d21b2b1
Author: Andre Vehreschild 
Date:   Thu Jun 6 14:01:13 2024 +0200

Fortran: Set the vptr of a class typed result.

PR fortran/90076

gcc/fortran/ChangeLog:

* trans-decl.cc (gfc_generate_function_code): Set vptr for
results to declared class type.
* trans-expr.cc (gfc_reset_vptr): Allow to provide the typespec
instead of the expression.
* trans.h (gfc_reset_vptr): Same.

gcc/testsuite/ChangeLog:

* gfortran.dg/class_76.f90: Add declared vtab occurrence.
* gfortran.dg/class_78.f90: New test.

Diff:
---
 gcc/fortran/trans-decl.cc  | 11 ++-
 gcc/fortran/trans-expr.cc  | 10 ++
 gcc/fortran/trans.h|  4 +++-
 gcc/testsuite/gfortran.dg/class_76.f90 |  2 +-
 gcc/testsuite/gfortran.dg/class_78.f90 | 29 +
 5 files changed, 45 insertions(+), 11 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index dca7779528bb..88538713a02b 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7926,11 +7926,12 @@ gfc_generate_function_code (gfc_namespace * ns)
   && CLASS_DATA (sym)->attr.dimension == 0
   && sym->result == sym)
{
- tmp = CLASS_DATA (sym)->backend_decl;
- tmp = fold_build3_loc (input_location, COMPONENT_REF,
-TREE_TYPE (tmp), result, tmp, NULL_TREE);
- gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp),
-   null_pointer_node));
+ tmp = gfc_class_data_get (result);
+ gfc_add_modify (&init, tmp,
+ fold_convert (TREE_TYPE (tmp),
+   null_pointer_node));
+ gfc_reset_vptr (&init, nullptr, result,
+ CLASS_DATA (sym->result)->ts.u.derived);
}
  else if (sym->ts.type == BT_DERIVED
   && !sym->attr.allocatable)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d6f4d6bfe457..558a73805169 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -530,13 +530,14 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool 
is_mold,
   return base_expr;
 }
 
-
 /* Reset the vptr to the declared type, e.g. after deallocation.
Use the variable in CLASS_CONTAINER if available.  Otherwise, recreate
-   one with E.  The generated assignment code is added at the end of BLOCK.  */
+   one with e or derived.  At least one of the two has to be set.  The 
generated
+   assignment code is added at the end of BLOCK.  */
 
 void
-gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree class_container)
+gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree class_container,
+   gfc_symbol *derived)
 {
   tree vptr = NULL_TREE;
 
@@ -546,6 +547,7 @@ gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree 
class_container)
   if (vptr == NULL_TREE)
 {
   gfc_se se;
+  gcc_assert (e);
 
   /* Evaluate the expression and obtain the vptr from it.  */
   gfc_init_se (&se, NULL);
@@ -570,7 +572,7 @@ gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree 
class_container)
   tree vtable;
 
   /* Return the vptr to the address of the declared type.  */
-  vtab = gfc_find_derived_vtab (e->ts.u.derived);
+  vtab = gfc_find_derived_vtab (derived ? derived : e->ts.u.derived);
   vtable = vtab->backend_decl;
   if (vtable == NULL_TREE)
vtable = gfc_get_symbol_decl (vtab);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index f94fa6014004..5e064af5ccbd 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -451,7 +451,9 @@ tree gfc_vptr_def_init_get (tree);
 tree gfc_vptr_copy_get (tree);
 tree gfc_vptr_final_get (tree);
 tree gfc_vptr_deallocate_get (tree);
-void gfc_reset_vptr (stmtblock_t *, gfc_expr *, tree = NULL_TREE);
+void
+gfc_reset_vptr (stmtblock_t *, gfc_expr *, tree = NULL_TREE,
+   gfc_symbol * = nullptr);
 void gfc_reset_len (stmtblock_t *, gfc_expr *);
 tree gfc_get_class_from_gfc_expr (gfc_expr *);
 tree gfc_get_class_from_expr (tree);
diff --git a/gcc/testsuite/gfortran.dg/class_76.f90 
b/gcc/testsuite/gfortran.dg/class_76.f90
index 1ee1e1fc25f2..c9842a15feab 100644
--- a/gcc/testsuite/gfortran.dg/class_76.f90
+++ b/gcc/testsuite/gfortran.dg/class_76.f90
@@ -61,6 +61,6 @@ contains
 end function newContainer
 end program returned_memory_leak
 
-! { dg-final { scan-tree-dump-times "newabstract" 14 "original" } }
+! { dg-final { scan-tree-dump-times "newabstract" 15 "original" } }
 ! { dg-final { scan-tree-dump-times "__builtin_free" 8 "original" } }
 
diff --git a/gcc/testsuite/gfortran.dg/class_78

[gcc r15-3958] Ensure coarrays in calls use a descriptor [PR81265]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:bac95615b50d4a012c448cba080c106702184e3a

commit r15-3958-gbac95615b50d4a012c448cba080c106702184e3a
Author: Andre Vehreschild 
Date:   Fri Sep 27 14:18:42 2024 +0200

Ensure coarrays in calls use a descriptor [PR81265]

gcc/fortran/ChangeLog:

PR fortran/81265

* trans-expr.cc (gfc_conv_procedure_call): Ensure coarrays use a
descriptor when passed.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/pr81265.f90: New test.

Diff:
---
 gcc/fortran/trans-expr.cc |  8 ++-
 gcc/testsuite/gfortran.dg/coarray/pr81265.f90 | 74 +++
 2 files changed, 81 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e4c491a98486..9f223a1314a6 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6438,11 +6438,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 {
   bool finalized = false;
   tree derived_array = NULL_TREE;
+  symbol_attribute *attr;
 
   e = arg->expr;
   fsym = formal ? formal->sym : NULL;
   parm_kind = MISSING;
 
+  attr = fsym ? &(fsym->ts.type == BT_CLASS ? CLASS_DATA (fsym)->attr
+   : fsym->attr)
+ : nullptr;
   /* If the procedure requires an explicit interface, the actual
 argument is passed according to the corresponding formal
 argument.  If the corresponding formal argument is a POINTER,
@@ -6458,7 +6462,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
   if (comp)
nodesc_arg = nodesc_arg || !comp->attr.always_explicit;
   else
-   nodesc_arg = nodesc_arg || !sym->attr.always_explicit;
+   nodesc_arg
+ = nodesc_arg
+   || !(sym->attr.always_explicit || (attr && attr->codimension));
 
   /* Class array expressions are sometimes coming completely unadorned
 with either arrayspec or _data component.  Correct that here.
diff --git a/gcc/testsuite/gfortran.dg/coarray/pr81265.f90 
b/gcc/testsuite/gfortran.dg/coarray/pr81265.f90
new file mode 100644
index ..378733bfa7c2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/pr81265.f90
@@ -0,0 +1,74 @@
+!{ dg-do run }
+
+! Contributed by Anton Shterenlikht  
+! Check PR81265 is fixed.
+
+module m
+implicit none
+private
+public :: s
+
+abstract interface
+  subroutine halo_exchange( array )
+integer, allocatable, intent( inout ) :: array(:,:,:,:)[:,:,:]
+  end subroutine halo_exchange
+end interface
+
+interface
+  module subroutine s( coarray, hx )
+integer, allocatable, intent( inout ) :: coarray(:,:,:,:)[:,:,:]
+procedure( halo_exchange ) :: hx
+  end subroutine s
+end interface
+
+end module m
+submodule( m ) sm
+contains
+module procedure s
+
+if ( .not. allocated(coarray) ) then
+  write (*,*) "ERROR: s: coarray is not allocated"
+  error stop
+end if
+
+sync all
+
+call hx( coarray ) 
+
+end procedure s
+
+end submodule sm
+module m2
+  implicit none
+  private
+  public :: s2
+  contains
+subroutine s2( coarray )
+  integer, allocatable, intent( inout ) :: coarray(:,:,:,:)[:,:,:]
+  if ( .not. allocated( coarray ) ) then
+write (*,'(a)') "ERROR: s2: coarray is not allocated"
+error stop
+  end if
+end subroutine s2
+end module m2
+program p
+use m
+use m2
+implicit none
+integer, allocatable :: space(:,:,:,:)[:,:,:]
+integer :: errstat
+
+allocate( space(10,10,10,2) [2,2,*], source=0, stat=errstat )
+if ( errstat .ne. 0 ) then
+  write (*,*) "ERROR: p: allocate( space ) )"
+  error stop
+end if
+
+if ( .not. allocated (space) ) then
+  write (*,*) "ERROR: p: space is not allocated"
+  error stop
+end if
+
+call s( space, s2 )
+
+end program p

[gcc r15-4405] Fix ICE with coarrays and submodules [PR80235]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:e32fff675c3bb040fa79854f6b0654c16bc38997

commit r15-4405-ge32fff675c3bb040fa79854f6b0654c16bc38997
Author: Andre Vehreschild 
Date:   Tue Sep 24 14:30:52 2024 +0200

Fix ICE with coarrays and submodules [PR80235]

Exposing a variable in a module and referencing it in a submodule made
the compiler ICE, because the external variable was not sorted into the
correct module.  In fact the module name was not set where the variable
got built.

gcc/fortran/ChangeLog:

PR fortran/80235

* trans-decl.cc (gfc_build_qualified_array): Make sure the array
is associated to the correct module and being marked as extern.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/add_sources/submodule_1_sub.f90: New test.
* gfortran.dg/coarray/submodule_1.f90: New test.

Diff:
---
 gcc/fortran/trans-decl.cc  |  7 --
 .../coarray/add_sources/submodule_1_sub.f90| 22 
 gcc/testsuite/gfortran.dg/coarray/submodule_1.f90  | 29 ++
 3 files changed, 56 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 56b6202510e8..9cced7c02e40 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1066,7 +1066,8 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
IDENTIFIER_POINTER (gfc_sym_mangled_identifier (sym;
  token = build_decl (DECL_SOURCE_LOCATION (decl), VAR_DECL, token_name,
  token_type);
- if (sym->attr.use_assoc)
+ if (sym->attr.use_assoc
+ || (sym->attr.host_assoc && sym->attr.used_in_submodule))
DECL_EXTERNAL (token) = 1;
  else
TREE_STATIC (token) = 1;
@@ -1091,9 +1092,11 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
 
   if (sym->module && !sym->attr.use_assoc)
{
+ module_htab_entry *mod
+   = cur_module ? cur_module : gfc_find_module (sym->module);
  pushdecl (token);
  DECL_CONTEXT (token) = sym->ns->proc_name->backend_decl;
- gfc_module_add_decl (cur_module, token);
+ gfc_module_add_decl (mod, token);
}
   else if (sym->attr.host_assoc
   && TREE_CODE (DECL_CONTEXT (current_function_decl))
diff --git a/gcc/testsuite/gfortran.dg/coarray/add_sources/submodule_1_sub.f90 
b/gcc/testsuite/gfortran.dg/coarray/add_sources/submodule_1_sub.f90
new file mode 100644
index ..fd177fcda298
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/add_sources/submodule_1_sub.f90
@@ -0,0 +1,22 @@
+! This test belongs to submodule_1.f90
+! It is references as additional source in that test.
+! The two code fragments need to be in separate files to show
+! the error of pr80235.
+
+submodule (pr80235) pr80235_sub
+
+contains
+  module subroutine test()
+implicit none
+if (var%v /= 42) stop 1
+  end subroutine
+end submodule pr80235_sub
+
+program pr80235_prg
+  use pr80235
+  
+  implicit none
+
+  var%v = 42
+  call test()
+end program
diff --git a/gcc/testsuite/gfortran.dg/coarray/submodule_1.f90 
b/gcc/testsuite/gfortran.dg/coarray/submodule_1.f90
new file mode 100644
index ..d0faef93ba76
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/submodule_1.f90
@@ -0,0 +1,29 @@
+!{ dg-do run }
+!{ dg-additional-sources add_sources/submodule_1_sub.f90 }
+
+! Separating the module and the submodule is needed to show the error.
+! Having all code pieces in one file does not show the error.
+
+module pr80235
+  implicit none
+
+  private
+  public :: test, var
+
+  type T
+integer :: v
+  end type T
+
+interface
+
+  module subroutine test()
+  end subroutine
+
+end interface
+
+  type(T) :: var[*]
+
+end module pr80235
+
+
+

[gcc r15-4171] Fix parsing of substring refs in coarrays. [PR51815]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:0ad2c76bea20dbeac753f10df6f9f86d142348d4

commit r15-4171-g0ad2c76bea20dbeac753f10df6f9f86d142348d4
Author: Andre Vehreschild 
Date:   Tue Oct 1 09:30:59 2024 +0200

Fix parsing of substring refs in coarrays. [PR51815]

The parser was greadily taking the substring ref as an array ref because
an array_spec was present.  Fix this by only parsing the coarray (pseudo)
ref when no regular array is present.

gcc/fortran/ChangeLog:

PR fortran/51815

* array.cc (gfc_match_array_ref): Only parse coarray part of
ref.
* match.h (gfc_match_array_ref): Add flag.
* primary.cc (gfc_match_varspec): Request only coarray ref
parsing when no regular array is present.  Report error on
unexpected additional ref.

gcc/testsuite/ChangeLog:

* gfortran.dg/pr102532.f90: Fix dg-errors: Add new error.
* gfortran.dg/coarray/substring_1.f90: New test.

Diff:
---
 gcc/fortran/array.cc  |  9 --
 gcc/fortran/match.h   |  3 +-
 gcc/fortran/primary.cc| 35 ---
 gcc/testsuite/gfortran.dg/coarray/substring_1.f90 | 16 +++
 gcc/testsuite/gfortran.dg/pr102532.f90| 16 +++
 5 files changed, 59 insertions(+), 20 deletions(-)

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 1fa61ebfe2a0..ed8cb54803b8 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -179,7 +179,7 @@ matched:
 
 match
 gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
-int corank)
+int corank, bool coarray_only)
 {
   match m;
   bool matched_bracket = false;
@@ -198,6 +198,8 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, 
int init,
matched_bracket = true;
goto coarray;
 }
+  else if (coarray_only && corank != 0)
+goto coarray;
 
   if (gfc_match_char ('(') != MATCH_YES)
 {
@@ -243,11 +245,12 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec 
*as, int init,
 coarray:
   if (!matched_bracket && gfc_match_char ('[') != MATCH_YES)
 {
-  if (ar->dimen > 0)
+  int dim = coarray_only ? 0 : ar->dimen;
+  if (dim > 0 || coarray_only)
{
  if (corank != 0)
{
- for (int i = ar->dimen; i < GFC_MAX_DIMENSIONS; ++i)
+ for (int i = dim; i < GFC_MAX_DIMENSIONS; ++i)
ar->dimen_type[i] = DIMEN_THIS_IMAGE;
  ar->codimen = corank;
}
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 84d84b818259..2c76afb179af 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -317,7 +317,8 @@ match gfc_match_init_expr (gfc_expr **);
 
 /* array.cc.  */
 match gfc_match_array_spec (gfc_array_spec **, bool, bool);
-match gfc_match_array_ref (gfc_array_ref *, gfc_array_spec *, int, int);
+match gfc_match_array_ref (gfc_array_ref *, gfc_array_spec *, int, int,
+  bool = false);
 match gfc_match_array_constructor (gfc_expr **);
 
 /* interface.cc.  */
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 09add925fcd1..c11359a559b2 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2192,7 +2192,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, 
bool sub_flag,
   bool intrinsic;
   bool inferred_type;
   locus old_loc;
-  char sep;
+  char peeked_char;
 
   tail = NULL;
 
@@ -2282,9 +2282,10 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, 
bool sub_flag,
sym->ts.u.derived = tgt_expr->ts.u.derived;
 }
 
-  if ((inferred_type && !sym->as && gfc_peek_ascii_char () == '(')
-  || (equiv_flag && gfc_peek_ascii_char () == '(')
-  || gfc_peek_ascii_char () == '[' || sym->attr.codimension
+  peeked_char = gfc_peek_ascii_char ();
+  if ((inferred_type && !sym->as && peeked_char == '(')
+  || (equiv_flag && peeked_char == '(') || peeked_char == '['
+  || sym->attr.codimension
   || (sym->attr.dimension && sym->ts.type != BT_CLASS
  && !sym->attr.proc_pointer && !gfc_is_proc_ptr_comp (primary)
  && !(gfc_matching_procptr_assignment
@@ -2295,6 +2296,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, 
bool sub_flag,
  || CLASS_DATA (sym)->attr.codimension)))
 {
   gfc_array_spec *as;
+  bool coarray_only = sym->attr.codimension && !sym->attr.dimension
+ && sym->ts.type == BT_CHARACTER;
 
   tail = extend_ref (primary, tail);
   tail->type = REF_ARRAY;
@@ -2310,12 +2313,18 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, 
bool sub_flag,
   else
as = sym->as;
 
-  m = gfc_match_array_ref (&tail->u.ar, as, equiv_flag,
-  as ? as->corank : 0);
+  m = gfc_match_array_ref (&tail->u.ar, as, equiv_flag, as ? as->corank : 
0,
+

[gcc r15-4329] Allow for class type coarray parameters. [PR77871]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:fd1a2f63bcac14cbedb8c8b1790525b9642567d9

commit r15-4329-gfd1a2f63bcac14cbedb8c8b1790525b9642567d9
Author: Andre Vehreschild 
Date:   Thu Aug 15 13:49:49 2024 +0200

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.

Diff:
---
 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(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 8094171eb275..b9f585d0d2f1 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_convert (gfc_array_index_type, *offset),
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index a282ae1c0903..80d75f26b095 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1900,7 +1900,7 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, 
tree lhs, tree lhs_kind,
   gfc_add_block_to_block (&se->post, &argse.post);
 
   caf_decl = gfc_get_tree_for_caf_expr (array_expr);
-  if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE)
+  if (POINTER_TYPE_P (TREE_TYPE (caf_decl)))
 caf_decl = build_fold_indirect_ref_loc (input_location, c

[gcc r15-3827] Fortran: Allow to nullify caf token when not in ultimate component. [PR101100]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:0c0d79c783f5c289651d76aa697b48d4505e169d

commit r15-3827-g0c0d79c783f5c289651d76aa697b48d4505e169d
Author: Andre Vehreschild 
Date:   Wed Sep 18 15:55:28 2024 +0200

Fortran: Allow to nullify caf token when not in ultimate component. 
[PR101100]

gcc/fortran/ChangeLog:

PR fortran/101100

* trans-expr.cc (trans_caf_token_assign): Take caf-token from
decl for non ultimate coarray components.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/proc_pointer_assign_1.f90: New test.

Diff:
---
 gcc/fortran/trans-expr.cc  |  8 +-
 .../gfortran.dg/coarray/proc_pointer_assign_1.f90  | 29 ++
 2 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 01cf3f0ff148..d0c7dfea903d 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10359,7 +10359,13 @@ trans_caf_token_assign (gfc_se *lse, gfc_se *rse, 
gfc_expr *expr1,
   else if (lhs_attr.codimension)
 {
   lhs_tok = gfc_get_ultimate_alloc_ptr_comps_caf_token (lse, expr1);
-  lhs_tok = build_fold_indirect_ref (lhs_tok);
+  if (!lhs_tok)
+   {
+ lhs_tok = gfc_get_tree_for_caf_expr (expr1);
+ lhs_tok = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (lhs_tok));
+   }
+  else
+   lhs_tok = build_fold_indirect_ref (lhs_tok);
   tmp = build2_loc (input_location, MODIFY_EXPR, void_type_node,
lhs_tok, null_pointer_node);
   gfc_prepend_expr_to_block (&lse->post, tmp);
diff --git a/gcc/testsuite/gfortran.dg/coarray/proc_pointer_assign_1.f90 
b/gcc/testsuite/gfortran.dg/coarray/proc_pointer_assign_1.f90
new file mode 100644
index ..81f0c3b19cf1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/proc_pointer_assign_1.f90
@@ -0,0 +1,29 @@
+!{ dg-do run }
+
+! Check that PR101100 is fixed.
+
+! Contributed by G. Steinmetz  
+
+program p
+  type t
+procedure(), pointer, nopass :: f
+  end type
+
+  integer :: i = 0
+  type(t) :: x[*]
+
+  x%f => null()
+  if ( associated(x%f) ) stop 1
+
+  x%f => g
+  if (.not. associated(x%f) ) stop 2
+
+  call x%f()
+  if ( i /= 1 ) stop 3
+
+contains
+  subroutine g()
+i = 1
+  end subroutine
+end
+

[gcc r15-3825] Fortran: Assign allocated caf-memory to scalar members [PR84870]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:f5035d7d015ebd4a7f5df5831cfc1269f9567e06

commit r15-3825-gf5035d7d015ebd4a7f5df5831cfc1269f9567e06
Author: Andre Vehreschild 
Date:   Thu Sep 19 15:09:52 2024 +0200

Fortran: Assign allocated caf-memory to scalar members [PR84870]

Allocating a coarray required an array-descriptor.  For scalars a
temporary descriptor was created.  Assigning the allocated memory from
the temporary descriptor back to the scalar is now added.

gcc/fortran/ChangeLog:

PR fortran/84870

* trans-array.cc (duplicate_allocatable_coarray): For scalar
allocatable components the memory allocated is now assigned to
the component's pointer.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/alloc_comp_10.f90: New test.

Diff:
---
 gcc/fortran/trans-array.cc |  2 ++
 .../gfortran.dg/coarray/alloc_comp_10.f90  | 24 ++
 2 files changed, 26 insertions(+)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7d8274ab5718..0b8ef0b5e018 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9505,6 +9505,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, 
tree src, tree type,
  gfc_build_addr_expr (NULL_TREE, dest_tok),
  NULL_TREE, NULL_TREE, NULL_TREE,
  GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY);
+  gfc_add_modify (&block, dest, gfc_conv_descriptor_data_get (dummy_desc));
   null_data = gfc_finish_block (&block);
 
   gfc_init_block (&block);
@@ -9514,6 +9515,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, 
tree src, tree type,
  gfc_build_addr_expr (NULL_TREE, dest_tok),
  NULL_TREE, NULL_TREE, NULL_TREE,
  GFC_CAF_COARRAY_ALLOC);
+  gfc_add_modify (&block, dest, gfc_conv_descriptor_data_get (dummy_desc));
 
   tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
   tmp = build_call_expr_loc (input_location, tmp, 3, dest, src,
diff --git a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_10.f90 
b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_10.f90
new file mode 100644
index ..a31d005498c1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_10.f90
@@ -0,0 +1,24 @@
+!{ dg-do run }
+
+! Check that copying of memory for allocated scalar is assigned
+! to coarray object.
+
+! Contributed by G. Steinmetz  
+
+program p
+  type t
+integer, allocatable :: a
+  end type
+  type t2
+type(t), allocatable :: b
+  end type
+  type(t2) :: x, y[*]
+
+  x%b = t(1)
+  y = x
+  y%b%a = 2
+
+  if (x%b%a /= 1) stop 1
+  if (y%b%a /= 2) stop 2
+end
+

[gcc r15-3711] Fortran: Break recursion building recursive types. [PR106606]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:de915fbe3cb1ce7be35dce7d6bc8d04dc7125e61

commit r15-3711-gde915fbe3cb1ce7be35dce7d6bc8d04dc7125e61
Author: Andre Vehreschild 
Date:   Fri Aug 23 16:28:38 2024 +0200

Fortran: Break recursion building recursive types. [PR106606]

Build a derived type component's type only, when it is not already being
built 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 built.

gcc/testsuite/ChangeLog:

* gfortran.dg/recursive_alloc_comp_5.f90: New test.

Diff:
---
 gcc/fortran/trans-types.cc | 20 
 .../gfortran.dg/recursive_alloc_comp_5.f90 | 37 ++
 2 files changed, 51 insertions(+), 6 deletions(-)

diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 3a1ff98b33c3..96ef8b49fbef 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 ..f26d6a8da381
--- /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
+

[gcc r15-3707] Fix deep copy allocatable components in coarrays. [PR85002]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:361903ad1affd508bafdb9b771d6a6ffc98a2100

commit r15-3707-g361903ad1affd508bafdb9b771d6a6ffc98a2100
Author: Andre Vehreschild 
Date:   Fri Aug 23 09:07:09 2024 +0200

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.

Diff:
---
 gcc/fortran/trans-array.cc | 16 +++
 gcc/fortran/trans-expr.cc  |  2 +-
 gcc/testsuite/gfortran.dg/coarray/alloc_comp_9.f90 | 23 ++
 3 files changed, 32 insertions(+), 9 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8c35926436d7..838b6d3da800 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 07e28a9f7a8d..01cf3f0ff148 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9645,7 +9645,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/testsuite/gfortran.dg/coarray/alloc_comp_9.f90 
b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_9.f90
new file mode 100644
index ..d8e739a07d87
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_9.f90
@@ -0,0 +1,23 @@
+!{ dg-do run }
+
+! Check PR85002 i

[gcc r15-6615] Fortran: Extend cylic type detection for deallocate [PR116669]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:d897090949086d1a094429f043a4dcb7bbc74448

commit r15-6615-gd897090949086d1a094429f043a4dcb7bbc74448
Author: Andre Vehreschild 
Date:   Mon Dec 9 14:56:27 2024 +0100

Fortran: Extend cylic type detection for deallocate [PR116669]

Using cycles in derived/class types lead to the compiler doing a endless
recursion in several locations, when the cycle was not immediate.
An immediate cyclic dependency is present in, for example T T::comp.
Cylcic dependencies of the form T T2::comp; T2 T::comp2; are now
detected and the recursive bit in the derived type's attr is set.

gcc/fortran/ChangeLog:

PR fortran/116669

* class.cc (gfc_find_derived_vtab): Use attr to determine cyclic
type dependendies.
* expr.cc (gfc_has_default_initializer): Prevent endless
recursion by storing already visited derived types.
* resolve.cc (resolve_cyclic_derived_type): Determine if a type
is used in its hierarchy in a cyclic way.
(resolve_fl_derived0): Call resolve_cyclic_derived_type.
(resolve_fl_derived): Ensure vtab is generated when cyclic
derived types have allocatable components.
* trans-array.cc (structure_alloc_comps): Prevent endless loop
for derived type cycles.
* trans-expr.cc (gfc_get_ultimate_alloc_ptr_comps_caf_token):
Off topic, just prevent memory leaks.

gcc/testsuite/ChangeLog:

* gfortran.dg/class_array_15.f03: Freeing more memory.
* gfortran.dg/recursive_alloc_comp_6.f90: New test.

Diff:
---
 gcc/fortran/class.cc   | 19 +--
 gcc/fortran/expr.cc| 38 ++
 gcc/fortran/resolve.cc | 58 --
 gcc/fortran/trans-array.cc | 25 ++
 gcc/fortran/trans-expr.cc  | 10 +++-
 gcc/testsuite/gfortran.dg/class_array_15.f03   |  2 +-
 .../gfortran.dg/recursive_alloc_comp_6.f90 | 28 +++
 7 files changed, 136 insertions(+), 44 deletions(-)

diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index e0dd571cd68b..3e0dce1b54d8 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -2507,20 +2507,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
{
  gfc_component *c;
  gfc_symbol *parent = NULL, *parent_vtab = NULL;
- bool rdt = false;
-
- /* Is this a derived type with recursive allocatable
-components?  */
- c = (derived->attr.unlimited_polymorphic
-  || derived->attr.abstract) ?
- NULL : derived->components;
- for (; c; c= c->next)
-   if (c->ts.type == BT_DERIVED
-   && c->ts.u.derived == derived)
- {
-   rdt = true;
-   break;
- }
 
  gfc_get_symbol (name, ns, &vtype);
  if (!gfc_add_flavor (&vtype->attr, FL_DERIVED, NULL,
@@ -2703,9 +2689,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
  c->attr.access = ACCESS_PRIVATE;
  c->tb = XCNEW (gfc_typebound_proc);
  c->tb->ppc = 1;
- if (derived->attr.unlimited_polymorphic
- || derived->attr.abstract
- || !rdt)
+ if (derived->attr.unlimited_polymorphic || derived->attr.abstract
+ || !derived->attr.recursive)
c->initializer = gfc_get_null_expr (NULL);
  else
{
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 0b8d69436761..0e40b2493a5c 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5017,28 +5017,44 @@ is_non_empty_structure_constructor (gfc_expr * e)
 bool
 gfc_has_default_initializer (gfc_symbol *der)
 {
+  static hash_set seen_derived_types;
   gfc_component *c;
+  /* The rewrite to a result variable and breaks is only needed, because
+ there is no scope_guard in C++ yet.  */
+  bool result = false;
 
   gcc_assert (gfc_fl_struct (der->attr.flavor));
+  seen_derived_types.add (der);
   for (c = der->components; c; c = c->next)
-if (gfc_bt_struct (c->ts.type))
+if (gfc_bt_struct (c->ts.type)
+   && !seen_derived_types.contains (c->ts.u.derived))
   {
-if (!c->attr.pointer && !c->attr.proc_pointer
-&& !(c->attr.allocatable && der == c->ts.u.derived)
-&& ((c->initializer
- && is_non_empty_structure_constructor (c->initializer))
-|| gfc_has_default_initializer (c->ts.u.derived)))
- return true;
+   if (!c->attr.pointer && !c->attr.proc_pointer
+   && !(c->attr.allocatable && der == c->ts.u.derived)
+   && ((c->initializer
+&& is_non_empty_structure_constructor (c->initializer))
+  

[gcc r15-6618] Fortran: Ensure deep copy of allocatable components in cylic types [PR114612]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:25b380dc63cc7202ed1c7f2048994c3820a96fcd

commit r15-6618-g25b380dc63cc7202ed1c7f2048994c3820a96fcd
Author: Andre Vehreschild 
Date:   Fri Dec 13 12:07:01 2024 +0100

Fortran: Ensure deep copy of allocatable components in cylic types 
[PR114612]

gcc/fortran/ChangeLog:

PR fortran/114612

* trans-array.cc (structure_alloc_comps): Ensure deep copy is
also done for types having cycles.

gcc/testsuite/ChangeLog:

* gfortran.dg/alloc_comp_deep_copy_4.f03: New test.

Diff:
---
 gcc/fortran/trans-array.cc |  7 +++---
 .../gfortran.dg/alloc_comp_deep_copy_4.f03 | 29 ++
 2 files changed, 32 insertions(+), 4 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 057f6a63fdf5..44b091af2c69 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10584,10 +10584,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree 
decl, tree dest,
   false, false, NULL_TREE, NULL_TREE);
  gfc_add_expr_to_block (&fnblock, tmp);
}
- else if ((c->attr.allocatable)
-   && !c->attr.proc_pointer && !same_type
-   && (!(cmp_has_alloc_comps && c->as) || c->attr.codimension
-   || caf_in_coarray (caf_mode)))
+ else if (c->attr.allocatable && !c->attr.proc_pointer
+  && (!(cmp_has_alloc_comps && c->as) || c->attr.codimension
+  || caf_in_coarray (caf_mode)))
{
  rank = c->as ? c->as->rank : 0;
  if (c->attr.codimension)
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_4.f03 
b/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_4.f03
new file mode 100644
index ..3c445be032f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_4.f03
@@ -0,0 +1,29 @@
+!{ dg-do run }
+!
+! Contributed Vladimir Terzi  
+! Check that deep-copy for b=a works.
+
+program pr114672
+type node
+integer::val
+type(node),allocatable::next
+end type
+
+type(node)::a,b
+
+allocate(a%next)
+a%val=1
+a%next%val=2
+!print*,a%val,a%next%val
+b=a
+b%val=3
+b%next%val=4
+if (loc(b) == loc(a)) stop 1
+if (loc(b%next) == loc(a%next)) stop 2
+!print*,a%val,a%next%val
+deallocate(b%next)
+if (.NOT. allocated(a%next)) stop 3
+!print*,a%val,a%next%val
+deallocate(a%next)
+end
+

[gcc r15-6292] Fortran: Fix associate with derived type array construtor [PR117347]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:9684e70952ac159ce0b838533ce4e9c98474e1a8

commit r15-6292-g9684e70952ac159ce0b838533ce4e9c98474e1a8
Author: Andre Vehreschild 
Date:   Fri Dec 13 09:06:11 2024 +0100

Fortran: Fix associate with derived type array construtor [PR117347]

gcc/fortran/ChangeLog:

PR fortran/117347

* primary.cc (gfc_match_varspec): Add array constructors for
guessing their type like with unresolved function calls.

gcc/testsuite/ChangeLog:

* gfortran.dg/associate_71.f90: New test.

Diff:
---
 gcc/fortran/primary.cc |  1 +
 gcc/testsuite/gfortran.dg/associate_71.f90 | 39 ++
 2 files changed, 40 insertions(+)

diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 1db27929eebd..ab49eac450f6 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2423,6 +2423,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, 
bool sub_flag,
 component name 're' or 'im' could be found.  */
   if (tgt_expr
  && (tgt_expr->expr_type == EXPR_FUNCTION
+ || tgt_expr->expr_type == EXPR_ARRAY
  || (!resolved && tgt_expr->expr_type == EXPR_OP))
  && (sym->ts.type == BT_UNKNOWN
  || (inferred_type && sym->ts.type != BT_COMPLEX))
diff --git a/gcc/testsuite/gfortran.dg/associate_71.f90 
b/gcc/testsuite/gfortran.dg/associate_71.f90
new file mode 100644
index ..8f67b53180e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_71.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+!
+! Check that pr117347 is fixed.
+! Contributed by Ivan Pribec  
+
+program pr117347
+  implicit none
+
+  type :: point
+ real :: x = 42.
+  end type point
+
+  type(point) :: mypoint
+  real:: pi(1)
+  associate (points =>  mypoint )
+pi(:) = points% x
+  end associate
+  if (any(pi /= 42)) stop 1
+  associate (points => (mypoint))
+pi(:) = points% x
+  end associate
+  if (any(pi /= 42)) stop 2
+  associate (points => [mypoint])
+pi(:) = points% x
+  end associate
+  if (any(pi /= 42)) stop 3
+  associate (points => [rpoint()])
+pi(:) = points% x
+  end associate
+  if (any(pi /= 35)) stop 4
+
+contains
+
+  function rpoint() result(r)
+type(point) :: r
+r%x = 35
+  end function
+end program
+

[gcc r15-6383] Fortran: Fix caf_stop_numeric and reporting exceptions from caf [PR57598]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:a25cc26884663244c3b936af785854abee8949dd

commit r15-6383-ga25cc26884663244c3b936af785854abee8949dd
Author: Andre Vehreschild 
Date:   Wed Dec 18 12:43:39 2024 +0100

Fortran: Fix caf_stop_numeric and reporting exceptions from caf [PR57598]

Caf_stop_numeric always exited with code 0, which is wrong.  It shall
behave like regular stop.  Add reporting exceptions to caf's stop
handlers.  For this the existing library routine had to be exported.

libgfortran/ChangeLog:

PR fortran/57598

* caf/single.c (_gfortran_caf_stop_numeric): Report exceptions
on stop. And fix send_by_ref.
(_gfortran_caf_stop_str): Same.
(_gfortran_caf_error_stop_str): Same.
(_gfortran_caf_error_stop): Same.
* gfortran.map: Add report_exception for export.
* libgfortran.h (report_exception): Add to internal export.
* runtime/stop.c (report_exception): Same.

Diff:
---
 libgfortran/caf/single.c   | 19 +++
 libgfortran/gfortran.map   |  1 +
 libgfortran/libgfortran.h  |  3 +++
 libgfortran/runtime/stop.c |  7 +--
 4 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 41da970e8308..0ffbffa1d2ba 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -263,13 +263,17 @@ _gfortran_caf_sync_images (int count __attribute__ 
((unused)),
 *stat = 0;
 }
 
+extern void _gfortran_report_exception (void);
 
 void
 _gfortran_caf_stop_numeric(int stop_code, bool quiet)
 {
   if (!quiet)
-fprintf (stderr, "STOP %d\n", stop_code);
-  exit (0);
+{
+  _gfortran_report_exception ();
+  fprintf (stderr, "STOP %d\n", stop_code);
+}
+  exit (stop_code);
 }
 
 
@@ -278,6 +282,7 @@ _gfortran_caf_stop_str(const char *string, size_t len, bool 
quiet)
 {
   if (!quiet)
 {
+  _gfortran_report_exception ();
   fputs ("STOP ", stderr);
   while (len--)
fputc (*(string++), stderr);
@@ -292,6 +297,7 @@ _gfortran_caf_error_stop_str (const char *string, size_t 
len, bool quiet)
 {
   if (!quiet)
 {
+  _gfortran_report_exception ();
   fputs ("ERROR STOP ", stderr);
   while (len--)
fputc (*(string++), stderr);
@@ -373,7 +379,10 @@ void
 _gfortran_caf_error_stop (int error, bool quiet)
 {
   if (!quiet)
-fprintf (stderr, "ERROR STOP %d\n", error);
+{
+  _gfortran_report_exception ();
+  fprintf (stderr, "ERROR STOP %d\n", error);
+}
   exit (error);
 }
 
@@ -2131,14 +2140,16 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t 
*src_index,
  /* Assume that the rank and the dimensions fit for copying src
 to dst.  */
  GFC_DESCRIPTOR_DTYPE (dst) = GFC_DESCRIPTOR_DTYPE (src);
+ GFC_DESCRIPTOR_SPAN (dst) = GFC_DESCRIPTOR_SPAN (src);
  stride_dst = 1;
+ dst->offset = 0;
  for (size_t d = 0; d < src_rank; ++d)
{
  extent_dst = GFC_DIMENSION_EXTENT (src->dim[d]);
  GFC_DIMENSION_LBOUND (dst->dim[d]) = 1;
  GFC_DIMENSION_UBOUND (dst->dim[d]) = extent_dst;
  GFC_DIMENSION_STRIDE (dst->dim[d]) = stride_dst;
- dst->offset = -extent_dst;
+ dst->offset -= stride_dst;
  stride_dst *= extent_dst;
}
  /* Null the data-pointer to make register_component allocate
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index f58edc52e3c2..851df211 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1997,4 +1997,5 @@ GFORTRAN_15 {
 _gfortran_sminloc1_8_m2;
 _gfortran_sminloc1_8_m4;
 _gfortran_sminloc1_8_m8;
+_gfortran_report_exception;
 } GFORTRAN_14;
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index aaa9222c43b6..cf3dda07d3d1 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -986,6 +986,9 @@ internal_proto(filename_from_unit);
 
 /* stop.c */
 
+extern void report_exception (void);
+iexport_proto (report_exception);
+
 extern _Noreturn void stop_string (const char *, size_t, bool);
 export_proto(stop_string);
 
diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
index 2eefe21a9e90..3ac5beff6bba 100644
--- a/libgfortran/runtime/stop.c
+++ b/libgfortran/runtime/stop.c
@@ -38,7 +38,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If 
not, see
inexact - and we optionally ignore underflow, cf. thread starting at
http://mailman.j3-fortran.org/pipermail/j3/2013-June/006452.html.  */
 
-static void
+extern void report_exception (void);
+iexport_proto (report_exception);
+
+void
 report_exception (void)
 {
   struct iovec iov[8];
@@ -108,7 +111,7 @@ report_exception (void)
 
   estr_writev (iov, iovcnt);
 }
-
+iexport (report_exception);
 
 /* A numeric STOP statement

[gcc r15-6414] Fortran: Remove adding and removing of caf_get. [PR107635]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:91d52f87c5bc48eacaf305d515e7cce192c2cf9c

commit r15-6414-g91d52f87c5bc48eacaf305d515e7cce192c2cf9c
Author: Andre Vehreschild 
Date:   Thu Oct 31 15:35:47 2024 +0100

Fortran: Remove adding and removing of caf_get. [PR107635]

Preparatory work for PR107635.

During resolve prevent adding caf_get calls for expressions on the
left-hand-side of an assignment and removing them later on again.

Furthermore has the caf_token in a component become a pointer to
the component and not the backend_decl of the caf-component.
In some cases the caf_token was added as last component in a derived
type and not as the next one following the component that it was
needed to be associated to.

gcc/fortran/ChangeLog:

PR fortran/107635

* gfortran.h (gfc_comp_caf_token): Convenient macro for
accessing caf_token's tree.
* resolve.cc (gfc_resolve_ref): Backup caf_lhs when resolving
expr in array_ref.
(remove_caf_get_intrinsic): Removed.
(resolve_variable): Set flag caf_lhs when resolving lhs of
assignment to prevent insertion of caf_get.
(resolve_lock_unlock_event): Same, but the lhs is the parameter.
(resolve_ordinary_assign): Move conversion to caf_send to
resolve_codes.
(resolve_codes): Adress caf_get and caf_send here.
(resolve_fl_derived0): Set component's caf_token when token is
necessary.
* trans-array.cc (gfc_conv_array_parameter): Get a coarray for
expression that have a corank.
(structure_alloc_comps): Use macro to get caf_token's tree.
(gfc_alloc_allocatable_for_assignment): Same.
* trans-expr.cc (gfc_get_ultimate_alloc_ptr_comps_caf_token):
Same.
(gfc_trans_structure_assign): Same.
* trans-intrinsic.cc (conv_expr_ref_to_caf_ref): Same.
(has_ref_after_cafref): New function to figure that after a
reference of a coarray another reference is present.
(conv_caf_send): Get rhs from correct place, when caf_get is
not removed.
* trans-types.cc (gfc_get_derived_type): Get caf_token from
component and no longer guessing.

Diff:
---
 gcc/fortran/gfortran.h |   3 +-
 gcc/fortran/resolve.cc | 165 +
 gcc/fortran/trans-array.cc |  30 
 gcc/fortran/trans-expr.cc  |  15 ++--
 gcc/fortran/trans-intrinsic.cc |  32 ++--
 gcc/fortran/trans-types.cc |  44 +--
 6 files changed, 158 insertions(+), 131 deletions(-)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index d08439019a38..d66c13b26615 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1214,11 +1214,12 @@ typedef struct gfc_component
   /* Needed for procedure pointer components.  */
   struct gfc_typebound_proc *tb;
   /* When allocatable/pointer and in a coarray the associated token.  */
-  tree caf_token;
+  struct gfc_component *caf_token;
 }
 gfc_component;
 
 #define gfc_get_component() XCNEW (gfc_component)
+#define gfc_comp_caf_token(cm) (cm)->caf_token->backend_decl
 
 /* Formal argument lists are lists of symbols.  */
 typedef struct gfc_formal_arglist
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index f892d809d209..06d870d80de3 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -85,6 +85,8 @@ static bitmap_obstack labels_obstack;
 /* True when simplifying a EXPR_VARIABLE argument to an inquiry function.  */
 static bool inquiry_argument = false;
 
+/* True when we are on left hand side in an assignment of a coarray.  */
+static bool caf_lhs = false;
 
 /* Is the symbol host associated?  */
 static bool
@@ -5578,7 +5580,7 @@ gfc_resolve_ref (gfc_expr *expr)
 {
   int current_part_dimension, n_components, seen_part_dimension, dim;
   gfc_ref *ref, **prev, *array_ref;
-  bool equal_length;
+  bool equal_length, old_caf_lhs;
 
   for (ref = expr->ref; ref; ref = ref->next)
 if (ref->type == REF_ARRAY && ref->u.ar.as == NULL)
@@ -5588,13 +5590,18 @@ gfc_resolve_ref (gfc_expr *expr)
break;
   }
 
+  old_caf_lhs = caf_lhs;
+  caf_lhs = false;
   for (prev = &expr->ref; *prev != NULL;
prev = *prev == NULL ? prev : &(*prev)->next)
 switch ((*prev)->type)
   {
   case REF_ARRAY:
if (!resolve_array_ref (&(*prev)->u.ar))
- return false;
+ {
+   caf_lhs = old_caf_lhs;
+   return false;
+ }
break;
 
   case REF_COMPONENT:
@@ -5604,7 +5611,10 @@ gfc_resolve_ref (gfc_expr *expr)
   case REF_SUBSTRING:
equal_length = false;
if (!gfc_resolve_substring (*prev, &equal_length))
- return false;
+ {
+   caf_lhs = old_caf_lhs;
+   return false;
+ }
 
if (expr->expr_type !

[gcc r15-6415] Fortran: Replace getting of coarray data with accessor-based version. [PR107635]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:586477d67bf2e320e8ec41f82b194259c1dcc43a

commit r15-6415-g586477d67bf2e320e8ec41f82b194259c1dcc43a
Author: Andre Vehreschild 
Date:   Fri Dec 6 08:57:34 2024 +0100

Fortran: Replace getting of coarray data with accessor-based version. 
[PR107635]

Getting coarray data from remote images was slow, inefficient and did
not work for object files that where not compiled with coarray support
for derived types with allocatable/pointer components.  The old approach
emulated accessing data through a whole structure ref, which was error
prone for corner cases.  Furthermore was did it have a runtime
complexity of O(N), where N is the number of allocatable/pointer
components and descriptors involved.  Each of those needed communication
twice.  The new approach creates a routine for each access into a
coarray object putting all required operations there.  Looking a
tree-dump one will see those small routines.  But this time it is just
compiled fortran with all the knowledge of the compiler of bounds and so
on.  New paradigms will be available out of the box.  Furthermore is the
complexity of the communication reduced to be O(1).  E.g. the mpi
implementation sends one message for the parameters of the access and
one message back with the results without caring about the number of
allocatable/pointer/descriptor components in the access.

Identification of access routines is done be adding them to a hash map,
where the hash is the same on all images.  Translating the hash to an
index, which is the same on all images again, allows for fast calls of
the access routines.  Resolving the hash to an index is cached at
runtime, preventing additional hash map lookups.  A hashmap was use
because not all processor OS combinations may use the same address for
the access routine.

gcc/fortran/ChangeLog:

PR fortran/107635

* gfortran.h (gfc_add_caf_accessor): New function.
* gfortran.texi: Document new API routines.
* resolve.cc (get_arrayspec_from_expr): Synthesize the arrayspec
resulting from an expression, i.e. not only the rank, but also
the bounds.
(remove_coarray_from_derived_type): Remove coarray ref from a
derived type to access it in access routine.
(convert_coarray_class_to_derived_type): Same but for classes.
The result is a derived type.
(split_expr_at_caf_ref): Split an expression at the coarray
reference to move the reference after the coarray ref into the
access routine.
(check_add_new_component): Helper to add variables as
components to derived type transfered to the access routine.
(create_get_parameter_type): Create the derived type to transfer
addressing data to the access routine.
(create_get_callback): Create the access routine.
(add_caf_get_intrinsic): Use access routine instead of old
caf_get.
* trans-decl.cc (gfc_build_builtin_function_decls): Register new
API routines.
(gfc_create_module_variable): Use renamed flag.
(gfc_emit_parameter_debug_info):
(struct caf_accessor): Linked list of hash-access routine pairs.
(gfc_add_caf_accessor): Add a hash-access routine pair to above
linked list.
(create_caf_accessor_register): Add all registered hash-access
routine pairs to the current caf_init.
(generate_coarray_init): Use routine above.
(gfc_generate_module_vars): Use renamed flag.
(generate_local_decl): Same.
(gfc_generate_function_code): Same.
(gfc_process_block_locals): Same.
* trans-intrinsic.cc (conv_shape_to_cst): Build the product of a
shape.
(gfc_conv_intrinsic_caf_get): Create call to access routine.
(conv_caf_send): Adapt to caf_get using less arguments.
(gfc_conv_intrinsic_function): Same.
* trans.cc (gfc_trans_force_lval): Helper to ensure that an
expression can be used as an lvalue-ref.
* trans.h (gfc_trans_force_lval): See above.

libgfortran/ChangeLog:

* caf/libcaf.h (_gfortran_caf_register_accessor): New function
to register access routines at runtime.
(_gfortran_caf_register_accessors_finish): New function to
finish registration of access routine and sort hash map.
(_gfortran_caf_get_remote_function_index): New function to
convert an hash to an index.
(_gfortran_caf_get_by_ct): New function to get data from a
remote image using the access routine given by an index.
* caf/single.c (struct accessor_hash_t): Hashmap type.
(_gfortran_caf

[gcc r15-6425] Fortran: Fixup broken build on 32bit after r15-6415 [PR107635]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:dae506f73bdc03628e23d5e8c566b2e642086b60

commit r15-6425-gdae506f73bdc03628e23d5e8c566b2e642086b60
Author: Andre Vehreschild 
Date:   Mon Dec 23 15:01:30 2024 +0100

Fortran: Fixup broken build on 32bit after r15-6415 [PR107635]

gcc/testsuite/ChangeLog:

PR fortran/107635

* gfortran.dg/coarray_lib_comm_1.f90: Use less complicated
pattern, because all we need is the right count.

Diff:
---
 gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 
b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
index 68aa47ecd325..609f3c10cefa 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
@@ -38,6 +38,6 @@ B(1:5) = B(3:7)
 if (any (A-B /= 0)) STOP 4
 end
 
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get_by_ct \\\(caf_token.., 
0B, 0B, 1, \\\(unsigned long\\\) atmp.\[0-9\]+.span" 4 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get_by_ct" 4 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.., 
\\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - 
\\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, caf_token.., 
\\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - 
\\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 1, 0B\\\);" 
1 "original" } }

[gcc r15-6729] Fortran: Cylce detection for non vtypes only. [PR118337]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:d107140205537aec9c8e235d869b166e9b884775

commit r15-6729-gd107140205537aec9c8e235d869b166e9b884775
Author: Andre Vehreschild 
Date:   Wed Jan 8 14:58:35 2025 +0100

Fortran: Cylce detection for non vtypes only. [PR118337]

gcc/fortran/ChangeLog:

PR fortran/118337

* resolve.cc (resolve_fl_derived0): Exempt vtypes from cycle
detection.

Diff:
---
 gcc/fortran/resolve.cc | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 6dcda70679f2..dab0c3af6018 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -16840,7 +16840,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 
   /* Resolving components below, may create vtabs for which the cyclic type
  information needs to be present.  */
-  resolve_cyclic_derived_type (sym);
+  if (!sym->attr.vtype)
+resolve_cyclic_derived_type (sym);
 
   c = (sym->attr.is_class) ? CLASS_DATA (sym->components)
   : sym->components;

[gcc r15-8297] Fortran: Fix comp call in associate [PR119272]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:9a13dc48a3ac3282aaf9a77516b4f02faa60e393

commit r15-8297-g9a13dc48a3ac3282aaf9a77516b4f02faa60e393
Author: Andre Vehreschild 
Date:   Mon Mar 17 08:24:04 2025 +0100

Fortran: Fix comp call in associate [PR119272]

PR fortran/119272

gcc/fortran/ChangeLog:

* resolve.cc (resolve_compcall): Postpone error report when
symbol is not resolved yet for component call resolve.

gcc/testsuite/ChangeLog:

* gfortran.dg/associate_74.f90: New test.

Diff:
---
 gcc/fortran/resolve.cc |  5 ++--
 gcc/testsuite/gfortran.dg/associate_74.f90 | 47 ++
 2 files changed, 50 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index ddd982702309..b9c469a5beca 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -7351,8 +7351,9 @@ resolve_compcall (gfc_expr* e, const char **name)
   /* Check that's really a FUNCTION.  */
   if (!e->value.compcall.tbp->function)
 {
-  gfc_error ("%qs at %L should be a FUNCTION",
-e->value.compcall.name, &e->where);
+  if (e->symtree && e->symtree->n.sym->resolve_symbol_called)
+   gfc_error ("%qs at %L should be a FUNCTION", e->value.compcall.name,
+  &e->where);
   return false;
 }
 
diff --git a/gcc/testsuite/gfortran.dg/associate_74.f90 
b/gcc/testsuite/gfortran.dg/associate_74.f90
new file mode 100644
index ..057d63534c1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_74.f90
@@ -0,0 +1,47 @@
+!{ dg-do run }
+
+! Check that PR119272 is fixed
+! Contributed by Xing Jing Wei  
+
+module pr119272_module
+   type, public :: test_type
+  contains
+  procedure :: scal_function
+  procedure :: arr_function
+   end type test_type
+   contains
+   function scal_function(this) result(smth)
+  class(test_type) :: this
+  integer :: smth
+  smth = 2
+   end function
+   function arr_function(this) result(smth)
+  class(test_type) :: this
+  integer :: smth(9)
+  smth = (/(i, i=1, 9)/)
+   end function
+end module
+
+program pr119272
+  use pr119272_module
+  implicit none
+  
+  type(test_type) :: a
+  
+  call test_subroutine(a)
+  contains
+  subroutine test_subroutine(a)
+class(test_type) :: a
+integer :: i
+integer,parameter :: temp_int(3) = [ 1, 2, 3]
+integer,parameter :: identity(9) = (/(i* 5, i= 9, 1, -1)/)
+associate(temp => temp_int(a%scal_function()))
+if (temp /= 2) stop 1
+end associate
+
+associate(temparr => identity(a%arr_function()))
+if (any(temparr /= (/(i* 5, i= 9, 1, -1)/))) stop 2
+end associate
+  end subroutine
+end program
+

[gcc r15-8642] Fortran: Fix freeing procedure pointer components [PR119380]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:a5c69abf1384ec6163cd5e14146e8b3876e8b95c

commit r15-8642-ga5c69abf1384ec6163cd5e14146e8b3876e8b95c
Author: Andre Vehreschild 
Date:   Fri Mar 21 09:13:29 2025 +0100

Fortran: Fix freeing procedure pointer components [PR119380]

PR fortran/119380

gcc/fortran/ChangeLog:

* trans-array.cc (structure_alloc_comps): Prevent freeing of
procedure pointer components.

gcc/testsuite/ChangeLog:

* gfortran.dg/proc_ptr_comp_54.f90: New test.

Diff:
---
 gcc/fortran/trans-array.cc |  2 +-
 gcc/testsuite/gfortran.dg/proc_ptr_comp_54.f90 | 30 ++
 2 files changed, 31 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e9eacf201283..960613167f72 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10109,7 +10109,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree 
decl, tree dest,
  else
{
  attr = &c->attr;
- if (attr->pointer)
+ if (attr->pointer || attr->proc_pointer)
continue;
}
 
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_54.f90 
b/gcc/testsuite/gfortran.dg/proc_ptr_comp_54.f90
new file mode 100644
index ..f5b7fa84955d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_54.f90
@@ -0,0 +1,30 @@
+!{ dg-do run }
+
+! Do not free procedure pointer components.
+! Contributed by Damian Rouson  
+
+  implicit none
+
+  type foo_t
+integer, allocatable :: i_
+procedure(f), pointer, nopass :: f_
+procedure(c), pointer, nopass :: c_
+  end type
+
+  class(foo_t), allocatable :: ff
+
+  associate(foo => foo_t(1,f))
+  end associate
+
+contains
+
+  function f()
+logical, allocatable :: f
+f = .true.
+  end function
+
+  function c()
+class(foo_t), allocatable :: c
+allocate(c)
+  end function
+end

[gcc r15-8481] Fortran: Fix double free on polymorphic array dummy argument [PR119349]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:0f344846a62c8863375909d8d6b435b4b5fd35a0

commit r15-8481-g0f344846a62c8863375909d8d6b435b4b5fd35a0
Author: Andre Vehreschild 
Date:   Thu Mar 20 13:37:21 2025 +0100

Fortran: Fix double free on polymorphic array dummy argument [PR119349]

Calling elemental routines with polymorphic formals leads to generation
of a temporary polymorphic variable and code for its deallocation.
Sourcing this element from an array constructor the latter now is
prevented from generating a second deallocation.

PR fortran/119349

gcc/fortran/ChangeLog:

* trans-expr.cc (gfc_conv_procedure_call): Prevent deallocation
of array temporary for polymorphic temporary argument.

gcc/testsuite/ChangeLog:

* gfortran.dg/class_79.f90: New test.

Diff:
---
 gcc/fortran/trans-expr.cc  |  6 +-
 gcc/testsuite/gfortran.dg/class_79.f90 | 25 +
 2 files changed, 30 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d965539f11e7..923d46cb47c9 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7994,7 +7994,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
  gfc_add_expr_to_block (&se->post, local_tmp);
}
 
- if (!finalized && !e->must_finalize)
+ /* Items of array expressions passed to a polymorphic formal arguments
+create their own clean up, so prevent double free.  */
+ if (!finalized && !e->must_finalize
+ && !(e->expr_type == EXPR_ARRAY && fsym
+  && fsym->ts.type == BT_CLASS))
{
  bool scalar_res_outside_loop;
  scalar_res_outside_loop = e->expr_type == EXPR_FUNCTION
diff --git a/gcc/testsuite/gfortran.dg/class_79.f90 
b/gcc/testsuite/gfortran.dg/class_79.f90
new file mode 100644
index ..a2226e47aff3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_79.f90
@@ -0,0 +1,25 @@
+!{ dg-do run }
+
+! Check double free on array constructor in argument list is fixed.
+! Contributed by Damian Rouson  
+program pr119349
+  implicit none
+  
+  type string_t
+character(len=:), allocatable :: string_
+  end type
+
+  print *, true([string()])
+
+contains
+
+  type(string_t) function string()
+string%string_ = ""
+  end function
+
+  logical elemental function true(rhs)
+class(string_t), intent(in) :: rhs
+true = .true.
+  end function
+
+end program

[gcc r16-75] Fortran: Improve F2018 TEAM handling [PR87326, PR87556, PR88254, PR103896]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:8f4ee36bd5248cd244f65282167e3a13a3c98bc2

commit r16-75-g8f4ee36bd5248cd244f65282167e3a13a3c98bc2
Author: Andre Vehreschild 
Date:   Mon Apr 7 09:36:24 2025 +0200

Fortran: Improve F2018 TEAM handling [PR87326, PR87556, PR88254, PR103896]

Improve the implementation of F2018 TEAM handling routines. Add
runtime-functions to caf_single to allow testing.

PR fortran/87326
PR fortran/87556
PR fortran/88254
PR fortran/103796

gcc/fortran/ChangeLog:

* coarray.cc (split_expr_at_caf_ref): Treat polymorphic types
correctly.  Ensure resolve of expression after coindex.
(create_allocated_callback): Fix parameter of allocated function
for coarrays.
(coindexed_expr_callback): Improve detection of coarrays in
allocated function.
* decl.cc (gfc_match_end): Add team block matching.
* dump-parse-tree.cc (show_code_node): Dump change team block as
such.
* frontend-passes.cc (gfc_code_walker): Recognice team block.
* gfortran.texi: Add documentation for team api functions.
* intrinsic.texi: Add documentation about team_type in
iso_fortran_env module.
* iso-fortran-env.def (team_type): Use helper to get pointer
kind.
* match.cc (gfc_match_associate): Factor out matching of
association list, because it is used in change team as well.
(check_coarray_assoc): Ensure, that the association is to a
coarray.
(match_association_list): Match a list of association either in
associate or in change team.
(gfc_match_form_team): Match form team correctly include
new_index.
(gfc_match_change_team): Match change team with association
list.
(gfc_match_end_team): Match end team including stat and errmsg.
(gfc_match_return): Prevent return from team block.
* parse.cc (decode_statement): Sort team block.
(next_statement): Same.
(check_statement_label): Same.
(accept_statement): Same.
(verify_st_order): Same.
(parse_associate): Renamed to move_associates_to_block...
(move_associates_to_block): ... to enable reuse for change team.
(parse_change_team): Parse it as block.
(parse_executable): Same.
* parse.h (enum gfc_compile_state): Add team block as compiler
state.
* resolve.cc (resolve_scalar_argument): New function to resolve
an argument to a statement as a scalar.
(resolve_form_team): Resolve its members.
(resolve_change_team): Same.
(resolve_branch): Prevent branch from jumping out of team block.
(check_team): Removed.
* trans-decl.cc (gfc_build_builtin_function_decls): Add stat and
errmsg to team API functions and update their arguments.
* trans-expr.cc (gfc_trans_subcomponent_assign): Also null the
token when moving memory or an allocated() will not detect a
free.
* trans-intrinsic.cc (gfc_conv_intrinsic_caf_is_present_remote):
Adapt to signature change no longer a pointer-pointer.
* trans-stmt.cc (gfc_trans_form_team): Translate a form team
including new_index.
(gfc_trans_change_team): Translate a change team as a block.

libgfortran/ChangeLog:

* caf/libcaf.h: Remove commented block.
(_gfortran_caf_form_team): Allow for all relevant arguments.
(_gfortran_caf_change_team): Same.
(_gfortran_caf_end_team): Same.
(_gfortran_caf_sync_team): Same.
* caf/single.c (struct caf_single_team): Team handling
structures.
(_gfortran_caf_init): Initialize initial team.
(free_team_list): Free all teams and the memory they hold.
(_gfortran_caf_finalize): Free initial and sibling teams.
(_gfortran_caf_register): Add memory registered to current team.
(_gfortran_caf_deregister): Unregister memory from current team.
(_gfortran_caf_is_present_on_remote): Check token's memptr for
llocation.  May have been deallocated by an end team.
(_gfortran_caf_form_team): Push a new team stub to the list.
(_gfortran_caf_change_team): Push a formed team on top of the
ctive teams stack.
(_gfortran_caf_end_team): End the active team, free all memory
allocated during its livespan.
(_gfortran_caf_sync_team): Take stat and errmsg into account.

gcc/testsuite/ChangeLog:

* gfortran.dg/team_change_2.f90: New test.
* gfortran.dg/team_change_3.f90: New test.
 

[gcc r16-74] Fortran: Unify handling of STAT= and ERRMSG= optional arguments [PR87939]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:1be1970f97d05a07851cd826132fcf466827ebe5

commit r16-74-g1be1970f97d05a07851cd826132fcf466827ebe5
Author: Andre Vehreschild 
Date:   Fri Mar 14 14:20:18 2025 +0100

Fortran: Unify handling of STAT= and ERRMSG= optional arguments [PR87939]

In preparing F2018 Teams handling improvements, unify handling of STAT=
and ERRMSG= optional arguments.  Handling of stat and errmsg in most
teams statements is corrected in the next patch.

Implement stat and errmsg for move_alloc () to comply with F2018.

PR fortran/87939

gcc/fortran/ChangeLog:

* check.cc (gfc_check_move_alloc): Add stat and errmsg to
move_alloc.
* dump-parse-tree.cc (show_sync_stat): New helper function.
(show_code_node): Use show_sync_stat to print stat and errmsg.
* gfortran.h (struct sync_stat): New struct to unify stat and
errmsg handling.
* intrinsic.cc (add_subroutines): Correct signature of
move_alloc.
* intrinsic.h (gfc_check_move_alloc): Correct signature of
check_move_alloc.
* match.cc (match_named_arg): Match an optional argument to a
statement.
(match_stat_errmsg): Match a stat= or errmsg= named argument.
(gfc_match_critical): Use match_stat_errmsg to match the named
arguments.
(gfc_match_sync_team): Same.
* resolve.cc (resolve_team_argument): Resolve an expr to have
type TEAM_TYPE from iso_fortran_env.
(resolve_scalar_variable_as_arg): Resolve an argument as a
scalar type.
(resolve_sync_stat): Resolve stat and errmsg expressions.
(resolve_sync_team): Resolve a sync team statement using
sync_stat helper.
(resolve_end_team): Same.
(resolve_critical): Same.
* trans-decl.cc (gfc_build_builtin_function_decls): Correct
sync_team signature.
* trans-intrinsic.cc (conv_intrinsic_move_alloc): Store stat
an errmsg optional arguments in helper struct and use helper
to translate.
* trans-stmt.cc (trans_exit): Implement DRY pattern for
generating an _exit().
(gfc_trans_sync_stat): Translate stat and errmsg contents.
(gfc_trans_end_team): Use helper to translate stat and errmsg.
(gfc_trans_sync_team): Same.
(gfc_trans_critical): Same.
* trans-stmt.h (gfc_trans_sync_stat): New function.
* trans.cc (gfc_deallocate_with_status): Parameterize check at
runtime to allow unallocated (co-)array when freeing a
structure.
(gfc_deallocate_scalar_with_status): Same and also add errmsg.
* trans.h (gfc_deallocate_with_status): Signature changes.
(gfc_deallocate_scalar_with_status): Same.

libgfortran/ChangeLog:

* caf/single.c (_gfortran_caf_lock): Correct stat value, if
lock is already locked by current image.
(_gfortran_caf_unlock): Correct stat value, if lock is not
locked.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray_critical_2.f90: New test.
* gfortran.dg/coarray_critical_3.f90: New test.
* gfortran.dg/team_sync_1.f90: New test.
* gfortran.dg/move_alloc_11.f90: New test.

Diff:
---
 gcc/fortran/check.cc |  12 +-
 gcc/fortran/dump-parse-tree.cc   |  23 ++-
 gcc/fortran/gfortran.h   |   9 ++
 gcc/fortran/intrinsic.cc |  10 +-
 gcc/fortran/intrinsic.h  |   3 +-
 gcc/fortran/match.cc | 121 +--
 gcc/fortran/resolve.cc   |  52 ++-
 gcc/fortran/trans-decl.cc|   8 +-
 gcc/fortran/trans-intrinsic.cc   |  61 ++--
 gcc/fortran/trans-stmt.cc| 186 +++
 gcc/fortran/trans-stmt.h |   1 +
 gcc/fortran/trans.cc |  46 +++---
 gcc/fortran/trans.h  |  11 +-
 gcc/testsuite/gfortran.dg/coarray_critical_2.f90 |  30 
 gcc/testsuite/gfortran.dg/coarray_critical_3.f90 |  32 
 gcc/testsuite/gfortran.dg/move_alloc_11.f90  |  23 +++
 gcc/testsuite/gfortran.dg/team_sync_1.f90|  24 +++
 libgfortran/caf/single.c |   8 +-
 18 files changed, 532 insertions(+), 128 deletions(-)

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 9c66c25e0596..00342787a518 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -4683,8 +4683,18 @@ gfc_check_merge_bits (gfc_expr *i, gfc_expr *j, gfc_expr 
*mask)
 
 
 bool
-gfc_check_move_alloc (gfc_expr *from, gfc_expr *to)
+gfc_check_move_alloc (gfc_e

[gcc r16-76] Fortran: Update get_team, team_number and image_status to F2018 [PR88154, PR88960, PR97210, PR103001

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:621fe931be1e0220854e4d3c49cf2ce05cf735f7

commit r16-76-g621fe931be1e0220854e4d3c49cf2ce05cf735f7
Author: Andre Vehreschild 
Date:   Mon Apr 7 15:12:09 2025 +0200

Fortran: Update get_team, team_number and image_status to F2018 [PR88154, 
PR88960, PR97210, PR103001]

Add functions get_team() and team_number() to comply with F2018
standard.

Update image_status() to comply with F2018 standard.

PR fortran/88154
PR fortran/88960
PR fortran/97210
PR fortran/103001

gcc/fortran/ChangeLog:

* check.cc (team_type_check): Check a type for being team_type
from the iso_fortran_env module.
(gfc_check_image_status): Use team_type check.
(gfc_check_get_team): Check for level argument.
(gfc_check_team_number): Use team_type check.
* expr.cc (gfc_check_assign): Add treatment for returning
team_type in caf-single mode.
* gfortran.texi: Add/Update documentation for get_team and
team_number API functions.
* intrinsic.cc (add_functions): Update get_team signature.
* intrinsic.h (gfc_resolve_get_team): Add prototype.
* intrinsic.texi: Add/Update documentation for get_team and
team_number Fortran functions.
* iresolve.cc (gfc_resolve_get_team): Resolve return type to be
of type team_type.
* iso-fortran-env.def: Update STAT_LOCK constants.  They have
nothing to do with files.  Add level constants for get_team.
* libgfortran.h: Add level and unlock_stat constants.
* simplify.cc (gfc_simplify_get_team): Simply to correct return
type team_type.
* trans-decl.cc (gfc_build_builtin_function_decls): Update
get_team and image_status API prototypes to correct signatures.
* trans-intrinsic.cc (conv_intrinsic_image_status): Translate
second parameter correctly.
(conv_intrinsic_team_number): Translate optional single team
argument correctly.
(gfc_conv_intrinsic_function): Add translation of get_team.

libgfortran/ChangeLog:

* caf/libcaf.h: Add constants for get_team's level argument and
update stat values for failed images.
(_gfortran_caf_team_number): Add prototype.
(_gfortran_caf_get_team): Same.
* caf/single.c (_gfortran_caf_team_number): Get the given team's
team number.
(_gfortran_caf_get_team): Get the current team or the team given
by level when the argument is present.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/image_status_1.f08: Correct check for
team_type.
* gfortran.dg/pr102458.f90: Adapt to multiple errors.
* gfortran.dg/coarray/get_team_1.f90: New test.
* gfortran.dg/team_get_1.f90: New test.
* gfortran.dg/team_number_1.f90: Correct Fortran syntax.

Diff:
---
 gcc/fortran/check.cc   |  65 +++-
 gcc/fortran/expr.cc|   8 +-
 gcc/fortran/gfortran.texi  |  50 +
 gcc/fortran/intrinsic.cc   |   8 +-
 gcc/fortran/intrinsic.h|   2 +-
 gcc/fortran/intrinsic.texi | 112 +
 gcc/fortran/iresolve.cc|  22 +++-
 gcc/fortran/iso-fortran-env.def|  22 ++--
 gcc/fortran/libgfortran.h  |  10 +-
 gcc/fortran/simplify.cc|   6 +-
 gcc/fortran/trans-decl.cc  |  14 ++-
 gcc/fortran/trans-intrinsic.cc |  21 ++--
 gcc/testsuite/gfortran.dg/coarray/get_team_1.f90   |  29 ++
 .../gfortran.dg/coarray/image_status_1.f08 |   2 +-
 gcc/testsuite/gfortran.dg/pr102458.f90 |   2 +-
 gcc/testsuite/gfortran.dg/team_get_1.f90   |  27 +
 gcc/testsuite/gfortran.dg/team_number_1.f90|   6 +-
 libgfortran/caf/libcaf.h   |  13 ++-
 libgfortran/caf/single.c   |  26 +
 19 files changed, 367 insertions(+), 78 deletions(-)

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 00342787a518..a1c3de3e80dd 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -1809,6 +1809,23 @@ gfc_check_atomic_ref (gfc_expr *value, gfc_expr *atom, 
gfc_expr *stat)
   return gfc_check_atomic (atom, 1, value, 0, stat, 2);
 }
 
+bool
+team_type_check (gfc_expr *e, int n)
+{
+  if (e->ts.type != BT_DERIVED || !e->ts.u.derived
+  || e->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
+  || e->ts.u.derived->intmod_sym_id != ISOFORTRAN_TEAM_TYPE)
+{
+  gfc_error ("%qs argument of %qs intrinsic at %L shall be of t

[gcc r16-78] Fortran: Add teams support in image_index and num_images for F2018

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:14a014516ece49714a91e3c67b5a7c56834e8af3

commit r16-78-g14a014516ece49714a91e3c67b5a7c56834e8af3
Author: Andre Vehreschild 
Date:   Thu Apr 3 10:11:50 2025 +0200

Fortran: Add teams support in image_index and num_images for F2018

This more or less completes the set of functions that are affected by
teams.

gcc/fortran/ChangeLog:

* check.cc (gfc_check_image_index): Check for team or
team_number correctnes.
(gfc_check_num_images): Same.
* gfortran.texi: Update documentation on num_images' API
function.
* intrinsic.cc (add_functions): Update signature of image_index
and num_images.  Both can take either a team handle or number.
* intrinsic.h (gfc_check_num_images): Update signature to take
either team or team_number.
(gfc_check_image_index): Can take coarray, subscripts and team
or team number now.
(gfc_simplify_image_index): Same.
(gfc_simplify_num_images): Same.
(gfc_resolve_image_index): Same.
* intrinsic.texi: Update documentation of num_images() Fortran
function.
* iresolve.cc (gfc_resolve_image_index): Update signature.
* simplify.cc (gfc_simplify_num_images): Update signature and
remove undocumented failed argument.
(gfc_simplify_image_index): Add team or team number argument.
* trans-intrinsic.cc (conv_stat_and_team): Because being
optional teams need to be a pointer to the opaque pointer.
(conv_caf_sendget): Correct call; was two arguments short.
(trans_image_index): Support team or team_number.
(trans_num_images): Same.
(conv_intrinsic_cobound): Adapt to changed signature of
num_images in call.
* trans-stmt.cc (gfc_trans_sync): Same.

libgfortran/ChangeLog:

* caf/libcaf.h (_gfortran_caf_num_images): Correct prototype.
* caf/single.c (_gfortran_caf_num_images): Default
implementation.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray_49.f90: Adapt to changed error message.
* gfortran.dg/coarray_collectives_12.f90: Adapt to changed
function signature of num_images.
* gfortran.dg/coarray_collectives_16.f90: Same.
* gfortran.dg/coarray_lib_this_image_1.f90: Same.
* gfortran.dg/coarray_lib_this_image_2.f90: Same.
* gfortran.dg/coarray_this_image_1.f90: Adapt tests for
num_images.
* gfortran.dg/coarray_this_image_2.f90: Same.
* gfortran.dg/coarray_this_image_3.f90: Same.
* gfortran.dg/num_images_1.f90: Check that deprecated syntax is
no longer supported.

Diff:
---
 gcc/fortran/check.cc   | 63 ++---
 gcc/fortran/gfortran.texi  | 26 +
 gcc/fortran/intrinsic.cc   | 55 +-
 gcc/fortran/intrinsic.h| 10 ++--
 gcc/fortran/intrinsic.texi | 45 +++
 gcc/fortran/iresolve.cc|  3 +-
 gcc/fortran/simplify.cc| 12 +---
 gcc/fortran/trans-intrinsic.cc | 66 +-
 gcc/fortran/trans-stmt.cc  |  3 +-
 gcc/testsuite/gfortran.dg/coarray_49.f90   |  2 +-
 .../gfortran.dg/coarray_collectives_12.f90 |  2 +-
 .../gfortran.dg/coarray_collectives_16.f90 |  2 +-
 .../gfortran.dg/coarray_lib_this_image_1.f90   |  2 +-
 .../gfortran.dg/coarray_lib_this_image_2.f90   |  2 +-
 gcc/testsuite/gfortran.dg/coarray_this_image_1.f90 | 14 ++---
 gcc/testsuite/gfortran.dg/coarray_this_image_2.f90 | 16 +++---
 gcc/testsuite/gfortran.dg/coarray_this_image_3.f90 | 15 ++---
 gcc/testsuite/gfortran.dg/num_images_1.f90 |  2 +-
 libgfortran/caf/libcaf.h   |  2 +-
 libgfortran/caf/single.c   |  4 +-
 20 files changed, 171 insertions(+), 175 deletions(-)

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index c27f653d3b06..356e0d7f678c 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -6565,7 +6565,8 @@ gfc_check_stat_sub (gfc_expr *name, gfc_expr *array, 
gfc_expr *status)
 
 
 bool
-gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub)
+gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub,
+  gfc_expr *team_or_team_number)
 {
   mpz_t nelems;
 
@@ -6585,12 +6586,8 @@ gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub)
   return false;
 }
 
-  if (sub->ts.type != BT_INTEGER)
-{
-  gfc_error ("Type of %s argument of IMAGE_INDEX at %L shall be INTEGER",
-gfc_current_intrinsic_arg[1]->name, &sub->where);
-  re

[gcc r16-77] Fortran: Add team-support to this_image [PR87326]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:9ebd7c3b978dba986c44cbc61f94cd97f381cc62

commit r16-77-g9ebd7c3b978dba986c44cbc61f94cd97f381cc62
Author: Andre Vehreschild 
Date:   Tue Apr 1 12:17:43 2025 +0200

Fortran: Add team-support to this_image [PR87326]

This_image() no longer has a distance formal argument, but a team one.
The source of the distance argument could not be identified, i.e.
whether it came from a TS or standard draft.  To implement only the
standard it is removed.  Besides being defined, it was not used anyway.

PR fortran/87326

gcc/fortran/ChangeLog:

* check.cc (gfc_check_this_image): Check the three different
parameter lists possible for this_image and sort them correctly.
* gfortran.texi: Update documentation on this_image's API.
* intrinsic.cc (add_functions): Update this_image's signature.
(check_specific): Add specific check for this_image.
* intrinsic.h (gfc_check_this_image): Change to flexible
argument list.
* intrinsic.texi: Update documentation on this_image().
* iresolve.cc (gfc_resolve_this_image): Resolve the different
arguments.
* simplify.cc (gfc_simplify_this_image): Simplify the simplify
routine.
* trans-decl.cc (gfc_build_builtin_function_decls): Update
signature of this_image.
* trans-expr.cc (gfc_caf_get_image_index): Use correct signature
of this_image.
* trans-intrinsic.cc (trans_this_image): Adapt to correct
signature.

libgfortran/ChangeLog:

* caf/libcaf.h (_gfortran_caf_this_image): Correct prototype.
* caf/single.c (struct caf_single_team): Add new_index of image.
(_gfortran_caf_this_image): Return the image index in the given 
team.
(_gfortran_caf_form_team): Set new_index in team structure.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray_10.f90: Update error messages.
* gfortran.dg/coarray_lib_this_image_1.f90: Same.
* gfortran.dg/coarray_lib_this_image_2.f90: Same.
* gfortran.dg/coarray_this_image_1.f90: Add more tests and
remove incorrect ones.
* gfortran.dg/coarray_this_image_2.f90: Test more features.
* gfortran.dg/coarray_this_image_3.f90: New test.

Diff:
---
 gcc/fortran/check.cc   | 122 ++---
 gcc/fortran/gfortran.texi  |  16 +--
 gcc/fortran/intrinsic.cc   |  12 +-
 gcc/fortran/intrinsic.h|   2 +-
 gcc/fortran/intrinsic.texi |  30 +++--
 gcc/fortran/iresolve.cc|  23 +++-
 gcc/fortran/simplify.cc|   7 +-
 gcc/fortran/trans-decl.cc  |   6 +-
 gcc/fortran/trans-expr.cc  |   6 +-
 gcc/fortran/trans-intrinsic.cc |  39 +++
 gcc/testsuite/gfortran.dg/coarray_10.f90   |   2 +-
 .../gfortran.dg/coarray_lib_this_image_1.f90   |   2 +-
 .../gfortran.dg/coarray_lib_this_image_2.f90   |   2 +-
 gcc/testsuite/gfortran.dg/coarray_this_image_1.f90 |  49 -
 gcc/testsuite/gfortran.dg/coarray_this_image_2.f90 |  52 -
 gcc/testsuite/gfortran.dg/coarray_this_image_3.f90 |  34 ++
 libgfortran/caf/libcaf.h   |   2 +-
 libgfortran/caf/single.c   |  13 +--
 18 files changed, 290 insertions(+), 129 deletions(-)

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index a1c3de3e80dd..c27f653d3b06 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -6665,75 +6665,115 @@ gfc_check_team_number (gfc_expr *team)
 
 
 bool
-gfc_check_this_image (gfc_expr *coarray, gfc_expr *dim, gfc_expr *distance)
+gfc_check_this_image (gfc_actual_arglist *args)
 {
+  gfc_expr *coarray, *dim, *team, *cur;
+
+  coarray = dim = team = NULL;
+
   if (flag_coarray == GFC_FCOARRAY_NONE)
 {
   gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to 
enable");
   return false;
 }
 
-  if (coarray == NULL && dim == NULL && distance == NULL)
+  /* Shortcut when no arguments are given.  */
+  if (!args->expr && !args->next->expr && !args->next->next->expr)
 return true;
 
-  if (dim != NULL && coarray == NULL)
-{
-  gfc_error ("DIM argument without COARRAY argument not allowed for "
-"THIS_IMAGE intrinsic at %L", &dim->where);
-  return false;
-}
+  cur = args->expr;
 
-  if (distance && (coarray || dim))
+  if (cur)
 {
-  gfc_error ("The DISTANCE argument may not be specified together with the 
"
-"COARRAY or DIM argument in intrinsic at %L",
-&distance->where);
-  return false;
+  gfc_push_suppress_errors ();
+  if (coarray_check (

[gcc r16-79] Fortran: Various fixes on F2018 teams.

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:6e3b92848b529b1c4b7fc12fa3fe0f54df16ecec

commit r16-79-g6e3b92848b529b1c4b7fc12fa3fe0f54df16ecec
Author: Andre Vehreschild 
Date:   Tue Apr 15 15:21:26 2025 +0200

Fortran: Various fixes on F2018 teams.

gcc/fortran/ChangeLog:

* match.cc (match_exit_cycle): Allow to exit team block.
(gfc_match_end_team): Create end_team node also without
parameter list.
* trans-intrinsic.cc (conv_stat_and_team): Team and team_number
only need to be a single pointer.
* trans-stmt.cc (trans_associate_var): Create a mapping coarray
token for coarray associations or it is not addressed correctly.
* trans.h (enum gfc_coarray_regtype): Add mapping mode to
coarray register.

libgfortran/ChangeLog:

* caf/libcaf.h: Add mapping mode to coarray's register.
* caf/single.c (_gfortran_caf_register): Create a token sharing
another token's memory.
(check_team): Check team parameters to coindexed expressions are
valid.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/coindexed_3.f08: Add minimal test for
get_team().
* gfortran.dg/team_change_2.f90: Add test for change team with
label and exiting out of it.
* gfortran.dg/team_end_2.f90: Check parsing to labeled team
blocks is correct now.
* gfortran.dg/team_end_3.f90: Check that end_team call is
generated for labeled end_teams, too.
* gfortran.dg/coarray/coindexed_5.f90: New test.

Diff:
---
 gcc/fortran/match.cc  | 10 ++-
 gcc/fortran/trans-intrinsic.cc|  4 +-
 gcc/fortran/trans-stmt.cc | 24 +++
 gcc/fortran/trans.h   |  4 +-
 gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08 |  1 +
 gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90 | 80 +++
 gcc/testsuite/gfortran.dg/team_change_2.f90   |  7 ++
 gcc/testsuite/gfortran.dg/team_end_2.f90  |  9 +++
 gcc/testsuite/gfortran.dg/team_end_3.f90  |  8 ++-
 libgfortran/caf/libcaf.h  |  9 +--
 libgfortran/caf/single.c  | 60 ++---
 11 files changed, 193 insertions(+), 23 deletions(-)

diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 0d81b69025e0..474ba81b2aa0 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -3325,6 +3325,7 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
 
 case COMP_ASSOCIATE:
 case COMP_BLOCK:
+case COMP_CHANGE_TEAM:
 case COMP_IF:
 case COMP_SELECT:
 case COMP_SELECT_TYPE:
@@ -4162,9 +4163,12 @@ gfc_match_end_team (void)
 goto done;
 
   if (gfc_match_char ('(') != MATCH_YES)
-/* There could be a team-construct-name following.  Let caller decide
-   about error.  */
-return MATCH_NO;
+{
+  /* There could be a team-construct-name following.  Let caller decide
+about error.  */
+  new_st.op = EXEC_END_TEAM;
+  return MATCH_NO;
+}
 
   for (;;)
 {
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index f388ba5bc81d..440cbdd19abc 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1183,7 +1183,7 @@ conv_stat_and_team (stmtblock_t *block, gfc_expr *expr, 
tree *stat, tree *team,
 {
   gfc_se team_se;
   gfc_init_se (&team_se, NULL);
-  gfc_conv_expr_reference (&team_se, team_e);
+  gfc_conv_expr (&team_se, team_e);
   *team
= gfc_build_addr_expr (NULL_TREE, gfc_trans_force_lval (&team_se.pre,
team_se.expr));
@@ -1198,7 +1198,7 @@ conv_stat_and_team (stmtblock_t *block, gfc_expr *expr, 
tree *stat, tree *team,
 {
   gfc_se team_se;
   gfc_init_se (&team_se, NULL);
-  gfc_conv_expr_reference (&team_se, team_e);
+  gfc_conv_expr (&team_se, team_e);
   *team_no = gfc_build_addr_expr (
NULL_TREE,
gfc_trans_force_lval (&team_se.pre,
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 11fc1a8ff064..487b7687ef14 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2056,6 +2056,30 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block 
*block)
 
   gfc_conv_expr_descriptor (&se, e);
 
+  if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+   {
+ tree token = gfc_conv_descriptor_token (se.expr),
+  size
+  = sym->attr.dimension
+  ? fold_build2 (MULT_EXPR, gfc_array_index_type,
+ gfc_conv_descriptor_size (se.expr, e->rank),
+ gfc_conv_descriptor_span_get (se.expr))
+  : gfc_conv_descriptor_span_get (se.expr);
+

[gcc r16-94] Fortran: Use correct location in check of coarray functions [PR119200]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:cc2716a3f521bba81e9eb39705b30504e62ee6fe

commit r16-94-gcc2716a3f521bba81e9eb39705b30504e62ee6fe
Author: Andre Vehreschild 
Date:   Tue Apr 22 10:11:52 2025 +0200

Fortran: Use correct location in check of coarray functions [PR119200]

Use gfc_current_intrinsic_where during check(), because
gfc_current_locus is not set to correct location or at all.

PR fortran/119200

gcc/fortran/ChangeLog:

* check.cc (gfc_check_lcobound): Use locus from intrinsic_where.
(gfc_check_image_index): Same.
(gfc_check_num_images): Same.
(gfc_check_team_number): Same.
(gfc_check_this_image): Same.
(gfc_check_ucobound): Same.

Diff:
---
 gcc/fortran/check.cc | 18 --
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 356e0d7f678c..299c216cf36c 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -3835,7 +3835,8 @@ gfc_check_lcobound (gfc_expr *coarray, gfc_expr *dim, 
gfc_expr *kind)
 {
   if (flag_coarray == GFC_FCOARRAY_NONE)
 {
-  gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to 
enable");
+  gfc_fatal_error ("Coarrays disabled at %L, use %<-fcoarray=%> to enable",
+  gfc_current_intrinsic_where);
   return false;
 }
 
@@ -6572,7 +6573,8 @@ gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub,
 
   if (flag_coarray == GFC_FCOARRAY_NONE)
 {
-  gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to 
enable");
+  gfc_fatal_error ("Coarrays disabled at %L, use %<-fcoarray=%> to enable",
+  gfc_current_intrinsic_where);
   return false;
 }
 
@@ -6622,7 +6624,8 @@ gfc_check_num_images (gfc_expr *team_or_team_number)
 {
   if (flag_coarray == GFC_FCOARRAY_NONE)
 {
-  gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to 
enable");
+  gfc_fatal_error ("Coarrays disabled at %L, use %<-fcoarray=%> to enable",
+  gfc_current_intrinsic_where);
   return false;
 }
 
@@ -6651,7 +6654,8 @@ gfc_check_team_number (gfc_expr *team)
 {
   if (flag_coarray == GFC_FCOARRAY_NONE)
 {
-  gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to 
enable");
+  gfc_fatal_error ("Coarrays disabled at %L, use %<-fcoarray=%> to enable",
+  gfc_current_intrinsic_where);
   return false;
 }
 
@@ -6668,7 +6672,8 @@ gfc_check_this_image (gfc_actual_arglist *args)
 
   if (flag_coarray == GFC_FCOARRAY_NONE)
 {
-  gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to 
enable");
+  gfc_fatal_error ("Coarrays disabled at %L, use %<-fcoarray=%> to enable",
+  gfc_current_intrinsic_where);
   return false;
 }
 
@@ -6967,7 +6972,8 @@ gfc_check_ucobound (gfc_expr *coarray, gfc_expr *dim, 
gfc_expr *kind)
 {
   if (flag_coarray == GFC_FCOARRAY_NONE)
 {
-  gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to 
enable");
+  gfc_fatal_error ("Coarrays disabled at %L, use %<-fcoarray=%> to enable",
+  gfc_current_intrinsic_where);
   return false;
 }

[gcc r15-7747] Fortran: Ensure finalizer is called for unreferenced variable [PR118730]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:c1606e383a3c3abd260dfbb1177637abf05dd9a2

commit r15-7747-gc1606e383a3c3abd260dfbb1177637abf05dd9a2
Author: Andre Vehreschild 
Date:   Thu Feb 27 12:27:10 2025 +0100

Fortran: Ensure finalizer is called for unreferenced variable [PR118730]

PR fortran/118730

gcc/fortran/ChangeLog:

* resolve.cc: Mark unused derived type variable with finalizers
referenced to execute finalizer when leaving scope.

gcc/testsuite/ChangeLog:

* gfortran.dg/class_array_15.f03: Remove unused variable.
* gfortran.dg/coarray_poly_7.f90: Adapt scan-tree-dump expr.
* gfortran.dg/coarray_poly_8.f90: Same.
* gfortran.dg/finalize_60.f90: New test.

Diff:
---
 gcc/fortran/resolve.cc   |  8 +++
 gcc/testsuite/gfortran.dg/class_array_15.f03 |  2 +-
 gcc/testsuite/gfortran.dg/coarray_poly_7.f90 |  2 +-
 gcc/testsuite/gfortran.dg/coarray_poly_8.f90 |  2 +-
 gcc/testsuite/gfortran.dg/finalize_60.f90| 33 
 5 files changed, 44 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 6a83a7967a8b..f83d122a3a21 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -17063,6 +17063,14 @@ skip_interfaces:
   return;
 }
 
+  /* Ensure that variables of derived or class type having a finalizer are
+ marked used even when the variable is not used anything else in the scope.
+ This fixes PR118730.  */
+  if (sym->attr.flavor == FL_VARIABLE && !sym->attr.referenced
+  && (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
+  && gfc_may_be_finalized (sym->ts))
+gfc_set_sym_referenced (sym);
+
   if (sym->attr.flavor == FL_DERIVED && !resolve_fl_derived (sym))
 return;
 
diff --git a/gcc/testsuite/gfortran.dg/class_array_15.f03 
b/gcc/testsuite/gfortran.dg/class_array_15.f03
index 332b39833ebf..f53b2356952a 100644
--- a/gcc/testsuite/gfortran.dg/class_array_15.f03
+++ b/gcc/testsuite/gfortran.dg/class_array_15.f03
@@ -100,7 +100,7 @@ subroutine pr54992  ! This test remains as the original.
   implicit none
   type (tn), target  :: b
   class(ncBh), pointer :: bh
-  class(ncBh), allocatable, dimension(:) :: t
+
   allocate(b%cBh(1),source=defaultBhC)
   b%cBh(1)%hostNode => b
 ! #1 this worked
diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 
b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
index d8d83aea39b5..21a3054f59c9 100644
--- a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
@@ -18,4 +18,4 @@ end
 ! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & 
restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) 
caf_offset..\\)" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* 
restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) 
caf_offset..\\)" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data.token, 
\\(integer\\(kind=\[48\]\\)\\) class..._data.data - 
\\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&class.\[0-9\]+, y._data.token, 
\\(integer\\(kind=\[48\]\\)\\) class.\[0-9\]+._data.data - 
\\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 
b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
index abdfc0ca5f82..9ceece419aeb 100644
--- a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
@@ -18,4 +18,4 @@ end
 ! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & 
restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) 
caf_offset..\\)" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* 
restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) 
caf_offset..\\)" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data.token, 
\\(integer\\(kind=\[48\]\\)\\) class..._data.data - 
\\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&class.\[0-9\]+, y._data.token, 
\\(integer\\(kind=\[48\]\\)\\) class.\[0-9\]+._data.data - 
\\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_60.f90 
b/gcc/testsuite/gfortran.dg/finalize_60.f90
new file mode 100644
index ..1ce50b3a3f4f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_60.f90
@@ -0,0 +1,33 @@
+!{ dg-do run }
+!
+! Check that the finalizer is called on unused variables too.
+! Contributed by LXYAN  
+
+module pr118730_mod
+  implicit none
+
+  logical :: finished = .FALSE.
+

[gcc r15-7789] Fortran: Fix regression on double free on elemental function [PR118747]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:43c11931acc50f3a44efb485b03e6a8d44df97e0

commit r15-7789-g43c11931acc50f3a44efb485b03e6a8d44df97e0
Author: Andre Vehreschild 
Date:   Wed Feb 26 14:30:13 2025 +0100

Fortran: Fix regression on double free on elemental function [PR118747]

Fix a regression were adding a temporary variable inserted a copy of the
argument to the elemental function.  That copy was then later used to
free allocated memory, but the freeing was not tracked in the source
array correctly.

PR fortran/118747

gcc/fortran/ChangeLog:

* trans-array.cc (gfc_trans_array_ctor_element): Remove copy to
temporary variable.
* trans-expr.cc (gfc_conv_procedure_call): Use references to
array members instead of copies when freeing after use.
Formatting fix.

gcc/testsuite/ChangeLog:

* gfortran.dg/alloc_comp_auto_array_4.f90: New test.

Diff:
---
 gcc/fortran/trans-array.cc | 11 -
 gcc/fortran/trans-expr.cc  | 13 ---
 .../gfortran.dg/alloc_comp_auto_array_4.f90| 27 ++
 3 files changed, 41 insertions(+), 10 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8f76870b286a..6a00d26cb2f3 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2002,13 +2002,10 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, 
tree desc,
 
   if (expr->expr_type == EXPR_FUNCTION && expr->ts.type == BT_DERIVED
   && expr->ts.u.derived->attr.alloc_comp)
-{
-  if (!VAR_P (se->expr))
-   se->expr = gfc_evaluate_now (se->expr, &se->pre);
-  gfc_add_expr_to_block (&se->finalblock,
-gfc_deallocate_alloc_comp_no_caf (
-  expr->ts.u.derived, se->expr, expr->rank, true));
-}
+gfc_add_expr_to_block (&se->finalblock,
+  gfc_deallocate_alloc_comp_no_caf (expr->ts.u.derived,
+tmp, expr->rank,
+true));
 
   if (expr->ts.type == BT_CHARACTER)
 {
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ab55940638e2..e619013f261e 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6999,6 +6999,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
  if ((fsym && fsym->attr.value)
  || (ulim_copy && (argc == 2 || argc == 3)))
gfc_conv_expr (&parmse, e);
+ else if (e->expr_type == EXPR_ARRAY)
+   {
+ gfc_conv_expr (&parmse, e);
+ if (e->ts.type != BT_CHARACTER)
+   parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
+   }
  else
gfc_conv_expr_reference (&parmse, e);
 
@@ -7930,11 +7936,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
  /* It is known the e returns a structure type with at least one
 allocatable component.  When e is a function, ensure that the
 function is called once only by using a temporary variable.  */
- if (!DECL_P (parmse.expr))
+ if (!DECL_P (parmse.expr) && e->expr_type == EXPR_FUNCTION)
parmse.expr = gfc_evaluate_now_loc (input_location,
parmse.expr, &se->pre);
 
- if (fsym && fsym->attr.value)
+ if ((fsym && fsym->attr.value) || e->expr_type == EXPR_ARRAY)
tmp = parmse.expr;
  else
tmp = build_fold_indirect_ref_loc (input_location,
@@ -7993,7 +7999,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
  /* Scalars passed to an assumed rank argument are converted to
 a descriptor. Obtain the data field before deallocating any
 allocatable components.  */
- if (parm_rank == 0 && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ if (parm_rank == 0 && e->expr_type != EXPR_ARRAY
+ && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
tmp = gfc_conv_descriptor_data_get (tmp);
 
  if (scalar_res_outside_loop)
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_4.f90 
b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_4.f90
new file mode 100644
index ..06bd8b50b967
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_4.f90
@@ -0,0 +1,27 @@
+!{ dg-do run }
+
+! Check freeing derived typed result's allocatable components is not done 
twice.
+! Contributed by Damian Rouson  
+
+program pr118747
+  implicit none
+
+  type string_t
+character(len=:), allocatable :: string_
+  end type
+
+  call check_allocation([foo(), foo()])
+
+contains
+
+  type(string_t) function foo()
+foo%string_ = "foo"
+  end function
+
+  elemental subroutine check_allocation(string)
+

[gcc r15-7804] Fortran: Prevent ICE when getting caf-token from abstract type [PR77872]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:5bd664838398980f1c8af60a946947ff83744fcc

commit r15-7804-g5bd664838398980f1c8af60a946947ff83744fcc
Author: Andre Vehreschild 
Date:   Mon Mar 3 14:42:28 2025 +0100

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.

Diff:
---
 gcc/fortran/trans-expr.cc |  5 +
 gcc/testsuite/gfortran.dg/coarray/class_1.f90 | 16 
 2 files changed, 21 insertions(+)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 7c0b17428cdd..0d790b63f956 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 ..fa70b1d61629
--- /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

[gcc r15-7803] Fortran: Reduce code complexity [PR77872]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:ef605e106c6075bfe2a5625add7185a9a3f722b1

commit r15-7803-gef605e106c6075bfe2a5625add7185a9a3f722b1
Author: Andre Vehreschild 
Date:   Mon Mar 3 10:41:05 2025 +0100

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.

Diff:
---
 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 e619013f261e..7c0b17428cdd 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;

[gcc r15-7812] Fortran: Fix gimplification error on assignment to pointer [PR103391]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:04909c7ecc023874c3444b85f88c60b7b7cc7778

commit r15-7812-g04909c7ecc023874c3444b85f88c60b7b7cc7778
Author: Andre Vehreschild 
Date:   Tue Mar 4 12:56:20 2025 +0100

Fortran: Fix gimplification error on assignment to pointer [PR103391]

PR fortran/103391

gcc/fortran/ChangeLog:

* trans-expr.cc (gfc_trans_assignment_1): Do not use poly assign
for pointer arrays on lhs (as it is done for allocatables
already).

gcc/testsuite/ChangeLog:

* gfortran.dg/assign_12.f90: New test.

Diff:
---
 gcc/fortran/trans-expr.cc   | 16 
 gcc/testsuite/gfortran.dg/assign_12.f90 | 28 
 2 files changed, 36 insertions(+), 8 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0d790b63f956..fbe7333fd711 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -12876,14 +12876,14 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * 
expr2, bool init_flag,
  needed.  */
   lhs_attr = gfc_expr_attr (expr1);
 
-  is_poly_assign = (use_vptr_copy || lhs_attr.pointer
-   || (lhs_attr.allocatable && !lhs_attr.dimension))
-  && (expr1->ts.type == BT_CLASS
-  || gfc_is_class_array_ref (expr1, NULL)
-  || gfc_is_class_scalar_expr (expr1)
-  || gfc_is_class_array_ref (expr2, NULL)
-  || gfc_is_class_scalar_expr (expr2))
-  && lhs_attr.flavor != FL_PROCEDURE;
+  is_poly_assign
+= (use_vptr_copy
+   || ((lhs_attr.pointer || lhs_attr.allocatable) && !lhs_attr.dimension))
+  && (expr1->ts.type == BT_CLASS || gfc_is_class_array_ref (expr1, NULL)
+ || gfc_is_class_scalar_expr (expr1)
+ || gfc_is_class_array_ref (expr2, NULL)
+ || gfc_is_class_scalar_expr (expr2))
+  && lhs_attr.flavor != FL_PROCEDURE;
 
   assoc_assign = is_assoc_assign (expr1, expr2);
 
diff --git a/gcc/testsuite/gfortran.dg/assign_12.f90 
b/gcc/testsuite/gfortran.dg/assign_12.f90
new file mode 100644
index ..be31021f24c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_12.f90
@@ -0,0 +1,28 @@
+!{ dg-do run }
+!
+! Check assignment works for derived types to memory referenced by pointer
+! Contributed by G. Steinmetz  
+
+program pr103391
+   type t
+ character(1) :: c
+   end type
+   type t2
+  type(t), pointer :: a(:)
+   end type
+
+   type(t), target :: arr(2)
+   type(t2) :: r
+
+   arr = [t('a'), t('b')]
+
+   r = f([arr])
+   if (any(r%a(:)%c /= ['a', 'b'])) stop 1
+contains
+   function f(x)
+  class(t), intent(in), target :: x(:)
+  type(t2) :: f
+  allocate(f%a(size(x,1)))
+  f%a = x
+   end
+end

[gcc r15-7925] Fortran: Fix gimplification error for pointer remapping in forall [PR107143]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:f2339cefd6985e20014f9b0795fb651a96788246

commit r15-7925-gf2339cefd6985e20014f9b0795fb651a96788246
Author: Andre Vehreschild 
Date:   Wed Mar 5 15:18:48 2025 +0100

Fortran: Fix gimplification error for pointer remapping in forall [PR107143]

Enhance dependency checking for data pointers to check for same derived
type and not only for a type being a derived type.  This prevent
generation of a descriptor for a function call, that is unsuitable in
forall's pointer assignment.

PR fortran/107143

gcc/fortran/ChangeLog:

* dependency.cc (check_data_pointer_types): Do not just compare
for derived type, but for same derived type.

gcc/testsuite/ChangeLog:

* gfortran.dg/forall_20.f90: New test.

Diff:
---
 gcc/fortran/dependency.cc   |  3 ++-
 gcc/testsuite/gfortran.dg/forall_20.f90 | 40 +
 2 files changed, 42 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index 8354b185f347..28b872f66382 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -1250,7 +1250,8 @@ check_data_pointer_types (gfc_expr *expr1, gfc_expr 
*expr2)
   sym2 = expr2->symtree->n.sym;
 
   /* Keep it simple for now.  */
-  if (sym1->ts.type == BT_DERIVED && sym2->ts.type == BT_DERIVED)
+  if (sym1->ts.type == BT_DERIVED && sym2->ts.type == BT_DERIVED
+  && sym1->ts.u.derived == sym2->ts.u.derived)
 return false;
 
   if (sym1->attr.pointer)
diff --git a/gcc/testsuite/gfortran.dg/forall_20.f90 
b/gcc/testsuite/gfortran.dg/forall_20.f90
new file mode 100644
index ..b0bb0dcb62fd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_20.f90
@@ -0,0 +1,40 @@
+!{ dg-do run }
+!
+! Check pointer aliasing is done w/o temp.
+! Contributed by Arseny Solokha  
+
+program pr107143
+  type ta
+ integer, POINTER :: ip(:)
+  end type ta
+
+  type tb
+ integer, POINTER :: ip(:,:)
+  end type tb
+
+  integer, parameter :: cnt = 3
+  type(ta) :: a(cnt)
+  type(tb) :: b(cnt)
+  integer, target :: arr(8) = [1,2,3,4,5,6,7,8]
+
+  do i = 1, cnt
+allocate(a(i)%ip(8), SOURCE=arr * i)
+  end do
+  call s5(b, a, 2, 4)
+
+  do i = 1, cnt
+if (any(b(i)%ip /= reshape(arr * i, [2, 4]))) stop i
+  end do
+
+contains
+
+subroutine s5(y,z,n1,n2)
+
+  type(tb) :: y(:)
+  type(ta), TARGET :: z(:)
+
+  forall (i=1:cnt)
+y(i)%ip(1:n1,1:n2) => z(i)%ip
+  end forall
+end subroutine s5
+end program

[gcc r15-7726] Fortran: Fix ICE on associate of pointer [PR118789]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:0fc1abcc46ecc34e8d2d7ec7167656ede2cd5690

commit r15-7726-g0fc1abcc46ecc34e8d2d7ec7167656ede2cd5690
Author: Andre Vehreschild 
Date:   Tue Feb 25 17:15:47 2025 +0100

Fortran: Fix ICE on associate of pointer [PR118789]

Fix ICE when associating a pointer to void (c_ptr) by looking at the
compatibility of the type hierarchy.

PR fortran/118789

gcc/fortran/ChangeLog:

* trans-stmt.cc (trans_associate_var): Compare pointed to types when
expr to associate is already a pointer.

gcc/testsuite/ChangeLog:

* gfortran.dg/associate_73.f90: New test.

Diff:
---
 gcc/fortran/trans-stmt.cc  |  7 ++-
 gcc/testsuite/gfortran.dg/associate_73.f90 | 21 +
 2 files changed, 27 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index e7da8fea3b24..f16e1e3b46e3 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2287,7 +2287,12 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block 
*block)
  tmp = se.expr;
}
}
- if (!POINTER_TYPE_P (TREE_TYPE (se.expr)))
+ /* For non-pointer types in se.expr, the first condition holds.
+For pointer or reference types in se.expr, a double TREE_TYPE ()
+is possible and an associate variable always is a pointer.  */
+ if (!POINTER_TYPE_P (TREE_TYPE (se.expr))
+ || TREE_TYPE (TREE_TYPE (se.expr))
+  != TREE_TYPE (TREE_TYPE (sym->backend_decl)))
tmp = gfc_build_addr_expr (tmp, se.expr);
}
 
diff --git a/gcc/testsuite/gfortran.dg/associate_73.f90 
b/gcc/testsuite/gfortran.dg/associate_73.f90
new file mode 100644
index ..a5c3ca79b9cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_73.f90
@@ -0,0 +1,21 @@
+!{ dg-do compile }
+
+! Check associate to a "void *" does not ICE.
+! Contributed by Matthias Klose  
+! and Steve Kargl  
+
+module pr118789
+
+   implicit none
+
+   CONTAINS
+
+   subroutine fckit_c_nodelete(cptr) bind(c)
+  use, intrinsic :: iso_c_binding
+  type(c_ptr), value :: cptr
+  associate( unused_ => cptr )
+  end associate
+   end subroutine
+
+end module
+

[gcc r15-7826] Fortran: Add view convert to pointer assign when only pointer/alloc attr differs [PR104684]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:705ae582d519f1230de3ec0d75a75e72341a674e

commit r15-7826-g705ae582d519f1230de3ec0d75a75e72341a674e
Author: Andre Vehreschild 
Date:   Tue Mar 4 17:06:31 2025 +0100

Fortran: Add view convert to pointer assign when only pointer/alloc attr 
differs [PR104684]

PR fortran/104684

gcc/fortran/ChangeLog:

* trans-array.cc (gfc_conv_expr_descriptor): Look at the
lang-specific akind and do a view convert when only the akind
attribute differs between pointer and allocatable array.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/ptr_comp_6.f08: New test.

Diff:
---
 gcc/fortran/trans-array.cc   | 10 +-
 gcc/testsuite/gfortran.dg/coarray/ptr_comp_6.f08 | 25 
 2 files changed, 34 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 6a00d26cb2f3..925030465ac3 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8186,8 +8186,16 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
{
  if (se->direct_byref && !se->byref_noassign)
{
+ struct lang_type *lhs_ls
+   = TYPE_LANG_SPECIFIC (TREE_TYPE (se->expr)),
+   *rhs_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (desc));
+ /* When only the array_kind differs, do a view_convert.  */
+ tmp = lhs_ls && rhs_ls && lhs_ls->rank == rhs_ls->rank
+   && lhs_ls->akind != rhs_ls->akind
+ ? build1 (VIEW_CONVERT_EXPR, TREE_TYPE (se->expr), desc)
+ : desc;
  /* Copy the descriptor for pointer assignments.  */
- gfc_add_modify (&se->pre, se->expr, desc);
+ gfc_add_modify (&se->pre, se->expr, tmp);
 
  /* Add any offsets from subreferences.  */
  gfc_get_dataptr_offset (&se->pre, se->expr, desc, NULL_TREE,
diff --git a/gcc/testsuite/gfortran.dg/coarray/ptr_comp_6.f08 
b/gcc/testsuite/gfortran.dg/coarray/ptr_comp_6.f08
new file mode 100644
index ..397a09bc8bc2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/ptr_comp_6.f08
@@ -0,0 +1,25 @@
+!{ dg-do run }
+!
+! Contributed by Arseny Solokha  
+
+program pr104684
+  type :: index_map
+integer, allocatable :: send_index(:)
+  end type
+  type(index_map) :: imap
+
+  imap%send_index = [5,4,3]
+  call sub(imap)
+contains
+  subroutine sub(this)
+type(index_map), intent(inout), target :: this
+type :: box
+  integer, pointer :: array(:)
+end type
+type(box), allocatable :: buffer[:]
+allocate(buffer[*])
+buffer%array => this%send_index
+if (any(buffer%array /= [5,4,3])) stop 1
+  end subroutine
+end program
+

[gcc r15-7997] Fortran: Add F2018 TEAM_NUMBER to coindexed expressions [PR98903]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:baa9b2b8d2eef7177118652d93ca0e7c933ba174

commit r15-7997-gbaa9b2b8d2eef7177118652d93ca0e7c933ba174
Author: Andre Vehreschild 
Date:   Thu Mar 6 15:14:24 2025 +0100

Fortran: Add F2018 TEAM_NUMBER to coindexed expressions [PR98903]

Add missing parsing and code generation for a[..., TEAM_NUMBER=...] as
defined from F2015 onwards.  Because F2015 is not used as dedicated
standard in GFortran add it to the F2018 standard feature set.

PR fortran/98903

gcc/fortran/ChangeLog:

* array.cc (gfc_copy_array_ref): Copy team, team_type and stat.
(match_team_or_stat): Match a single team(_number)= or stat=.
(gfc_match_array_ref): Add switching to image_selector_parsing
and error handling when indices come after named arguments.
* coarray.cc (move_coarray_ref): Move also team_type.
* expr.cc (gfc_free_ref_list): Free team and stat expression.
(gfc_find_team_co): Find team or team_number in array-ref.
* gfortran.h (enum gfc_array_ref_team_type): New enum to
distinguish unset, team or team_number expression.
(gfc_find_team_co): Default searching to team= expressions.
* resolve.cc (resolve_array_ref): Check for type correctness of
team(_number) and stats in coindices.
* trans-array.cc (gfc_conv_array_ref): Ensure stat is cleared
when fcoarray=single is used.
* trans-intrinsic.cc (conv_stat_and_team): Including team_number
in conversion.
(gfc_conv_intrinsic_caf_get): Propagate team_number to ABI
routine.
(conv_caf_send_to_remote): Same.
(conv_caf_sendget): Same.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/coindexed_2.f90: New test.
* gfortran.dg/coarray/coindexed_3.f08: New test.
* gfortran.dg/coarray/coindexed_4.f08: New test.

Diff:
---
 gcc/fortran/array.cc  | 172 +++---
 gcc/fortran/coarray.cc|   2 +
 gcc/fortran/expr.cc   |  12 +-
 gcc/fortran/gfortran.h|   9 +-
 gcc/fortran/resolve.cc|  75 ++
 gcc/fortran/trans-array.cc|   9 ++
 gcc/fortran/trans-intrinsic.cc|  50 ---
 gcc/testsuite/gfortran.dg/coarray/coindexed_2.f90 |  44 ++
 gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08 |  30 
 gcc/testsuite/gfortran.dg/coarray/coindexed_4.f08 |  13 ++
 10 files changed, 342 insertions(+), 74 deletions(-)

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 841a0ac4a844..fa177fa91f7e 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -51,6 +51,9 @@ gfc_copy_array_ref (gfc_array_ref *src)
   dest->stride[i] = gfc_copy_expr (src->stride[i]);
 }
 
+  dest->stat = gfc_copy_expr (src->stat);
+  dest->team = gfc_copy_expr (src->team);
+
   return dest;
 }
 
@@ -172,6 +175,76 @@ matched:
   return (saw_boz ? MATCH_ERROR : MATCH_YES);
 }
 
+/** Match one of TEAM=, TEAM_NUMBER= or STAT=.  */
+
+match
+match_team_or_stat (gfc_array_ref *ar)
+{
+  gfc_expr *tmp;
+  bool team_error = false;
+
+  if (gfc_match (" team = %e", &tmp) == MATCH_YES)
+{
+  if (ar->team == NULL && ar->team_type == TEAM_UNSET)
+   {
+ ar->team = tmp;
+ ar->team_type = TEAM_TEAM;
+   }
+  else if (ar->team_type == TEAM_TEAM)
+   {
+ gfc_error ("Duplicate TEAM= attribute in %C");
+ return MATCH_ERROR;
+   }
+  else
+   team_error = true;
+}
+  else if (gfc_match (" team_number = %e", &tmp) == MATCH_YES)
+{
+  if (!gfc_notify_std (GFC_STD_F2018, "TEAM_NUMBER= not supported at %C"))
+   return MATCH_ERROR;
+  if (ar->team == NULL && ar->team_type == TEAM_UNSET)
+   {
+ ar->team = tmp;
+ ar->team_type = TEAM_NUMBER;
+   }
+  else if (ar->team_type == TEAM_NUMBER)
+   {
+ gfc_error ("Duplicate TEAM_NUMBER= attribute in %C");
+ return MATCH_ERROR;
+   }
+  else
+   team_error = true;
+}
+  else if (gfc_match (" stat = %e", &tmp) == MATCH_YES)
+{
+  if (ar->stat == NULL)
+   {
+ if (gfc_is_coindexed (tmp))
+   {
+ gfc_error ("Expression in STAT= at %C must not be coindexed");
+ gfc_free_expr (tmp);
+ return MATCH_ERROR;
+   }
+ ar->stat = tmp;
+   }
+  else
+   {
+ gfc_error ("Duplicate STAT= attribute in %C");
+ return MATCH_ERROR;
+   }
+}
+  else
+return MATCH_NO;
+
+  if (ar->team && team_error)
+{
+  gfc_error ("Only one of TEAM= or TEAM_NUMBER= may appear in a "
+"coarray reference at %C");
+  return MATCH_ERROR;
+}
+
+  return MATCH_YES;
+}
 
 /* Match an array r

[gcc r15-7662] Fortran: Fix build on solaris [PR107635]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:08bdc2ac98ae05ef694f4e55c296835fc01a3673

commit r15-7662-g08bdc2ac98ae05ef694f4e55c296835fc01a3673
Author: Andre Vehreschild 
Date:   Fri Feb 21 08:18:40 2025 +0100

Fortran: Fix build on solaris [PR107635]

libgfortran/ChangeLog:

PR fortran/107635
* caf/single.c: Replace alloca with __builtin_alloca.

Diff:
---
 libgfortran/caf/single.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index d4e081be4dd7..9c1c0c1bc8ca 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -672,12 +672,12 @@ _gfortran_caf_transfer_between_remotes (
   if (!scalar_transfer)
 {
   const size_t desc_size = sizeof (*transfer_desc);
-  transfer_desc = alloca (desc_size);
+  transfer_desc = __builtin_alloca (desc_size);
   memset (transfer_desc, 0, desc_size);
   transfer_ptr = transfer_desc;
 }
   else if (opt_dst_charlen)
-transfer_ptr = alloca (*opt_dst_charlen * src_size);
+transfer_ptr = __builtin_alloca (*opt_dst_charlen * src_size);
   else
 {
   buffer = NULL;

[gcc r15-7641] Fortran: Add caf_is_present_on_remote. [PR107635]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:15847252648ede9d2ad9eea398b7b870f62a2b30

commit r15-7641-g15847252648ede9d2ad9eea398b7b870f62a2b30
Author: Andre Vehreschild 
Date:   Wed Jan 22 15:12:29 2025 +0100

Fortran: Add caf_is_present_on_remote. [PR107635]

Replace caf_is_present by caf_is_present_on_remote which is using a
dedicated callback for each object to test on the remote image.

gcc/fortran/ChangeLog:

PR fortran/107635

* coarray.cc (create_allocated_callback): Add creating remote
side procedure for checking allocation status of coarray.
(rewrite_caf_allocated): Rewrite ALLOCATED on coarray to use caf
routine.
(coindexed_expr_callback): Exempt caf_is_present_on_remote from
being rewritten again.
* gfortran.h (enum gfc_isym_id): Add caf_is_present_on_remote
id.
* gfortran.texi: Add documentation for caf_is_present_on_remote.
* intrinsic.cc (add_functions): Add caf_is_present_on_remote
symbol.
* trans-decl.cc (gfc_build_builtin_function_decls): Define
interface of caf_is_present_on_remote.
* trans-intrinsic.cc (gfc_conv_intrinsic_caf_is_present_remote):
Translate caf_is_present_on_remote.
(trans_caf_is_present): Remove.
(caf_this_image_ref): Remove.
(gfc_conv_allocated): Take out coarray treatment, because that
is rewritten to caf_is_present_on_remote now.
(gfc_conv_intrinsic_function): Handle caf_is_present_on_remote
calls.
* trans.h: Add symbol for caf_is_present_on_remote and remove
old one.

libgfortran/ChangeLog:

* caf/libcaf.h (_gfortran_caf_is_present_on_remote): Add new
function.
(_gfortran_caf_is_present): Remove deprecated one.
* caf/single.c (struct accessor_hash_t): Add function ptr access
for remote side call.
(_gfortran_caf_is_present_on_remote): Added.
(_gfortran_caf_is_present): Removed.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/coarray_allocated.f90: Adapt to new method
of checking on remote image.
* gfortran.dg/coarray_lib_alloc_4.f90: Same.

Diff:
---
 gcc/fortran/coarray.cc | 157 +
 gcc/fortran/gfortran.h |   1 +
 gcc/fortran/gfortran.texi  |  34 +
 gcc/fortran/intrinsic.cc   |   7 +
 gcc/fortran/trans-decl.cc  |  11 +-
 gcc/fortran/trans-intrinsic.cc | 136 --
 gcc/fortran/trans.h|   2 +-
 .../gfortran.dg/coarray/coarray_allocated.f90  |  16 +--
 gcc/testsuite/gfortran.dg/coarray_lib_alloc_4.f90  |   2 +-
 libgfortran/caf/libcaf.h   |   5 +-
 libgfortran/caf/single.c   | 126 -
 11 files changed, 297 insertions(+), 200 deletions(-)

diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
index fb211715581b..c4e637e0f519 100644
--- a/gcc/fortran/coarray.cc
+++ b/gcc/fortran/coarray.cc
@@ -942,6 +942,154 @@ add_caf_get_from_remote (gfc_expr *e)
   free (wrapper);
 }
 
+static gfc_expr *
+create_allocated_callback (gfc_expr *expr)
+{
+  gfc_namespace *ns;
+  gfc_symbol *extproc, *proc, *result, *base, *add_data, *caller_image;
+  char tname[GFC_MAX_SYMBOL_LEN + 1];
+  char *name;
+  const char *mname;
+  gfc_expr *cb, *post_caf_ref_expr;
+  gfc_code *code;
+  gfc_code *backup_caf_accessor_prepend = caf_accessor_prepend;
+  caf_accessor_prepend = nullptr;
+  gfc_expr swp;
+
+  /* Find the top-level namespace.  */
+  for (ns = gfc_current_ns; ns->parent; ns = ns->parent)
+;
+
+  if (expr->value.function.actual->expr->expr_type == EXPR_VARIABLE)
+strcpy (tname, expr->value.function.actual->expr->symtree->name);
+  else
+strcpy (tname, "dummy");
+  if (expr->value.function.actual->expr->symtree->n.sym->module)
+mname = expr->value.function.actual->expr->symtree->n.sym->module;
+  else
+mname = "main";
+  name = xasprintf ("_caf_present_%s_%s_%d", mname, tname, ++caf_sym_cnt);
+  gfc_get_symbol (name, ns, &extproc);
+  extproc->declared_at = expr->where;
+  gfc_set_sym_referenced (extproc);
+  ++extproc->refs;
+  gfc_commit_symbol (extproc);
+
+  /* Set up namespace.  */
+  gfc_namespace *sub_ns = gfc_get_namespace (ns, 0);
+  sub_ns->sibling = ns->contained;
+  ns->contained = sub_ns;
+  sub_ns->resolved = 1;
+  /* Set up procedure symbol.  */
+  gfc_find_symbol (name, sub_ns, 1, &proc);
+  sub_ns->proc_name = proc;
+  proc->attr.if_source = IFSRC_DECL;
+  proc->attr.access = ACCESS_PUBLIC;
+  gfc_add_subroutine (&proc->attr, name, NULL);
+  proc->attr.host_assoc = 1;
+  proc->attr.always_explicit = 1;
+  proc->declared_at = expr->whe

[gcc r15-7642] Fortran: Add send_to_remote [PR107635]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:69eb02682b80b84dd0f562f19821c8c8c37ad243

commit r15-7642-g69eb02682b80b84dd0f562f19821c8c8c37ad243
Author: Andre Vehreschild 
Date:   Wed Jan 29 12:42:18 2025 +0100

Fortran: Add send_to_remote [PR107635]

Refactor to use send_to_remote instead of the slow send_by_ref.

gcc/fortran/ChangeLog:

PR fortran/107635

* coarray.cc (move_coarray_ref): Move the coarray reference out
of the given one.  Especially when there is a regular array ref.
(fixup_comp_refs): Move components refs to a derived type where
the codim has been removed, aka a new type.
(split_expr_at_caf_ref): Correctly split the reference chain.
(remove_caf_ref): Simplify.
(create_get_callback): Fix some deficiencies.
(create_allocated_callback): Adapt to new signature of split.
(create_send_callback): New function.
(rewrite_caf_send): Rewrite a call to caf_send to
caf_send_to_remote.
(coindexed_code_callback): Treat caf_send and caf_sendget
correctly.
* gfortran.h (enum gfc_isym_id): Add SENDGET-isym.
* gfortran.texi: Add documentation for send_to_remote.
* resolve.cc (gfc_resolve_code): No longer generate send_by_ref
when allocatable coarray (component) is on the lhs.
* trans-decl.cc (gfc_build_builtin_function_decls): Add
caf_send_to_remote decl.
* trans-intrinsic.cc (conv_caf_func_index): Ensure the static
variables created are not in a block-scope.
(conv_caf_send_to_remote): Translate caf_send_to_remote calls.
(conv_caf_send): Renamed to conv_caf_sendget.
(conv_caf_sendget): Renamed from conv_caf_send.
(gfc_conv_intrinsic_subroutine): Branch correctly for
conv_caf_send and sendget.
* trans.h: Correct decl.

libgfortran/ChangeLog:

* caf/libcaf.h: Add/Correct prototypes for caf_get_from_remote,
caf_send_to_remote.
* caf/single.c (struct accessor_hash_t): Rename accessor_t to
getter_t.
(_gfortran_caf_register_accessor): Use new name of getter_t.
(_gfortran_caf_send_to_remote): New function for sending data to
coarray on a remote image.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/send_char_array_1.f90: Extend test to
catch more cases.
* gfortran.dg/coarray_42.f90: Invert tests use, because no
longer a send is needed when local memory in a coarray is
allocated.

Diff:
---
 gcc/fortran/coarray.cc | 402 ++---
 gcc/fortran/gfortran.h |   1 +
 gcc/fortran/gfortran.texi  |  69 
 gcc/fortran/resolve.cc |   3 +-
 gcc/fortran/trans-decl.cc  |  10 +
 gcc/fortran/trans-intrinsic.cc | 209 ++-
 gcc/fortran/trans.h|   9 +-
 .../gfortran.dg/coarray/send_char_array_1.f90  |  13 +-
 gcc/testsuite/gfortran.dg/coarray_42.f90   |   4 +-
 libgfortran/caf/libcaf.h   |  12 +-
 libgfortran/caf/single.c   |  57 ++-
 11 files changed, 706 insertions(+), 83 deletions(-)

diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
index c4e637e0f519..50029102eb9a 100644
--- a/gcc/fortran/coarray.cc
+++ b/gcc/fortran/coarray.cc
@@ -242,25 +242,125 @@ convert_coarray_class_to_derived_type (gfc_symbol *base, 
gfc_namespace *ns)
   base->attr.pointer = 0; // Ensure, that it is no pointer.
 }
 
+static void
+move_coarray_ref (gfc_ref **from, gfc_expr *expr)
+{
+  int i;
+  gfc_ref *to = expr->ref;
+  for (; to && to->next; to = to->next)
+;
+
+  if (!to)
+{
+  expr->ref = gfc_get_ref ();
+  to = expr->ref;
+  to->type = REF_ARRAY;
+}
+  gcc_assert (to->type == REF_ARRAY);
+  to->u.ar.as = gfc_copy_array_spec ((*from)->u.ar.as);
+  to->u.ar.codimen = (*from)->u.ar.codimen;
+  to->u.ar.dimen = (*from)->u.ar.dimen;
+  to->u.ar.type = AR_FULL;
+  to->u.ar.stat = (*from)->u.ar.stat;
+  (*from)->u.ar.stat = nullptr;
+  to->u.ar.team = (*from)->u.ar.team;
+  (*from)->u.ar.team = nullptr;
+  for (i = 0; i < to->u.ar.dimen; ++i)
+{
+  to->u.ar.start[i] = nullptr;
+  to->u.ar.end[i] = nullptr;
+  to->u.ar.stride[i] = nullptr;
+}
+  for (i = (*from)->u.ar.dimen; i < (*from)->u.ar.dimen + 
(*from)->u.ar.codimen;
+   ++i)
+{
+  to->u.ar.dimen_type[i] = (*from)->u.ar.dimen_type[i];
+  to->u.ar.start[i] = (*from)->u.ar.start[i];
+  (*from)->u.ar.start[i] = nullptr;
+  to->u.ar.end[i] = (*from)->u.ar.end[i];
+  (*from)->u.ar.end[i] = nullptr;
+  to->u.ar.stride[i] = (*from)->u.ar.stride[i];
+  (*f

[gcc r15-7638] Fortran: Move caf_get-rewrite to coarray.cc [PR107635]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:90ba8291c31f2cfb6a8c7bf0c0d6a9d93bbbacc9

commit r15-7638-g90ba8291c31f2cfb6a8c7bf0c0d6a9d93bbbacc9
Author: Andre Vehreschild 
Date:   Wed Jan 8 12:33:27 2025 +0100

Fortran: Move caf_get-rewrite to coarray.cc [PR107635]

Add a rewriter to keep all expression tree that is not optimization
together.  At the moment this is just a move from resolve.cc, but will
be extended to handle more cases where rewriting the expression tree may
be easier.  The first use case is to extract accessors for coarray
remote image data access.

gcc/fortran/ChangeLog:

PR fortran/107635
* Make-lang.in: Add coarray.cc.
* coarray.cc: New file.
* gfortran.h (gfc_coarray_rewrite): New procedure.
* parse.cc (rewrite_expr_tree): Add entrypoint for rewriting
expression trees.
* resolve.cc (gfc_resolve_ref): Remove caf_lhs handling.
(get_arrayspec_from_expr): Moved to rewrite.cc.
(remove_coarray_from_derived_type): Same.
(convert_coarray_class_to_derived_type): Same.
(split_expr_at_caf_ref): Same.
(check_add_new_component): Same.
(create_get_parameter_type): Same.
(create_get_callback): Same.
(add_caf_get_intrinsic): Same.
(resolve_variable): Remove caf_lhs handling.

libgfortran/ChangeLog:

* caf/single.c (_gfortran_caf_finalize): Free memory preventing
leaks.
(_gfortran_caf_get_by_ct): Fix constness.
* caf/libcaf.h (_gfortran_caf_register_accessor): Fix constness.

Diff:
---
 gcc/fortran/Make-lang.in |  14 +-
 gcc/fortran/coarray.cc   | 761 +++
 gcc/fortran/gfortran.h   |   2 +
 gcc/fortran/parse.cc |  13 +
 gcc/fortran/resolve.cc   | 693 +-
 libgfortran/caf/libcaf.h |   8 +-
 libgfortran/caf/single.c |   9 +-
 7 files changed, 793 insertions(+), 707 deletions(-)

diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index e3219c1f01ed..5b2f921bf2ef 100644
--- a/gcc/fortran/Make-lang.in
+++ b/gcc/fortran/Make-lang.in
@@ -52,13 +52,13 @@ fortran-warn = $(STRICT_WARN)
 # from the parse tree to GENERIC
 
 F95_PARSER_OBJS = fortran/arith.o fortran/array.o fortran/bbt.o \
-fortran/check.o fortran/class.o fortran/constructor.o fortran/cpp.o \
-fortran/data.o fortran/decl.o fortran/dump-parse-tree.o fortran/error.o \
-fortran/expr.o fortran/interface.o fortran/intrinsic.o fortran/io.o \
-fortran/iresolve.o fortran/match.o fortran/matchexp.o fortran/misc.o \
-fortran/module.o fortran/openmp.o fortran/options.o fortran/parse.o \
-fortran/primary.o fortran/resolve.o fortran/scanner.o fortran/simplify.o \
-fortran/st.o fortran/symbol.o fortran/target-memory.o
+fortran/check.o fortran/class.o fortran/coarray.o fortran/constructor.o \
+fortran/cpp.o fortran/data.o fortran/decl.o fortran/dump-parse-tree.o \
+fortran/error.o fortran/expr.o fortran/interface.o fortran/intrinsic.o \
+fortran/io.o fortran/iresolve.o fortran/match.o fortran/matchexp.o \
+fortran/misc.o fortran/module.o fortran/openmp.o fortran/options.o \
+fortran/parse.o fortran/primary.o fortran/resolve.o fortran/scanner.o \
+fortran/simplify.o fortran/st.o fortran/symbol.o fortran/target-memory.o
 
 F95_OBJS = $(F95_PARSER_OBJS) $(FORTRAN_TARGET_OBJS) \
 fortran/convert.o fortran/dependency.o fortran/f95-lang.o \
diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
new file mode 100644
index ..1094a3aec2a0
--- /dev/null
+++ b/gcc/fortran/coarray.cc
@@ -0,0 +1,761 @@
+/* Rewrite the expression tree for coarrays.
+   Copyright (C) 2010-2025 Free Software Foundation, Inc.
+   Contributed by Andre Vehreschild.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+.  */
+
+/* Rewrite the expression for coarrays where needed:
+   - coarray indexing operations need the indexing expression put into a
+ routine callable on the remote image
+
+   This rewriter is meant to used for non-optimisational expression tree
+   rewrites.  When implementing early optimisation it is recommended to
+   do this in frontend-passes.cc.
+*/
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "options.h"
+#include "bitmap.h"
+#in

[gcc r15-7639] Fortran: Prepare for more caf-rework. [PR107635]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:b114312bbaae51567bc0436d07990c4fbaa3c81d

commit r15-7639-gb114312bbaae51567bc0436d07990c4fbaa3c81d
Author: Andre Vehreschild 
Date:   Wed Jan 8 12:33:36 2025 +0100

Fortran: Prepare for more caf-rework. [PR107635]

Factor out generation of code to get remote function index and to
create the additional data structure.  Rename caf_get_by_ct to
caf_get_from_remote.

gcc/fortran/ChangeLog:

PR fortran/107635

* gfortran.texi: Rename caf_get_by_ct to caf_get_from_remote.
* trans-decl.cc (gfc_build_builtin_function_decls): Rename
intrinsic.
* trans-intrinsic.cc (conv_caf_func_index): Factor out
functionality to be reused by other caf-functions.
(conv_caf_add_call_data): Same.
(gfc_conv_intrinsic_caf_get): Use functions factored out.
* trans.h: Rename intrinsic symbol.

libgfortran/ChangeLog:

* caf/libcaf.h (_gfortran_caf_get_by_ref): Remove from ABI.
This function is replaced by caf_get_from_remote ().
(_gfortran_caf_get_remote_function_index): Use better name.
* caf/single.c (_gfortran_caf_finalize): Free internal data.
(_gfortran_caf_get_by_ref): Remove from public interface, but
keep it, because it is still used by sendget ().

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray_lib_comm_1.f90: Adapt to renamed ABI
function.
* gfortran.dg/coarray_stat_function.f90: Same.
* gfortran.dg/coindexed_1.f90: Same.

Diff:
---
 gcc/fortran/gfortran.texi  |  14 +-
 gcc/fortran/trans-decl.cc  |  25 +--
 gcc/fortran/trans-intrinsic.cc | 236 -
 gcc/fortran/trans.h|   3 +-
 gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90   |   2 +-
 .../gfortran.dg/coarray_stat_function.f90  |   6 +-
 gcc/testsuite/gfortran.dg/coindexed_1.f90  |   4 +-
 libgfortran/caf/libcaf.h   |  18 +-
 libgfortran/caf/single.c   |  11 +-
 9 files changed, 168 insertions(+), 151 deletions(-)

diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index fa7f563ba2ae..3337a79319a8 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -4211,7 +4211,7 @@ future implementation of teams.  It is about to change 
without further notice.
 * _gfortran_caf_sendget:: Sending data between remote images
 * _gfortran_caf_send_by_ref:: Sending data from a local image to a remote 
image using enhanced references
 * _gfortran_caf_get_by_ref:: Getting data from a remote image using enhanced 
references
-* _gfortran_caf_get_by_ct:: Getting data from a remote image using a remote 
side accessor
+* _gfortran_caf_get_from_remote:: Getting data from a remote image using a 
remote side accessor
 * _gfortran_caf_sendget_by_ref:: Sending data between remote images using 
enhanced references
 * _gfortran_caf_lock:: Locking a lock variable
 * _gfortran_caf_unlock:: Unlocking a lock variable
@@ -4617,8 +4617,8 @@ Return the index of the accessor in the lookup table 
build by
 fast, because it may be called often.  A log(N) lookup time for a given hash is
 preferred.  The reference implementation uses @code{bsearch ()}, for example.
 The index returned shall be an array index to be used by
-@ref{_gfortran_caf_get_by_ct}, i.e. a constant time operation is mandatory for
-quick access.
+@ref{_gfortran_caf_get_from_remote}, i.e. a constant time operation is 
mandatory
+for quick access.
 
 The GFortran compiler ensures that
 @code{_gfortran_caf_get_remote_function_index} is called once only for each
@@ -4975,9 +4975,9 @@ error message why the operation is not permitted.
 @end table
 
 
-@node _gfortran_caf_get_by_ct
-@subsection @code{_gfortran_caf_get_by_ct} --- Getting data from a remote 
image using a remote side accessor
-@cindex Coarray, _gfortran_caf_get_by_ct
+@node _gfortran_caf_get_from_remote
+@subsection @code{_gfortran_caf_get_from_remote} --- Getting data from a 
remote image using a remote side accessor
+@cindex Coarray, _gfortran_caf_get_from_remote
 
 @table @asis
 @item @emph{Description}:
@@ -4985,7 +4985,7 @@ Called to get a scalar, an array section or a whole array 
from a remote image
 identified by the @var{image_index}.
 
 @item @emph{Syntax}:
-@code{void _gfortran_caf_get_by_ct (caf_token_t token,
+@code{void _gfortran_caf_get_from_remote (caf_token_t token,
 const gfc_descriptor_t *opt_src_desc, const size_t *opt_src_charlen,
 const int image_index, const size_t dst_size, void **dst_data,
 size_t *opt_dst_charlen, gfc_descriptor_t *opt_dst_desc,
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index ebb63a47531c..0a6b7477c879 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -140,7 +140,6 @@ tree gfor_fndec

[gcc r15-7643] Fortran: Add transfer_between_remotes [PR107635]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:8bf0ee8d62b8a08e808344d31354ab713157e15d

commit r15-7643-g8bf0ee8d62b8a08e808344d31354ab713157e15d
Author: Andre Vehreschild 
Date:   Fri Feb 7 11:25:31 2025 +0100

Fortran: Add transfer_between_remotes [PR107635]

Add the last missing coarray data manipulation routine using remote
accessors.

gcc/fortran/ChangeLog:

PR fortran/107635

* coarray.cc (rewrite_caf_send): Rewrite to
transfer_between_remotes when both sides of the assignment have
a coarray.
(coindexed_code_callback): Prevent duplicate rewrite.
* gfortran.texi: Add documentation for transfer_between_remotes.
* intrinsic.cc (add_subroutines): Add intrinsic symbol for
caf_sendget to allow easy rewrite to transfer_between_remotes.
* trans-decl.cc (gfc_build_builtin_function_decls): Add
prototype for transfer_between_remotes.
* trans-intrinsic.cc (conv_caf_vector_subscript_elem): Mark as
deprecated.
(conv_caf_vector_subscript): Same.
(compute_component_offset): Same.
(conv_expr_ref_to_caf_ref): Same.
(conv_stat_and_team): Extract stat and team from expr.
(gfc_conv_intrinsic_caf_get): Use conv_stat_and_team.
(conv_caf_send_to_remote): Same.
(has_ref_after_cafref): Mark as deprecated.
(conv_caf_sendget): Translate to transfer_between_remotes.
* trans.h: Add prototype for transfer_between_remotes.

libgfortran/ChangeLog:

* caf/libcaf.h: Add prototype for transfer_between_remotes.
* caf/single.c: Implement transfer_between_remotes.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray_lib_comm_1.f90: Fix up scan_trees.

Diff:
---
 gcc/fortran/coarray.cc   |   32 +-
 gcc/fortran/gfortran.texi|  106 +
 gcc/fortran/intrinsic.cc |4 +
 gcc/fortran/trans-decl.cc|   15 +-
 gcc/fortran/trans-intrinsic.cc   | 2346 --
 gcc/fortran/trans.h  |1 +
 gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 |4 +-
 libgfortran/caf/libcaf.h |   12 +
 libgfortran/caf/single.c |   69 +
 9 files changed, 1517 insertions(+), 1072 deletions(-)

diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
index 50029102eb9a..e5648e0d0279 100644
--- a/gcc/fortran/coarray.cc
+++ b/gcc/fortran/coarray.cc
@@ -1351,12 +1351,6 @@ rewrite_caf_send (gfc_code *c)
   && arg->next->next && arg->next->next->expr->expr_type == EXPR_VARIABLE)
 return;
 
-  if (gfc_is_coindexed (rhs))
-{
-  c->resolved_isym->id = GFC_ISYM_CAF_SENDGET;
-  return;
-}
-
   send_to_remote_expr = create_send_callback (lhs, rhs);
   send_to_remote_hash_expr = gfc_get_expr ();
   send_to_remote_hash_expr->expr_type = EXPR_CONSTANT;
@@ -1372,6 +1366,28 @@ rewrite_caf_send (gfc_code *c)
   arg = arg->next;
   arg->expr = send_to_remote_expr;
   gfc_add_caf_accessor (send_to_remote_hash_expr, send_to_remote_expr);
+
+  if (gfc_is_coindexed (rhs))
+{
+  gfc_expr *get_from_remote_expr, *get_from_remote_hash_expr;
+
+  c->resolved_isym = gfc_intrinsic_subroutine_by_id (GFC_ISYM_CAF_SENDGET);
+  get_from_remote_expr = create_get_callback (rhs);
+  get_from_remote_hash_expr = gfc_get_expr ();
+  get_from_remote_hash_expr->expr_type = EXPR_CONSTANT;
+  get_from_remote_hash_expr->ts.type = BT_INTEGER;
+  get_from_remote_hash_expr->ts.kind = gfc_default_integer_kind;
+  get_from_remote_hash_expr->where = rhs->where;
+  mpz_init_set_ui (get_from_remote_hash_expr->value.integer,
+  gfc_hash_value (get_from_remote_expr->symtree->n.sym));
+  arg->next = gfc_get_actual_arglist ();
+  arg = arg->next;
+  arg->expr = get_from_remote_hash_expr;
+  arg->next = gfc_get_actual_arglist ();
+  arg = arg->next;
+  arg->expr = get_from_remote_expr;
+  gfc_add_caf_accessor (get_from_remote_hash_expr, get_from_remote_expr);
+}
 }
 
 static int
@@ -1451,7 +1467,9 @@ coindexed_code_callback (gfc_code **c, int *walk_subtrees,
*walk_subtrees = 0;
break;
  case GFC_ISYM_CAF_SENDGET:
-   // rewrite_caf_sendget (*c);
+   /* Seldomly this routine is called again with the symbol already
+  changed to CAF_SENDGET.  Do not process the subtree again.  The
+  rewrite has already been done by rewrite_caf_send ().  */
*walk_subtrees = 0;
break;
  case GFC_ISYM_ATOMIC_ADD:
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 059022ea5439..36c203b27b3a 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -4214,6 +4214,7 @@ future implement

[gcc r15-7640] Fortran: Allow to use non-pure/non-elemental functions in coarray indexes [PR107635]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:abbfeb2ecbb5e90aa5d68e489ac283348ee6b8d5

commit r15-7640-gabbfeb2ecbb5e90aa5d68e489ac283348ee6b8d5
Author: Andre Vehreschild 
Date:   Wed Jan 22 13:36:21 2025 +0100

Fortran: Allow to use non-pure/non-elemental functions in coarray indexes 
[PR107635]

Extract calls to non-pure or non-elemental functions from index
expressions on a coarray.

gcc/fortran/ChangeLog:

PR fortran/107635

* coarray.cc (get_arrayspec_from_expr): Treat array result of
function calls correctly.
(remove_coarray_from_derived_type): Prevent memory loss.
(add_caf_get_from_remote): Correct locus.
(find_comp): New function to find or create a new component in a
derived type.
(check_add_new_comp_handle_array): Handle allocatable arrays or
non-pure/non-elemental functions in indexes of coarrays.
(check_add_new_component): Use above function.
(create_get_parameter_type): Rename to
create_caf_add_data_parameter_type.
(create_caf_add_data_parameter_type): Renaming of variable and
make the additional data a coarray.
(remove_caf_ref): Factor out to reuse in other caf-functions.
(create_get_callback): Use function factored out, set locus
correctly and ensure a kind is set for parameters.
(add_caf_get_intrinsic): Rename to add_caf_get_from_remote and
rename some variables.
(coindexed_expr_callback): Skip over function created by the
rewriter.
(coindexed_code_callback): Filter some intrinsics not to
process.
(gfc_coarray_rewrite): Rewrite also contained functions.
* trans-intrinsic.cc (gfc_conv_intrinsic_caf_get): Reflect
changed order on caf_get_from_remote ().

libgfortran/ChangeLog:

* caf/libcaf.h (_gfortran_caf_register_accessor): Reflect
changed parameter order.
* caf/single.c (struct accessor_hash_t): Same.
(_gfortran_caf_register_accessor): Call accessor using a token
for accessing arrays with a descriptor on the source side.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray_lib_comm_1.f90: Adapt scan expression.
* gfortran.dg/coarray/get_with_fn_parameter.f90: New test.
* gfortran.dg/coarray/get_with_scalar_fn.f90: New test.

Diff:
---
 gcc/fortran/coarray.cc | 557 -
 gcc/fortran/trans-intrinsic.cc |   3 +-
 .../gfortran.dg/coarray/get_with_fn_parameter.f90  |  29 ++
 .../gfortran.dg/coarray/get_with_scalar_fn.f90 |  30 ++
 gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90   |   2 +-
 libgfortran/caf/libcaf.h   |   5 +-
 libgfortran/caf/single.c   |  23 +-
 7 files changed, 499 insertions(+), 150 deletions(-)

diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
index 1094a3aec2a0..fb211715581b 100644
--- a/gcc/fortran/coarray.cc
+++ b/gcc/fortran/coarray.cc
@@ -34,10 +34,16 @@ along with GCC; see the file COPYING3.  If not see
 #include "bitmap.h"
 #include "gfortran.h"
 
+/* The code tree element that is currently processed.  */
 static gfc_code **current_code;
 
+/* Code that is inserted into the current caf_accessor at the beginning.  */
+static gfc_code *caf_accessor_prepend = nullptr;
+
 static bool caf_on_lhs = false;
 
+static int caf_sym_cnt = 0;
+
 static gfc_array_spec *
 get_arrayspec_from_expr (gfc_expr *expr)
 {
@@ -49,6 +55,9 @@ get_arrayspec_from_expr (gfc_expr *expr)
   if (expr->rank == 0)
 return NULL;
 
+  if (expr->expr_type == EXPR_FUNCTION)
+return gfc_copy_array_spec (expr->symtree->n.sym->as);
+
   /* Follow any component references.  */
   if (expr->expr_type == EXPR_VARIABLE || expr->expr_type == EXPR_CONSTANT)
 {
@@ -158,6 +167,9 @@ get_arrayspec_from_expr (gfc_expr *expr)
break;
 
  case AR_FULL:
+   if (dst_as)
+ /* Prevent memory loss.  */
+ gfc_free_array_spec (dst_as);
dst_as = gfc_copy_array_spec (src_as);
break;
  }
@@ -206,6 +218,7 @@ remove_coarray_from_derived_type (gfc_symbol *base, 
gfc_namespace *ns,
 
   p = n;
 }
+  derived->declared_at = base->declared_at;
   gfc_set_sym_referenced (derived);
   gfc_commit_symbol (derived);
   base->ts.u.derived = derived;
@@ -236,6 +249,7 @@ split_expr_at_caf_ref (gfc_expr *expr, gfc_namespace *ns,
   gfc_ref *caf_ref = NULL;
   gfc_symtree *st;
   gfc_symbol *base;
+  bool created;
 
   gcc_assert (expr->expr_type == EXPR_VARIABLE);
   if (!expr->symtree->n.sym->attr.codimension)
@@ -251,8 +265,9 @@ split_expr_at_caf_ref (gfc_expr *expr, gfc_namespace *ns,
}
 }
 
-  gcc_assert (!gf

[gcc r15-7693] Fortran: Use correct size when transferring between images [PR107635]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:cc81363c33a3b5768daf2d8a62ae1a80db12ef96

commit r15-7693-gcc81363c33a3b5768daf2d8a62ae1a80db12ef96
Author: Andre Vehreschild 
Date:   Wed Feb 19 09:04:47 2025 +0100

Fortran: Use correct size when transferring between images [PR107635]

gcc/fortran/ChangeLog:

PR fortran/107635

* trans-intrinsic.cc (conv_caf_sendget): Use the size of data
transferred between the two images and not the descritor's size.

Diff:
---
 gcc/fortran/trans-intrinsic.cc | 9 ++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 2c4c47816c82..80e98dc3c202 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1658,20 +1658,23 @@ conv_caf_sendget (gfc_code *code)
   gfc_init_se (&rhs_se, NULL);
   if (rhs_expr->rank == 0)
 {
-  gfc_conv_expr (&rhs_se, rhs_expr);
-  gfc_add_block_to_block (&block, &rhs_se.pre);
   opt_rhs_desc = null_pointer_node;
   if (rhs_expr->ts.type == BT_CHARACTER)
{
+ gfc_conv_expr (&rhs_se, rhs_expr);
+ gfc_add_block_to_block (&block, &rhs_se.pre);
  opt_rhs_charlen = gfc_build_addr_expr (
NULL_TREE, gfc_trans_force_lval (&block, rhs_se.string_length));
  rhs_size = build_int_cstu (size_type_node, rhs_expr->ts.kind);
}
   else
{
+ gfc_typespec *ts
+   = &sender_fn_expr->symtree->n.sym->formal->next->next->sym->ts;
+
  opt_rhs_charlen
= build_zero_cst (build_pointer_type (size_type_node));
- rhs_size = TREE_TYPE (rhs_se.expr)->type_common.size_unit;
+ rhs_size = gfc_typenode_for_spec (ts)->type_common.size_unit;
}
 }
   else if (!TYPE_LANG_SPECIFIC (TREE_TYPE (rhs_caf_decl))->rank

[gcc r15-7694] Fortran: Fix detection of descriptor arrays in coarray [PR107635]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:af73228fdb2e61c6354f972987ba2a746c3519f7

commit r15-7694-gaf73228fdb2e61c6354f972987ba2a746c3519f7
Author: Andre Vehreschild 
Date:   Fri Feb 21 14:06:28 2025 +0100

Fortran: Fix detection of descriptor arrays in coarray [PR107635]

Look at the formal arguments generated type in the function declaration
to figure if an argument is a descriptor arrays.  Fix handling of class
types while splitting coarray expressions.

PR fortran/107635

gcc/fortran/ChangeLog:

* coarray.cc (fixup_comp_refs): For class types set correct
component (class) type.
(split_expr_at_caf_ref): Provide location.
* trans-intrinsic.cc (conv_caf_send_to_remote): Look at
generated formal argument and not declared one to detect
descriptor arrays.
(conv_caf_sendget): Same.

Diff:
---
 gcc/fortran/coarray.cc | 15 ++-
 gcc/fortran/trans-intrinsic.cc | 30 --
 2 files changed, 34 insertions(+), 11 deletions(-)

diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
index e5648e0d0279..f53de0b20e32 100644
--- a/gcc/fortran/coarray.cc
+++ b/gcc/fortran/coarray.cc
@@ -295,11 +295,12 @@ move_coarray_ref (gfc_ref **from, gfc_expr *expr)
 static void
 fixup_comp_refs (gfc_expr *expr)
 {
-  gfc_symbol *type = expr->symtree->n.sym->ts.type == BT_DERIVED
-  ? expr->symtree->n.sym->ts.u.derived
-  : (expr->symtree->n.sym->ts.type == BT_CLASS
-   ? CLASS_DATA (expr->symtree->n.sym)->ts.u.derived
-   : nullptr);
+  bool class_ref = expr->symtree->n.sym->ts.type == BT_CLASS;
+  gfc_symbol *type
+= expr->symtree->n.sym->ts.type == BT_DERIVED
+   ? expr->symtree->n.sym->ts.u.derived
+   : (class_ref ? CLASS_DATA (expr->symtree->n.sym)->ts.u.derived
+: nullptr);
   if (!type)
 return;
   gfc_ref **pref = &(expr->ref);
@@ -317,6 +318,9 @@ fixup_comp_refs (gfc_expr *expr)
  ref = nullptr;
  break;
}
+ if (class_ref)
+   /* Link to the class type to allow for derived type resolution.  */
+   (*pref)->u.c.sym = ref->u.c.sym;
  (*pref)->next = ref->next;
  ref->next = NULL;
  gfc_free_ref_list (ref);
@@ -372,6 +376,7 @@ split_expr_at_caf_ref (gfc_expr *expr, gfc_namespace *ns,
   st->n.sym->attr.dummy = 1;
   st->n.sym->attr.intent = INTENT_IN;
   st->n.sym->ts = *caf_ts;
+  st->n.sym->declared_at = expr->where;
 
   *post_caf_ref_expr = gfc_get_variable_expr (st);
   (*post_caf_ref_expr)->where = expr->where;
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 80e98dc3c202..c97829fd8a82 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1445,8 +1445,14 @@ conv_caf_send_to_remote (gfc_code *code)
  NULL_TREE, gfc_trans_force_lval (&block, lhs_se.string_length));
   else
opt_lhs_charlen = build_zero_cst (build_pointer_type (size_type_node));
-  if (!TYPE_LANG_SPECIFIC (TREE_TYPE (caf_decl))->rank
- || GFC_ARRAY_TYPE_P (TREE_TYPE (caf_decl)))
+  /* Get the third formal argument of the receiver function.  (This is the
+location where to put the data on the remote image.)  Need to look at
+the argument in the function decl, because in the gfc_symbol's formal
+argument an array may have no descriptor while in the generated
+function decl it has.  */
+  tmp = TREE_VALUE (TREE_CHAIN (TREE_CHAIN (TYPE_ARG_TYPES (
+   TREE_TYPE (receiver_fn_expr->symtree->n.sym->backend_decl);
+  if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
opt_lhs_desc = null_pointer_node;
   else
opt_lhs_desc
@@ -1635,8 +1641,14 @@ conv_caf_sendget (gfc_code *code)
  NULL_TREE, gfc_trans_force_lval (&block, lhs_se.string_length));
   else
opt_lhs_charlen = build_zero_cst (build_pointer_type (size_type_node));
-  if (!TYPE_LANG_SPECIFIC (TREE_TYPE (lhs_caf_decl))->rank
- || GFC_ARRAY_TYPE_P (TREE_TYPE (lhs_caf_decl)))
+  /* Get the third formal argument of the receiver function.  (This is the
+location where to put the data on the remote image.)  Need to look at
+the argument in the function decl, because in the gfc_symbol's formal
+argument an array may have no descriptor while in the generated
+function decl it has.  */
+  tmp = TREE_VALUE (TREE_CHAIN (TREE_CHAIN (TYPE_ARG_TYPES (
+   TREE_TYPE (receiver_fn_expr->symtree->n.sym->backend_decl);
+  if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
opt_lhs_desc = null_pointer_node;
   else
opt_lhs_desc
@@ -1677,8 +1689,14 @@ conv_caf_sendget (gfc_code *code)
  rhs_size = gfc_typenode_for_spec (ts)->type_common.size_unit;
}
 }
-  else if (!TYPE_LANG_SPECIFIC (TREE_

[gcc r15-7712] Fortran: Remove SAVE_EXPR on lhs in assign [PR108233]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:751b37047b2ad3a358d41ac792487b42430e9901

commit r15-7712-g751b37047b2ad3a358d41ac792487b42430e9901
Author: Andre Vehreschild 
Date:   Tue Feb 25 14:17:16 2025 +0100

Fortran: Remove SAVE_EXPR on lhs in assign [PR108233]

With vectorial shaped datatypes like e.g. complex numbers, fold_convert
inserts a SAVE_EXPR.  Using that on the lhs in an assignment prevented
the update of the variable, when in a coarray.

PR fortran/108233

gcc/fortran/ChangeLog:

* trans-expr.cc (gfc_trans_assignment_1): Remove SAVE_EXPR on lhs.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/complex_1.f90: New test.

Diff:
---
 gcc/fortran/trans-expr.cc   | 13 +++
 gcc/testsuite/gfortran.dg/coarray/complex_1.f90 | 31 +
 2 files changed, 39 insertions(+), 5 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 8a3e737a6a8f..ab55940638e2 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -13017,11 +13017,14 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * 
expr2, bool init_flag,
   else
 {
   gfc_conv_expr (&lse, expr1);
-  if (gfc_option.rtcheck & GFC_RTCHECK_MEM
- && !init_flag
- && gfc_expr_attr (expr1).allocatable
- && expr1->rank
- && !expr2->rank)
+  /* For some expression (e.g. complex numbers) fold_convert uses a
+SAVE_EXPR, which is hazardous on the lhs, because the value is
+not updated when assigned to.  */
+  if (TREE_CODE (lse.expr) == SAVE_EXPR)
+   lse.expr = TREE_OPERAND (lse.expr, 0);
+
+  if (gfc_option.rtcheck & GFC_RTCHECK_MEM && !init_flag
+ && gfc_expr_attr (expr1).allocatable && expr1->rank && !expr2->rank)
{
  tree cond;
  const char* msg;
diff --git a/gcc/testsuite/gfortran.dg/coarray/complex_1.f90 
b/gcc/testsuite/gfortran.dg/coarray/complex_1.f90
new file mode 100644
index ..5db0b795278b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/complex_1.f90
@@ -0,0 +1,31 @@
+!{ dg-do run }
+
+! Check that complex numbers in coarrays can get assigned to.
+! Contributed by Harald Anlauf  
+
+program pr108233
+  implicit none
+  complex :: c = (3.0,4.0), z[*] = (6.0, 7.0)
+  complex, allocatable ::   y[:]
+  allocate (y[*])
+  y = c ! allocatable complex scalar coarray is OK
+  if (c /= y) error stop 1
+  z = c ! non-allocatable complex scalar coarray was bad
+  if (c /= z) error stop 2
+  call bcast_scalar  (z, c) ! failed too
+  if (c /= z) error stop 3
+  call assign_scalar (z, c) ! this works
+  if (c /= z) error stop 4
+contains
+  subroutine assign_scalar (out, in)
+complex, intent(out) :: out
+complex, intent(in)  :: in
+out = in
+  end subroutine assign_scalar
+  subroutine bcast_scalar (out, in)
+complex, intent(out) :: out[*]
+complex, intent(in)  :: in
+out = in
+  end subroutine bcast_scalar
+end
+

[gcc r14-11522] Fortran: Fix freeing procedure pointer components [PR119380]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:f955c5b409a96bd12765680517ce583d7086c62d

commit r14-11522-gf955c5b409a96bd12765680517ce583d7086c62d
Author: Andre Vehreschild 
Date:   Fri Mar 21 09:13:29 2025 +0100

Fortran: Fix freeing procedure pointer components [PR119380]

Backported from gcc-15.

PR fortran/119380

gcc/fortran/ChangeLog:

* trans-array.cc (structure_alloc_comps): Prevent freeing of
procedure pointer components.

gcc/testsuite/ChangeLog:

* gfortran.dg/proc_ptr_comp_54.f90: New test.

Diff:
---
 gcc/fortran/trans-array.cc |  4 ++--
 gcc/testsuite/gfortran.dg/proc_ptr_comp_54.f90 | 30 ++
 2 files changed, 32 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c1c2b933b279..50286e4120e6 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9694,13 +9694,13 @@ structure_alloc_comps (gfc_symbol * der_type, tree 
decl, tree dest,
  if (c->ts.type == BT_CLASS)
{
  attr = &CLASS_DATA (c)->attr;
- if (attr->class_pointer)
+ if (attr->class_pointer || c->attr.proc_pointer)
continue;
}
  else
{
  attr = &c->attr;
- if (attr->pointer)
+ if (attr->pointer || attr->proc_pointer)
continue;
}
 
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_54.f90 
b/gcc/testsuite/gfortran.dg/proc_ptr_comp_54.f90
new file mode 100644
index ..73abc590e9ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_54.f90
@@ -0,0 +1,30 @@
+!{ dg-do run }
+
+! Check that components of procedure pointer aren't freeed.
+! Contributed by Damian Rouson  
+
+  implicit none
+
+  type foo_t
+integer, allocatable :: i_
+procedure(f), pointer, nopass :: f_
+procedure(c), pointer, nopass :: c_
+  end type
+
+  class(foo_t), allocatable :: ff
+
+  associate(foo => foo_t(1,f))
+  end associate
+
+contains
+
+  function f()
+logical, allocatable :: f
+f = .true.
+  end function
+
+  function c()
+class(foo_t), allocatable :: c
+allocate(c)
+  end function
+end

[gcc r15-9831] Fortran: Fix missing substring ref for allocatable saved vars [PR120483]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:1549bb90c10c5e3ef1c5f2080cdb58dbaee25291

commit r15-9831-g1549bb90c10c5e3ef1c5f2080cdb58dbaee25291
Author: Andre Vehreschild 
Date:   Mon Jun 2 10:41:48 2025 +0200

Fortran: Fix missing substring ref for allocatable saved vars [PR120483]

Compute a substring ref on an allocatable static character array
using pointer arithmetic.  Using an array type corrupts type
layouting and crashes omp generation.

PR fortran/120483

gcc/fortran/ChangeLog:

* trans-expr.cc (gfc_conv_substring): Use pointer arithmetic on
static allocatable char arrays.

gcc/testsuite/ChangeLog:

* gfortran.dg/save_8.f90: New test.

(cherry picked from commit 5c9bdfd2748b8159856a37404ab7b34d977242ce)

Diff:
---
 gcc/fortran/trans-expr.cc| 16 +---
 gcc/testsuite/gfortran.dg/save_8.f90 | 13 +
 2 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 7031a829759f..a92d5cd75b67 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2784,9 +2784,11 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
start.expr = gfc_evaluate_now (start.expr, &se->pre);
 
   /* Change the start of the string.  */
-  if ((TREE_CODE (TREE_TYPE (se->expr)) == ARRAY_TYPE
-  || TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE)
- && TYPE_STRING_FLAG (TREE_TYPE (se->expr)))
+  if (((TREE_CODE (TREE_TYPE (se->expr)) == ARRAY_TYPE
+   || TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE)
+  && TYPE_STRING_FLAG (TREE_TYPE (se->expr)))
+ || (POINTER_TYPE_P (TREE_TYPE (se->expr))
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (se->expr))) != ARRAY_TYPE))
tmp = se->expr;
   else
tmp = build_fold_indirect_ref_loc (input_location,
@@ -2797,6 +2799,14 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
  tmp = gfc_build_array_ref (tmp, start.expr, NULL_TREE, true);
  se->expr = gfc_build_addr_expr (type, tmp);
}
+  else if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+   {
+ tree diff;
+ diff = fold_build2 (MINUS_EXPR, size_type_node, start.expr,
+ build_one_cst (size_type_node));
+ se->expr
+   = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (tmp), tmp, diff);
+   }
 }
 
   /* Length = end + 1 - start.  */
diff --git a/gcc/testsuite/gfortran.dg/save_8.f90 
b/gcc/testsuite/gfortran.dg/save_8.f90
new file mode 100644
index ..8e9198caeb18
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/save_8.f90
@@ -0,0 +1,13 @@
+!{ dg-do run }
+
+! Check PR120483 is fixed.
+! Contributed by Thomas Koenig  
+!and Peter Güntert   
+
+program save_8
+  implicit none
+  character(len=:), allocatable, save :: s1
+  s1 = 'ABC'
+  if (s1(3:3) /= 'C') stop 1
+end program save_8
+

[gcc r16-1696] Fortran: Fix out of bounds access in structure constructor's clean up [PR120711]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:dff66a690f6d47963e5cb96677d0e194b85948fa

commit r16-1696-gdff66a690f6d47963e5cb96677d0e194b85948fa
Author: Andre Vehreschild 
Date:   Wed Jun 25 09:12:35 2025 +0200

Fortran: Fix out of bounds access in structure constructor's clean up 
[PR120711]

A structure constructor's generated clean up code was using an offset
variable, which was manipulated before the clean up was run leading to
an out of bounds access.

PR fortran/120711

gcc/fortran/ChangeLog:

* trans-array.cc (gfc_trans_array_ctor_element): Store the value
of the offset for reuse.

gcc/testsuite/ChangeLog:

* gfortran.dg/asan/array_constructor_1.f90: New test.

Diff:
---
 gcc/fortran/trans-array.cc | 10 ++
 .../gfortran.dg/asan/array_constructor_1.f90   | 23 ++
 2 files changed, 29 insertions(+), 4 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 3d274439895d..7be2d7b11a62 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1991,14 +1991,17 @@ static void
 gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
  tree offset, gfc_se * se, gfc_expr * expr)
 {
-  tree tmp;
+  tree tmp, offset_eval;
 
   gfc_conv_expr (se, expr);
 
   /* Store the value.  */
   tmp = build_fold_indirect_ref_loc (input_location,
 gfc_conv_descriptor_data_get (desc));
-  tmp = gfc_build_array_ref (tmp, offset, NULL);
+  /* The offset may change, so get its value now and use that to free memory.
+   */
+  offset_eval = gfc_evaluate_now (offset, &se->pre);
+  tmp = gfc_build_array_ref (tmp, offset_eval, NULL);
 
   if (expr->expr_type == EXPR_FUNCTION && expr->ts.type == BT_DERIVED
   && expr->ts.u.derived->attr.alloc_comp)
@@ -3150,8 +3153,7 @@ finish:
  the reference.  */
   if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
&& finalblock.head != NULL_TREE)
-gfc_add_block_to_block (&loop->post, &finalblock);
-
+gfc_prepend_expr_to_block (&loop->post, finalblock.head);
 }
 
 
diff --git a/gcc/testsuite/gfortran.dg/asan/array_constructor_1.f90 
b/gcc/testsuite/gfortran.dg/asan/array_constructor_1.f90
new file mode 100644
index ..45eafacd5a67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/array_constructor_1.f90
@@ -0,0 +1,23 @@
+!{ dg-do run }
+
+! Contributed by Christopher Albert  
+
+program grow_type_array
+type :: container
+integer, allocatable :: arr(:)
+end type container
+
+type(container), allocatable :: list(:)
+
+list = [list, new_elem(5)]
+
+deallocate(list)
+
+contains
+
+type(container) function new_elem(s) result(out)
+integer :: s
+allocate(out%arr(s))
+end function new_elem
+  
+end program grow_type_array

[gcc r16-1697] Fortran: Fix wasting memory in coarray single mode.

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:84947575bd0281cd4d99f1a31029ca4da11fc997

commit r16-1697-g84947575bd0281cd4d99f1a31029ca4da11fc997
Author: Andre Vehreschild 
Date:   Wed Jun 25 12:27:04 2025 +0200

Fortran: Fix wasting memory in coarray single mode.

gcc/fortran/ChangeLog:

* resolve.cc (resolve_fl_derived0): Do not create the token
component when not in coarray lib mode.
* trans-types.cc: Do not access the token when not in coarray
lib mode.

Diff:
---
 gcc/fortran/resolve.cc | 4 ++--
 gcc/fortran/trans-types.cc | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 7089e4f171d1..58f7aee29c35 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -16841,8 +16841,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 return false;
 
   /* Now add the caf token field, where needed.  */
-  if (flag_coarray != GFC_FCOARRAY_NONE
-  && !sym->attr.is_class && !sym->attr.vtype)
+  if (flag_coarray == GFC_FCOARRAY_LIB && !sym->attr.is_class
+  && !sym->attr.vtype)
 {
   for (c = sym->components; c; c = c->next)
if (!c->attr.dimension && !c->attr.codimension
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index e15b1bb89f01..1754d9821532 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -3187,7 +3187,7 @@ copy_derived_types:
 for (c = derived->components; c; c = c->next)
   {
/* Do not add a caf_token field for class container components.  */
-   if ((codimen || coarray_flag) && !c->attr.dimension
+   if (codimen && coarray_flag && !c->attr.dimension
&& !c->attr.codimension && (c->attr.allocatable || c->attr.pointer)
&& !derived->attr.is_class)
  {

[gcc r16-1698] Fortran: Prevent creation of unused tree.

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:24940ad1534aa71ed74cf059982446c6df1f3f74

commit r16-1698-g24940ad1534aa71ed74cf059982446c6df1f3f74
Author: Andre Vehreschild 
Date:   Wed Jun 25 12:27:35 2025 +0200

Fortran: Prevent creation of unused tree.

gcc/fortran/ChangeLog:

* trans.cc (gfc_allocate_using_malloc): Prevent possible memory
leak when allocation was already done.

Diff:
---
 gcc/fortran/trans.cc | 11 +++
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index fdeb1e89a765..13fd5ad498da 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -822,6 +822,7 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree 
pointer,
   tree tmp, error_cond;
   stmtblock_t on_error;
   tree status_type = status ? TREE_TYPE (status) : NULL_TREE;
+  bool cond_is_true = cond == boolean_true_node;
 
   /* If successful and stat= is given, set status to 0.  */
   if (status != NULL_TREE)
@@ -834,11 +835,13 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree 
pointer,
   tmp = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
 size, build_int_cst (size_type_node, 1));
 
-  tmp = build_call_expr_loc (input_location,
-builtin_decl_explicit (BUILT_IN_MALLOC), 1, tmp);
-  if (cond == boolean_true_node)
+  if (!cond_is_true)
+tmp = build_call_expr_loc (input_location,
+  builtin_decl_explicit (BUILT_IN_MALLOC), 1, tmp);
+  else
 tmp = alt_alloc;
-  else if (cond)
+
+  if (!cond_is_true && cond)
 tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), cond,
  alt_alloc, tmp);

[gcc r16-1096] Fortran: Fix missing substring ref for allocatable saved vars [PR120483]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:afa2de8093a0cd47394df42c7092aa6a357d2f9c

commit r16-1096-gafa2de8093a0cd47394df42c7092aa6a357d2f9c
Author: Andre Vehreschild 
Date:   Mon Jun 2 10:41:48 2025 +0200

Fortran: Fix missing substring ref for allocatable saved vars [PR120483]

Compute a substring ref on an allocatable static character array
using pointer arithmetic.  Using an array type corrupts type
layouting and crashes omp generation.

PR fortran/120483

gcc/fortran/ChangeLog:

* trans-expr.cc (gfc_conv_substring): Use pointer arithmetic on
static allocatable char arrays.

gcc/testsuite/ChangeLog:

* gfortran.dg/save_8.f90: New test.

Diff:
---
 gcc/fortran/trans-expr.cc| 16 +---
 gcc/testsuite/gfortran.dg/save_8.f90 | 13 +
 2 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 8d9448eb9b6d..74d4265f27d8 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2782,9 +2782,11 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
start.expr = gfc_evaluate_now (start.expr, &se->pre);
 
   /* Change the start of the string.  */
-  if ((TREE_CODE (TREE_TYPE (se->expr)) == ARRAY_TYPE
-  || TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE)
- && TYPE_STRING_FLAG (TREE_TYPE (se->expr)))
+  if (((TREE_CODE (TREE_TYPE (se->expr)) == ARRAY_TYPE
+   || TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE)
+  && TYPE_STRING_FLAG (TREE_TYPE (se->expr)))
+ || (POINTER_TYPE_P (TREE_TYPE (se->expr))
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (se->expr))) != ARRAY_TYPE))
tmp = se->expr;
   else
tmp = build_fold_indirect_ref_loc (input_location,
@@ -2795,6 +2797,14 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
  tmp = gfc_build_array_ref (tmp, start.expr, NULL_TREE, true);
  se->expr = gfc_build_addr_expr (type, tmp);
}
+  else if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+   {
+ tree diff;
+ diff = fold_build2 (MINUS_EXPR, size_type_node, start.expr,
+ build_one_cst (size_type_node));
+ se->expr
+   = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (tmp), tmp, diff);
+   }
 }
 
   /* Length = end + 1 - start.  */
diff --git a/gcc/testsuite/gfortran.dg/save_8.f90 
b/gcc/testsuite/gfortran.dg/save_8.f90
new file mode 100644
index ..8e9198caeb18
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/save_8.f90
@@ -0,0 +1,13 @@
+!{ dg-do run }
+
+! Check PR120483 is fixed.
+! Contributed by Thomas Koenig  
+!and Peter Güntert   
+
+program save_8
+  implicit none
+  character(len=:), allocatable, save :: s1
+  s1 = 'ABC'
+  if (s1(3:3) /= 'C') stop 1
+end program save_8
+

[gcc r15-9914] Fortran: Fix out of bounds access in structure constructor's clean up [PR120711]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:8b7a779b85df65a29fe3820886cbd72663b6dba4

commit r15-9914-g8b7a779b85df65a29fe3820886cbd72663b6dba4
Author: Andre Vehreschild 
Date:   Wed Jun 25 09:12:35 2025 +0200

Fortran: Fix out of bounds access in structure constructor's clean up 
[PR120711]

A structure constructor's generated clean up code was using an offset
variable, which was manipulated before the clean up was run leading to
an out of bounds access.

PR fortran/120711

gcc/fortran/ChangeLog:

* trans-array.cc (gfc_trans_array_ctor_element): Store the value
of the offset for reuse.

gcc/testsuite/ChangeLog:

* gfortran.dg/asan/array_constructor_1.f90: New test.

(cherry picked from commit dff66a690f6d47963e5cb96677d0e194b85948fa)

Diff:
---
 gcc/fortran/trans-array.cc | 10 ++
 .../gfortran.dg/asan/array_constructor_1.f90   | 23 ++
 2 files changed, 29 insertions(+), 4 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 960613167f72..4dd2d33fea76 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1991,14 +1991,17 @@ static void
 gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
  tree offset, gfc_se * se, gfc_expr * expr)
 {
-  tree tmp;
+  tree tmp, offset_eval;
 
   gfc_conv_expr (se, expr);
 
   /* Store the value.  */
   tmp = build_fold_indirect_ref_loc (input_location,
 gfc_conv_descriptor_data_get (desc));
-  tmp = gfc_build_array_ref (tmp, offset, NULL);
+  /* The offset may change, so get its value now and use that to free memory.
+   */
+  offset_eval = gfc_evaluate_now (offset, &se->pre);
+  tmp = gfc_build_array_ref (tmp, offset_eval, NULL);
 
   if (expr->expr_type == EXPR_FUNCTION && expr->ts.type == BT_DERIVED
   && expr->ts.u.derived->attr.alloc_comp)
@@ -3150,8 +3153,7 @@ finish:
  the reference.  */
   if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
&& finalblock.head != NULL_TREE)
-gfc_add_block_to_block (&loop->post, &finalblock);
-
+gfc_prepend_expr_to_block (&loop->post, finalblock.head);
 }
 
 
diff --git a/gcc/testsuite/gfortran.dg/asan/array_constructor_1.f90 
b/gcc/testsuite/gfortran.dg/asan/array_constructor_1.f90
new file mode 100644
index ..45eafacd5a67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/array_constructor_1.f90
@@ -0,0 +1,23 @@
+!{ dg-do run }
+
+! Contributed by Christopher Albert  
+
+program grow_type_array
+type :: container
+integer, allocatable :: arr(:)
+end type container
+
+type(container), allocatable :: list(:)
+
+list = [list, new_elem(5)]
+
+deallocate(list)
+
+contains
+
+type(container) function new_elem(s) result(out)
+integer :: s
+allocate(out%arr(s))
+end function new_elem
+  
+end program grow_type_array

[gcc r16-1967] Fortran: Remove corank conformability checks [PR120843]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:15413e05eb9cde976b8890cd9b597d0a41a8eb27

commit r16-1967-g15413e05eb9cde976b8890cd9b597d0a41a8eb27
Author: Andre Vehreschild 
Date:   Wed Jul 2 11:06:17 2025 +0200

Fortran: Remove corank conformability checks [PR120843]

Remove the checks on coranks conformability in expressions,
because there is nothing in the standard about it.  When a coarray
has no coindexes it it treated like a non-coarray, when it has
a full-corank coindex its result is a regular array.  So nothing
to check for corank conformability.

PR fortran/120843

gcc/fortran/ChangeLog:

* resolve.cc (resolve_operator): Remove conformability check,
because it is not in the standard.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/coindexed_6.f90: Enhance test to have
coarray components covered.

Diff:
---
 gcc/fortran/resolve.cc| 29 ---
 gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 | 13 +++---
 2 files changed, 10 insertions(+), 32 deletions(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 50a6fe7fc52d..4a6e951cdf16 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -4807,35 +4807,6 @@ resolve_operator (gfc_expr *e)
  return false;
}
}
-
-  /* coranks have to be equal or one has to be zero to be combinable.  */
-  if (op1->corank == op2->corank || (op1->corank != 0 && op2->corank == 0))
-   {
- e->corank = op1->corank;
- /* Only do this, when regular array has not set a shape yet.  */
- if (e->shape == NULL)
-   {
- if (op1->corank != 0)
-   {
- e->shape = gfc_copy_shape (op1->shape, op1->corank);
-   }
-   }
-   }
-  else if (op1->corank == 0 && op2->corank != 0)
-   {
- e->corank = op2->corank;
- /* Only do this, when regular array has not set a shape yet.  */
- if (e->shape == NULL)
-   e->shape = gfc_copy_shape (op2->shape, op2->corank);
-   }
-  else if ((op1->ref && !gfc_ref_this_image (op1->ref))
-  || (op2->ref && !gfc_ref_this_image (op2->ref)))
-   {
- gfc_error ("Inconsistent coranks for operator at %L and %L",
-&op1->where, &op2->where);
- return false;
-   }
-
   break;
 
 case INTRINSIC_PARENTHESES:
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 
b/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90
index 8f5dcabb859a..d566c504134f 100644
--- a/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90
@@ -5,13 +5,20 @@
 program p
   implicit none
 
-  integer, allocatable :: arr(:,:) [:,:]
+  type T
+integer, allocatable :: arr(:,:) [:,:]
+  end type
+
+  type(T) :: o
+  integer, allocatable :: vec(:)[:,:]
   integer :: c[*]
 
   c = 7
 
-  allocate(arr(4,3)[2,*], source=6)
+  allocate(o%arr(4,3)[2,*], source=6)
+  allocate(vec(10)[1,*], source=7)
 
-  if (arr(2,2)* c /= 42) stop 1
+  if (vec(3) * c /= 49) stop 1
+  if (o%arr(2,2)* c /= 42) stop 2
 
 end program p

[gcc r16-1885] Fortran: Fix non-conformable corank on this_image ref [PR120843]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:1b0930e9046e0b6201fa03c2843f3b06e522acd1

commit r16-1885-g1b0930e9046e0b6201fa03c2843f3b06e522acd1
Author: Andre Vehreschild 
Date:   Fri Jun 27 14:39:13 2025 +0200

Fortran: Fix non-conformable corank on this_image ref [PR120843]

PR fortran/120843

gcc/fortran/ChangeLog:

* resolve.cc (resolve_operator): Report inconsistent coranks
only when not referencing this_image.
(gfc_op_rank_conformable): Treat coranks as inconformable only
when a coindex other then implicit this_image is used.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/coindexed_6.f90: New test.

Diff:
---
 gcc/fortran/resolve.cc|  7 ---
 gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 | 17 +
 2 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 58f7aee29c35..50a6fe7fc52d 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -4828,7 +4828,8 @@ resolve_operator (gfc_expr *e)
  if (e->shape == NULL)
e->shape = gfc_copy_shape (op2->shape, op2->corank);
}
-  else
+  else if ((op1->ref && !gfc_ref_this_image (op1->ref))
+  || (op2->ref && !gfc_ref_this_image (op2->ref)))
{
  gfc_error ("Inconsistent coranks for operator at %L and %L",
 &op1->where, &op2->where);
@@ -6070,8 +6071,8 @@ gfc_op_rank_conformable (gfc_expr *op1, gfc_expr *op2)
 gfc_expression_rank (op2);
 
   return (op1->rank == 0 || op2->rank == 0 || op1->rank == op2->rank)
-&& (op1->corank == 0 || op2->corank == 0
-|| op1->corank == op2->corank);
+&& (op1->corank == 0 || op2->corank == 0 || op1->corank == op2->corank
+|| (!gfc_is_coindexed (op1) && !gfc_is_coindexed (op2)));
 }
 
 /* Resolve a variable expression.  */
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 
b/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90
new file mode 100644
index ..8f5dcabb859a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90
@@ -0,0 +1,17 @@
+!{ dg-do compile }
+
+! Check PR120843 is fixed
+
+program p
+  implicit none
+
+  integer, allocatable :: arr(:,:) [:,:]
+  integer :: c[*]
+
+  c = 7
+
+  allocate(arr(4,3)[2,*], source=6)
+
+  if (arr(2,2)* c /= 42) stop 1
+
+end program p

[gcc r16-1891] Fortran: Ensure arguments in coarray call get unique components in add_data [PR120847]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:ee31ab9b1950b7f47f030bda231ace34d187ae26

commit r16-1891-gee31ab9b1950b7f47f030bda231ace34d187ae26
Author: Andre Vehreschild 
Date:   Fri Jun 27 15:31:21 2025 +0200

Fortran: Ensure arguments in coarray call get unique components in add_data 
[PR120847]

PR fortran/120847

gcc/fortran/ChangeLog:

* coarray.cc (check_add_new_comp_handle_array): Make the count
of components static to be able to create more than one.  Create
an array component only for array expressions.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/coindexed_7.f90: New test.

Diff:
---
 gcc/fortran/coarray.cc|  4 ++--
 gcc/testsuite/gfortran.dg/coarray/coindexed_7.f90 | 24 +++
 2 files changed, 26 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
index 2f067f855e54..6914697c78b4 100644
--- a/gcc/fortran/coarray.cc
+++ b/gcc/fortran/coarray.cc
@@ -503,7 +503,7 @@ check_add_new_comp_handle_array (gfc_expr *e, gfc_symbol 
*type,
 gfc_symbol *add_data)
 {
   gfc_component *comp;
-  int cnt = -1;
+  static int cnt = -1;
   gfc_symtree *caller_image;
   gfc_code *pre_code = caf_accessor_prepend;
   bool static_array_or_scalar = true;
@@ -566,7 +566,7 @@ check_add_new_comp_handle_array (gfc_expr *e, gfc_symbol 
*type,
   else
 {
   comp->initializer = gfc_copy_expr (e);
-  if (e_attr.dimension)
+  if (e_attr.dimension && e->rank)
{
  comp->attr.dimension = 1;
  comp->as = get_arrayspec_from_expr (e);
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_7.f90 
b/gcc/testsuite/gfortran.dg/coarray/coindexed_7.f90
new file mode 100644
index ..066397024f47
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_7.f90
@@ -0,0 +1,24 @@
+!{ dg-do compile }
+
+! Check PR120847 is fixed.
+
+program p
+  implicit none
+
+  type T
+integer, allocatable :: i(:, :) [:]
+  end type T
+
+  type(T) :: o
+  integer, allocatable :: c[:]
+  integer :: i
+
+  c = 7
+
+  allocate(o%i(4, 5)[*], source=6)
+
+  do i = 1, 4
+c = o%i(mod(i, 2), mod(i, 3))[1]
+  end do
+
+end program p

[gcc r16-2086] Fortran: Ensure finalizers are created correctly [PR120637]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:d1f05661fa6c8a6ea6f59ad365a84469100e425e

commit r16-2086-gd1f05661fa6c8a6ea6f59ad365a84469100e425e
Author: Andre Vehreschild 
Date:   Wed Jun 25 14:46:16 2025 +0200

Fortran: Ensure finalizers are created correctly [PR120637]

Finalize_component freeed an expression that it used to remember which
components in which context it had finalized already.  While it makes
sense to free the copy of the expression, if it is unused, it causes
issues, when comparing to a non existent expression. This is now
detected by returning true, when the expression has been used.

PR fortran/120637

gcc/fortran/ChangeLog:

* class.cc (finalize_component): Return true, when a finalizable
component was detect and do not free it.

gcc/testsuite/ChangeLog:

* gfortran.dg/asan/finalize_1.f90: New test.

Diff:
---
 gcc/fortran/class.cc  | 24 ++
 gcc/testsuite/gfortran.dg/asan/finalize_1.f90 | 67 +++
 2 files changed, 81 insertions(+), 10 deletions(-)

diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index df18601e45bd..a1c6fafa75ef 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -1034,7 +1034,7 @@ comp_is_finalizable (gfc_component *comp)
of calling the appropriate finalizers, coarray deregistering, and
deallocation of allocatable subcomponents.  */
 
-static void
+static bool
 finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
gfc_symbol *stat, gfc_symbol *fini_coarray, gfc_code **code,
gfc_namespace *sub_ns)
@@ -1044,14 +1044,14 @@ finalize_component (gfc_expr *expr, gfc_symbol 
*derived, gfc_component *comp,
   gfc_was_finalized *f;
 
   if (!comp_is_finalizable (comp))
-return;
+return false;
 
   /* If this expression with this component has been finalized
  already in this namespace, there is nothing to do.  */
   for (f = sub_ns->was_finalized; f; f = f->next)
 {
   if (f->e == expr && f->c == comp)
-   return;
+   return false;
 }
 
   e = gfc_copy_expr (expr);
@@ -1208,8 +1208,6 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, 
gfc_component *comp,
   final_wrap->ext.actual->next->next = gfc_get_actual_arglist ();
   final_wrap->ext.actual->next->next->expr = fini_coarray_expr;
 
-
-
   if (*code)
{
  (*code)->next = final_wrap;
@@ -1221,11 +1219,14 @@ finalize_component (gfc_expr *expr, gfc_symbol 
*derived, gfc_component *comp,
   else
 {
   gfc_component *c;
+  bool ret = false;
 
   for (c = comp->ts.u.derived->components; c; c = c->next)
-   finalize_component (e, comp->ts.u.derived, c, stat, fini_coarray, code,
-   sub_ns);
-  gfc_free_expr (e);
+   ret |= finalize_component (e, comp->ts.u.derived, c, stat, fini_coarray,
+  code, sub_ns);
+  /* Only free the expression, if it has never been used.  */
+  if (!ret)
+   gfc_free_expr (e);
 }
 
   /* Record that this was finalized already in this namespace.  */
@@ -1234,6 +1235,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, 
gfc_component *comp,
   sub_ns->was_finalized->e = expr;
   sub_ns->was_finalized->c = comp;
   sub_ns->was_finalized->next = f;
+  return true;
 }
 
 
@@ -2314,6 +2316,7 @@ finish_assumed_rank:
 {
   gfc_symbol *stat;
   gfc_code *block = NULL;
+  gfc_expr *ptr_expr;
 
   if (!ptr)
{
@@ -2359,14 +2362,15 @@ finish_assumed_rank:
 sub_ns);
   block = block->next;
 
+  ptr_expr = gfc_lval_expr_from_sym (ptr);
   for (comp = derived->components; comp; comp = comp->next)
{
  if (comp == derived->components && derived->attr.extension
  && ancestor_wrapper && ancestor_wrapper->expr_type != EXPR_NULL)
continue;
 
- finalize_component (gfc_lval_expr_from_sym (ptr), derived, comp,
- stat, fini_coarray, &block, sub_ns);
+ finalize_component (ptr_expr, derived, comp, stat, fini_coarray,
+ &block, sub_ns);
  if (!last_code->block->next)
last_code->block->next = block;
}
diff --git a/gcc/testsuite/gfortran.dg/asan/finalize_1.f90 
b/gcc/testsuite/gfortran.dg/asan/finalize_1.f90
new file mode 100644
index ..ab53a9ecf2be
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/finalize_1.f90
@@ -0,0 +1,67 @@
+!{ dg-do run }
+
+! PR fortran/120637
+
+! Contributed by Antony Lewis  
+! The unused module is needed to trigger the issue of not freeing the
+! memory of second module.
+
+module MiscUtils
+implicit none
+
+contains
+
+logical function isFloat0(R)
+class(*), intent(in) :: R
+
+select type(R)
+type is (real)
+isFloat0 = .true.
+e

[gcc r15-9945] Fortran: Remove corank conformability checks [PR120843]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:120efb3931260de35173267ec6870d8f17fbadb5

commit r15-9945-g120efb3931260de35173267ec6870d8f17fbadb5
Author: Andre Vehreschild 
Date:   Wed Jul 2 11:06:17 2025 +0200

Fortran: Remove corank conformability checks [PR120843]

Remove the checks on coranks conformability in expressions,
because there is nothing in the standard about it.  When a coarray
has no coindexes it it treated like a non-coarray, when it has
a full-corank coindex its result is a regular array.  So nothing
to check for corank conformability.

PR fortran/120843

gcc/fortran/ChangeLog:

* resolve.cc (resolve_operator): Remove conformability check,
because it is not in the standard.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/coindexed_6.f90: Enhance test to have
coarray components covered.

(cherry picked from commit 15413e05eb9cde976b8890cd9b597d0a41a8eb27)

Diff:
---
 gcc/fortran/resolve.cc| 29 ---
 gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 | 13 +++---
 2 files changed, 10 insertions(+), 32 deletions(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 2fbe7c451428..760526eb4029 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -4807,35 +4807,6 @@ resolve_operator (gfc_expr *e)
  return false;
}
}
-
-  /* coranks have to be equal or one has to be zero to be combinable.  */
-  if (op1->corank == op2->corank || (op1->corank != 0 && op2->corank == 0))
-   {
- e->corank = op1->corank;
- /* Only do this, when regular array has not set a shape yet.  */
- if (e->shape == NULL)
-   {
- if (op1->corank != 0)
-   {
- e->shape = gfc_copy_shape (op1->shape, op1->corank);
-   }
-   }
-   }
-  else if (op1->corank == 0 && op2->corank != 0)
-   {
- e->corank = op2->corank;
- /* Only do this, when regular array has not set a shape yet.  */
- if (e->shape == NULL)
-   e->shape = gfc_copy_shape (op2->shape, op2->corank);
-   }
-  else if ((op1->ref && !gfc_ref_this_image (op1->ref))
-  || (op2->ref && !gfc_ref_this_image (op2->ref)))
-   {
- gfc_error ("Inconsistent coranks for operator at %L and %L",
-&op1->where, &op2->where);
- return false;
-   }
-
   break;
 
 case INTRINSIC_PARENTHESES:
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 
b/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90
index 8f5dcabb859a..d566c504134f 100644
--- a/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90
@@ -5,13 +5,20 @@
 program p
   implicit none
 
-  integer, allocatable :: arr(:,:) [:,:]
+  type T
+integer, allocatable :: arr(:,:) [:,:]
+  end type
+
+  type(T) :: o
+  integer, allocatable :: vec(:)[:,:]
   integer :: c[*]
 
   c = 7
 
-  allocate(arr(4,3)[2,*], source=6)
+  allocate(o%arr(4,3)[2,*], source=6)
+  allocate(vec(10)[1,*], source=7)
 
-  if (arr(2,2)* c /= 42) stop 1
+  if (vec(3) * c /= 49) stop 1
+  if (o%arr(2,2)* c /= 42) stop 2
 
 end program p

[gcc r15-9935] Fortran: Ensure arguments in coarray call get unique components in add_data [PR120847]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:67452737d8e6d2629104ac811eaf6ec8c1790614

commit r15-9935-g67452737d8e6d2629104ac811eaf6ec8c1790614
Author: Andre Vehreschild 
Date:   Fri Jun 27 15:31:21 2025 +0200

Fortran: Ensure arguments in coarray call get unique components in add_data 
[PR120847]

PR fortran/120847

gcc/fortran/ChangeLog:

* coarray.cc (check_add_new_comp_handle_array): Make the count
of components static to be able to create more than one.  Create
an array component only for array expressions.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/coindexed_7.f90: New test.

(cherry picked from commit ee31ab9b1950b7f47f030bda231ace34d187ae26)

Diff:
---
 gcc/fortran/coarray.cc|  4 ++--
 gcc/testsuite/gfortran.dg/coarray/coindexed_7.f90 | 24 +++
 2 files changed, 26 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
index 70583254d0d8..a2cfdc0fb52c 100644
--- a/gcc/fortran/coarray.cc
+++ b/gcc/fortran/coarray.cc
@@ -498,7 +498,7 @@ check_add_new_comp_handle_array (gfc_expr *e, gfc_symbol 
*type,
 gfc_symbol *add_data)
 {
   gfc_component *comp;
-  int cnt = -1;
+  static int cnt = -1;
   gfc_symtree *caller_image;
   gfc_code *pre_code = caf_accessor_prepend;
   bool static_array_or_scalar = true;
@@ -561,7 +561,7 @@ check_add_new_comp_handle_array (gfc_expr *e, gfc_symbol 
*type,
   else
 {
   comp->initializer = gfc_copy_expr (e);
-  if (e_attr.dimension)
+  if (e_attr.dimension && e->rank)
{
  comp->attr.dimension = 1;
  comp->as = get_arrayspec_from_expr (e);
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_7.f90 
b/gcc/testsuite/gfortran.dg/coarray/coindexed_7.f90
new file mode 100644
index ..066397024f47
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_7.f90
@@ -0,0 +1,24 @@
+!{ dg-do compile }
+
+! Check PR120847 is fixed.
+
+program p
+  implicit none
+
+  type T
+integer, allocatable :: i(:, :) [:]
+  end type T
+
+  type(T) :: o
+  integer, allocatable :: c[:]
+  integer :: i
+
+  c = 7
+
+  allocate(o%i(4, 5)[*], source=6)
+
+  do i = 1, 4
+c = o%i(mod(i, 2), mod(i, 3))[1]
+  end do
+
+end program p

[gcc r15-9934] Fortran: Fix non-conformable corank on this_image ref [PR120843]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:887ddb4d8c3ddd27c3a5cfd79f21dd52403c82fa

commit r15-9934-g887ddb4d8c3ddd27c3a5cfd79f21dd52403c82fa
Author: Andre Vehreschild 
Date:   Fri Jun 27 14:39:13 2025 +0200

Fortran: Fix non-conformable corank on this_image ref [PR120843]

PR fortran/120843

gcc/fortran/ChangeLog:

* resolve.cc (resolve_operator): Report inconsistent coranks
only when not referencing this_image.
(gfc_op_rank_conformable): Treat coranks as inconformable only
when a coindex other then implicit this_image is used.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/coindexed_6.f90: New test.

(cherry picked from commit 1b0930e9046e0b6201fa03c2843f3b06e522acd1)

Diff:
---
 gcc/fortran/resolve.cc|  7 ---
 gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 | 17 +
 2 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index ee5b22a728d4..2fbe7c451428 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -4828,7 +4828,8 @@ resolve_operator (gfc_expr *e)
  if (e->shape == NULL)
e->shape = gfc_copy_shape (op2->shape, op2->corank);
}
-  else
+  else if ((op1->ref && !gfc_ref_this_image (op1->ref))
+  || (op2->ref && !gfc_ref_this_image (op2->ref)))
{
  gfc_error ("Inconsistent coranks for operator at %L and %L",
 &op1->where, &op2->where);
@@ -6070,8 +6071,8 @@ gfc_op_rank_conformable (gfc_expr *op1, gfc_expr *op2)
 gfc_expression_rank (op2);
 
   return (op1->rank == 0 || op2->rank == 0 || op1->rank == op2->rank)
-&& (op1->corank == 0 || op2->corank == 0
-|| op1->corank == op2->corank);
+&& (op1->corank == 0 || op2->corank == 0 || op1->corank == op2->corank
+|| (!gfc_is_coindexed (op1) && !gfc_is_coindexed (op2)));
 }
 
 /* Resolve a variable expression.  */
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 
b/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90
new file mode 100644
index ..8f5dcabb859a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90
@@ -0,0 +1,17 @@
+!{ dg-do compile }
+
+! Check PR120843 is fixed
+
+program p
+  implicit none
+
+  integer, allocatable :: arr(:,:) [:,:]
+  integer :: c[*]
+
+  c = 7
+
+  allocate(arr(4,3)[2,*], source=6)
+
+  if (arr(2,2)* c /= 42) stop 1
+
+end program p

[gcc r15-9978] Fortran: Ensure finalizers are created correctly [PR120637]

[Andre Vehreschild via Gcc-cvs]

https://gcc.gnu.org/g:1cb95b3006dd615a03d3e4bade5605532c4ab65e

commit r15-9978-g1cb95b3006dd615a03d3e4bade5605532c4ab65e
Author: Andre Vehreschild 
Date:   Wed Jun 25 14:46:16 2025 +0200

Fortran: Ensure finalizers are created correctly [PR120637]

Finalize_component freeed an expression that it used to remember which
components in which context it had finalized already.  While it makes
sense to free the copy of the expression, if it is unused, it causes
issues, when comparing to a non existent expression. This is now
detected by returning true, when the expression has been used.

PR fortran/120637

gcc/fortran/ChangeLog:

* class.cc (finalize_component): Return true, when a finalizable
component was detect and do not free it.

gcc/testsuite/ChangeLog:

* gfortran.dg/asan/finalize_1.f90: New test.

(cherry picked from commit d1f05661fa6c8a6ea6f59ad365a84469100e425e)

Diff:
---
 gcc/fortran/class.cc  | 24 ++
 gcc/testsuite/gfortran.dg/asan/finalize_1.f90 | 67 +++
 2 files changed, 81 insertions(+), 10 deletions(-)

diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index df18601e45bd..a1c6fafa75ef 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -1034,7 +1034,7 @@ comp_is_finalizable (gfc_component *comp)
of calling the appropriate finalizers, coarray deregistering, and
deallocation of allocatable subcomponents.  */
 
-static void
+static bool
 finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
gfc_symbol *stat, gfc_symbol *fini_coarray, gfc_code **code,
gfc_namespace *sub_ns)
@@ -1044,14 +1044,14 @@ finalize_component (gfc_expr *expr, gfc_symbol 
*derived, gfc_component *comp,
   gfc_was_finalized *f;
 
   if (!comp_is_finalizable (comp))
-return;
+return false;
 
   /* If this expression with this component has been finalized
  already in this namespace, there is nothing to do.  */
   for (f = sub_ns->was_finalized; f; f = f->next)
 {
   if (f->e == expr && f->c == comp)
-   return;
+   return false;
 }
 
   e = gfc_copy_expr (expr);
@@ -1208,8 +1208,6 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, 
gfc_component *comp,
   final_wrap->ext.actual->next->next = gfc_get_actual_arglist ();
   final_wrap->ext.actual->next->next->expr = fini_coarray_expr;
 
-
-
   if (*code)
{
  (*code)->next = final_wrap;
@@ -1221,11 +1219,14 @@ finalize_component (gfc_expr *expr, gfc_symbol 
*derived, gfc_component *comp,
   else
 {
   gfc_component *c;
+  bool ret = false;
 
   for (c = comp->ts.u.derived->components; c; c = c->next)
-   finalize_component (e, comp->ts.u.derived, c, stat, fini_coarray, code,
-   sub_ns);
-  gfc_free_expr (e);
+   ret |= finalize_component (e, comp->ts.u.derived, c, stat, fini_coarray,
+  code, sub_ns);
+  /* Only free the expression, if it has never been used.  */
+  if (!ret)
+   gfc_free_expr (e);
 }
 
   /* Record that this was finalized already in this namespace.  */
@@ -1234,6 +1235,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, 
gfc_component *comp,
   sub_ns->was_finalized->e = expr;
   sub_ns->was_finalized->c = comp;
   sub_ns->was_finalized->next = f;
+  return true;
 }
 
 
@@ -2314,6 +2316,7 @@ finish_assumed_rank:
 {
   gfc_symbol *stat;
   gfc_code *block = NULL;
+  gfc_expr *ptr_expr;
 
   if (!ptr)
{
@@ -2359,14 +2362,15 @@ finish_assumed_rank:
 sub_ns);
   block = block->next;
 
+  ptr_expr = gfc_lval_expr_from_sym (ptr);
   for (comp = derived->components; comp; comp = comp->next)
{
  if (comp == derived->components && derived->attr.extension
  && ancestor_wrapper && ancestor_wrapper->expr_type != EXPR_NULL)
continue;
 
- finalize_component (gfc_lval_expr_from_sym (ptr), derived, comp,
- stat, fini_coarray, &block, sub_ns);
+ finalize_component (ptr_expr, derived, comp, stat, fini_coarray,
+ &block, sub_ns);
  if (!last_code->block->next)
last_code->block->next = block;
}
diff --git a/gcc/testsuite/gfortran.dg/asan/finalize_1.f90 
b/gcc/testsuite/gfortran.dg/asan/finalize_1.f90
new file mode 100644
index ..ab53a9ecf2be
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/finalize_1.f90
@@ -0,0 +1,67 @@
+!{ dg-do run }
+
+! PR fortran/120637
+
+! Contributed by Antony Lewis  
+! The unused module is needed to trigger the issue of not freeing the
+! memory of second module.
+
+module MiscUtils
+implicit none
+
+contains
+
+logical function isFloat0(R)
+class(*), intent(in) ::