From: Paul Richard Thomas <paul.richard.thomas@gmail.com>
To: "fortran@gcc.gnu.org" <fortran@gcc.gnu.org>,
gcc-patches <gcc-patches@gcc.gnu.org>
Subject: [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
Date: Tue, 28 Mar 2023 22:04:55 +0100 [thread overview]
Message-ID: <CAGkQGiJENziaSDDmmhZ6EVU4NVqoN6wQansyZjzb325_muQSyA@mail.gmail.com> (raw)
[-- Attachment #1.1: Type: text/plain, Size: 2624 bytes --]
Hi All,
I have made a start on ASSOCIATE issues. Some of the low(-ish) hanging
fruit are already fixed but I have yet to check that they a really fixed
and to close them:
pr102106, pr102111, pr104430, pr106048, pr85510, pr87460, pr92960 & pr93338
The attached patch picks up those PRs involving deferred length characters
in one guise or another. I believe that it is all pretty straightforward.
Structure constructors with allocatable, deferred length, character array
components just weren't implemented and so this is the biggest part of the
patch. I found two other, non-associate PRs(106918 & 105205) that are
fixed and there are probably more.
The chunk in trans-io.cc is something of a kludge, which I will come back
to. Some descriptors come through with a data pointer that looks as if it
should be OK but
I thought to submit this now to get it out of the way. The ratio of PRs
fixed to the size of the patch warrants this. The next stage is going to be
rather messy and so "I might take a little while" (cross talk between
associate and select type, in particular).
Regtests OK - good for mainline?
Cheers
Paul
Fortran: Fix some of the bugs in associate [PR87477]
2023-03-28 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR fortran/87477
* trans-array.cc (gfc_conv_expr_descriptor): Guard string len
expression in condition.
(duplicate_allocatable): Make element type more explicit with
'eltype'.
* 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/92994
* gfortran.dg/finalize_51.f90 : Update an error message.
PR fortran/85686
* gfortran.dg/pr85686.f90 : New test
PR fortran/88247
* gfortran.dg/pr88247.f90 : New test
PR fortran/91941
* gfortran.dg/pr91941.f90 : New test
PR fortran/92779
* gfortran.dg/pr92779.f90 : New test
PR fortran/93339
* gfortran.dg/pr93339.f90 : New test
PR fortran/93813
* gfortran.dg/pr93813.f90 : New test
PR fortran/100948
* gfortran.dg/pr100948.f90 : New test
PR fortran/102106
* gfortran.dg/pr102106.f90 : New test
PR fortran/105205
* gfortran.dg/pr105205.f90 : New test
PR fortran/106918
* gfortran.dg/pr106918.f90 : New test
[-- Attachment #2: pr100948.diff --]
[-- Type: application/x-patch, Size: 9830 bytes --]
[-- Attachment #3: pr85686.f90 --]
[-- Type: application/octet-stream, Size: 382 bytes --]
! { dg-do run }
!
! Used to segfault at the write statement.
!
! Contributed by Gerhard Steinmetz <gscfq@t-online.de>
!
character(20) :: buffer
call s([" g'day "," bye!! "])
print *, buffer
if (trim (buffer) .ne. " a g'day a bye!!") stop 1
contains
subroutine s(x)
character(*) :: x(:)
associate (y => 'a'//x)
write (buffer, *) y
end associate
end
end
[-- Attachment #4: pr88247.f90 --]
[-- Type: application/octet-stream, Size: 647 bytes --]
! { dg-do run }
!
! Contributed by Gerhard Steinmetz <gscfq@t-online.de>
!
program p
call foo
contains
subroutine foo
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 1
end subroutine foo
end
[-- Attachment #5: pr91941.f90 --]
[-- Type: application/octet-stream, Size: 317 bytes --]
! { dg-do-compile }
!
! Contributed by Gerhard Steinmetz <gscfq@t-online.de>
!
program p
character(:), allocatable :: x(:), z(:)
x = [' abc', ' xyz']
z = adjustl(x)
associate (y => adjustl(x))
if (any(y .ne. ['abc ', 'xyz '])) stop 1
end associate
deallocate(x, z) ! For valgrind testing
end
[-- Attachment #6: pr92779.f90 --]
[-- Type: application/octet-stream, Size: 230 bytes --]
! { dg-do-run }
!
! Contributed by Gerhard Steinmetz <gscfq@t-online.de>
!
program p
character(3) :: a = 'abc'
associate (y => spread(trim(a),1,2) // 'd')
if (any (y .ne. ['abcd','abcd'])) stop 1
end associate
end
[-- Attachment #7: pr93339.f90 --]
[-- Type: application/octet-stream, Size: 466 bytes --]
! { dg-do-run }
!
! Contributed by Gerhard Steinmetz <gscfq@t-online.de>
!
program p
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 1
associate (z => x%a)
if (any (y .ne. z)) stop 2
end associate
end associate
deallocate (x%a)
end
[-- Attachment #8: pr93813.f90 --]
[-- Type: application/octet-stream, Size: 455 bytes --]
! { dg-do-run }
!
! Contributed by Gerhard Steinmetz <gscfq@t-online.de>
!
program p
type t
end type
type, extends(t) :: t2
end type
class(t), allocatable :: x
associate (y => (x)) ! The parentheses triggered an ICE in select type
select type (y)
type is (t2)
print *, "is T2"
stop 1
type is (t)
print *, "is T"
class default
stop 2
end select
end associate
end
[-- Attachment #9: pr102106.f90 --]
[-- Type: application/octet-stream, Size: 412 bytes --]
! { dg-do run }
!
! Contributed by Brad Richardson <everythingfunctional@protonmail.com>
!
program main
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 program
[-- Attachment #10: pr106918.f90 --]
[-- Type: application/octet-stream, Size: 469 bytes --]
! { dg-do run }
!
! Contributed by Lionel Guez <guez@lmd.ens.fr>
!
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
end
[-- Attachment #11: pr105205.f90 --]
[-- Type: application/octet-stream, Size: 566 bytes --]
! { dg-do run }
!
! Contributed by Rich Townsend <townsend@astro.wisc.edu>
!
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)) stop1
end do
if (any (a%c .ne. check)) stop 2
if (any (a%c(start:finish) .ne. check)) stop 3
end
[-- Attachment #12: pr100948.f90 --]
[-- Type: text/x-fortran, Size: 637 bytes --]
! { dg-do-run }
!
! Contributed by Gerhard Steinmetz <gscfq@t-online.de>
!
program p
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 1
if (any (y .ne. ['ab','cd'])) stop 2
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 3
if (any (y .ne. ['ef','gh'])) stop 4
end associate
deallocate (x)
end
next reply other threads:[~2023-03-28 21:05 UTC|newest]
Thread overview: 19+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-03-28 21:04 Paul Richard Thomas [this message]
2023-03-29 8:24 ` Manfred Schwarb
2023-03-29 8:53 ` Paul Richard Thomas
2023-04-07 7:02 ` Paul Richard Thomas
2023-04-07 9:40 ` Harald Anlauf
2023-04-07 9:40 ` Harald Anlauf
2023-04-07 7:07 ` Ping! " Paul Richard Thomas
2023-04-07 9:41 ` Harald Anlauf
2023-04-07 9:41 ` Harald Anlauf
2023-04-07 13:53 ` Paul Richard Thomas
2023-04-07 19:28 ` Harald Anlauf
2023-04-07 19:28 ` Harald Anlauf
2023-04-07 21:35 ` Paul Richard Thomas
2023-04-07 21:38 ` Paul Richard Thomas
2023-04-08 13:56 ` Harald Anlauf
2023-04-08 13:56 ` Harald Anlauf
2023-06-01 15:20 Paul Richard Thomas
2023-06-01 17:58 ` Mikael Morin
2023-06-02 7:46 ` Paul Richard Thomas
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=CAGkQGiJENziaSDDmmhZ6EVU4NVqoN6wQansyZjzb325_muQSyA@mail.gmail.com \
--to=paul.richard.thomas@gmail.com \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).