Hi Andre,
Am 03.07.24 um 12:58 schrieb Andre Vehreschild:
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.
this is a really huge patch to review, and I am not sure that I can do
this without help from others. Paul? Anybody else?
As far as I can tell for now:
- pr96992_3p1.patch (the libgfortran part) looks good to me.
- git had some whitespace issues with pr96992_3p2.patch as attached,
but I could fix that locally and do some testing parallel to reading.
A few advance comments on the latter patch:
- my understanding is that the PR at the end of a summary line should be
like in:
Fortran: Fix rejecting class arrays of different ranks as storage
association argument [PR96992]
I was told that this helps people explicitly scanning for the PR
number in that place.
- some rewrites of logical conditions change the coding style from
what it recommended GNU coding style, and I find the more compact
way used in some places harder to grok (but that may be just me).
Example:
@@ -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
I understand that this may be your personal coding style, but you
might keep in mind that reviewers have to understand the code, too...
I have not fully understood your logic when packing is now invoked.
We not only need to do it for explicit-size arrays, but also for
assumed-size. This still fails for my slightly extended testcase
(see attached) where I pass the class array via:
subroutine d4(x,n)
integer, intent(in) :: n
! class (foo), intent(inout) :: x(n) ! OK
class (foo), intent(inout) :: x(*) ! not OK
call d3(x,n) ! Simply pass assumed-size array
end subroutine d4
I am unable to point to the places in your patch where you need to
handle that in addition.
Otherwise I was unable to see any obvious, major problem with the
patch, but then I am not fluent enough in class handling in the
gfortran FE. So if e.g. Paul jumps in here within the next 72 hours,
it would be great.
So here comes the issue with the attached code variant.
After your patch, this prints as last 4 relevant lines:
full: -43 44 45 -46 47
48 -49 50
d3_1: -43 44 45
d3_2: 43 -44 -45
full: 43 -44 -45 -46 47
48 -49 50
while when switching the declaration of the dummy argument of d4:
full: -43 44 45 -46 47
48 -49 50
d3_1: -43 -46 -49
d3_2: 43 46 49
full: 43 44 45 46 47
48 49 50
The latter one is correct, the former one isn't.
Sorry for spoiling the show...
Nevertheless, thanks for your great effort so far!
Harald
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.
[remaining part of mail removed]
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)
!print *, "d1:lbound=", lbound (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) :: x(n,n,n)
!print *, "d2:lbound=", lbound (x)
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)
!print *, "d3:lbound=", lbound (x)
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
subroutine d4(x,n)
integer, intent(in) :: n
! class (foo), intent(inout) :: x(n) ! OK
class (foo), intent(inout) :: x(*) ! not OK
call d3(x,n) ! Simply pass assumed-size array
end subroutine d4
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
call d4(f(1:m:k),1+(m-1)/k)
print *, "full:", f%i
print *, "(the last printed line should be identical to the first one)"
deallocate (f)
end program main
