duuuh! Please find them attached.
Thanks
Paul
On Fri, 7 Apr 2023 at 10:41, Harald Anlauf <[email protected]> wrote:
> Hi Paul,
>
> I don't see the new testcases. Is this an issue on my side,
> or did you forget to attach them?
>
> Thanks,
> Harald
>
> On 4/7/23 09:07, Paul Richard Thomas via Gcc-patches wrote:
> > Dear All,
> >
> > Please find attached a slightly updated version of the patch with a
> > consolidated testcase. The three additional testcases are nothing to do
> > with associate and test fixes of character related bugs.
> >
> > OK for mainline?
> >
> > Cheers
> >
> > Paul
> > Fortran: Fix some of the bugs in associate [PR87477]
> >
> > 2023-04-07 Paul Thomas <[email protected]>
> >
> > gcc/fortran
> > PR fortran/87477
> > * resolve.cc (resolve_assoc_var): Handle parentheses around the
> > target expression.
> > (resolve_block_construct): Remove unnecessary static decls.
> > * trans-array.cc (gfc_conv_expr_descriptor): Guard string len
> > expression in condition. Improve handling of string length and
> > span, especially for substrings of the descriptor.
> > (duplicate_allocatable): Make element type more explicit with
> > 'eltype'.
> > * trans_decl.cc (gfc_get_symbol_decl): Emit a fatal error with
> > appropriate message instead of ICE if symbol type is unknown.
> > * trans-expr.cc (gfc_get_expr_charlen): Retain last charlen in
> > 'previous' and use if end expression in substring reference is
> > null.
> > (gfc_conv_string_length): Use gfc_conv_expr_descriptor if
> > 'expr_flat' is an array.
> > (gfc_trans_alloc_subarray_assign): If this is a deferred string
> > length component, store the string length in the hidden comp.
> > Update the typespec length accordingly. Generate a new type
> > spec for the call to gfc_duplicate-allocatable in this case.
> > * trans-io.cc (gfc_trans_transfer): Scalarize transfer of
> > deferred character array components.
> >
> >
> > gcc/testsuite/
> > PR fortran/87477
> > * gfortran.dg/finalize_47.f90 : Enable substring test.
> > * gfortran.dg/finalize_51.f90 : Update an error message.
> >
> > PR fortran/85686
> > PR fortran/88247
> > PR fortran/91941
> > PR fortran/92779
> > PR fortran/93339
> > PR fortran/93813
> > PR fortran/100948
> > PR fortran/102106
> > * gfortran.dg/associate_60.f90 : New test
> >
> > PR fortran/98408
> > * gfortran.dg/pr98408.f90 : New test
> >
> > PR fortran/105205
> > * gfortran.dg/pr105205.f90 : New test
> >
> > PR fortran/106918
> > * gfortran.dg/pr106918.f90 : New test
>
>
--
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein
! { dg-do run }
!
! Tests fixes for various pr87477 dependencies
!
! Contributed by Gerhard Steinmetz <[email protected]> except for pr102106:
! which was contributed by Brad Richardson <[email protected]>
!
program associate_60
implicit none
character(20) :: buffer
call pr102106
call pr100948
call pr85686
call pr88247
call pr91941
call pr92779
call pr93339
call pr93813
contains
subroutine pr102106
type :: sub_class_t
integer :: i
end type
type :: with_polymorphic_component_t
class(sub_class_t), allocatable :: sub_obj_
end type
associate(obj => with_polymorphic_component_t(sub_class_t(42)))
if (obj%sub_obj_%i .ne. 42) stop 1
end associate
end
subroutine pr100948
type t
character(:), allocatable :: c(:)
end type
type(t), allocatable :: x
!
! Valid test in comment 1
!
x = t(['ab','cd'])
associate (y => x%c(:))
if (any (y .ne. x%c)) stop 2
if (any (y .ne. ['ab','cd'])) stop 3
end associate
deallocate (x)
!
! Allocation with source was found to only copy over one of the array elements
!
allocate (x, source = t(['ef','gh']))
associate (y => x%c(:))
if (any (y .ne. x%c)) stop 4
if (any (y .ne. ['ef','gh'])) stop 5
end associate
deallocate (x)
end
subroutine pr85686
call s85686([" g'day "," bye!! "])
if (trim (buffer) .ne. " a g'day a bye!!") stop 6
end
subroutine s85686(x)
character(*) :: x(:)
associate (y => 'a'//x)
write (buffer, *) y ! Used to segfault at the write statement.
end associate
end
subroutine pr88247
type t
character(:), dimension(:), allocatable :: d
end type t
type(t), allocatable :: x
character(5) :: buffer(3)
allocate (x, source = t (['ab','cd'])) ! Didn't work
write(buffer(1), *) x%d(2:1:-1) ! Was found to be broken
write(buffer(2), *) [x%d(2:1:-1)] ! Was OK
associate (y => [x%d(2:1:-1)])
write(buffer(3), *) y ! Bug in comment 7
end associate
if (any (buffer .ne. " cdab")) stop 7
end
subroutine pr91941
character(:), allocatable :: x(:), z(:)
x = [' abc', ' xyz']
z = adjustl(x)
associate (y => adjustl(x)) ! Wrong character length was passed
if (any(y .ne. ['abc ', 'xyz '])) stop 8
end associate
end
subroutine pr92779
character(3) :: a = 'abc'
associate (y => spread(trim(a),1,2) // 'd')
if (any (y .ne. ['abcd','abcd'])) stop 9
end associate
end
subroutine pr93339
type t
character(:), allocatable :: a(:)
end type
type(t) :: x
x = t(["abc "]) ! Didn't assign anything
! allocate (x%a(1), source = 'abc') ! Worked OK
associate (y => x%a)
if (any (y .ne. 'abc ')) stop 10
associate (z => x%a)
if (any (y .ne. z)) stop 11
end associate
end associate
end
subroutine pr93813
type t
end type
type, extends(t) :: t2
end type
class(t), allocatable :: x
integer :: i = 0
associate (y => (x)) ! The parentheses triggered an ICE in select type
select type (y)
type is (t2)
stop 12
type is (t)
i = 42
class default
stop 13
end select
end associate
if (i .ne. 42) stop 14
end
end
! { dg-do run }
!
! Contributed by Thomas Koenig <[email protected]>
!
program main
character (len=:), allocatable :: a(:)
allocate (character(len=10) :: a(5))
if (sizeof(a) .ne. 50) stop 1
deallocate (a)
end program main
! { dg-do run }
!
! Contributed by Rich Townsend <[email protected]>
!
program alloc_char_type
implicit none
integer, parameter :: start = 1, finish = 4
character(3) :: check(4)
type mytype
character(:), allocatable :: c(:)
end type mytype
type(mytype) :: a
type(mytype) :: b
integer :: i
a%c = ['foo','bar','biz','buz']
check = ['foo','bar','biz','buz']
b = a
do i = 1, size(b%c)
if (b%c(i) .ne. check(i)) stop 1
end do
if (any (a%c .ne. check)) stop 2
if (any (a%c(start:finish) .ne. check)) stop 3
deallocate (a%c)
deallocate (b%c)
end
! { dg-do run }
!
! Contributed by Lionel Guez <[email protected]>
!
character(len = :), allocatable:: attr_name(:)
character(6) :: buffer
type coord_def
character(len = :), allocatable:: attr_name(:)
end type coord_def
type(coord_def) coordinates
attr_name = ["units"]
write (buffer, *) attr_name
if (buffer .ne. " units") stop 1
coordinates = coord_def(attr_name)
write (buffer, *) coordinates%attr_name
if (buffer .ne. " units") stop 2
deallocate (attr_name)
deallocate (coordinates%attr_name)
end
