* [Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument
@ 2024-06-14 15:05 Andre Vehreschild
2024-06-16 21:27 ` Harald Anlauf
0 siblings, 1 reply; 7+ messages in thread
From: Andre Vehreschild @ 2024-06-14 15:05 UTC (permalink / raw)
To: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 661 bytes --]
Hi all,
I somehow got assigned to this PR so I fixed it. GFortran was ICEing because of
the ASSUME_RANK in a derived to class conversion. After fixing this, storage
association was producing segfaults. The "shape conversion" of the class array
as dummy argument was not initializing the dim 0 stride and with that grabbing
into the memory somewhere. This is now fixed and
regtests fine on x86_64 Fedora 39. Ok for mainline?
I assume this patch could be fixing some other PRs with class array's parameter
passing, too. If that sounds familiar, feel free to point me to them.
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr96992_1.patch --]
[-- Type: text/x-patch, Size: 4701 bytes --]
From 86ac3179e1314ca1c41f52025c5a156ad7346dc1 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Fri, 14 Jun 2024 16:54:37 +0200
Subject: [PATCH] Fortran: [PR96992] Fix rejecting class arrays of different
ranks as storage association argument.
Removing the assert in trans-expr, lead to initial strides not set
which is not fixed.
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.
* trans-expr.cc (gfc_conv_derived_to_class): Remove assert to
allow converting derived to class type arrays with assumend
rank.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr96992.f90: New test.
---
gcc/fortran/trans-array.cc | 7 ++-
gcc/fortran/trans-expr.cc | 2 -
gcc/testsuite/gfortran.dg/pr96992.f90 | 61 +++++++++++++++++++++++++++
3 files changed, 67 insertions(+), 3 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr96992.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b3088a892c8..9fa8bad2f35 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6798,6 +6798,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.
@@ -7134,7 +7137,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))
+ && sym->attr.dummy && !sym->attr.elemental && gfc_is_nodesc_array (sym))
{
gfc_trans_g77_array (sym, block);
return;
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0796fb75505..4bb62cfb1ad 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -903,8 +903,6 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
if (e->rank != class_ts.u.derived->components->as->rank)
{
- gcc_assert (class_ts.u.derived->components->as->type
- == AS_ASSUMED_RANK);
if (derived_array
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse->expr)))
{
diff --git a/gcc/testsuite/gfortran.dg/pr96992.f90 b/gcc/testsuite/gfortran.dg/pr96992.f90
new file mode 100644
index 00000000000..c56ed80f394
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96992.f90
@@ -0,0 +1,61 @@
+! { dg-do run }
+
+! PR fortran/96992
+
+! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
+
+! From the standard:
+! An actual argument that represents an element sequence and
+! corresponds to a dummy argument that is an array is sequence
+! associated with the dummy argument. The rank and shape of the
+! actual argument need not agree with the rank and shape of the
+! dummy argument, but the number of elements in the dummy argument
+! shall not exceed the number of elements in the element sequence
+! of the actual argument. If the dummy argument is assumed-size,
+! the number of elements in the dummy argument is exactly
+! the number of elements in the element sequence.
+
+! Check that walking the sequence starts with an initialized stride
+! for dim == 0.
+
+module foo_mod
+ implicit none
+ type foo
+ integer :: i
+ end type foo
+contains
+ subroutine d1(x,n)
+ integer, intent(in) :: n
+ integer :: i
+ class (foo), intent(out), dimension(n) :: x
+ select type(x)
+ class is(foo)
+ x(:)%i = (/ (42 + i, i = 1, n ) /)
+ class default
+ stop 1
+ end select
+ end subroutine d1
+ subroutine d2(x,n)
+ integer, intent(in) :: n
+ integer :: i
+ class (foo), intent(in), dimension(n,n,n) :: x
+ select type (x)
+ class is (foo)
+ print *,x%i
+ if ( any( x%i /= reshape((/ (42 + i, i = 1, n ** 3 ) /), [n, n, n] ))) stop 2
+ class default
+ stop 3
+ end select
+ end subroutine d2
+end module foo_mod
+program main
+ use foo_mod
+ implicit none
+ type (foo), dimension(:), allocatable :: f
+ integer :: n
+ n = 3
+ allocate (f(n*n*n))
+ call d1(f,n*n*n)
+ call d2(f,n)
+end program main
+
--
2.45.1
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument
2024-06-14 15:05 [Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument Andre Vehreschild
@ 2024-06-16 21:27 ` Harald Anlauf
2024-06-16 21:27 ` Harald Anlauf
2024-06-19 7:07 ` Andre Vehreschild
0 siblings, 2 replies; 7+ messages in thread
From: Harald Anlauf @ 2024-06-16 21:27 UTC (permalink / raw)
To: gcc-patches; +Cc: fortran
Hi Andre,
Am 14.06.24 um 17:05 schrieb Andre Vehreschild:
> Hi all,
>
> I somehow got assigned to this PR so I fixed it. GFortran was ICEing because of
> the ASSUME_RANK in a derived to class conversion. After fixing this, storage
> association was producing segfaults. The "shape conversion" of the class array
> as dummy argument was not initializing the dim 0 stride and with that grabbing
> into the memory somewhere. This is now fixed and
>
> regtests fine on x86_64 Fedora 39. Ok for mainline?
the patch fixes the testcase in your submission, but not the following
slight variation of the main program:
module foo_mod
implicit none
type foo
integer :: i
end type foo
contains
subroutine d1(x,n)
integer, intent(in) :: n
integer :: i
class (foo), intent(out) :: x(n)
select type(x)
class is(foo)
x(:)%i = (/ (42 + i, i = 1, n ) /)
class default
stop 1
end select
end subroutine d1
subroutine d2(x,n)
integer, intent(in) :: n
integer :: i
class (foo), intent(in) :: x(n,n,n)
select type (x)
class is (foo)
print *,x%i
if ( any( x%i /= reshape((/ (42 + i, i = 1, n ** 3 ) /), [n, n,
n] ))) stop 2
class default
stop 3
end select
end subroutine d2
end module foo_mod
program main
use foo_mod
implicit none
type (foo), dimension(:), allocatable :: f
integer :: n
n = 2
allocate (f(n*n*n))
! Original testcase:
call d1(f,n*n*n)
call d2(f,n) ! OK
call d1(f(1:n*n*n),n*n*n)
print *, "After call d1(f(1:n*n*n:1),n*n*n):"
print *, f%i
call d2(f(1:n*n*n),n) ! OK
! Using stride -1:
call d1(f(n*n*n:1:-1),n*n*n)
print *, "After call d1(f(n*n*n:1:-1),n*n*n):"
print *, f%i
call d2(f(n*n*n:1:-1),n) ! not OK
deallocate (f)
end program main
While this runs fine with the latest Intel compiler, gfortran including
your patch prints:
43 44 45 46 47
48 49 50
After call d1(f(1:n*n*n:1),n*n*n):
43 44 45 46 47
48 49 50
43 44 45 46 47
48 49 50
After call d1(f(n*n*n:1:-1),n*n*n):
50 49 48 47 46
45 44 43
43 0 0 49 0
34244976 0 34238480
STOP 2
So while the negative stride (-1) in the call to d1 appears to
work as it should, it does not work properly for the call to d2.
The first array element is fine in d2, but anything else isn't.
Do you see what goes wrong here?
(This may be a more general, pre-existing issue in a different place.)
Thanks,
Harald
P.S.: regarding your commit message, I think the reference to the pr
in brackets should be moved to the end of the summary line, i.e. for
Fortran: [PR96992] Fix rejecting class arrays of different ranks as
storage association argument.
the "[PR96992" should be moved. Makes it also easier to read.
> I assume this patch could be fixing some other PRs with class array's parameter
> passing, too. If that sounds familiar, feel free to point me to them.
>
> Regards,
> Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument
2024-06-16 21:27 ` Harald Anlauf
@ 2024-06-16 21:27 ` Harald Anlauf
2024-06-19 7:07 ` Andre Vehreschild
1 sibling, 0 replies; 7+ messages in thread
From: Harald Anlauf @ 2024-06-16 21:27 UTC (permalink / raw)
To: Andre Vehreschild, GCC-Patches-ML, GCC-Fortran-ML
Hi Andre,
Am 14.06.24 um 17:05 schrieb Andre Vehreschild:
> Hi all,
>
> I somehow got assigned to this PR so I fixed it. GFortran was ICEing because of
> the ASSUME_RANK in a derived to class conversion. After fixing this, storage
> association was producing segfaults. The "shape conversion" of the class array
> as dummy argument was not initializing the dim 0 stride and with that grabbing
> into the memory somewhere. This is now fixed and
>
> regtests fine on x86_64 Fedora 39. Ok for mainline?
the patch fixes the testcase in your submission, but not the following
slight variation of the main program:
module foo_mod
implicit none
type foo
integer :: i
end type foo
contains
subroutine d1(x,n)
integer, intent(in) :: n
integer :: i
class (foo), intent(out) :: x(n)
select type(x)
class is(foo)
x(:)%i = (/ (42 + i, i = 1, n ) /)
class default
stop 1
end select
end subroutine d1
subroutine d2(x,n)
integer, intent(in) :: n
integer :: i
class (foo), intent(in) :: x(n,n,n)
select type (x)
class is (foo)
print *,x%i
if ( any( x%i /= reshape((/ (42 + i, i = 1, n ** 3 ) /), [n, n,
n] ))) stop 2
class default
stop 3
end select
end subroutine d2
end module foo_mod
program main
use foo_mod
implicit none
type (foo), dimension(:), allocatable :: f
integer :: n
n = 2
allocate (f(n*n*n))
! Original testcase:
call d1(f,n*n*n)
call d2(f,n) ! OK
call d1(f(1:n*n*n),n*n*n)
print *, "After call d1(f(1:n*n*n:1),n*n*n):"
print *, f%i
call d2(f(1:n*n*n),n) ! OK
! Using stride -1:
call d1(f(n*n*n:1:-1),n*n*n)
print *, "After call d1(f(n*n*n:1:-1),n*n*n):"
print *, f%i
call d2(f(n*n*n:1:-1),n) ! not OK
deallocate (f)
end program main
While this runs fine with the latest Intel compiler, gfortran including
your patch prints:
43 44 45 46 47
48 49 50
After call d1(f(1:n*n*n:1),n*n*n):
43 44 45 46 47
48 49 50
43 44 45 46 47
48 49 50
After call d1(f(n*n*n:1:-1),n*n*n):
50 49 48 47 46
45 44 43
43 0 0 49 0
34244976 0 34238480
STOP 2
So while the negative stride (-1) in the call to d1 appears to
work as it should, it does not work properly for the call to d2.
The first array element is fine in d2, but anything else isn't.
Do you see what goes wrong here?
(This may be a more general, pre-existing issue in a different place.)
Thanks,
Harald
P.S.: regarding your commit message, I think the reference to the pr
in brackets should be moved to the end of the summary line, i.e. for
Fortran: [PR96992] Fix rejecting class arrays of different ranks as
storage association argument.
the "[PR96992" should be moved. Makes it also easier to read.
> I assume this patch could be fixing some other PRs with class array's parameter
> passing, too. If that sounds familiar, feel free to point me to them.
>
> Regards,
> Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument
2024-06-16 21:27 ` Harald Anlauf
2024-06-16 21:27 ` Harald Anlauf
@ 2024-06-19 7:07 ` Andre Vehreschild
2024-06-19 19:17 ` Harald Anlauf
1 sibling, 1 reply; 7+ messages in thread
From: Andre Vehreschild @ 2024-06-19 7:07 UTC (permalink / raw)
To: Harald Anlauf; +Cc: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 626 bytes --]
Hi Harald,
thank you for the investigation and useful tips. I had to figure what went
wrong here, but I now figured, that the array needs repacking when a negative
stride is used (or at least a call to that routine, which then fixes "stuff").
I have added it, freeing the memory allocated potentially by pack, and also
updated the testcase to include the negative stride.
Regtests fine on x86_64-pc-linux-gnu/Fedora 39. Ok for mainline?
Regards,
Andre
On Sun, 16 Jun 2024 23:27:46 +0200
Harald Anlauf <anlauf@gmx.de> wrote:
<< snipped for brevity >>>
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr96992_2.patch --]
[-- Type: text/x-patch, Size: 6606 bytes --]
From c0c95afa95bb682385e47cc248f04e6eecd91e6d Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Fri, 14 Jun 2024 16:54:37 +0200
Subject: [PATCH] Fortran: Fix rejecting class arrays of different ranks as
storage association argument.
Removing the assert in trans-expr, lead to initial strides not set
which is not fixed. When the array needs repacking, this is done for
class arrays now, too.
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.
* trans-expr.cc (gfc_conv_derived_to_class): Remove assert to
allow converting derived to class type arrays with assumed
rank. Add packing when necessary.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr96992.f90: New test.
---
gcc/fortran/trans-array.cc | 7 ++-
gcc/fortran/trans-expr.cc | 31 ++++++++++++-
gcc/testsuite/gfortran.dg/pr96992.f90 | 66 +++++++++++++++++++++++++++
3 files changed, 101 insertions(+), 3 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr96992.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 24a9a51692c..573e056d7c6 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6798,6 +6798,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.
@@ -7143,7 +7146,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))
+ && sym->attr.dummy && !sym->attr.elemental && gfc_is_nodesc_array (sym))
{
gfc_trans_g77_array (sym, block);
return;
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0796fb75505..4468163e482 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -874,6 +874,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
stmtblock_t block;
gfc_init_block (&block);
gfc_ref *ref;
+ tree maybetmp = NULL_TREE, origdata = NULL_TREE;
parmse->ss = ss;
parmse->use_offset = 1;
@@ -903,8 +904,29 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
if (e->rank != class_ts.u.derived->components->as->rank)
{
- gcc_assert (class_ts.u.derived->components->as->type
- == AS_ASSUMED_RANK);
+ tree desc;
+
+ desc = parmse->expr;
+ if (VAR_P (desc) && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))
+ && !GFC_DECL_PACKED_ARRAY (desc)
+ && !GFC_DECL_PARTIAL_PACKED_ARRAY (desc))
+ {
+ origdata = gfc_evaluate_now (
+ fold_convert (pvoid_type_node,
+ gfc_conv_descriptor_data_get (desc)),
+ &block);
+ tmp = gfc_build_addr_expr (NULL, desc);
+ tmp = build_call_expr (gfor_fndecl_in_pack, 1, tmp);
+ maybetmp = gfc_evaluate_now (tmp, &block);
+ gfc_conv_descriptor_data_set (&block, desc, maybetmp);
+ /* Add code to free eventually allocated temporary array
+ from pack. */
+ tmp = fold_build2 (NE_EXPR, boolean_type_node, maybetmp,
+ origdata);
+ tmp = build3_v (COND_EXPR, tmp, gfc_call_free (maybetmp),
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&parmse->post, tmp);
+ }
if (derived_array
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse->expr)))
{
@@ -933,6 +955,11 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
if (derived_array && *derived_array != NULL_TREE)
gfc_conv_descriptor_data_set (&block, *derived_array,
null_pointer_node);
+ if (maybetmp)
+ {
+ gfc_add_modify (&block, maybetmp, null_pointer_node);
+ gfc_add_modify (&block, origdata, null_pointer_node);
+ }
tmp = build3_v (COND_EXPR, cond_optional, tmp,
gfc_finish_block (&block));
diff --git a/gcc/testsuite/gfortran.dg/pr96992.f90 b/gcc/testsuite/gfortran.dg/pr96992.f90
new file mode 100644
index 00000000000..e4b38ef35f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96992.f90
@@ -0,0 +1,66 @@
+! { dg-do run }
+
+! PR fortran/96992
+
+! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
+
+! From the standard:
+! An actual argument that represents an element sequence and
+! corresponds to a dummy argument that is an array is sequence
+! associated with the dummy argument. The rank and shape of the
+! actual argument need not agree with the rank and shape of the
+! dummy argument, but the number of elements in the dummy argument
+! shall not exceed the number of elements in the element sequence
+! of the actual argument. If the dummy argument is assumed-size,
+! the number of elements in the dummy argument is exactly
+! the number of elements in the element sequence.
+
+! Check that walking the sequence starts with an initialized stride
+! for dim == 0.
+
+module foo_mod
+ implicit none
+ type foo
+ integer :: i
+ end type foo
+contains
+ subroutine d1(x,n)
+ integer, intent(in) :: n
+ integer :: i
+ class (foo), intent(out), dimension(n) :: x
+ select type(x)
+ class is(foo)
+ x(:)%i = (/ (42 + i, i = 1, n ) /)
+ class default
+ stop 1
+ end select
+ end subroutine d1
+ subroutine d2(x,n)
+ integer, intent(in) :: n
+ integer :: i
+ class (foo), intent(in), dimension(n,n,n) :: x
+ select type (x)
+ class is (foo)
+ if ( any( x%i /= reshape((/ (42 + i, i = 1, n ** 3 ) /), [n, n, n] ))) stop 2
+ class default
+ stop 3
+ end select
+ end subroutine d2
+end module foo_mod
+program main
+ use foo_mod
+ implicit none
+ type (foo), dimension(:), allocatable :: f
+ integer :: n,i
+ n = 3
+ allocate (f(n*n*n))
+ call d1(f,n*n*n)
+ call d2(f,n)
+
+ ! Use negative stride
+ call d1(f(n*n*n:1:-1),n*n*n)
+ if ( any( f%i /= (/ (42 + i, i = n ** 3, 1, -1 ) /) )) stop 4
+ call d2(f(n*n*n:1:-1),n)
+ deallocate (f)
+end program main
+
--
2.45.2
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument
2024-06-19 7:07 ` Andre Vehreschild
@ 2024-06-19 19:17 ` Harald Anlauf
2024-06-19 19:17 ` Harald Anlauf
2024-07-03 10:58 ` [Fortran, Patch, PR 96992, V3] " Andre Vehreschild
0 siblings, 2 replies; 7+ messages in thread
From: Harald Anlauf @ 2024-06-19 19:17 UTC (permalink / raw)
To: gcc-patches; +Cc: fortran
Hi Andre,
Am 19.06.24 um 09:07 schrieb Andre Vehreschild:
> Hi Harald,
>
> thank you for the investigation and useful tips. I had to figure what went
> wrong here, but I now figured, that the array needs repacking when a negative
> stride is used (or at least a call to that routine, which then fixes "stuff").
> I have added it, freeing the memory allocated potentially by pack, and also
> updated the testcase to include the negative stride.
hmmm, the pack does not always get generated:
module foo_mod
implicit none
type foo
integer :: i
end type foo
contains
subroutine d1(x,n)
integer, intent(in) :: n
integer :: i
class (foo), intent(out) :: x(n)
select type(x)
class is(foo)
x(:)%i = (/ (42 + i, i = 1, n ) /)
class default
stop 1
end select
end subroutine d1
subroutine d2(x,n)
integer, intent(in) :: n
integer :: i
class (foo), intent(in) :: x(n,n,n)
select type (x)
class is (foo)
print *,"d2: ", x%i
if ( any( x%i /= reshape((/ (42 + i, i = 1, n ** 3 ) /), [n, n,
n] ))) stop 2
class default
stop 3
end select
end subroutine d2
subroutine d3(x,n)
integer, intent(in) :: n
integer :: i
class (foo), intent(inout) :: x(n)
select type (x)
class is (foo)
print *,"d3_1:", x%i
x%i = -x%i ! Simply negate elements
print *,"d3_2:", x%i
class default
stop 33
end select
end subroutine d3
end module foo_mod
program main
use foo_mod
implicit none
type (foo), dimension(:), allocatable :: f
integer :: n, k, m
n = 2
allocate (f(n*n*n))
! Original testcase:
call d1(f,n*n*n)
print *, "d1->:", f%i
call d2(f,n)
! Ensure that array f is ok:
print *, "d2->:", f%i
! The following shows that no appropriate internal pack is generated:
call d1(f,n*n*n)
print *, "d1->:", f%i
m = n*n*n
k = 3
print *, "->d3:", f(1:m:k)%i
call d3(f(1:m:k),1+(m-1)/k)
print *, "d3->:", f(1:m:k)%i
print *, "full:", f%i
deallocate (f)
end program main
After the second version of your patch this prints:
d1->: 43 44 45 46 47
48 49 50
d2: 43 44 45 46 47
48 49 50
d2->: 43 44 45 46 47
48 49 50
d1->: 43 44 45 46 47
48 49 50
->d3: 43 46 49
d3_1: 43 44 45
d3_2: -43 -44 -45
d3->: -43 46 49
full: -43 -44 -45 46 47
48 49 50
While the print properly handles f(1:m:k)%i, passing it as
actual argument to subroutine d3 does not do pack/unpack.
Can you have another look?
Thanks,
Harald
> Regtests fine on x86_64-pc-linux-gnu/Fedora 39. Ok for mainline?
>
> Regards,
> Andre
>
> On Sun, 16 Jun 2024 23:27:46 +0200
> Harald Anlauf <anlauf@gmx.de> wrote:
>
> << snipped for brevity >>>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument
2024-06-19 19:17 ` Harald Anlauf
@ 2024-06-19 19:17 ` Harald Anlauf
2024-07-03 10:58 ` [Fortran, Patch, PR 96992, V3] " Andre Vehreschild
1 sibling, 0 replies; 7+ messages in thread
From: Harald Anlauf @ 2024-06-19 19:17 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML
Hi Andre,
Am 19.06.24 um 09:07 schrieb Andre Vehreschild:
> Hi Harald,
>
> thank you for the investigation and useful tips. I had to figure what went
> wrong here, but I now figured, that the array needs repacking when a negative
> stride is used (or at least a call to that routine, which then fixes "stuff").
> I have added it, freeing the memory allocated potentially by pack, and also
> updated the testcase to include the negative stride.
hmmm, the pack does not always get generated:
module foo_mod
implicit none
type foo
integer :: i
end type foo
contains
subroutine d1(x,n)
integer, intent(in) :: n
integer :: i
class (foo), intent(out) :: x(n)
select type(x)
class is(foo)
x(:)%i = (/ (42 + i, i = 1, n ) /)
class default
stop 1
end select
end subroutine d1
subroutine d2(x,n)
integer, intent(in) :: n
integer :: i
class (foo), intent(in) :: x(n,n,n)
select type (x)
class is (foo)
print *,"d2: ", x%i
if ( any( x%i /= reshape((/ (42 + i, i = 1, n ** 3 ) /), [n, n,
n] ))) stop 2
class default
stop 3
end select
end subroutine d2
subroutine d3(x,n)
integer, intent(in) :: n
integer :: i
class (foo), intent(inout) :: x(n)
select type (x)
class is (foo)
print *,"d3_1:", x%i
x%i = -x%i ! Simply negate elements
print *,"d3_2:", x%i
class default
stop 33
end select
end subroutine d3
end module foo_mod
program main
use foo_mod
implicit none
type (foo), dimension(:), allocatable :: f
integer :: n, k, m
n = 2
allocate (f(n*n*n))
! Original testcase:
call d1(f,n*n*n)
print *, "d1->:", f%i
call d2(f,n)
! Ensure that array f is ok:
print *, "d2->:", f%i
! The following shows that no appropriate internal pack is generated:
call d1(f,n*n*n)
print *, "d1->:", f%i
m = n*n*n
k = 3
print *, "->d3:", f(1:m:k)%i
call d3(f(1:m:k),1+(m-1)/k)
print *, "d3->:", f(1:m:k)%i
print *, "full:", f%i
deallocate (f)
end program main
After the second version of your patch this prints:
d1->: 43 44 45 46 47
48 49 50
d2: 43 44 45 46 47
48 49 50
d2->: 43 44 45 46 47
48 49 50
d1->: 43 44 45 46 47
48 49 50
->d3: 43 46 49
d3_1: 43 44 45
d3_2: -43 -44 -45
d3->: -43 46 49
full: -43 -44 -45 46 47
48 49 50
While the print properly handles f(1:m:k)%i, passing it as
actual argument to subroutine d3 does not do pack/unpack.
Can you have another look?
Thanks,
Harald
> Regtests fine on x86_64-pc-linux-gnu/Fedora 39. Ok for mainline?
>
> Regards,
> Andre
>
> On Sun, 16 Jun 2024 23:27:46 +0200
> Harald Anlauf <anlauf@gmx.de> wrote:
>
> << snipped for brevity >>>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Fortran, Patch, PR 96992, V3] Fix Class arrays of different ranks are rejected as storage association argument
2024-06-19 19:17 ` Harald Anlauf
2024-06-19 19:17 ` Harald Anlauf
@ 2024-07-03 10:58 ` Andre Vehreschild
1 sibling, 0 replies; 7+ messages in thread
From: Andre Vehreschild @ 2024-07-03 10:58 UTC (permalink / raw)
To: Harald Anlauf; +Cc: GCC-Patches-ML, GCC-Fortran-ML, Paul Richard Thomas
[-- Attachment #1: Type: text/plain, Size: 4926 bytes --]
Hi Harald,
I am sorry for the long delay, but fixing the negative stride lead from one
issue to the next. I finally got a version that does not regress. Please have a
look.
This patch has two parts:
1. The runtime library part in pr96992_3p1.patch and
2. the compiler changes in pr96992_3p2.patch.
In my branch also the two patches from Paul for pr59104 and pr102689 are
living, which might lead to small shifts during application of the patches.
NOTE, this patch adds internal packing and unpacking of class arrays similar to
the regular pack and unpack. I think this is necessary, because the regular
un-/pack does not use the vptr's _copy routine for moving data and therefore
may produce bugs.
The un-/pack_class routines are yet only used for converting a derived type
array to a class array. Extending their use when a UN-/PACK() is applied on a
class array is still to be done (as part of another PR).
Regtests fine on x86_64-pc-linux-gnu/ Fedora 39.
Regards,
Andre
PS: @Paul I could figure my test failures with -Ox with x e { 2, 3, s } to be
caused by initialization order. I.e. a member was set only after it was read.
On Wed, 19 Jun 2024 21:17:23 +0200
Harald Anlauf <anlauf@gmx.de> wrote:
> Hi Andre,
>
> Am 19.06.24 um 09:07 schrieb Andre Vehreschild:
> > Hi Harald,
> >
> > thank you for the investigation and useful tips. I had to figure what went
> > wrong here, but I now figured, that the array needs repacking when a
> > negative stride is used (or at least a call to that routine, which then
> > fixes "stuff"). I have added it, freeing the memory allocated potentially
> > by pack, and also updated the testcase to include the negative stride.
>
> hmmm, the pack does not always get generated:
>
> module foo_mod
> implicit none
> type foo
> integer :: i
> end type foo
> contains
> subroutine d1(x,n)
> integer, intent(in) :: n
> integer :: i
> class (foo), intent(out) :: x(n)
> select type(x)
> class is(foo)
> x(:)%i = (/ (42 + i, i = 1, n ) /)
> class default
> stop 1
> end select
> end subroutine d1
> subroutine d2(x,n)
> integer, intent(in) :: n
> integer :: i
> class (foo), intent(in) :: x(n,n,n)
> select type (x)
> class is (foo)
> print *,"d2: ", x%i
> if ( any( x%i /= reshape((/ (42 + i, i = 1, n ** 3 ) /), [n, n,
> n] ))) stop 2
> class default
> stop 3
> end select
> end subroutine d2
>
> subroutine d3(x,n)
> integer, intent(in) :: n
> integer :: i
> class (foo), intent(inout) :: x(n)
> select type (x)
> class is (foo)
> print *,"d3_1:", x%i
> x%i = -x%i ! Simply negate elements
> print *,"d3_2:", x%i
> class default
> stop 33
> end select
> end subroutine d3
> end module foo_mod
> program main
> use foo_mod
> implicit none
> type (foo), dimension(:), allocatable :: f
> integer :: n, k, m
> n = 2
> allocate (f(n*n*n))
> ! Original testcase:
> call d1(f,n*n*n)
> print *, "d1->:", f%i
> call d2(f,n)
> ! Ensure that array f is ok:
> print *, "d2->:", f%i
>
> ! The following shows that no appropriate internal pack is generated:
> call d1(f,n*n*n)
> print *, "d1->:", f%i
> m = n*n*n
> k = 3
> print *, "->d3:", f(1:m:k)%i
> call d3(f(1:m:k),1+(m-1)/k)
> print *, "d3->:", f(1:m:k)%i
> print *, "full:", f%i
> deallocate (f)
> end program main
>
>
> After the second version of your patch this prints:
>
> d1->: 43 44 45 46 47
> 48 49 50
> d2: 43 44 45 46 47
> 48 49 50
> d2->: 43 44 45 46 47
> 48 49 50
> d1->: 43 44 45 46 47
> 48 49 50
> ->d3: 43 46 49
> d3_1: 43 44 45
> d3_2: -43 -44 -45
> d3->: -43 46 49
> full: -43 -44 -45 46 47
> 48 49 50
>
> While the print properly handles f(1:m:k)%i, passing it as
> actual argument to subroutine d3 does not do pack/unpack.
>
> Can you have another look?
>
> Thanks,
> Harald
>
>
> > Regtests fine on x86_64-pc-linux-gnu/Fedora 39. Ok for mainline?
> >
> > Regards,
> > Andre
> >
> > On Sun, 16 Jun 2024 23:27:46 +0200
> > Harald Anlauf <anlauf@gmx.de> wrote:
> >
> > << snipped for brevity >>>
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr96992_3p1.patch --]
[-- Type: text/x-patch, Size: 16036 bytes --]
From d429783a8b5c9dc9b6004ea8bc89247d1da63127 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Fri, 28 Jun 2024 08:31:29 +0200
Subject: [PATCH 1/2] libgfortran: Add internal un/pack_class runtime
functions.
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.
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.
---
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 +++++++++++++++++++++++
6 files changed, 328 insertions(+), 4 deletions(-)
create mode 100644 libgfortran/runtime/in_pack_class.c
create mode 100644 libgfortran/runtime/in_unpack_class.c
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index ab605d49984..8524cc6ed03 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -156,7 +156,9 @@ intrinsics/selected_real_kind.f90 \
intrinsics/trigd.c \
intrinsics/unpack_generic.c \
runtime/in_pack_generic.c \
-runtime/in_unpack_generic.c
+runtime/in_unpack_generic.c \
+runtime/in_pack_class.c \
+runtime/in_unpack_class.c
if !LIBGFOR_MINIMAL
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index ced10e98aaa..6c6c89cc14e 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -569,8 +569,8 @@ am__objects_58 = intrinsics/associated.lo intrinsics/abort.lo \
intrinsics/selected_int_kind.lo \
intrinsics/selected_real_kind.lo intrinsics/trigd.lo \
intrinsics/unpack_generic.lo runtime/in_pack_generic.lo \
- runtime/in_unpack_generic.lo $(am__objects_56) \
- $(am__objects_57)
+ runtime/in_unpack_generic.lo runtime/in_pack_class.lo \
+ runtime/in_unpack_class.lo $(am__objects_56) $(am__objects_57)
@IEEE_SUPPORT_TRUE@am__objects_59 = ieee/ieee_arithmetic.lo \
@IEEE_SUPPORT_TRUE@ ieee/ieee_exceptions.lo \
@IEEE_SUPPORT_TRUE@ ieee/ieee_features.lo
@@ -985,7 +985,8 @@ gfor_helper_src = intrinsics/associated.c intrinsics/abort.c \
intrinsics/selected_int_kind.f90 \
intrinsics/selected_real_kind.f90 intrinsics/trigd.c \
intrinsics/unpack_generic.c runtime/in_pack_generic.c \
- runtime/in_unpack_generic.c $(am__append_4) $(am__append_5)
+ runtime/in_unpack_generic.c runtime/in_pack_class.c \
+ runtime/in_unpack_class.c $(am__append_4) $(am__append_5)
@IEEE_SUPPORT_TRUE@gfor_ieee_helper_src = ieee/ieee_helper.c
@IEEE_SUPPORT_FALSE@gfor_ieee_src =
@IEEE_SUPPORT_TRUE@gfor_ieee_src = \
@@ -3174,6 +3175,10 @@ runtime/in_pack_generic.lo: runtime/$(am__dirstamp) \
runtime/$(DEPDIR)/$(am__dirstamp)
runtime/in_unpack_generic.lo: runtime/$(am__dirstamp) \
runtime/$(DEPDIR)/$(am__dirstamp)
+runtime/in_pack_class.lo: runtime/$(am__dirstamp) \
+ runtime/$(DEPDIR)/$(am__dirstamp)
+runtime/in_unpack_class.lo: runtime/$(am__dirstamp) \
+ runtime/$(DEPDIR)/$(am__dirstamp)
intrinsics/access.lo: intrinsics/$(am__dirstamp) \
intrinsics/$(DEPDIR)/$(am__dirstamp)
intrinsics/c99_functions.lo: intrinsics/$(am__dirstamp) \
@@ -4223,7 +4228,9 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/environ.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/error.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/fpu.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/in_pack_class.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/in_pack_generic.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/in_unpack_class.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/in_unpack_generic.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/main.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@runtime/$(DEPDIR)/memory.Plo@am__quote@
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 4a5a037a906..82f8f3c5e9c 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1770,3 +1770,9 @@ GFORTRAN_14 {
global:
_gfortran_selected_logical_kind;
} GFORTRAN_13;
+
+GFORTRAN_15 {
+ global:
+ _gfortran_internal_pack_class;
+ _gfortran_internal_unpack_class;
+} GFORTRAN_14;
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 5c59ec26e16..a4526d97ce7 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -570,6 +570,29 @@ typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_full_a
#define GFC_UNALIGNED_C8(x) (((uintptr_t)(x)) & \
(__alignof__(GFC_COMPLEX_8) - 1))
+/* Generic vtab structure. */
+typedef struct
+{
+ GFC_INTEGER_4 _hash;
+ size_t _size;
+ struct gfc_vtype_generic_t *_extends;
+ void *_def_init;
+ void (*_copy) (const void *, void *);
+ void *(*_final);
+ void (*_deallocate) (void *);
+} gfc_vtype_generic_t;
+
+/* Generic class structure. */
+#define GFC_CLASS_T(type) \
+ struct \
+ { \
+ type _data; \
+ gfc_vtype_generic_t *_vptr; \
+ size_t _len; \
+ }
+
+typedef GFC_CLASS_T (GFC_ARRAY_DESCRIPTOR (void)) gfc_class_array_t;
+
/* Runtime library include. */
#define stringize(x) expand_macro(x)
#define expand_macro(x) # x
diff --git a/libgfortran/runtime/in_pack_class.c b/libgfortran/runtime/in_pack_class.c
new file mode 100644
index 00000000000..2bc96a15ab6
--- /dev/null
+++ b/libgfortran/runtime/in_pack_class.c
@@ -0,0 +1,152 @@
+/* Class specific helper function for repacking arrays.
+ Copyright (C) 2003-2024 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran 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 of the License, or (at your option) any later version.
+
+Libgfortran 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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <string.h>
+
+extern void
+internal_pack_class (gfc_class_array_t *, gfc_class_array_t *, const size_t,
+ const int);
+export_proto (internal_pack_class);
+
+/* attr is a bitfield. The bits in use are:
+ 0 - _len is present.
+ */
+void
+internal_pack_class (gfc_class_array_t *dest_class,
+ gfc_class_array_t *source_class, const size_t size_class,
+ const int attr)
+{
+#define BIT_TEST(mask, bit) (((mask) & (1U << (bit))) == (1U << (bit)))
+
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ index_type dim;
+ index_type ssize;
+ index_type dest_stride;
+ index_type n;
+ const void *src;
+ void *dest;
+ int packed;
+ index_type size;
+ gfc_array_void *source_arr;
+ gfc_array_void *dest_arr;
+ size_t dest_offset;
+ bool len_present = BIT_TEST (attr, 0);
+ gfc_vtype_generic_t *vtab;
+ void (*copyfn) (const void *, void *);
+
+ /* Always make sure the dest is initialized. */
+ memcpy (dest_class, source_class, size_class);
+ if (source_class->_data.base_addr == NULL)
+ return;
+
+ source_arr = (gfc_array_void *) &(source_class->_data);
+ size = GFC_DESCRIPTOR_SIZE (source_arr);
+ dim = GFC_DESCRIPTOR_RANK (source_arr);
+ ssize = 1;
+ packed = 1;
+ for (n = 0; n < dim; n++)
+ {
+ count[n] = 0;
+ stride[n] = GFC_DESCRIPTOR_STRIDE (source_arr, n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT (source_arr, n);
+ if (extent[n] <= 0)
+ {
+ /* Do nothing. */
+ packed = 1;
+ break;
+ }
+
+ if (ssize != stride[n])
+ packed = 0;
+
+ ssize *= extent[n];
+ }
+
+ /* When the data is packed already, nothing needs to be done and unpack, will
+ quit immediately, because _data is identical and nothing needs to be done.
+ */
+ if (packed)
+ return;
+
+ /* Allocate storage for the destination. */
+ dest_arr = (gfc_array_void *) &dest_class->_data;
+ dest_stride = 1;
+ dest_offset = 0;
+ for (n = 0; n < dim; ++n)
+ {
+ GFC_DESCRIPTOR_LBOUND (dest_arr, n) = 1;
+ GFC_DESCRIPTOR_UBOUND (dest_arr, n) = extent[n];
+ GFC_DESCRIPTOR_STRIDE (dest_arr, n) = dest_stride;
+ dest_offset -= dest_stride * 1 /* GFC_DESCRIPTOR_LBOUND (dest_arr, n) */;
+ dest_stride *= GFC_DESCRIPTOR_EXTENT (dest_arr, n);
+ }
+ dest_arr->offset = dest_offset;
+ dest_arr->base_addr = xmallocarray (ssize, size);
+ dest = (void *) dest_arr->base_addr;
+ src = source_arr->base_addr;
+ stride0 = stride[0] * size;
+ /* Can not use the dimension here, because the class may be allocated for
+ a higher dimensional array, but only a smaller amount is present. */
+ vtab = *(gfc_vtype_generic_t **) (((void *) source_class) + size_class
+ - (len_present ? sizeof (size_t) : 0)
+ - sizeof (void *)); /* _vptr */
+ copyfn = vtab->_copy;
+
+ while (src)
+ {
+ /* Copy the data. */
+ copyfn (src, dest);
+ /* Advance to the next element. */
+ dest += size;
+ src += stride0;
+ count[0]++;
+ /* Advance to the next source element. */
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so probably not worth it. */
+ src -= stride[n] * extent[n] * size;
+ n++;
+ if (n == dim)
+ {
+ src = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ src += stride[n] * size;
+ }
+ }
+ }
+}
diff --git a/libgfortran/runtime/in_unpack_class.c b/libgfortran/runtime/in_unpack_class.c
new file mode 100644
index 00000000000..068c604ff15
--- /dev/null
+++ b/libgfortran/runtime/in_unpack_class.c
@@ -0,0 +1,134 @@
+/* Class helper function for repacking arrays.
+ Copyright (C) 2003-2024 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran 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 of the License, or (at your option) any later version.
+
+Libgfortran 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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <string.h>
+
+extern void
+internal_unpack_class (gfc_class_array_t *, gfc_class_array_t *, const size_t,
+ const int);
+export_proto (internal_unpack_class);
+
+void
+internal_unpack_class (gfc_class_array_t *dest_class,
+ gfc_class_array_t *source_class, const size_t size_class,
+ const int attr)
+{
+#define BIT_TEST(mask, bit) (((mask) & (1U << (bit))) == (1U << (bit)))
+
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ index_type dim;
+ index_type dsize;
+ void *dest;
+ const void *src;
+ index_type size;
+ const gfc_array_void *src_arr;
+ gfc_array_void *dest_arr;
+ bool len_present = BIT_TEST (attr, 0);
+ gfc_vtype_generic_t *vtab;
+ void (*copyfn) (const void *, void *);
+
+ /* This check may be redundant, but do it anyway. */
+ if (!source_class || !dest_class || !source_class->_data.base_addr
+ || !dest_class->_data.base_addr)
+ return;
+
+ dest_arr = (gfc_array_void *) &(dest_class->_data);
+ dest = dest_arr->base_addr;
+ size = GFC_DESCRIPTOR_SIZE (dest_arr);
+ dim = GFC_DESCRIPTOR_RANK (dest_arr);
+ dsize = 1;
+ for (index_type n = 0; n < dim; n++)
+ {
+ count[n] = 0;
+ stride[n] = GFC_DESCRIPTOR_STRIDE (dest_arr, n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT (dest_arr, n);
+ if (extent[n] <= 0)
+ return;
+
+ if (dsize == stride[n])
+ dsize *= extent[n];
+ else
+ dsize = 0;
+ }
+
+ src_arr = (gfc_array_void *) &source_class->_data;
+ src = src_arr->base_addr;
+
+ vtab = *(gfc_vtype_generic_t **) (((void *) source_class) + size_class
+ - (len_present ? sizeof (size_t) : 0)
+ - sizeof (void *)); /* _vptr */
+ copyfn = vtab->_copy;
+
+ if (dsize != 0)
+ {
+ for (index_type n = 0; n < dsize; ++n)
+ {
+ copyfn (src, dest);
+ src += size;
+ dest += size;
+ }
+ free (src_arr->base_addr);
+ return;
+ }
+
+ stride0 = stride[0] * size;
+
+ while (dest)
+ {
+ /* Copy the data. */
+ copyfn (src, dest);
+ /* Advance to the next element. */
+ src += size;
+ dest += stride0;
+ count[0]++;
+ /* Advance to the next source element. */
+ index_type n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so probably not worth it. */
+ dest -= stride[n] * extent[n] * size;
+ n++;
+ if (n == dim)
+ {
+ dest = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += stride[n] * size;
+ }
+ }
+ }
+ free (src_arr->base_addr);
+}
--
2.45.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: pr96992_3p2.patch --]
[-- Type: text/x-patch, Size: 37964 bytes --]
From 29dca0dbacbe4171f24bb18f431da4a3af86f3fd Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Fri, 14 Jun 2024 16:54:37 +0200
Subject: [PATCH 2/2] Fortran: Fix rejecting class arrays of different ranks as
storage association argument. [96992]
Removing the assert in trans-expr, lead to initial strides not set
which is not fixed. When the array needs repacking, this is done for
class arrays now, too.
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.
gcc/testsuite/ChangeLog:
* gfortran.dg/class_dummy_11.f90: New test.
---
gcc/fortran/trans-array.cc | 199 +++++++++++----
gcc/fortran/trans-array.h | 5 +-
gcc/fortran/trans-decl.cc | 16 +-
gcc/fortran/trans-expr.cc | 241 +++++++++----------
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 | 167 +++++++++++++
8 files changed, 463 insertions(+), 182 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/class_dummy_11.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index df5b9911887..a8cbdbe9a6c 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6886,6 +6886,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.
@@ -7231,7 +7234,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))
+ && sym->attr.dummy && !sym->attr.elemental && gfc_is_nodesc_array (sym))
{
gfc_trans_g77_array (sym, block);
return;
@@ -8730,15 +8735,17 @@ is_pointer (gfc_expr *e)
/* Convert an array for passing as an actual parameter. */
void
-gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
+gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
const gfc_symbol *fsym, const char *proc_name,
- tree *size)
+ tree *size, tree *lbshift, tree *packed)
{
tree ptr;
tree desc;
tree tmp = NULL_TREE;
tree stmt;
tree parent = DECL_CONTEXT (current_function_decl);
+ tree ctree;
+ tree pack_attr;
bool full_array_var;
bool this_array_result;
bool contiguous;
@@ -8850,20 +8857,24 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
/* There is no need to pack and unpack the array, if it is contiguous
and not a deferred- or assumed-shape array, or if it is simply
contiguous. */
- no_pack = ((sym && sym->as
- && !sym->attr.pointer
- && sym->as->type != AS_DEFERRED
- && sym->as->type != AS_ASSUMED_RANK
- && sym->as->type != AS_ASSUMED_SHAPE)
- ||
- (ref && ref->u.ar.as
- && ref->u.ar.as->type != AS_DEFERRED
+ no_pack = false;
+ gfc_array_spec *as;
+ if (sym)
+ {
+ symbol_attribute *attr
+ = &(IS_CLASS_ARRAY (sym) ? CLASS_DATA (sym)->attr : sym->attr);
+ as = IS_CLASS_ARRAY (sym) ? CLASS_DATA (sym)->as : sym->as;
+ no_pack
+ = (as && !attr->pointer && as->type != AS_DEFERRED
+ && as->type != AS_ASSUMED_RANK && as->type != AS_ASSUMED_SHAPE);
+ }
+ if (ref && ref->u.ar.as)
+ no_pack = no_pack
+ || (ref->u.ar.as->type != AS_DEFERRED
&& ref->u.ar.as->type != AS_ASSUMED_RANK
- && ref->u.ar.as->type != AS_ASSUMED_SHAPE)
- ||
- gfc_is_simply_contiguous (expr, false, true));
-
- no_pack = contiguous && no_pack;
+ && ref->u.ar.as->type != AS_ASSUMED_SHAPE);
+ no_pack
+ = contiguous && (no_pack || gfc_is_simply_contiguous (expr, false, true));
/* If we have an EXPR_OP or a function returning an explicit-shaped
or allocatable array, an array temporary will be generated which
@@ -8918,6 +8929,14 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
return;
}
+ if (fsym && fsym->ts.type == BT_CLASS)
+ {
+ gcc_assert (se->expr);
+ ctree = se->expr;
+ }
+ else
+ ctree = NULL_TREE;
+
if (this_array_result)
{
/* Result of the enclosing function. */
@@ -8936,7 +8955,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
else
{
/* Every other type of array. */
- se->want_pointer = 1;
+ se->want_pointer = (ctree) ? 0 : 1;
gfc_conv_expr_descriptor (se, expr);
if (size)
@@ -8944,6 +8963,55 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
build_fold_indirect_ref_loc (input_location,
se->expr),
expr, size);
+ if (ctree)
+ {
+ stmtblock_t block;
+
+ gfc_init_block (&block);
+ if (lbshift && *lbshift)
+ {
+ /* Apply a shift of the lbound when supplied. */
+ for (int dim = 0; dim < expr->rank; ++dim)
+ gfc_conv_shift_descriptor_lbound (&block, se->expr, dim,
+ *lbshift);
+ }
+ tmp = gfc_class_data_get (ctree);
+ if (expr->rank > 1 && CLASS_DATA (fsym)->as->rank != expr->rank
+ && CLASS_DATA (fsym)->as->type == AS_EXPLICIT && !no_pack)
+ {
+ tree arr = gfc_create_var (TREE_TYPE (tmp), "parm");
+ gfc_conv_descriptor_data_set (&block, arr,
+ gfc_conv_descriptor_data_get (
+ se->expr));
+ gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
+ gfc_index_zero_node);
+ gfc_conv_descriptor_ubound_set (
+ &block, arr, gfc_index_zero_node,
+ gfc_conv_descriptor_size (se->expr, expr->rank));
+ gfc_conv_descriptor_stride_set (
+ &block, arr, gfc_index_zero_node,
+ gfc_conv_descriptor_stride_get (se->expr, gfc_index_zero_node));
+ gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
+ gfc_conv_descriptor_dtype (se->expr));
+ gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
+ build_int_cst (signed_char_type_node, 1));
+ gfc_conv_descriptor_span_set (&block, arr,
+ gfc_conv_descriptor_span_get (arr));
+ gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
+ se->expr = arr;
+ }
+ gfc_class_array_data_assign (&block, tmp, se->expr, true);
+
+ /* Handle optional. */
+ if (fsym && fsym->attr.optional && sym && sym->attr.optional)
+ tmp = build3_v (COND_EXPR, gfc_conv_expr_present (sym),
+ gfc_finish_block (&block),
+ build_empty_stmt (input_location));
+ else
+ tmp = gfc_finish_block (&block);
+
+ gfc_add_expr_to_block (&se->pre, tmp);
+ }
}
/* Deallocate the allocatable components of structures that are
@@ -8963,12 +9031,12 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
if (g77 || (fsym && fsym->attr.contiguous
&& !gfc_is_simply_contiguous (expr, false, true)))
{
- tree origptr = NULL_TREE;
+ tree origptr = NULL_TREE, packedptr = NULL_TREE;
desc = se->expr;
/* For contiguous arrays, save the original value of the descriptor. */
- if (!g77)
+ if (!g77 && !ctree)
{
origptr = gfc_create_var (pvoid_type_node, "origptr");
tmp = build_fold_indirect_ref_loc (input_location, desc);
@@ -9007,18 +9075,50 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
return;
}
- ptr = build_call_expr_loc (input_location,
- gfor_fndecl_in_pack, 1, desc);
-
- if (fsym && fsym->attr.optional && sym && sym->attr.optional)
+ if (ctree)
{
- tmp = gfc_conv_expr_present (sym);
- ptr = build3_loc (input_location, COND_EXPR, TREE_TYPE (se->expr),
- tmp, fold_convert (TREE_TYPE (se->expr), ptr),
- fold_convert (TREE_TYPE (se->expr), null_pointer_node));
+ packedptr
+ = gfc_build_addr_expr (NULL_TREE, gfc_create_var (TREE_TYPE (ctree),
+ "packed"));
+ if (fsym)
+ {
+ int pack_mask = 0;
+
+ /* Set bit 0 to the mask, when this is an unlimited_poly class. */
+ if (CLASS_DATA (fsym)->ts.u.derived->attr.unlimited_polymorphic)
+ pack_mask = 1 << 0;
+ pack_attr = build_int_cst (integer_type_node, pack_mask);
+ }
+ else
+ pack_attr = integer_zero_node;
+
+ gfc_add_expr_to_block (
+ &se->pre,
+ build_call_expr_loc (input_location, gfor_fndecl_in_pack_class, 4,
+ packedptr,
+ gfc_build_addr_expr (NULL_TREE, ctree),
+ size_in_bytes (TREE_TYPE (ctree)), pack_attr));
+ ptr = gfc_conv_array_data (gfc_class_data_get (packedptr));
+ se->expr = packedptr;
+ if (packed)
+ *packed = packedptr;
}
+ else
+ {
+ ptr = build_call_expr_loc (input_location, gfor_fndecl_in_pack, 1,
+ desc);
+
+ if (fsym && fsym->attr.optional && sym && sym->attr.optional)
+ {
+ tmp = gfc_conv_expr_present (sym);
+ ptr = build3_loc (input_location, COND_EXPR, TREE_TYPE (se->expr),
+ tmp, fold_convert (TREE_TYPE (se->expr), ptr),
+ fold_convert (TREE_TYPE (se->expr),
+ null_pointer_node));
+ }
- ptr = gfc_evaluate_now (ptr, &se->pre);
+ ptr = gfc_evaluate_now (ptr, &se->pre);
+ }
/* Use the packed data for the actual argument, except for contiguous arrays,
where the descriptor's data component is set. */
@@ -9030,8 +9130,11 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
gfc_ss * ss = gfc_walk_expr (expr);
if (!transposed_dims (ss))
- gfc_conv_descriptor_data_set (&se->pre, tmp, ptr);
- else
+ {
+ if (!ctree)
+ gfc_conv_descriptor_data_set (&se->pre, tmp, ptr);
+ }
+ else if (!ctree)
{
tree old_field, new_field;
@@ -9104,22 +9207,36 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
/* Copy the data back. */
if (fsym == NULL || fsym->attr.intent != INTENT_IN)
{
- tmp = build_call_expr_loc (input_location,
- gfor_fndecl_in_unpack, 2, desc, ptr);
+ if (ctree)
+ {
+ tmp = gfc_build_addr_expr (NULL_TREE, ctree);
+ tmp = build_call_expr_loc (input_location,
+ gfor_fndecl_in_unpack_class, 4, tmp,
+ packedptr,
+ size_in_bytes (TREE_TYPE (ctree)),
+ pack_attr);
+ }
+ else
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_in_unpack, 2,
+ desc, ptr);
gfc_add_expr_to_block (&block, tmp);
}
+ else if (ctree && fsym->attr.intent == INTENT_IN)
+ {
+ /* Need to free the memory for class arrays, that got packed. */
+ gfc_add_expr_to_block (&block, gfc_call_free (ptr));
+ }
/* Free the temporary. */
- tmp = gfc_call_free (ptr);
- gfc_add_expr_to_block (&block, tmp);
+ if (!ctree)
+ gfc_add_expr_to_block (&block, gfc_call_free (ptr));
stmt = gfc_finish_block (&block);
gfc_init_block (&block);
/* Only if it was repacked. This code needs to be executed before the
loop cleanup code. */
- tmp = build_fold_indirect_ref_loc (input_location,
- desc);
+ tmp = (ctree) ? desc : build_fold_indirect_ref_loc (input_location, desc);
tmp = gfc_conv_array_data (tmp);
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
fold_convert (TREE_TYPE (tmp), ptr), tmp);
@@ -9137,11 +9254,11 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
gfc_init_block (&se->post);
/* Reset the descriptor pointer. */
- if (!g77)
- {
- tmp = build_fold_indirect_ref_loc (input_location, desc);
- gfc_conv_descriptor_data_set (&se->post, tmp, origptr);
- }
+ if (!g77 && !ctree)
+ {
+ tmp = build_fold_indirect_ref_loc (input_location, desc);
+ gfc_conv_descriptor_data_set (&se->post, tmp, origptr);
+ }
gfc_add_block_to_block (&se->post, &block);
}
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index a51e9a5256b..29499a337c2 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -152,8 +152,9 @@ tree gfc_get_array_span (tree, gfc_expr *);
/* Evaluate an array expression. */
void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *);
/* Convert an array for passing as an actual function parameter. */
-void gfc_conv_array_parameter (gfc_se *, gfc_expr *, bool,
- const gfc_symbol *, const char *, tree *);
+void gfc_conv_array_parameter (gfc_se *, gfc_expr *, bool, const gfc_symbol *,
+ const char *, tree *, tree * = nullptr,
+ tree * = nullptr);
/* These work with both descriptors and descriptorless arrays. */
tree gfc_conv_array_data (tree);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 11247ddc07a..54ab60b4935 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -118,6 +118,8 @@ tree gfor_fndecl_fdate;
tree gfor_fndecl_ttynam;
tree gfor_fndecl_in_pack;
tree gfor_fndecl_in_unpack;
+tree gfor_fndecl_in_pack_class;
+tree gfor_fndecl_in_unpack_class;
tree gfor_fndecl_associated;
tree gfor_fndecl_system_clock4;
tree gfor_fndecl_system_clock8;
@@ -3916,9 +3918,19 @@ gfc_build_builtin_function_decls (void)
get_identifier (PREFIX("internal_unpack")), ". w R ",
void_type_node, 2, pvoid_type_node, pvoid_type_node);
+ gfor_fndecl_in_pack_class = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX ("internal_pack_class")), ". w R r r ",
+ void_type_node, 4, pvoid_type_node, pvoid_type_node, size_type_node,
+ integer_type_node);
+
+ gfor_fndecl_in_unpack_class = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX ("internal_unpack_class")), ". w R r r ",
+ void_type_node, 4, pvoid_type_node, pvoid_type_node, size_type_node,
+ integer_type_node);
+
gfor_fndecl_associated = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("associated")), ". R R ",
- integer_type_node, 2, ppvoid_type_node, ppvoid_type_node);
+ get_identifier (PREFIX ("associated")), ". R R ", integer_type_node, 2,
+ ppvoid_type_node, ppvoid_type_node);
DECL_PURE_P (gfor_fndecl_associated) = 1;
TREE_NOTHROW (gfor_fndecl_associated) = 1;
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index c847ca8367d..42c6008b37a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -598,7 +598,6 @@ 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. */
@@ -606,6 +605,7 @@ void
gfc_class_set_vptr (stmtblock_t *block, tree to, tree from)
{
tree tmp, vptr_ref;
+ gfc_symbol *type;
vptr_ref = gfc_get_vptr_from_expr (to);
if (POINTER_TYPE_P (TREE_TYPE (from))
@@ -614,38 +614,44 @@ gfc_class_set_vptr (stmtblock_t *block, tree to, tree from)
gfc_add_modify (block, vptr_ref,
fold_convert (TREE_TYPE (vptr_ref),
gfc_get_vptr_from_expr (from)));
+ return;
}
- else if (VAR_P (from)
- && strncmp (IDENTIFIER_POINTER (DECL_NAME (from)), "__vtab", 6) == 0)
+ tmp = gfc_get_vptr_from_expr (from);
+ if (tmp)
+ {
+ gfc_add_modify (block, vptr_ref,
+ fold_convert (TREE_TYPE (vptr_ref), tmp));
+ return;
+ }
+ 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));
+ return;
}
- else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (from)))
- && GFC_CLASS_TYPE_P (
- TREE_TYPE (TREE_OPERAND (TREE_OPERAND (from, 0), 0))))
+ 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))));
+ return;
}
- 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));
- }
-}
+ /* If nothing of the above matches, set the vtype according to the 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);
+ tmp = gfc_find_derived_vtab (type)->backend_decl;
+ gcc_assert (tmp);
+ gfc_add_modify (block, vptr_ref,
+ gfc_build_addr_expr (TREE_TYPE (vptr_ref), tmp));
+}
/* Reset the len for unlimited polymorphic objects. */
@@ -739,10 +745,9 @@ gfc_get_vptr_from_expr (tree expr)
return NULL_TREE;
}
-
-static void
-class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
- bool lhs_type)
+void
+gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
+ bool lhs_type)
{
tree tmp, tmp2, type;
@@ -766,9 +771,8 @@ class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
gfc_add_modify (block, tmp, tmp2);
}
-
/* Takes a derived type expression and returns the address of a temporary
- class object of the 'declared' type. If vptr is not NULL, this is
+ class object of the 'declared' type. If opt_vptr_src is not NULL, this is
used for the temporary class object.
optional_alloc_ptr is false when the dummy is neither allocatable
nor a pointer; that's only relevant for the optional handling.
@@ -776,49 +780,65 @@ class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
expression for deallocation of allocatable components. Assumed rank
formal arguments made this necessary. */
void
-gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
- gfc_typespec class_ts, tree vptr, bool optional,
- bool optional_alloc_ptr,
+gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym,
+ tree opt_vptr_src, bool optional,
+ bool optional_alloc_ptr, const char *proc_name,
tree *derived_array)
{
- gfc_symbol *vtab;
tree cond_optional = NULL_TREE;
gfc_ss *ss;
tree ctree;
tree var;
tree tmp;
- int dim;
+ tree packed = NULL_TREE;
- /* The derived type needs to be converted to a temporary
- CLASS object. */
- tmp = gfc_typenode_for_spec (&class_ts);
+ /* The derived type needs to be converted to a temporary CLASS object. */
+ tmp = gfc_typenode_for_spec (&fsym->ts);
var = gfc_create_var (tmp, "class");
/* Set the vptr. */
- ctree = gfc_class_vptr_get (var);
-
- if (vptr != NULL_TREE)
- {
- /* Use the dynamic vptr. */
- tmp = vptr;
- }
+ if (opt_vptr_src)
+ gfc_class_set_vptr (&parmse->pre, var, opt_vptr_src);
else
- {
- /* In this case the vtab corresponds to the derived type and the
- vptr must point to it. */
- vtab = gfc_find_derived_vtab (e->ts.u.derived);
- gcc_assert (vtab);
- tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab));
- }
- gfc_add_modify (&parmse->pre, ctree,
- fold_convert (TREE_TYPE (ctree), tmp));
+ gfc_reset_vptr (&parmse->pre, e, var);
/* Now set the data field. */
- ctree = gfc_class_data_get (var);
+ ctree = gfc_class_data_get (var);
if (optional)
cond_optional = gfc_conv_expr_present (e->symtree->n.sym);
+ /* Set the _len as early as possible. */
+ if (fsym->ts.u.derived->components->ts.type == BT_DERIVED
+ && fsym->ts.u.derived->components->ts.u.derived->attr
+ .unlimited_polymorphic)
+ {
+ /* Take care about initializing the _len component correctly. */
+ tree len_tree = gfc_class_len_get (var);
+ if (UNLIMITED_POLY (e))
+ {
+ gfc_expr *len;
+ gfc_se se;
+
+ len = gfc_find_and_cut_at_last_class_ref (e);
+ gfc_add_len_component (len);
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, len);
+ if (optional)
+ tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (se.expr),
+ cond_optional, se.expr,
+ fold_convert (TREE_TYPE (se.expr),
+ integer_zero_node));
+ else
+ tmp = se.expr;
+ gfc_free_expr (len);
+ }
+ else
+ tmp = integer_zero_node;
+ gfc_add_modify (&parmse->pre, len_tree,
+ fold_convert (TREE_TYPE (len_tree), tmp));
+ }
+
if (parmse->expr && POINTER_TYPE_P (TREE_TYPE (parmse->expr)))
{
/* If there is a ready made pointer to a derived type, use it
@@ -847,7 +867,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_conv_expr_reference (parmse, e);
/* Scalar to an assumed-rank array. */
- if (class_ts.u.derived->components->as)
+ if (fsym->ts.u.derived->components->as)
{
tree type;
type = get_scalar_to_descriptor_type (parmse->expr,
@@ -878,15 +898,22 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
stmtblock_t block;
gfc_init_block (&block);
gfc_ref *ref;
+ int dim;
+ tree lbshift = NULL_TREE;
- parmse->ss = ss;
- parmse->use_offset = 1;
- gfc_conv_expr_descriptor (parmse, e);
+ /* Array refs with sections indicate, that a for a formal argument
+ expecting contiguous repacking needs to be done. */
+ for (ref = e->ref; ref; ref = ref->next)
+ if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
+ break;
+ if (IS_CLASS_ARRAY (fsym)
+ && CLASS_DATA (fsym)->as->type == AS_EXPLICIT
+ && (ref || e->rank != fsym->ts.u.derived->components->as->rank))
+ fsym->attr.contiguous = 1;
/* Detect any array references with vector subscripts. */
for (ref = e->ref; ref; ref = ref->next)
- if (ref->type == REF_ARRAY
- && ref->u.ar.type != AR_ELEMENT
+ if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT
&& ref->u.ar.type != AR_FULL)
{
for (dim = 0; dim < ref->u.ar.dimen; dim++)
@@ -895,37 +922,20 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
if (dim < ref->u.ar.dimen)
break;
}
-
- /* Array references with vector subscripts and non-variable expressions
- need be converted to a one-based descriptor. */
+ /* Array references with vector subscripts and non-variable
+ expressions need be converted to a one-based descriptor. */
if (ref || e->expr_type != EXPR_VARIABLE)
- {
- for (dim = 0; dim < e->rank; ++dim)
- gfc_conv_shift_descriptor_lbound (&block, parmse->expr, dim,
- gfc_index_one_node);
- }
+ lbshift = gfc_index_one_node;
- if (e->rank != class_ts.u.derived->components->as->rank)
- {
- gcc_assert (class_ts.u.derived->components->as->type
- == AS_ASSUMED_RANK);
- if (derived_array
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse->expr)))
- {
- *derived_array = gfc_create_var (TREE_TYPE (parmse->expr),
- "array");
- gfc_add_modify (&block, *derived_array , parmse->expr);
- }
- class_array_data_assign (&block, ctree, parmse->expr, false);
- }
- else
+ parmse->expr = var;
+ gfc_conv_array_parameter (parmse, e, false, fsym, proc_name, nullptr,
+ &lbshift, &packed);
+
+ if (derived_array && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse->expr)))
{
- if (gfc_expr_attr (e).codimension)
- parmse->expr = fold_build1_loc (input_location,
- VIEW_CONVERT_EXPR,
- TREE_TYPE (ctree),
- parmse->expr);
- gfc_add_modify (&block, ctree, parmse->expr);
+ *derived_array
+ = gfc_create_var (TREE_TYPE (parmse->expr), "array");
+ gfc_add_modify (&block, *derived_array, parmse->expr);
}
if (optional)
@@ -947,47 +957,19 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
}
}
- if (class_ts.u.derived->components->ts.type == BT_DERIVED
- && class_ts.u.derived->components->ts.u.derived
- ->attr.unlimited_polymorphic)
- {
- /* Take care about initializing the _len component correctly. */
- ctree = gfc_class_len_get (var);
- if (UNLIMITED_POLY (e))
- {
- gfc_expr *len;
- gfc_se se;
-
- len = gfc_find_and_cut_at_last_class_ref (e);
- gfc_add_len_component (len);
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, len);
- if (optional)
- tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (se.expr),
- cond_optional, se.expr,
- fold_convert (TREE_TYPE (se.expr),
- integer_zero_node));
- else
- tmp = se.expr;
- gfc_free_expr (len);
- }
- else
- tmp = integer_zero_node;
- gfc_add_modify (&parmse->pre, ctree, fold_convert (TREE_TYPE (ctree),
- tmp));
- }
/* Pass the address of the class object. */
- parmse->expr = gfc_build_addr_expr (NULL_TREE, var);
+ if (packed)
+ parmse->expr = packed;
+ else
+ parmse->expr = gfc_build_addr_expr (NULL_TREE, var);
if (optional && optional_alloc_ptr)
- parmse->expr = build3_loc (input_location, COND_EXPR,
- TREE_TYPE (parmse->expr),
- cond_optional, parmse->expr,
- fold_convert (TREE_TYPE (parmse->expr),
- null_pointer_node));
+ parmse->expr
+ = build3_loc (input_location, COND_EXPR, TREE_TYPE (parmse->expr),
+ cond_optional, parmse->expr,
+ fold_convert (TREE_TYPE (parmse->expr), null_pointer_node));
}
-
/* Create a new class container, which is required as scalar coarrays
have an array descriptor while normal scalars haven't. Optionally,
NULL pointer checks are added if the argument is OPTIONAL. */
@@ -1307,7 +1289,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
gfc_conv_descriptor_data_set (&block, ctree, tmp);
}
else
- class_array_data_assign (&block, ctree, parmse->expr, false);
+ gfc_class_array_data_assign (&block, ctree, parmse->expr, false);
}
else
{
@@ -1333,7 +1315,8 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
gfc_conv_descriptor_data_get (ctree)));
}
else
- class_array_data_assign (&parmse->post, parmse->expr, ctree, true);
+ gfc_class_array_data_assign (&parmse->post, parmse->expr, ctree,
+ true);
}
else
gfc_add_modify (&parmse->post, parmse->expr, ctree);
@@ -6547,13 +6530,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* The derived type needs to be converted to a temporary
CLASS object. */
gfc_init_se (&parmse, se);
- gfc_conv_derived_to_class (&parmse, e, fsym->ts, NULL,
+ gfc_conv_derived_to_class (&parmse, e, fsym, NULL_TREE,
fsym->attr.optional
- && e->expr_type == EXPR_VARIABLE
- && e->symtree->n.sym->attr.optional,
+ && e->expr_type == EXPR_VARIABLE
+ && e->symtree->n.sym->attr.optional,
CLASS_DATA (fsym)->attr.class_pointer
- || CLASS_DATA (fsym)->attr.allocatable,
- &derived_array);
+ || CLASS_DATA (fsym)->attr.allocatable,
+ sym->name, &derived_array);
}
else if (UNLIMITED_POLY (fsym) && e->ts.type != BT_CLASS
&& e->ts.type != BT_PROCEDURE
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index ee2cc560cdf..7ab82fa2f5b 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -2462,8 +2462,8 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,
|| (ts->type == BT_CLASS
&& !GFC_CLASS_TYPE_P (TREE_TYPE (decl))))
gfc_conv_derived_to_class (se, code->expr1,
- dtio_sub->formal->sym->ts,
- vptr, false, false);
+ dtio_sub->formal->sym, vptr, false,
+ false, "transfer");
addr_expr = se->expr;
function = iocall[IOCALL_X_DERIVED];
break;
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 60275e18867..89a10d9a537 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2108,11 +2108,9 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
{
/* This is bound to be a class array element. */
gfc_conv_expr_reference (&se, e);
- /* Get the _vptr component of the class object. */
- tmp = gfc_get_vptr_from_expr (se.expr);
/* Obtain a temporary class container for the result. */
- gfc_conv_derived_to_class (&se, e, sym->ts, tmp, false, false);
- se.expr = build_fold_indirect_ref_loc (input_location, se.expr);
+ gfc_conv_derived_to_class (&se, e, sym, se.expr, false, false,
+ e->symtree->name);
need_len_assign = false;
}
else
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index ec04aede0fd..65519069d81 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -464,8 +464,9 @@ bool gfc_add_comp_finalizer_call (stmtblock_t *, tree, gfc_component *, bool);
void gfc_finalize_tree_expr (gfc_se *, gfc_symbol *, symbol_attribute, int);
bool gfc_assignment_finalizer_call (gfc_se *, gfc_expr *, bool);
-void gfc_conv_derived_to_class (gfc_se *, gfc_expr *, gfc_typespec, tree, bool,
- bool, tree *derived_array = NULL);
+void gfc_class_array_data_assign (stmtblock_t *, tree, tree, bool);
+void gfc_conv_derived_to_class (gfc_se *, gfc_expr *, gfc_symbol *fsym, tree, bool,
+ bool, const char *proc_name, tree *derived_array = NULL);
void gfc_conv_class_to_class (gfc_se *, gfc_expr *, gfc_typespec, bool, bool,
bool, bool);
@@ -872,6 +873,8 @@ extern GTY(()) tree gfor_fndecl_ctime;
extern GTY(()) tree gfor_fndecl_fdate;
extern GTY(()) tree gfor_fndecl_in_pack;
extern GTY(()) tree gfor_fndecl_in_unpack;
+extern GTY(()) tree gfor_fndecl_in_pack_class;
+extern GTY(()) tree gfor_fndecl_in_unpack_class;
extern GTY(()) tree gfor_fndecl_associated;
extern GTY(()) tree gfor_fndecl_system_clock4;
extern GTY(()) tree gfor_fndecl_system_clock8;
diff --git a/gcc/testsuite/gfortran.dg/class_dummy_11.f90 b/gcc/testsuite/gfortran.dg/class_dummy_11.f90
new file mode 100644
index 00000000000..02537eaddfa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_dummy_11.f90
@@ -0,0 +1,167 @@
+! { dg-do run }
+
+! PR fortran/96992
+
+! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
+
+! From the standard:
+! An actual argument that represents an element sequence and
+! corresponds to a dummy argument that is an array is sequence
+! associated with the dummy argument. The rank and shape of the
+! actual argument need not agree with the rank and shape of the
+! dummy argument, but the number of elements in the dummy argument
+! shall not exceed the number of elements in the element sequence
+! of the actual argument. If the dummy argument is assumed-size,
+! the number of elements in the dummy argument is exactly
+! the number of elements in the element sequence.
+
+! Check that walking the sequence starts with an initialized stride
+! for dim == 0.
+
+module foo_mod
+ implicit none
+ type foo
+ integer :: i
+ end type foo
+contains
+ subroutine d1(x,n)
+ integer, intent(in) :: n
+ integer :: i
+ class (foo), intent(out), dimension(n) :: x
+
+ x(:)%i = (/ (42 + i, i = 1, n ) /)
+ end subroutine d1
+ subroutine d2(x,n,sb)
+ integer, intent(in) :: n
+ integer :: i, sb
+ class (foo), intent(in), dimension(n,n,n) :: x
+
+ if ( any( x%i /= reshape((/ (42 + i, i = 1, n ** 3 ) /), [n, n, n] ))) stop sb + 1
+ end subroutine d2
+ subroutine d3(x,n)
+ integer, intent(in) :: n
+ integer :: i
+ class (foo), intent(inout) :: x(n)
+
+ x%i = -x%i ! Simply negate elements
+ end subroutine d3
+ subroutine d1s(x,n, sb)
+ integer, intent(in) :: n, sb
+ integer :: i
+ class (*), intent(out), dimension(n) :: x
+ select type(x)
+ class is(foo)
+ x(:)%i = (/ (42 + i, i = 1, n ) /)
+ class default
+ stop sb + 2
+ end select
+ end subroutine d1s
+ subroutine d2s(x,n,sb)
+ integer, intent(in) :: n,sb
+ integer :: i
+ class (*), intent(in), dimension(n,n,n) :: x
+ select type (x)
+ class is (foo)
+ if ( any( x%i /= reshape((/ (42 + i, i = 1, n ** 3 ) /), [n, n, n] ))) stop sb + 3
+ class default
+ stop sb + 4
+ end select
+ end subroutine d2s
+ subroutine d3s(x,n,sb)
+ integer, intent(in) :: n, sb
+ integer :: i
+ class (*), intent(inout) :: x(n)
+ select type (x)
+ class is (foo)
+ x%i = -x%i ! Simply negate elements
+ class default
+ stop sb + 5
+ end select
+ end subroutine d3s
+end module foo_mod
+program main
+ use foo_mod
+ implicit none
+ type (foo), dimension(:), allocatable :: f
+ type (foo), dimension(27) :: g
+ type (foo), dimension(3, 9) :: td
+ integer :: n,i,np3
+ n = 3
+ np3 = n **3
+ allocate (f(np3))
+ call d1(f, np3)
+ call d2(f, n, 0)
+
+ call d1s(f, np3, 0)
+ call d2s(f, n, 0)
+
+ ! Use negative stride
+ call d1(f(np3:1:-1), np3)
+ if ( any( f%i /= (/ (42 + i, i = np3, 1, -1 ) /) )) stop 6
+ call d2(f(np3:1:-1), n, 0)
+ call d3(f(1:np3:4), np3/4)
+ if ( any( f%i /= (/ (merge(-(42 + (np3 - i)), &
+ 42 + (np3 - i), &
+ MOD(i, 4) == 0 .AND. i < 21), &
+ i = 0, np3 - 1 ) /) )) &
+ stop 7
+
+ call d1s(f(np3:1:-1), np3, 0)
+ if ( any( f%i /= (/ (42 + i, i = np3, 1, -1 ) /) )) stop 8
+ call d2s(f(np3:1:-1), n, 0)
+ call d3s(f(1:np3:4), np3/4, 0)
+ if ( any( f%i /= (/ (merge(-(42 + (np3 - i)), &
+ 42 + (np3 - i), &
+ MOD(i, 4) == 0 .AND. i < 21), &
+ i = 0, np3 - 1 ) /) )) &
+ stop 9
+
+ deallocate (f)
+
+ call d1(g, np3)
+ call d2(g, n, 10)
+
+ call d1s(g, np3, 10)
+ call d2s(g, n, 10)
+
+ ! Use negative stride
+ call d1(g(np3:1:-1), np3)
+ if ( any( g%i /= (/ (42 + i, i = np3, 1, -1 ) /) )) stop 16
+ call d2(g(np3:1:-1), n, 10)
+ call d3(g(1:np3:4), np3/4)
+ if ( any( g%i /= (/ (merge(-(42 + (np3 - i)), &
+ 42 + (np3 - i), &
+ MOD(i, 4) == 0 .AND. i < 21), &
+ i = 0, np3 - 1 ) /) )) &
+ stop 17
+
+ call d1s(g(np3:1:-1), np3, 10)
+ if ( any( g%i /= (/ (42 + i, i = np3, 1, -1 ) /) )) stop 18
+ call d2s(g(np3:1:-1), n, 10)
+ call d3s(g(1:np3:4), np3/4, 10)
+ if ( any( g%i /= (/ (merge(-(42 + (np3 - i)), &
+ 42 + (np3 - i), &
+ MOD(i, 4) == 0 .AND. i < 21), &
+ i = 0, np3 - 1 ) /) )) &
+ stop 19
+
+ ! Check for 2D
+ call d1(td, np3)
+ call d2(td, n, 20)
+
+ call d1s(td, np3, 20)
+ call d2s(td, n, 20)
+
+ ! Use negative stride
+ call d1(td(3:1:-1,9:1:-1), np3)
+ if ( any( reshape(td%i, [np3]) /= (/ (42 + i, i = np3, 1, -1 ) /) )) stop 25
+ call d2(td(3:1:-1,9:1:-1), n, 20)
+ call d3(td(2,1:n), n)
+ if ( any( reshape(td%i, [np3]) /= (/ (merge(-(42 + (np3 - i)), &
+ 42 + (np3 - i), &
+ MOD(i, 3) == 1 .AND. i < 9), &
+ i = 0, np3 - 1 ) /) )) &
+ stop 26
+
+end program main
+
--
2.45.2
^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2024-07-03 10:58 UTC | newest]
Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-06-14 15:05 [Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument Andre Vehreschild
2024-06-16 21:27 ` Harald Anlauf
2024-06-16 21:27 ` Harald Anlauf
2024-06-19 7:07 ` Andre Vehreschild
2024-06-19 19:17 ` Harald Anlauf
2024-06-19 19:17 ` Harald Anlauf
2024-07-03 10:58 ` [Fortran, Patch, PR 96992, V3] " Andre Vehreschild
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).