public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
@ 2023-03-28 21:04 Paul Richard Thomas
  2023-03-29  8:24 ` Manfred Schwarb
  2023-04-07  7:07 ` Ping! " Paul Richard Thomas
  0 siblings, 2 replies; 16+ messages in thread
From: Paul Richard Thomas @ 2023-03-28 21:04 UTC (permalink / raw)
  To: fortran, gcc-patches


[-- 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

^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  2023-03-28 21:04 [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement Paul Richard Thomas
@ 2023-03-29  8:24 ` Manfred Schwarb
  2023-03-29  8:53   ` Paul Richard Thomas
  2023-04-07  7:07 ` Ping! " Paul Richard Thomas
  1 sibling, 1 reply; 16+ messages in thread
From: Manfred Schwarb @ 2023-03-29  8:24 UTC (permalink / raw)
  To: Paul Richard Thomas; +Cc: gcc-patches, fortran

Am 28.03.23 um 23:04 schrieb Paul Richard Thomas via Fortran:
> 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?
>

Paul, you have some "dg-do-run" and "dg-do-compile" statements in your testcases,
could you change them into their single-minus-sign variants?

Cheers,
Manfred


BTW: I just ran my script again and found the following testsuite issues (note that outer-most
braces need to be space-padded):

./c-interop/removed-restrictions-1.f90:! { dg-do compile}
./c-interop/removed-restrictions-2.f90:! { dg-do compile}
./c-interop/removed-restrictions-3.f90:! { dg-do compile}
./c-interop/removed-restrictions-4.f90:! { dg-do compile}
./c-interop/tkr.f90:! { dg-do compile}
./c-interop/c407c-1.f90:! { dg-do compile}
./c-interop/deferred-character-1.f90:! { dg-do compile}
./c-interop/allocatable-optional-pointer.f90:! { dg-do compile}
./c-interop/c407a-1.f90:! { dg-do compile}
./c-interop/c407b-1.f90:! { dg-do compile}
./c-interop/c407b-2.f90:! { dg-do compile}
./c-interop/c535a-1.f90:! { dg-do compile}
./c-interop/c535a-2.f90:! { dg-do compile}
./c-interop/c535b-1.f90:! { dg-do compile}
./c-interop/c535b-2.f90:! { dg-do compile}
./c-interop/c535b-3.f90:! { dg-do compile}
./c-interop/c535c-1.f90:! { dg-do compile}
./c-interop/c535c-2.f90:! { dg-do compile}
./gomp/affinity-clause-1.f90:! { dg final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):b\\\[\\(.* <?i>? \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):d\\\[\\(\\(integer\\(kind=8\\)\\) i \\+ -1\\) \\* 6\\\]\\)"  1 "original" } }
./class_result_10.f90:! { dg-do run}
./pr103258.f90:! { dg-do compile}
./dtio_35.f90:! { dg-compile }
./pr93835.f08:! {dg-do run }
./pr59107.f90:! { dg-compile }



> 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


^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  2023-03-29  8:24 ` Manfred Schwarb
@ 2023-03-29  8:53   ` Paul Richard Thomas
  2023-04-07  7:02     ` Paul Richard Thomas
  0 siblings, 1 reply; 16+ messages in thread
From: Paul Richard Thomas @ 2023-03-29  8:53 UTC (permalink / raw)
  To: Manfred Schwarb; +Cc: gcc-patches, fortran

[-- Attachment #1: Type: text/plain, Size: 5151 bytes --]

Hi Manfred,

Indeed I do :-) Thanks for the spot. I have decided that it will be less
messy if I roll all the testcases into one or, perhaps two =>
associate_xx.f90

Forgetting the space before the final brace seems to be rife!

Cheers

Paul


On Wed, 29 Mar 2023 at 09:24, Manfred Schwarb <manfred99@gmx.ch> wrote:

> Am 28.03.23 um 23:04 schrieb Paul Richard Thomas via Fortran:
> > 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?
> >
>
> Paul, you have some "dg-do-run" and "dg-do-compile" statements in your
> testcases,
> could you change them into their single-minus-sign variants?
>
> Cheers,
> Manfred
>
>
> BTW: I just ran my script again and found the following testsuite issues
> (note that outer-most
> braces need to be space-padded):
>
> ./c-interop/removed-restrictions-1.f90:! { dg-do compile}
> ./c-interop/removed-restrictions-2.f90:! { dg-do compile}
> ./c-interop/removed-restrictions-3.f90:! { dg-do compile}
> ./c-interop/removed-restrictions-4.f90:! { dg-do compile}
> ./c-interop/tkr.f90:! { dg-do compile}
> ./c-interop/c407c-1.f90:! { dg-do compile}
> ./c-interop/deferred-character-1.f90:! { dg-do compile}
> ./c-interop/allocatable-optional-pointer.f90:! { dg-do compile}
> ./c-interop/c407a-1.f90:! { dg-do compile}
> ./c-interop/c407b-1.f90:! { dg-do compile}
> ./c-interop/c407b-2.f90:! { dg-do compile}
> ./c-interop/c535a-1.f90:! { dg-do compile}
> ./c-interop/c535a-2.f90:! { dg-do compile}
> ./c-interop/c535b-1.f90:! { dg-do compile}
> ./c-interop/c535b-2.f90:! { dg-do compile}
> ./c-interop/c535b-3.f90:! { dg-do compile}
> ./c-interop/c535c-1.f90:! { dg-do compile}
> ./c-interop/c535c-2.f90:! { dg-do compile}
> ./gomp/affinity-clause-1.f90:! { dg final { scan-tree-dump-times "#pragma
> omp task affinity\\(iterator\\(integer\\(kind=4\\)
> i=D\\.\[0-9\]+:5:1\\):b\\\[\\(.* <?i>? \\+ -1\\\]\\)
> affinity\\(iterator\\(integer\\(kind=4\\)
> i=D\\.\[0-9\]+:5:1\\):d\\\[\\(\\(integer\\(kind=8\\)\\) i \\+ -1\\) \\*
> 6\\\]\\)"  1 "original" } }
> ./class_result_10.f90:! { dg-do run}
> ./pr103258.f90:! { dg-do compile}
> ./dtio_35.f90:! { dg-compile }
> ./pr93835.f08:! {dg-do run }
> ./pr59107.f90:! { dg-compile }
>
>
>
> > 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
>
>

-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  2023-03-29  8:53   ` Paul Richard Thomas
@ 2023-04-07  7:02     ` Paul Richard Thomas
  2023-04-07  9:40       ` Harald Anlauf
  0 siblings, 1 reply; 16+ messages in thread
From: Paul Richard Thomas @ 2023-04-07  7:02 UTC (permalink / raw)
  To: Manfred Schwarb; +Cc: gcc-patches, fortran


[-- Attachment #1.1: Type: text/plain, Size: 6979 bytes --]

Hi All,

Please find attached the patch to fix the dg directives and remove a lot of
trailing white space.

Unless there are any objections, I will commit as obvious over the weekend.

Cheers

Paul

Fortran: Fix dg directives and remove trailing whitespaces in testsuite

2023-04-07  Paul Thomas  <pault@gcc.gnu.org>

* gfortran.dg/c-interop/allocatable-optional-pointer.f90 : Fix
dg directive and remove trailing whitespace.
* gfortran.dg/c-interop/c407a-1.f90 : ditto
* gfortran.dg/c-interop/c407b-1.f90 : ditto
* gfortran.dg/c-interop/c407b-2.f90 : ditto
* gfortran.dg/c-interop/c407c-1.f90 : ditto
* gfortran.dg/c-interop/c535a-1.f90 : ditto
* gfortran.dg/c-interop/c535a-2.f90 : ditto
* gfortran.dg/c-interop/c535b-1.f90 : ditto
* gfortran.dg/c-interop/c535b-2.f90 : ditto
* gfortran.dg/c-interop/c535b-3.f90 : ditto
* gfortran.dg/c-interop/c535c-1.f90 : ditto
* gfortran.dg/c-interop/c535c-2.f90 : ditto
* gfortran.dg/c-interop/deferred-character-1.f90 : ditto
* gfortran.dg/c-interop/removed-restrictions-1.f90 : ditto
* gfortran.dg/c-interop/removed-restrictions-2.f90 : ditto
* gfortran.dg/c-interop/removed-restrictions-4.f90 : ditto
* gfortran.dg/c-interop/tkr.f90 : ditto
* gfortran.dg/class_result_10.f90 : ditto
* gfortran.dg/dtio_35.f90 : ditto
* gfortran.dg/goacc/array-with-dt-2.f90 : ditto
* gfortran.dg/gomp/affinity-clause-1.f90 : ditto
* gfortran.dg/pr103258.f90 : ditto
* gfortran.dg/pr59107.f90 : ditto
* gfortran.dg/pr93835.f08 : ditto



On Wed, 29 Mar 2023 at 09:53, Paul Richard Thomas <
paul.richard.thomas@gmail.com> wrote:

> Hi Manfred,
>
> Indeed I do :-) Thanks for the spot. I have decided that it will be less
> messy if I roll all the testcases into one or, perhaps two =>
> associate_xx.f90
>
> Forgetting the space before the final brace seems to be rife!
>
> Cheers
>
> Paul
>
>
> On Wed, 29 Mar 2023 at 09:24, Manfred Schwarb <manfred99@gmx.ch> wrote:
>
>> Am 28.03.23 um 23:04 schrieb Paul Richard Thomas via Fortran:
>> > 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?
>> >
>>
>> Paul, you have some "dg-do-run" and "dg-do-compile" statements in your
>> testcases,
>> could you change them into their single-minus-sign variants?
>>
>> Cheers,
>> Manfred
>>
>>
>> BTW: I just ran my script again and found the following testsuite issues
>> (note that outer-most
>> braces need to be space-padded):
>>
>> ./c-interop/removed-restrictions-1.f90:! { dg-do compile}
>> ./c-interop/removed-restrictions-2.f90:! { dg-do compile}
>> ./c-interop/removed-restrictions-3.f90:! { dg-do compile}
>> ./c-interop/removed-restrictions-4.f90:! { dg-do compile}
>> ./c-interop/tkr.f90:! { dg-do compile}
>> ./c-interop/c407c-1.f90:! { dg-do compile}
>> ./c-interop/deferred-character-1.f90:! { dg-do compile}
>> ./c-interop/allocatable-optional-pointer.f90:! { dg-do compile}
>> ./c-interop/c407a-1.f90:! { dg-do compile}
>> ./c-interop/c407b-1.f90:! { dg-do compile}
>> ./c-interop/c407b-2.f90:! { dg-do compile}
>> ./c-interop/c535a-1.f90:! { dg-do compile}
>> ./c-interop/c535a-2.f90:! { dg-do compile}
>> ./c-interop/c535b-1.f90:! { dg-do compile}
>> ./c-interop/c535b-2.f90:! { dg-do compile}
>> ./c-interop/c535b-3.f90:! { dg-do compile}
>> ./c-interop/c535c-1.f90:! { dg-do compile}
>> ./c-interop/c535c-2.f90:! { dg-do compile}
>> ./gomp/affinity-clause-1.f90:! { dg final { scan-tree-dump-times "#pragma
>> omp task affinity\\(iterator\\(integer\\(kind=4\\)
>> i=D\\.\[0-9\]+:5:1\\):b\\\[\\(.* <?i>? \\+ -1\\\]\\)
>> affinity\\(iterator\\(integer\\(kind=4\\)
>> i=D\\.\[0-9\]+:5:1\\):d\\\[\\(\\(integer\\(kind=8\\)\\) i \\+ -1\\) \\*
>> 6\\\]\\)"  1 "original" } }
>> ./class_result_10.f90:! { dg-do run}
>> ./pr103258.f90:! { dg-do compile}
>> ./dtio_35.f90:! { dg-compile }
>> ./pr93835.f08:! {dg-do run }
>> ./pr59107.f90:! { dg-compile }
>>
>>
>>
>> > 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
>>
>>
>
> --
> "If you can't explain it simply, you don't understand it well enough" -
> Albert Einstein
>


-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

[-- Attachment #2: dg-fix.diff --]
[-- Type: text/x-patch, Size: 21690 bytes --]

diff --git a/gcc/testsuite/gfortran.dg/c-interop/allocatable-optional-pointer.f90 b/gcc/testsuite/gfortran.dg/c-interop/allocatable-optional-pointer.f90
index 5a785b8a94d..7d22eb3ac84 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/allocatable-optional-pointer.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/allocatable-optional-pointer.f90
@@ -1,9 +1,9 @@
-! { dg-do compile}
+! { dg-do compile }
 !
 ! TS 29113
 ! 5.3 ALLOCATABLE, OPTIONAL, and POINTER attributes
-! The ALLOCATABLE, OPTIONAL, and POINTER attributes may be specified
-! for a dummy argument in a procedure interface that has the BIND
+! The ALLOCATABLE, OPTIONAL, and POINTER attributes may be specified
+! for a dummy argument in a procedure interface that has the BIND
 ! attribute.

 subroutine test (a, b, c)
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c407a-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/c407a-1.f90
index f239a1e8c43..86a20127511 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c407a-1.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c407a-1.f90
@@ -1,8 +1,8 @@
-! { dg-do compile}
+! { dg-do compile }
 !
 ! TS 29113
-! C407a An assumed-type entity shall be a dummy variable that does not
-! have the ALLOCATABLE, CODIMENSION, INTENT(OUT), POINTER, or VALUE
+! C407a An assumed-type entity shall be a dummy variable that does not
+! have the ALLOCATABLE, CODIMENSION, INTENT(OUT), POINTER, or VALUE
 ! attribute and is not an explicit-shape array.
 !
 ! This test file contains tests that are expected to all pass.
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c407b-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/c407b-1.f90
index c9fc2b99647..a148afc5273 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c407b-1.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c407b-1.f90
@@ -1,15 +1,15 @@
-! { dg-do compile}
+! { dg-do compile }
 !
 ! TS 29113
 ! C407b  An assumed-type variable name shall not appear in a designator
 ! or expression except as an actual argument corresponding to a dummy
 ! argument that is assumed-type, or as the first argument to any of
-! the intrinsic and intrinsic module functions IS_CONTIGUOUS, LBOUND,
+! the intrinsic and intrinsic module functions IS_CONTIGUOUS, LBOUND,
 ! PRESENT, RANK, SHAPE, SIZE, UBOUND, and C_LOC.
 !
 ! This test file contains tests that are expected to all pass.

-! Check that passing an assumed-type variable as an actual argument
+! Check that passing an assumed-type variable as an actual argument
 ! corresponding to an assumed-type dummy works.

 module m
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c407b-2.f90 b/gcc/testsuite/gfortran.dg/c-interop/c407b-2.f90
index 49352fc9d71..90ae68fa7df 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c407b-2.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c407b-2.f90
@@ -1,16 +1,16 @@
 ! PR 101337
-! { dg-do compile}
+! { dg-do compile }
 !
 ! TS 29113
 ! C407b  An assumed-type variable name shall not appear in a designator
 ! or expression except as an actual argument corresponding to a dummy
 ! argument that is assumed-type, or as the first argument to any of
-! the intrinsic and intrinsic module functions IS_CONTIGUOUS, LBOUND,
+! the intrinsic and intrinsic module functions IS_CONTIGUOUS, LBOUND,
 ! PRESENT, RANK, SHAPE, SIZE, UBOUND, and C_LOC.
 !
 ! This file contains tests that are expected to give diagnostics.

-! Check that passing an assumed-type variable as an actual argument
+! Check that passing an assumed-type variable as an actual argument
 ! corresponding to a non-assumed-type dummy gives a diagnostic.

 module m
@@ -72,35 +72,35 @@ subroutine s2 (x, y)
     type is (integer)
       i = 0
     type is (real)
-      i = 1
+      i = 1
     class default
       i = -1
   end select

   ! relational operations
   if (x & ! { dg-error "Assumed.type" "pr101337" }
-      .eq. y) then  ! { dg-error "Assumed.type" }
+      .eq. y) then  ! { dg-error "Assumed.type" }
     return
   end if
   if (.not. (x & ! { dg-error "Assumed.type" "pr101337" }
-             .ne. y)) then  ! { dg-error "Assumed.type" }
+             .ne. y)) then  ! { dg-error "Assumed.type" }
     return
   end if
-  if (.not. x) then  ! { dg-error "Assumed.type" }
+  if (.not. x) then  ! { dg-error "Assumed.type" }
     return
   end if

   ! assignment
-  x &  ! { dg-error "Assumed.type" }
-    = y  ! { dg-error "Assumed.type" }
-  i = x  ! { dg-error "Assumed.type" }
-  y = i  ! { dg-error "Assumed.type" }
+  x &  ! { dg-error "Assumed.type" }
+    = y  ! { dg-error "Assumed.type" }
+  i = x  ! { dg-error "Assumed.type" }
+  y = i  ! { dg-error "Assumed.type" }

   ! arithmetic
-  i = x + 1  ! { dg-error "Assumed.type" }
-  i = -y  ! { dg-error "Assumed.type" }
+  i = x + 1  ! { dg-error "Assumed.type" }
+  i = -y  ! { dg-error "Assumed.type" }
   i = (x & ! { dg-error "Assumed.type" "pr101337" }
-       + y)  ! { dg-error "Assumed.type" }
+       + y)  ! { dg-error "Assumed.type" }

   ! computed go to
   goto (10, 20, 30), x  ! { dg-error "Assumed.type|must be a scalar integer" }
@@ -116,7 +116,7 @@ subroutine s2 (x, y)
     continue
   end do

-end subroutine
+end subroutine

 ! Check that calls to disallowed intrinsic functions produce a diagnostic.
 ! Again, this isn't exhaustive, there are just too many intrinsics and
@@ -147,4 +147,4 @@ subroutine s3 (x, y)

   i = kind (x)  ! { dg-error "Assumed.type" }

-end subroutine
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90
index 699f75f6142..7abe3382740 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c407c-1.f90
@@ -1,5 +1,5 @@
 ! PR101333
-! { dg-do compile}
+! { dg-do compile }
 !
 ! TS 29113
 ! C407c An assumed-type actual argument that corresponds to an
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535a-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535a-1.f90
index 5550cf24005..f933808ff89 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535a-1.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535a-1.f90
@@ -1,4 +1,4 @@
-! { dg-do compile}
+! { dg-do compile }
 !
 ! TS 29113
 ! C535a  An assumed-rank entity shall be a dummy variable that does not
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535a-2.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535a-2.f90
index 026be4a5525..816e69124ce 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535a-2.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535a-2.f90
@@ -1,4 +1,4 @@
-! { dg-do compile}
+! { dg-do compile }
 ! { dg-additional-options "-fcoarray=single" }
 !
 ! TS 29113
@@ -43,7 +43,7 @@ subroutine s0 (a)
     integer, dimension(..) :: badblocklocal2  ! { dg-error "Assumed.rank" }
     integer :: badblocklocal3  ! { dg-error "Assumed.rank" }
     dimension badblocklocal3(..)
-  end block
+  end block

 end subroutine

@@ -62,7 +62,7 @@ module m
     integer, dimension(..) :: badcomponent2  ! { dg-error "must have an explicit shape" }
   end type
 end module
-
+
 ! Check that diagnostics are issued when dimension(..) is used in combination
 ! with the forbidden attributes.

diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535b-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535b-1.f90
index 748e027f897..f8ecabe9a02 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535b-1.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535b-1.f90
@@ -1,9 +1,9 @@
-! { dg-do compile}
+! { dg-do compile }
 ! { dg-additional-options "-fcoarray=single" }
 !
 ! TS 29113
 ! C535b An assumed-rank variable name shall not appear in a designator
-! or expression except as an actual argument corresponding to a dummy
+! or expression except as an actual argument corresponding to a dummy
 ! argument that is assumed-rank, the argument of the C_LOC function
 ! in the ISO_C_BINDING intrinsic module, or the first argument in a
 ! reference to an intrinsic inquiry function.
@@ -13,7 +13,7 @@
 !
 ! This test file contains tests that are expected to all pass.

-! Check that passing an assumed-rank variable as an actual argument
+! Check that passing an assumed-rank variable as an actual argument
 ! corresponding to an assumed-rank dummy works.

 module m
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535b-2.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535b-2.f90
index 4d99f7fdb0e..caf61fe8270 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535b-2.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535b-2.f90
@@ -1,11 +1,11 @@
 ! PR 101334
 ! PR 101337
-! { dg-do compile}
+! { dg-do compile }
 ! { dg-additional-options "-fcoarray=single" }
 !
 ! TS 29113
 ! C535b An assumed-rank variable name shall not appear in a designator
-! or expression except as an actual argument corresponding to a dummy
+! or expression except as an actual argument corresponding to a dummy
 ! argument that is assumed-rank, the argument of the C_LOC function
 ! in the ISO_C_BINDING intrinsic module, or the first argument in a
 ! reference to an intrinsic inquiry function.
@@ -16,7 +16,7 @@
 ! This test file contains tests that are expected to issue diagnostics
 ! for invalid code.

-! Check that passing an assumed-rank variable as an actual argument
+! Check that passing an assumed-rank variable as an actual argument
 ! corresponding to a non-assumed-rank dummy gives a diagnostic.

 module m
@@ -57,7 +57,7 @@ subroutine test_calls (x, y)
   ! Make sure each invalid argument produces a diagnostic.
   ! scalar dummies
   call f (x, &  ! { dg-error "(A|a)ssumed.rank" }
-          y)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
+          y)  ! { dg-error "(A|a)ssumed.rank" "pr101337" }
   ! assumed-rank dummies
   call g (x, y)  ! OK
   ! assumed-size dummies
@@ -295,15 +295,15 @@ subroutine test_expressions (a, b, c, l, m, n, x, y, z, p, q, r, s, i, j)
   n &  ! { dg-error "(A|a)ssumed.rank" }
     = j .neqv. m  ! { dg-error "(A|a)ssumed.rank" }

-end subroutine
+end subroutine

 ! Check that calls to disallowed intrinsic functions produce a diagnostic.
 ! There are 100+ "elemental" intrinsics defined in the standard, and
 ! 25+ "transformational" intrinsics that accept array operands, and that
 ! doesn't include intrinsics in the standard modules.  To keep the length of
-! this test to something sane, check only a handful of these functions on
-! the theory that related functions are probably implemented similarly and
-! probably share the same argument-processing code.
+! this test to something sane, check only a handful of these functions on
+! the theory that related functions are probably implemented similarly and
+! probably share the same argument-processing code.

 subroutine test_intrinsics (i1, i2, r1, r2, c1, c2, l1, l2, s1, s2)
   implicit none
@@ -331,7 +331,7 @@ subroutine test_intrinsics (i1, i2, r1, r2, c1, c2, l1, l2, s1, s2)
     = exp (r2)  ! { dg-error "(A|a)ssumed.rank" }
   r1 &  ! { dg-error "(A|a)ssumed.rank" }
     = sinh (r2)  ! { dg-error "(A|a)ssumed.rank" }
-
+
   ! bit operations
   l1 &  ! { dg-error "(A|a)ssumed.rank" }
     = blt (i1, &  ! { dg-error "(A|a)ssumed.rank" }
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535b-3.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535b-3.f90
index 23862e54d74..e882fbcfd2f 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535b-3.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535b-3.f90
@@ -1,10 +1,10 @@
 ! PR 101334
-! { dg-do compile}
+! { dg-do compile }
 ! { dg-additional-options "-fcoarray=single" }
 !
 ! TS 29113
 ! C535b An assumed-rank variable name shall not appear in a designator
-! or expression except as an actual argument corresponding to a dummy
+! or expression except as an actual argument corresponding to a dummy
 ! argument that is assumed-rank, the argument of the C_LOC function
 ! in the ISO_C_BINDING intrinsic module, or the first argument in a
 ! reference to an intrinsic inquiry function.
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535c-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535c-1.f90
index 2158c35be82..8f0cff111db 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535c-1.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535c-1.f90
@@ -1,9 +1,9 @@
 ! PR 54753
-! { dg-do compile}
+! { dg-do compile }
 !
 ! TS 29113
 ! C535c If an assumed-size or nonallocatable nonpointer assumed-rank
-! array is an actual argument corresponding to a dummy argument that
+! array is an actual argument corresponding to a dummy argument that
 ! is an INTENT(OUT) assumed-rank array, it shall not be polymorphic, [...].
 !
 ! This constraint is numbered C839 in the Fortran 2018 standard.
@@ -16,7 +16,7 @@ module t
     integer :: id
     real :: xyz(3)
   end type
-end module
+end module

 module m
   use t
@@ -74,7 +74,7 @@ contains
     class(*) :: a1, a2
     call upoly (a1, a2)
   end subroutine
-
+
   ! The polymorphic cases for assumed-size are bad.
   subroutine test_assumed_size_nonpolymorphic (a1, a2)
     type(t1) :: a1(*), a2(*)
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535c-2.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535c-2.f90
index f232efae9fc..5e89f57640c 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535c-2.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535c-2.f90
@@ -1,10 +1,10 @@
 ! PR 54753
-! { dg-do compile}
+! { dg-do compile }
 !
 ! TS 29113
 ! C535c If an assumed-size or nonallocatable nonpointer assumed-rank
-! array is an actual argument corresponding to a dummy argument that
-! is an INTENT(OUT) assumed-rank array, it shall not be [...]
+! array is an actual argument corresponding to a dummy argument that
+! is an INTENT(OUT) assumed-rank array, it shall not be [...]
 ! finalizable [...].
 !
 ! This constraint is numbered C839 in the Fortran 2018 standard.
@@ -44,7 +44,7 @@ contains
   ! Calls with an assumed-size array argument should be rejected.
   subroutine test_assumed_size (a1, a2)
     type(t1) :: a1(*), a2(*)
-
+
     call s1 (a1, a2)  !  { dg-error "(A|a)ssumed.rank" }
   end subroutine

@@ -61,7 +61,7 @@ contains

     call s1 (a1, a2)
   end subroutine
-
+
   ! The call should be rejected with a nonallocatable nonpointer
   ! assumed-rank actual argument.
   subroutine test_assumed_rank_plain (a1, a2)
diff --git a/gcc/testsuite/gfortran.dg/c-interop/deferred-character-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/deferred-character-1.f90
index 3c3c2574101..6a26fd0eea3 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/deferred-character-1.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/deferred-character-1.f90
@@ -1,9 +1,9 @@
 ! PR92482
-! { dg-do compile}
+! { dg-do compile }
 !
 ! TS 29113
 ! 8.7 Interoperability of procedures and procedure interfaces
-!
+!
 ! If a dummy argument in an interoperable interface is of type
 ! CHARACTER and is allocatable or a pointer, its character length shall
 ! be deferred.
diff --git a/gcc/testsuite/gfortran.dg/c-interop/removed-restrictions-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/removed-restrictions-1.f90
index d2155ec6eeb..250c3970b0e 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/removed-restrictions-1.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/removed-restrictions-1.f90
@@ -1,8 +1,8 @@
-! { dg-do compile}
+! { dg-do compile }
 !
 ! TS 29113
 ! 8.1 Removed restrictions on ISO_C_BINDING module procedures
-!
+!
 ! The subroutine C_F_POINTER from the intrinsic module ISO_C_BINDING has
 ! the restriction in ISO/IEC 1539- 1:2010 that if FPTR is an array, it
 ! shall be of interoperable type.
diff --git a/gcc/testsuite/gfortran.dg/c-interop/removed-restrictions-2.f90 b/gcc/testsuite/gfortran.dg/c-interop/removed-restrictions-2.f90
index 3c49de37152..eb0c970eb53 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/removed-restrictions-2.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/removed-restrictions-2.f90
@@ -1,8 +1,8 @@
-! { dg-do compile}
+! { dg-do compile }
 !
 ! TS 29113
 ! 8.1 Removed restrictions on ISO_C_BINDING module procedures
-!
+!
 ! The function C_F_PROCPOINTER from the intrinsic module ISO_C_BINDING
 ! has the restriction in ISO/IEC 1539-1:2010 that CPTR and FPTR shall
 ! not be the C address and interface of a noninteroperable Fortran
diff --git a/gcc/testsuite/gfortran.dg/c-interop/removed-restrictions-4.f90 b/gcc/testsuite/gfortran.dg/c-interop/removed-restrictions-4.f90
index b44defd40e1..a5827235341 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/removed-restrictions-4.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/removed-restrictions-4.f90
@@ -1,8 +1,8 @@
-! { dg-do compile}
+! { dg-do compile }
 !
 ! TS 29113
 ! 8.1 Removed restrictions on ISO_C_BINDING module procedures
-!
+!
 ! [...]
 !
 ! The function C_FUNLOC from the intrinsic module ISO_C_BINDING has
diff --git a/gcc/testsuite/gfortran.dg/c-interop/tkr.f90 b/gcc/testsuite/gfortran.dg/c-interop/tkr.f90
index c0c0d7e86f8..9ba7f95937a 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/tkr.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/tkr.f90
@@ -1,12 +1,12 @@
-! { dg-do compile}
+! { dg-do compile }
 !
 ! TS 29113
-! The definition of TKR compatible in paragraph 2 of subclause 12.4.3.4.5
+! The definition of TKR compatible in paragraph 2 of subclause 12.4.3.4.5
 ! of ISO/IEC 1539-1:2010 is changed to:
 !
-! A dummy argument is type, kind, and rank compatible, or TKR compatible,
-! with another dummy argument if the first is type compatible with the
-! second, the kind type parameters of the first have the same values as
+! A dummy argument is type, kind, and rank compatible, or TKR compatible,
+! with another dummy argument if the first is type compatible with the
+! second, the kind type parameters of the first have the same values as
 ! the corresponding kind type parameters of the second, and both have the
 ! same rank or either is assumed-rank.
 !
diff --git a/gcc/testsuite/gfortran.dg/class_result_10.f90 b/gcc/testsuite/gfortran.dg/class_result_10.f90
index a4d29ab9c1d..acfb7c35cfb 100644
--- a/gcc/testsuite/gfortran.dg/class_result_10.f90
+++ b/gcc/testsuite/gfortran.dg/class_result_10.f90
@@ -1,4 +1,4 @@
-! { dg-do run}
+! { dg-do run }


 ! PR fortran/99585
diff --git a/gcc/testsuite/gfortran.dg/dtio_35.f90 b/gcc/testsuite/gfortran.dg/dtio_35.f90
index d7211df87ac..c56fa011655 100644
--- a/gcc/testsuite/gfortran.dg/dtio_35.f90
+++ b/gcc/testsuite/gfortran.dg/dtio_35.f90
@@ -1,4 +1,4 @@
-! { dg-compile }
+! { dg-do compile }
 !
 ! Reported by Vladimir Nikishkin
 ! at https://stackoverflow.com/questions/60972134/whats-wrong-with-the-following-fortran-code-gfortran-dtio-dummy-argument-at#
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
index 58f4ce84a2c..560e5351323 100644
--- a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
@@ -8,8 +8,9 @@ type(t), allocatable :: b(:)
 ! { dg-note {'b' declared here} {} { target *-*-* } .-1 }

 !$acc update host(b(::2))
-! { dg-warning {'b\.dim\[0\]\.ubound' is used uninitialized} {} { target *-*-* } .-1 }
-! { dg-warning {'b\.dim\[0\]\.lbound' is used uninitialized} {} { target *-*-* } .-2 }
+! { dg-warning {'b\.span' is used uninitialized} {} { target *-*-* } .-1 }
+! { dg-warning {'b\.dim\[0\]\.ubound' is used uninitialized} {} { target *-*-* } .-2 }
+! { dg-warning {'b\.dim\[0\]\.lbound' is used uninitialized} {} { target *-*-* } .-3 }
 !$acc update host(b(1)%A(::3,::4))
 end

diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90
index 08c7740cf0d..b8c7b5d68ad 100644
--- a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90
@@ -24,7 +24,7 @@ end

 ! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) jj=2:5:2, integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):b\\\[.* <?i>? \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) jj=2:5:2, integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):d\\\[\\(.*jj \\* 5 \\+ .* <?i>?\\) \\+ -6\\\]\\)" 1 "original" } }

-! { dg final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):b\\\[\\(.* <?i>? \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):d\\\[\\(\\(integer\\(kind=8\\)\\) i \\+ -1\\) \\* 6\\\]\\)"  1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):b\\\[\\(.* <?i>? \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):d\\\[\\(\\(integer\\(kind=8\\)\\) i \\+ -1\\) \\* 6\\\]\\)"  1 "original" } }

 ! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=1:5:1\\):a\\)\[^ \]" 1 "original" } }

diff --git a/gcc/testsuite/gfortran.dg/pr103258.f90 b/gcc/testsuite/gfortran.dg/pr103258.f90
index 4521fcd69c1..4a3bb6fc2e7 100644
--- a/gcc/testsuite/gfortran.dg/pr103258.f90
+++ b/gcc/testsuite/gfortran.dg/pr103258.f90
@@ -1,4 +1,4 @@
-! { dg-do compile}
+! { dg-do compile }
 ! { dg-additional-options "-Wno-pedantic" }
 !
 ! Test from PR103258.  This used to ICE due to incorrectly marking the
diff --git a/gcc/testsuite/gfortran.dg/pr59107.f90 b/gcc/testsuite/gfortran.dg/pr59107.f90
index a84328f0851..969154a1537 100644
--- a/gcc/testsuite/gfortran.dg/pr59107.f90
+++ b/gcc/testsuite/gfortran.dg/pr59107.f90
@@ -1,4 +1,4 @@
-! { dg-compile }
+! { dg-do compile }
 ! { dg-options "-Wsurprising" }

 ! There should be no surprising warnings
diff --git a/gcc/testsuite/gfortran.dg/pr93835.f08 b/gcc/testsuite/gfortran.dg/pr93835.f08
index 933e249e632..2fa1585604b 100644
--- a/gcc/testsuite/gfortran.dg/pr93835.f08
+++ b/gcc/testsuite/gfortran.dg/pr93835.f08
@@ -1,4 +1,4 @@
-! {dg-do run }
+! { dg-do run }
 !
 ! PR fortran/93835 - the following code resulted in an ICE
 !

^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: Ping! [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  2023-03-28 21:04 [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement Paul Richard Thomas
  2023-03-29  8:24 ` Manfred Schwarb
@ 2023-04-07  7:07 ` Paul Richard Thomas
  2023-04-07  9:41   ` Harald Anlauf
  1 sibling, 1 reply; 16+ messages in thread
From: Paul Richard Thomas @ 2023-04-07  7:07 UTC (permalink / raw)
  To: fortran, gcc-patches


[-- Attachment #1.1: Type: text/plain, Size: 1938 bytes --]

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  <pault@gcc.gnu.org>

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

[-- Attachment #2: submit060423.diff --]
[-- Type: text/x-patch, Size: 12519 bytes --]

diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 33794f0a858..8acad60a02b 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -230,7 +230,9 @@ gfc_resolve_adjustl (gfc_expr *f, gfc_expr *string)
 {
   f->ts.type = BT_CHARACTER;
   f->ts.kind = string->ts.kind;
-  if (string->ts.u.cl)
+  if (string->ts.deferred)
+    f->ts = string->ts;
+  else if (string->ts.u.cl)
     f->ts.u.cl = gfc_new_charlen (gfc_current_ns, string->ts.u.cl);

   f->value.function.name = gfc_get_string ("__adjustl_s%d", f->ts.kind);
@@ -242,7 +244,9 @@ gfc_resolve_adjustr (gfc_expr *f, gfc_expr *string)
 {
   f->ts.type = BT_CHARACTER;
   f->ts.kind = string->ts.kind;
-  if (string->ts.u.cl)
+  if (string->ts.deferred)
+    f->ts = string->ts;
+  else if (string->ts.u.cl)
     f->ts.u.cl = gfc_new_charlen (gfc_current_ns, string->ts.u.cl);

   f->value.function.name = gfc_get_string ("__adjustr_s%d", f->ts.kind);
@@ -3361,7 +3365,7 @@ gfc_resolve_mvbits (gfc_code *c)
 }


-/* Set up the call to RANDOM_INIT.  */
+/* Set up the call to RANDOM_INIT.  */

 void
 gfc_resolve_random_init (gfc_code *c)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index f6ec76acb0b..6e42397c2ea 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -9084,6 +9084,7 @@ static void
 resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 {
   gfc_expr* target;
+  bool parentheses = false;

   gcc_assert (sym->assoc);
   gcc_assert (sym->attr.flavor == FL_VARIABLE);
@@ -9096,6 +9097,16 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
     return;
   gcc_assert (!sym->assoc->dangling);

+  if (target->expr_type == EXPR_OP
+      && target->value.op.op == INTRINSIC_PARENTHESES
+      && target->value.op.op1->expr_type == EXPR_VARIABLE)
+    {
+      sym->assoc->target = gfc_copy_expr (target->value.op.op1);
+      gfc_free_expr (target);
+      target = sym->assoc->target;
+      parentheses = true;
+    }
+
   if (resolve_target && !gfc_resolve_expr (target))
     return;

@@ -9177,6 +9188,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)

   /* See if this is a valid association-to-variable.  */
   sym->assoc->variable = (target->expr_type == EXPR_VARIABLE
+			  && !parentheses
 			  && !gfc_has_vector_subscript (target));

   /* Finally resolve if this is an array or not.  */
@@ -9191,7 +9203,6 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
       return;
     }

-
   /* We cannot deal with class selectors that need temporaries.  */
   if (target->ts.type == BT_CLASS
 	&& gfc_ref_needs_temporary_p (target->ref))
@@ -10885,11 +10896,6 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)


 /* Resolve a BLOCK construct statement.  */
-static gfc_expr*
-get_temp_from_expr (gfc_expr *, gfc_namespace *);
-static gfc_code *
-build_assignment (gfc_exec_op, gfc_expr *, gfc_expr *,
-		  gfc_component *, gfc_component *, locus);

 static void
 resolve_block_construct (gfc_code* code)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 41661b4195e..e1725808033 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7568,6 +7568,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   int full;
   bool subref_array_target = false;
   bool deferred_array_component = false;
+  bool substr = false;
   gfc_expr *arg, *ss_expr;

   if (se->want_coarray)
@@ -7618,6 +7619,9 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	  && TREE_CODE (desc) == COMPONENT_REF)
 	deferred_array_component = true;

+      substr = info->ref && info->ref->next
+	       && info->ref->next->type == REF_SUBSTRING;
+
       subref_array_target = (is_subref_array (expr)
 			     && (se->direct_byref
 				 || expr->ts.type == BT_CHARACTER));
@@ -7659,7 +7663,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 				      subref_array_target, expr);

 	      /* ....and set the span field.  */
-	      tmp = gfc_conv_descriptor_span_get (desc);
+	      if (ss_info->expr->ts.type == BT_CHARACTER)
+		tmp = gfc_conv_descriptor_span_get (desc);
+	      else
+		tmp = gfc_get_array_span (desc, expr);
 	      gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
 	    }
 	  else if (se->want_pointer)
@@ -7730,6 +7737,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)

 	  need_tmp = 1;
 	  if (expr->ts.type == BT_CHARACTER
+		&& expr->ts.u.cl->length
 		&& expr->ts.u.cl->length->expr_type != EXPR_CONSTANT)
 	    get_array_charlen (expr, se);

@@ -7915,7 +7923,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       /* Set the string_length for a character array.  */
       if (expr->ts.type == BT_CHARACTER)
 	{
-	  if (deferred_array_component)
+	  if (deferred_array_component && !substr)
 	    se->string_length = ss_info->string_length;
 	  else
 	    se->string_length =  gfc_get_expr_charlen (expr);
@@ -7992,7 +8000,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	}

       /* Set the span field.  */
-      tmp = gfc_get_array_span (desc, expr);
+      tmp = NULL_TREE;
+      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
+	tmp = gfc_conv_descriptor_span_get (desc);
+      else
+	tmp = gfc_get_array_span (desc, expr);
       if (tmp)
 	gfc_conv_descriptor_span_set (&loop.pre, parm, tmp);

@@ -8766,6 +8778,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
 		       tree add_when_allocated)
 {
   tree tmp;
+  tree eltype;
   tree size;
   tree nelems;
   tree null_cond;
@@ -8782,10 +8795,11 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
       null_data = gfc_finish_block (&block);

       gfc_init_block (&block);
+      eltype = TREE_TYPE (type);
       if (str_sz != NULL_TREE)
 	size = str_sz;
       else
-	size = TYPE_SIZE_UNIT (TREE_TYPE (type));
+	size = TYPE_SIZE_UNIT (eltype);

       if (!no_malloc)
 	{
@@ -8812,11 +8826,19 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
       else
 	nelems = gfc_index_one_node;

+      /* If type is not the array type, then it is the element type.  */
+      if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
+	eltype = gfc_get_element_type (type);
+      else
+	eltype = type;
+
       if (str_sz != NULL_TREE)
 	tmp = fold_convert (gfc_array_index_type, str_sz);
       else
 	tmp = fold_convert (gfc_array_index_type,
-			    TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+			    TYPE_SIZE_UNIT (eltype));
+
+      tmp = gfc_evaluate_now (tmp, &block);
       size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
 			      nelems, tmp);
       if (!no_malloc)
@@ -9865,6 +9887,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 	      /* This component cannot have allocatable components,
 		 therefore add_when_allocated of duplicate_allocatable ()
 		 is always NULL.  */
+	      rank = c->as ? c->as->rank : 0;
 	      tmp = duplicate_allocatable (dcmp, comp, ctype, rank,
 					   false, false, size, NULL_TREE);
 	      gfc_add_expr_to_block (&fnblock, tmp);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 25737881ae0..299764b08b2 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1791,6 +1791,9 @@ gfc_get_symbol_decl (gfc_symbol * sym)
       return decl;
     }

+  if (sym->ts.type == BT_UNKNOWN)
+    gfc_fatal_error ("%s at %C has no default type", sym->name);
+
   if (sym->attr.intrinsic)
     gfc_internal_error ("intrinsic variable which isn't a procedure");

@@ -7538,6 +7541,7 @@ gfc_generate_function_code (gfc_namespace * ns)
     }

   trans_function_start (sym);
+  gfc_current_locus = sym->declared_at;

   gfc_init_block (&init);
   gfc_init_block (&cleanup);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d996d295bd2..023258c1b43 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2124,6 +2124,7 @@ gfc_get_expr_charlen (gfc_expr *e)
 {
   gfc_ref *r;
   tree length;
+  tree previous = NULL_TREE;
   gfc_se se;

   gcc_assert (e->expr_type == EXPR_VARIABLE
@@ -2149,6 +2150,7 @@ gfc_get_expr_charlen (gfc_expr *e)
   /* Look through the reference chain for component references.  */
   for (r = e->ref; r; r = r->next)
     {
+      previous = length;
       switch (r->type)
 	{
 	case REF_COMPONENT:
@@ -2164,7 +2166,10 @@ gfc_get_expr_charlen (gfc_expr *e)
 	  gfc_init_se (&se, NULL);
 	  gfc_conv_expr_type (&se, r->u.ss.start, gfc_charlen_type_node);
 	  length = se.expr;
-	  gfc_conv_expr_type (&se, r->u.ss.end, gfc_charlen_type_node);
+	  if (r->u.ss.end)
+	    gfc_conv_expr_type (&se, r->u.ss.end, gfc_charlen_type_node);
+	  else
+	    se.expr = previous;
 	  length = fold_build2_loc (input_location, MINUS_EXPR,
 				    gfc_charlen_type_node,
 				    se.expr, length);
@@ -2554,9 +2559,12 @@ gfc_conv_string_length (gfc_charlen * cl, gfc_expr * expr, stmtblock_t * pblock)
       expr_flat = gfc_copy_expr (expr);
       flatten_array_ctors_without_strlen (expr_flat);
       gfc_resolve_expr (expr_flat);
-
-      gfc_conv_expr (&se, expr_flat);
-      gfc_add_block_to_block (pblock, &se.pre);
+      if (expr_flat->rank)
+	gfc_conv_expr_descriptor (&se, expr_flat);
+      else
+	gfc_conv_expr (&se, expr_flat);
+      if (expr_flat->expr_type != EXPR_VARIABLE)
+	gfc_add_block_to_block (pblock, &se.pre);
       cl->backend_decl = convert (gfc_charlen_type_node, se.string_length);

       gfc_free_expr (expr_flat);
@@ -8584,6 +8592,20 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
   gfc_conv_expr_descriptor (&se, expr);
   gfc_add_block_to_block (&block, &se.pre);
   gfc_add_modify (&block, dest, se.expr);
+  if (cm->ts.type == BT_CHARACTER
+      && gfc_deferred_strlen (cm, &tmp))
+    {
+      tmp = fold_build3_loc (input_location, COMPONENT_REF,
+			     TREE_TYPE (tmp),
+			     TREE_OPERAND (dest, 0),
+			     tmp, NULL_TREE);
+      gfc_add_modify (&block, tmp,
+			      fold_convert (TREE_TYPE (tmp),
+			      se.string_length));
+      cm->ts.u.cl->backend_decl = gfc_create_var (gfc_charlen_type_node,
+						  "slen");
+      gfc_add_modify (&block, cm->ts.u.cl->backend_decl, se.string_length);
+    }

   /* Deal with arrays of derived types with allocatable components.  */
   if (gfc_bt_struct (cm->ts.type)
@@ -8607,11 +8629,16 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
 					   tmp, expr->rank, NULL_TREE);
 	}
     }
+  else if (cm->ts.type == BT_CHARACTER && cm->ts.deferred)
+    tmp = gfc_duplicate_allocatable (dest, se.expr,
+				     gfc_typenode_for_spec (&cm->ts),
+				     cm->as->rank, NULL_TREE);
   else
     tmp = gfc_duplicate_allocatable (dest, se.expr,
 				     TREE_TYPE(cm->backend_decl),
 				     cm->as->rank, NULL_TREE);

+
   gfc_add_expr_to_block (&block, tmp);
   gfc_add_block_to_block (&block, &se.post);

diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index baeea955d35..9b54d2f0d31 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -2622,10 +2622,10 @@ gfc_trans_transfer (gfc_code * code)

       if (expr->ts.type != BT_CLASS
 	 && expr->expr_type == EXPR_VARIABLE
-	 && gfc_expr_attr (expr).pointer)
+	 && ((expr->symtree->n.sym->ts.type == BT_DERIVED && expr->ts.deferred)
+	     || gfc_expr_attr (expr).pointer))
 	goto scalarize;

-
       if (!(gfc_bt_struct (expr->ts.type)
 	      || expr->ts.type == BT_CLASS)
 	    && ref && ref->next == NULL
diff --git a/gcc/testsuite/gfortran.dg/associate_47.f90 b/gcc/testsuite/gfortran.dg/associate_47.f90
index 085c6f38338..d8a50c6091c 100644
--- a/gcc/testsuite/gfortran.dg/associate_47.f90
+++ b/gcc/testsuite/gfortran.dg/associate_47.f90
@@ -39,10 +39,9 @@ program p
    end associate
    if (x%d(1) .ne. 'zqrtyd') stop 5

-! Substrings of arrays still do not work correctly.
    call foo ('lmnopqrst','ghijklmno')
    associate (y => x%d(:)(2:4))
-!      if (any (y .ne. ['mno','hij'])) stop 6
+      if (any (y .ne. ['mno','hij'])) stop 6
    end associate

    call foo ('abcdef','ghijkl')
diff --git a/gcc/testsuite/gfortran.dg/associate_51.f90 b/gcc/testsuite/gfortran.dg/associate_51.f90
index e6f2e4fafa3..2e5218c78cf 100644
--- a/gcc/testsuite/gfortran.dg/associate_51.f90
+++ b/gcc/testsuite/gfortran.dg/associate_51.f90
@@ -51,7 +51,7 @@ recursive subroutine s
 end

 recursive subroutine s2
-   associate (y => (s2)) ! { dg-error "Associating selector-expression at .1. yields a procedure" }
+   associate (y => (s2)) ! { dg-error "is a procedure name" }
    end associate
 end


^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  2023-04-07  7:02     ` Paul Richard Thomas
@ 2023-04-07  9:40       ` Harald Anlauf
  0 siblings, 0 replies; 16+ messages in thread
From: Harald Anlauf @ 2023-04-07  9:40 UTC (permalink / raw)
  To: Paul Richard Thomas, Manfred Schwarb; +Cc: gcc-patches, fortran

Hi Paul,

On 4/7/23 09:02, Paul Richard Thomas via Gcc-patches wrote:
> Hi All,
>
> Please find attached the patch to fix the dg directives and remove a lot of
> trailing white space.
>
> Unless there are any objections, I will commit as obvious over the weekend.

this is OK.

Thanks for the patch!

Harald

> Cheers
>
> Paul
>
> Fortran: Fix dg directives and remove trailing whitespaces in testsuite
>
> 2023-04-07  Paul Thomas  <pault@gcc.gnu.org>
>
> * gfortran.dg/c-interop/allocatable-optional-pointer.f90 : Fix
> dg directive and remove trailing whitespace.
> * gfortran.dg/c-interop/c407a-1.f90 : ditto
> * gfortran.dg/c-interop/c407b-1.f90 : ditto
> * gfortran.dg/c-interop/c407b-2.f90 : ditto
> * gfortran.dg/c-interop/c407c-1.f90 : ditto
> * gfortran.dg/c-interop/c535a-1.f90 : ditto
> * gfortran.dg/c-interop/c535a-2.f90 : ditto
> * gfortran.dg/c-interop/c535b-1.f90 : ditto
> * gfortran.dg/c-interop/c535b-2.f90 : ditto
> * gfortran.dg/c-interop/c535b-3.f90 : ditto
> * gfortran.dg/c-interop/c535c-1.f90 : ditto
> * gfortran.dg/c-interop/c535c-2.f90 : ditto
> * gfortran.dg/c-interop/deferred-character-1.f90 : ditto
> * gfortran.dg/c-interop/removed-restrictions-1.f90 : ditto
> * gfortran.dg/c-interop/removed-restrictions-2.f90 : ditto
> * gfortran.dg/c-interop/removed-restrictions-4.f90 : ditto
> * gfortran.dg/c-interop/tkr.f90 : ditto
> * gfortran.dg/class_result_10.f90 : ditto
> * gfortran.dg/dtio_35.f90 : ditto
> * gfortran.dg/goacc/array-with-dt-2.f90 : ditto
> * gfortran.dg/gomp/affinity-clause-1.f90 : ditto
> * gfortran.dg/pr103258.f90 : ditto
> * gfortran.dg/pr59107.f90 : ditto
> * gfortran.dg/pr93835.f08 : ditto
>
>
>
> On Wed, 29 Mar 2023 at 09:53, Paul Richard Thomas <
> paul.richard.thomas@gmail.com> wrote:
>
>> Hi Manfred,
>>
>> Indeed I do :-) Thanks for the spot. I have decided that it will be less
>> messy if I roll all the testcases into one or, perhaps two =>
>> associate_xx.f90
>>
>> Forgetting the space before the final brace seems to be rife!
>>
>> Cheers
>>
>> Paul
>>
>>
>> On Wed, 29 Mar 2023 at 09:24, Manfred Schwarb <manfred99@gmx.ch> wrote:
>>
>>> Am 28.03.23 um 23:04 schrieb Paul Richard Thomas via Fortran:
>>>> 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?
>>>>
>>>
>>> Paul, you have some "dg-do-run" and "dg-do-compile" statements in your
>>> testcases,
>>> could you change them into their single-minus-sign variants?
>>>
>>> Cheers,
>>> Manfred
>>>
>>>
>>> BTW: I just ran my script again and found the following testsuite issues
>>> (note that outer-most
>>> braces need to be space-padded):
>>>
>>> ./c-interop/removed-restrictions-1.f90:! { dg-do compile}
>>> ./c-interop/removed-restrictions-2.f90:! { dg-do compile}
>>> ./c-interop/removed-restrictions-3.f90:! { dg-do compile}
>>> ./c-interop/removed-restrictions-4.f90:! { dg-do compile}
>>> ./c-interop/tkr.f90:! { dg-do compile}
>>> ./c-interop/c407c-1.f90:! { dg-do compile}
>>> ./c-interop/deferred-character-1.f90:! { dg-do compile}
>>> ./c-interop/allocatable-optional-pointer.f90:! { dg-do compile}
>>> ./c-interop/c407a-1.f90:! { dg-do compile}
>>> ./c-interop/c407b-1.f90:! { dg-do compile}
>>> ./c-interop/c407b-2.f90:! { dg-do compile}
>>> ./c-interop/c535a-1.f90:! { dg-do compile}
>>> ./c-interop/c535a-2.f90:! { dg-do compile}
>>> ./c-interop/c535b-1.f90:! { dg-do compile}
>>> ./c-interop/c535b-2.f90:! { dg-do compile}
>>> ./c-interop/c535b-3.f90:! { dg-do compile}
>>> ./c-interop/c535c-1.f90:! { dg-do compile}
>>> ./c-interop/c535c-2.f90:! { dg-do compile}
>>> ./gomp/affinity-clause-1.f90:! { dg final { scan-tree-dump-times "#pragma
>>> omp task affinity\\(iterator\\(integer\\(kind=4\\)
>>> i=D\\.\[0-9\]+:5:1\\):b\\\[\\(.* <?i>? \\+ -1\\\]\\)
>>> affinity\\(iterator\\(integer\\(kind=4\\)
>>> i=D\\.\[0-9\]+:5:1\\):d\\\[\\(\\(integer\\(kind=8\\)\\) i \\+ -1\\) \\*
>>> 6\\\]\\)"  1 "original" } }
>>> ./class_result_10.f90:! { dg-do run}
>>> ./pr103258.f90:! { dg-do compile}
>>> ./dtio_35.f90:! { dg-compile }
>>> ./pr93835.f08:! {dg-do run }
>>> ./pr59107.f90:! { dg-compile }
>>>
>>>
>>>
>>>> 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
>>>
>>>
>>
>> --
>> "If you can't explain it simply, you don't understand it well enough" -
>> Albert Einstein
>>
>
>


^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: Ping! [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  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
  0 siblings, 2 replies; 16+ messages in thread
From: Harald Anlauf @ 2023-04-07  9:41 UTC (permalink / raw)
  To: Paul Richard Thomas, fortran, gcc-patches

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  <pault@gcc.gnu.org>
>
> 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


^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: Ping! [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  2023-04-07  9:41   ` Harald Anlauf
@ 2023-04-07  9:41     ` Harald Anlauf
  2023-04-07 13:53     ` Paul Richard Thomas
  1 sibling, 0 replies; 16+ messages in thread
From: Harald Anlauf @ 2023-04-07  9:41 UTC (permalink / raw)
  To: fortran; +Cc: gcc-patches

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  <pault@gcc.gnu.org>
> 
> 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



^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: Ping! [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  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
  1 sibling, 1 reply; 16+ messages in thread
From: Paul Richard Thomas @ 2023-04-07 13:53 UTC (permalink / raw)
  To: Harald Anlauf; +Cc: fortran, gcc-patches


[-- Attachment #1.1: Type: text/plain, Size: 2589 bytes --]

duuuh! Please find them attached.

Thanks

Paul


On Fri, 7 Apr 2023 at 10:41, Harald Anlauf <anlauf@gmx.de> 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  <pault@gcc.gnu.org>
> >
> > 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

[-- Attachment #2: associate_60.f90 --]
[-- Type: text/x-fortran, Size: 3400 bytes --]

! { dg-do run }
!
! Tests fixes for various pr87477 dependencies
!
! Contributed by Gerhard Steinmetz  <gscfq@t-online.de> except for pr102106:
! which was contributed by Brad Richardson  <everythingfunctional@protonmail.com>
!
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

[-- Attachment #3: pr98408.f90 --]
[-- Type: text/x-fortran, Size: 233 bytes --]

! { dg-do run }
!
! Contributed by Thomas Koenig  <tkoenig@gcc.gnu.org>
!
program main
  character (len=:), allocatable :: a(:)
  allocate (character(len=10) :: a(5))
  if (sizeof(a) .ne. 50) stop 1
  deallocate (a)
end program main

[-- Attachment #4: pr105205.f90 --]
[-- Type: text/x-fortran, Size: 609 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)) 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

[-- Attachment #5: pr106918.f90 --]
[-- Type: text/x-fortran, Size: 531 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
  deallocate (attr_name)
  deallocate (coordinates%attr_name)
end

^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: Ping! [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  2023-04-07 13:53     ` Paul Richard Thomas
@ 2023-04-07 19:28       ` Harald Anlauf
  2023-04-07 21:35         ` Paul Richard Thomas
  0 siblings, 1 reply; 16+ messages in thread
From: Harald Anlauf @ 2023-04-07 19:28 UTC (permalink / raw)
  To: Paul Richard Thomas; +Cc: fortran, gcc-patches

Hi Paul,

On 4/7/23 15:53, Paul Richard Thomas via Gcc-patches wrote:
> duuuh! Please find them attached.

the patch LGTM.  Thanks!

However, I have comments on the new testcase associate_60.f90:
subroutine pr93813 is missing an allocation of x, e.g.:

     allocate (t :: x)

otherwise it would be invalid.  Please check and fix.

Interestingly, subroutine pr92779 exhibits a small memory leak
with memory allocated by the spread intrinsic.  I played a little
and found that the leak depends on the presence of trim(): omitting
trim() removes the leak.  But looking at the related pr, it seems
that trim() was essential, so omitting it is likely not an option.

I think the best way is to proceed and to open a PR on the memory
leak rather than leaving pr92779 open.  What do you think?

Cheers,
Harald


> Thanks
>
> Paul
>
>
> On Fri, 7 Apr 2023 at 10:41, Harald Anlauf <anlauf@gmx.de> 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  <pault@gcc.gnu.org>
>>>
>>> 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
>>
>>
>


^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: Ping! [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  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
  0 siblings, 2 replies; 16+ messages in thread
From: Paul Richard Thomas @ 2023-04-07 21:35 UTC (permalink / raw)
  To: Harald Anlauf; +Cc: fortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 5512 bytes --]

Hi Harald,

Well done on noticing the memory leak :-) I have a fix for it that I was
going to post separately. Actually, it is a trivial one liner, which I
could include with the patch.
@@ -2554,23 +2559,25 @@ gfc_conv_string_length (gfc_charlen * cl, gfc_expr
* expr, stmtblock_t * pblock)
       expr_flat = gfc_copy_expr (expr);
       flatten_array_ctors_without_strlen (expr_flat);
       gfc_resolve_expr (expr_flat);
-
-      gfc_conv_expr (&se, expr_flat);
-      gfc_add_block_to_block (pblock, &se.pre);
-      cl->backend_decl = convert (gfc_charlen_type_node, se.string_length);
-
+      if (expr_flat->rank)
+       gfc_conv_expr_descriptor (&se, expr_flat);
+      else
+       gfc_conv_expr (&se, expr_flat);
+      if (expr_flat->expr_type != EXPR_VARIABLE)
+       gfc_add_block_to_block (pblock, &se.pre);
+      se.expr = convert (gfc_charlen_type_node, se.string_length);
+      gfc_add_block_to_block (pblock, &se.post);
      // <<<right here>>>
       gfc_free_expr (expr_flat);
-      return;
     }
-
-  /* Convert cl->length.  */
-
-  gcc_assert (cl->length);
-
-  gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
-  se.expr = fold_build2_loc (input_location, MAX_EXPR,
gfc_charlen_type_node,
-                            se.expr, build_zero_cst (TREE_TYPE (se.expr)));
-  gfc_add_block_to_block (pblock, &se.pre);
+  else
+    {
+      /* Convert cl->length.  */
+      gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
+      se.expr = fold_build2_loc (input_location, MAX_EXPR,
+                                gfc_charlen_type_node, se.expr,
+                                build_zero_cst (TREE_TYPE (se.expr)));
+      gfc_add_block_to_block (pblock, &se.pre);
+    }

   if (cl->backend_decl && VAR_P (cl->backend_decl))
     gfc_add_modify (pblock, cl->backend_decl, se.expr);

Cheers

Paul


On Fri, 7 Apr 2023 at 20:28, Harald Anlauf <anlauf@gmx.de> wrote:

> Hi Paul,
>
> On 4/7/23 15:53, Paul Richard Thomas via Gcc-patches wrote:
> > duuuh! Please find them attached.
>
> the patch LGTM.  Thanks!
>
> However, I have comments on the new testcase associate_60.f90:
> subroutine pr93813 is missing an allocation of x, e.g.:
>
>      allocate (t :: x)
>
> otherwise it would be invalid.  Please check and fix.
>
> Interestingly, subroutine pr92779 exhibits a small memory leak
> with memory allocated by the spread intrinsic.  I played a little
> and found that the leak depends on the presence of trim(): omitting
> trim() removes the leak.  But looking at the related pr, it seems
> that trim() was essential, so omitting it is likely not an option.
>
> I think the best way is to proceed and to open a PR on the memory
> leak rather than leaving pr92779 open.  What do you think?
>
> Cheers,
> Harald
>
>
> > Thanks
> >
> > Paul
> >
> >
> > On Fri, 7 Apr 2023 at 10:41, Harald Anlauf <anlauf@gmx.de> 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  <pault@gcc.gnu.org>
> >>>
> >>> 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

^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: Ping! [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  2023-04-07 21:35         ` Paul Richard Thomas
@ 2023-04-07 21:38           ` Paul Richard Thomas
  2023-04-08 13:56           ` Harald Anlauf
  1 sibling, 0 replies; 16+ messages in thread
From: Paul Richard Thomas @ 2023-04-07 21:38 UTC (permalink / raw)
  To: Harald Anlauf; +Cc: fortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 6035 bytes --]

PS Quite right about the allocation in PR93813 - consider it to be included.

Cheers and thanks

Paul


On Fri, 7 Apr 2023 at 22:35, Paul Richard Thomas <
paul.richard.thomas@gmail.com> wrote:

> Hi Harald,
>
> Well done on noticing the memory leak :-) I have a fix for it that I was
> going to post separately. Actually, it is a trivial one liner, which I
> could include with the patch.
> @@ -2554,23 +2559,25 @@ gfc_conv_string_length (gfc_charlen * cl, gfc_expr
> * expr, stmtblock_t * pblock)
>        expr_flat = gfc_copy_expr (expr);
>        flatten_array_ctors_without_strlen (expr_flat);
>        gfc_resolve_expr (expr_flat);
> -
> -      gfc_conv_expr (&se, expr_flat);
> -      gfc_add_block_to_block (pblock, &se.pre);
> -      cl->backend_decl = convert (gfc_charlen_type_node,
> se.string_length);
> -
> +      if (expr_flat->rank)
> +       gfc_conv_expr_descriptor (&se, expr_flat);
> +      else
> +       gfc_conv_expr (&se, expr_flat);
> +      if (expr_flat->expr_type != EXPR_VARIABLE)
> +       gfc_add_block_to_block (pblock, &se.pre);
> +      se.expr = convert (gfc_charlen_type_node, se.string_length);
> +      gfc_add_block_to_block (pblock, &se.post);
>         // <<<right here>>>
>        gfc_free_expr (expr_flat);
> -      return;
>      }
> -
> -  /* Convert cl->length.  */
> -
> -  gcc_assert (cl->length);
> -
> -  gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
> -  se.expr = fold_build2_loc (input_location, MAX_EXPR,
> gfc_charlen_type_node,
> -                            se.expr, build_zero_cst (TREE_TYPE
> (se.expr)));
> -  gfc_add_block_to_block (pblock, &se.pre);
> +  else
> +    {
> +      /* Convert cl->length.  */
> +      gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
> +      se.expr = fold_build2_loc (input_location, MAX_EXPR,
> +                                gfc_charlen_type_node, se.expr,
> +                                build_zero_cst (TREE_TYPE (se.expr)));
> +      gfc_add_block_to_block (pblock, &se.pre);
> +    }
>
>    if (cl->backend_decl && VAR_P (cl->backend_decl))
>      gfc_add_modify (pblock, cl->backend_decl, se.expr);
>
> Cheers
>
> Paul
>
>
> On Fri, 7 Apr 2023 at 20:28, Harald Anlauf <anlauf@gmx.de> wrote:
>
>> Hi Paul,
>>
>> On 4/7/23 15:53, Paul Richard Thomas via Gcc-patches wrote:
>> > duuuh! Please find them attached.
>>
>> the patch LGTM.  Thanks!
>>
>> However, I have comments on the new testcase associate_60.f90:
>> subroutine pr93813 is missing an allocation of x, e.g.:
>>
>>      allocate (t :: x)
>>
>> otherwise it would be invalid.  Please check and fix.
>>
>> Interestingly, subroutine pr92779 exhibits a small memory leak
>> with memory allocated by the spread intrinsic.  I played a little
>> and found that the leak depends on the presence of trim(): omitting
>> trim() removes the leak.  But looking at the related pr, it seems
>> that trim() was essential, so omitting it is likely not an option.
>>
>> I think the best way is to proceed and to open a PR on the memory
>> leak rather than leaving pr92779 open.  What do you think?
>>
>> Cheers,
>> Harald
>>
>>
>> > Thanks
>> >
>> > Paul
>> >
>> >
>> > On Fri, 7 Apr 2023 at 10:41, Harald Anlauf <anlauf@gmx.de> 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  <pault@gcc.gnu.org>
>> >>>
>> >>> 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
>


-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: Ping! [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  2023-04-07 21:35         ` Paul Richard Thomas
  2023-04-07 21:38           ` Paul Richard Thomas
@ 2023-04-08 13:56           ` Harald Anlauf
  1 sibling, 0 replies; 16+ messages in thread
From: Harald Anlauf @ 2023-04-08 13:56 UTC (permalink / raw)
  To: Paul Richard Thomas; +Cc: fortran, gcc-patches

Hi Paul,

On 4/7/23 23:35, Paul Richard Thomas via Gcc-patches wrote:
> Hi Harald,
>
> Well done on noticing the memory leak :-) I have a fix for it that I was
> going to post separately. Actually, it is a trivial one liner, which I
> could include with the patch.

thanks for addressing this!  I can confirm that this correction
does the job.

Great work!

Harald

> @@ -2554,23 +2559,25 @@ gfc_conv_string_length (gfc_charlen * cl, gfc_expr
> * expr, stmtblock_t * pblock)
>         expr_flat = gfc_copy_expr (expr);
>         flatten_array_ctors_without_strlen (expr_flat);
>         gfc_resolve_expr (expr_flat);
> -
> -      gfc_conv_expr (&se, expr_flat);
> -      gfc_add_block_to_block (pblock, &se.pre);
> -      cl->backend_decl = convert (gfc_charlen_type_node, se.string_length);
> -
> +      if (expr_flat->rank)
> +       gfc_conv_expr_descriptor (&se, expr_flat);
> +      else
> +       gfc_conv_expr (&se, expr_flat);
> +      if (expr_flat->expr_type != EXPR_VARIABLE)
> +       gfc_add_block_to_block (pblock, &se.pre);
> +      se.expr = convert (gfc_charlen_type_node, se.string_length);
> +      gfc_add_block_to_block (pblock, &se.post);
>        // <<<right here>>>
>         gfc_free_expr (expr_flat);
> -      return;
>       }
> -
> -  /* Convert cl->length.  */
> -
> -  gcc_assert (cl->length);
> -
> -  gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
> -  se.expr = fold_build2_loc (input_location, MAX_EXPR,
> gfc_charlen_type_node,
> -                            se.expr, build_zero_cst (TREE_TYPE (se.expr)));
> -  gfc_add_block_to_block (pblock, &se.pre);
> +  else
> +    {
> +      /* Convert cl->length.  */
> +      gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
> +      se.expr = fold_build2_loc (input_location, MAX_EXPR,
> +                                gfc_charlen_type_node, se.expr,
> +                                build_zero_cst (TREE_TYPE (se.expr)));
> +      gfc_add_block_to_block (pblock, &se.pre);
> +    }
>
>     if (cl->backend_decl && VAR_P (cl->backend_decl))
>       gfc_add_modify (pblock, cl->backend_decl, se.expr);
>
> Cheers
>
> Paul
>
>
> On Fri, 7 Apr 2023 at 20:28, Harald Anlauf <anlauf@gmx.de> wrote:
>
>> Hi Paul,
>>
>> On 4/7/23 15:53, Paul Richard Thomas via Gcc-patches wrote:
>>> duuuh! Please find them attached.
>>
>> the patch LGTM.  Thanks!
>>
>> However, I have comments on the new testcase associate_60.f90:
>> subroutine pr93813 is missing an allocation of x, e.g.:
>>
>>       allocate (t :: x)
>>
>> otherwise it would be invalid.  Please check and fix.
>>
>> Interestingly, subroutine pr92779 exhibits a small memory leak
>> with memory allocated by the spread intrinsic.  I played a little
>> and found that the leak depends on the presence of trim(): omitting
>> trim() removes the leak.  But looking at the related pr, it seems
>> that trim() was essential, so omitting it is likely not an option.
>>
>> I think the best way is to proceed and to open a PR on the memory
>> leak rather than leaving pr92779 open.  What do you think?
>>
>> Cheers,
>> Harald
>>
>>
>>> Thanks
>>>
>>> Paul
>>>
>>>
>>> On Fri, 7 Apr 2023 at 10:41, Harald Anlauf <anlauf@gmx.de> 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  <pault@gcc.gnu.org>
>>>>>
>>>>> 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
>>>>
>>>>
>>>
>>
>>
>


^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  2023-06-01 17:58 ` Mikael Morin
@ 2023-06-02  7:46   ` Paul Richard Thomas
  0 siblings, 0 replies; 16+ messages in thread
From: Paul Richard Thomas @ 2023-06-02  7:46 UTC (permalink / raw)
  To: Mikael Morin; +Cc: fortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 1774 bytes --]

Thanks Mikael. Pushed as r14-1487-g3c2eba4b7a2355ed5099e35332388206c484744d

I should have credited you with the comments that you made about the half
baked patch, which pushed me to this patch.

Regards

Paul


On Thu, 1 Jun 2023 at 18:58, Mikael Morin <morin-mikael@orange.fr> wrote:

> Le 01/06/2023 à 17:20, Paul Richard Thomas via Fortran a écrit :
> > Hi All,
> >
> > This started out as the search for a fix to pr109948 and evolved to roll
> in
> > 5 other prs.
> >
> > Basically parse_associate was far too clunky and, in anycase, existing
> > functions in resolve.cc were well capable of doing the determination of
> the
> > target expression rank. While I was checking the comments, the lightbulb
> > flashed with respect to prs 102109/112/190 and the chunk dealing with
> > function results of unknown type was born.
> >
> > Thanks to the changes in parse.cc, the problem in pr99326 migrated
> > upstream to the resolution and the chunklet in resolve.cc was an obvious
> > fix.
> >
> > I am minded to s/{ dg-do run}/{ dg-do compile } for all six testcases.
> Makes sense, the PRs were bogus errors and ICEs, so all compile time
> issues.
>
> > At
> > the testing stage, I wanted to check that the testcases actually did what
> > they are supposed to do :-)
> >
> > Bootstraps and regtests OK - good for head?
> >
> OK.  Thanks for this.
>
> > Paul
> >
> > PS I need to do some housekeeping on pr87477 now. Some of the blockers
> have
> > "fixed themselves" and others are awaiting backporting. I think that
> there
> > are only 4 or so left, of which 89645 and 99065 are the most difficult to
> > deal with.
>
>

-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

^ permalink raw reply	[flat|nested] 16+ messages in thread

* Re: [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
  2023-06-01 15:20 Paul Richard Thomas
@ 2023-06-01 17:58 ` Mikael Morin
  2023-06-02  7:46   ` Paul Richard Thomas
  0 siblings, 1 reply; 16+ messages in thread
From: Mikael Morin @ 2023-06-01 17:58 UTC (permalink / raw)
  To: Paul Richard Thomas, fortran, gcc-patches

Le 01/06/2023 à 17:20, Paul Richard Thomas via Fortran a écrit :
> Hi All,
> 
> This started out as the search for a fix to pr109948 and evolved to roll in
> 5 other prs.
> 
> Basically parse_associate was far too clunky and, in anycase, existing
> functions in resolve.cc were well capable of doing the determination of the
> target expression rank. While I was checking the comments, the lightbulb
> flashed with respect to prs 102109/112/190 and the chunk dealing with
> function results of unknown type was born.
> 
> Thanks to the changes in parse.cc, the problem in pr99326 migrated
> upstream to the resolution and the chunklet in resolve.cc was an obvious
> fix.
> 
> I am minded to s/{ dg-do run}/{ dg-do compile } for all six testcases.
Makes sense, the PRs were bogus errors and ICEs, so all compile time issues.

> At
> the testing stage, I wanted to check that the testcases actually did what
> they are supposed to do :-)
> 
> Bootstraps and regtests OK - good for head?
> 
OK.  Thanks for this.

> Paul
> 
> PS I need to do some housekeeping on pr87477 now. Some of the blockers have
> "fixed themselves" and others are awaiting backporting. I think that there
> are only 4 or so left, of which 89645 and 99065 are the most difficult to
> deal with.


^ permalink raw reply	[flat|nested] 16+ messages in thread

* [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement
@ 2023-06-01 15:20 Paul Richard Thomas
  2023-06-01 17:58 ` Mikael Morin
  0 siblings, 1 reply; 16+ messages in thread
From: Paul Richard Thomas @ 2023-06-01 15:20 UTC (permalink / raw)
  To: fortran, gcc-patches


[-- Attachment #1.1: Type: text/plain, Size: 1043 bytes --]

Hi All,

This started out as the search for a fix to pr109948 and evolved to roll in
5 other prs.

Basically parse_associate was far too clunky and, in anycase, existing
functions in resolve.cc were well capable of doing the determination of the
target expression rank. While I was checking the comments, the lightbulb
flashed with respect to prs 102109/112/190 and the chunk dealing with
function results of unknown type was born.

Thanks to the changes in parse.cc, the problem in pr99326 migrated
upstream to the resolution and the chunklet in resolve.cc was an obvious
fix.

I am minded to s/{ dg-do run}/{ dg-do compile } for all six testcases. At
the testing stage, I wanted to check that the testcases actually did what
they are supposed to do :-)

Bootstraps and regtests OK - good for head?

Paul

PS I need to do some housekeeping on pr87477 now. Some of the blockers have
"fixed themselves" and others are awaiting backporting. I think that there
are only 4 or so left, of which 89645 and 99065 are the most difficult to
deal with.

[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 13255 bytes --]

diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 5e2a95688d2..3947444f17c 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -4919,6 +4919,7 @@ parse_associate (void)
   gfc_state_data s;
   gfc_statement st;
   gfc_association_list* a;
+  gfc_array_spec *as;
 
   gfc_notify_std (GFC_STD_F2003, "ASSOCIATE construct at %C");
 
@@ -4934,8 +4935,7 @@ parse_associate (void)
   for (a = new_st.ext.block.assoc; a; a = a->next)
     {
       gfc_symbol* sym;
-      gfc_ref *ref;
-      gfc_array_ref *array_ref;
+      gfc_expr *target;
 
       if (gfc_get_sym_tree (a->name, NULL, &a->st, false))
 	gcc_unreachable ();
@@ -4952,6 +4952,7 @@ parse_associate (void)
 	 for parsing component references on the associate-name
 	 in case of association to a derived-type.  */
       sym->ts = a->target->ts;
+      target = a->target;
 
       /* Don’t share the character length information between associate
 	 variable and target if the length is not a compile-time constant,
@@ -4971,31 +4972,37 @@ parse_associate (void)
 	       && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT))
 	sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
 
-      /* Check if the target expression is array valued.  This cannot always
-	 be done by looking at target.rank, because that might not have been
-	 set yet.  Therefore traverse the chain of refs, looking for the last
-	 array ref and evaluate that.  */
-      array_ref = NULL;
-      for (ref = a->target->ref; ref; ref = ref->next)
-	if (ref->type == REF_ARRAY)
-	  array_ref = &ref->u.ar;
-      if (array_ref || a->target->rank)
+      /* Check if the target expression is array valued. This cannot be done
+	 by calling gfc_resolve_expr because the context is unavailable.
+	 However, the references can be resolved and the rank of the target
+	 expression set.  */
+      if (target->ref && gfc_resolve_ref (target)
+	  && target->expr_type != EXPR_ARRAY
+	  && target->expr_type != EXPR_COMPCALL)
+	gfc_expression_rank (target);
+
+      /* Determine whether or not function expressions with unknown type are
+	 structure constructors. If so, the function result can be converted
+	 to be a derived type.
+	 TODO: Deal with references to sibling functions that have not yet been
+	 parsed (PRs 89645 and 99065).  */
+      if (target->expr_type == EXPR_FUNCTION && target->ts.type == BT_UNKNOWN)
 	{
-	  gfc_array_spec *as;
-	  int dim, rank = 0;
-	  if (array_ref)
+	  gfc_symbol *derived;
+	  /* The derived type has a leading uppercase character.  */
+	  gfc_find_symbol (gfc_dt_upper_string (target->symtree->name),
+			   my_ns->parent, 1, &derived);
+	  if (derived && derived->attr.flavor == FL_DERIVED)
 	    {
-	      a->rankguessed = 1;
-	      /* Count the dimension, that have a non-scalar extend.  */
-	      for (dim = 0; dim < array_ref->dimen; ++dim)
-		if (array_ref->dimen_type[dim] != DIMEN_ELEMENT
-		    && !(array_ref->dimen_type[dim] == DIMEN_UNKNOWN
-			 && array_ref->end[dim] == NULL
-			 && array_ref->start[dim] != NULL))
-		  ++rank;
+	      sym->ts.type = BT_DERIVED;
+	      sym->ts.u.derived = derived;
 	    }
-	  else
-	    rank = a->target->rank;
+	}
+
+      if (target->rank)
+	{
+	  int rank = 0;
+	  rank = target->rank;
 	  /* When the rank is greater than zero then sym will be an array.  */
 	  if (sym->ts.type == BT_CLASS && CLASS_DATA (sym))
 	    {
@@ -5006,8 +5013,8 @@ parse_associate (void)
 		  /* Don't just (re-)set the attr and as in the sym.ts,
 		     because this modifies the target's attr and as.  Copy the
 		     data and do a build_class_symbol.  */
-		  symbol_attribute attr = CLASS_DATA (a->target)->attr;
-		  int corank = gfc_get_corank (a->target);
+		  symbol_attribute attr = CLASS_DATA (target)->attr;
+		  int corank = gfc_get_corank (target);
 		  gfc_typespec type;
 
 		  if (rank || corank)
@@ -5042,7 +5049,7 @@ parse_associate (void)
 	      as = gfc_get_array_spec ();
 	      as->type = AS_DEFERRED;
 	      as->rank = rank;
-	      as->corank = gfc_get_corank (a->target);
+	      as->corank = gfc_get_corank (target);
 	      sym->as = as;
 	      sym->attr.dimension = 1;
 	      if (as->corank)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 83e45f1b693..c0515fd0c97 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -16087,7 +16087,8 @@ resolve_symbol (gfc_symbol *sym)
 
       if (((as->type == AS_ASSUMED_SIZE && !as->cp_was_assumed)
 	   || as->type == AS_ASSUMED_SHAPE)
-	  && !sym->attr.dummy && !sym->attr.select_type_temporary)
+	  && !sym->attr.dummy && !sym->attr.select_type_temporary
+	  && !sym->attr.associate_var)
 	{
 	  if (as->type == AS_ASSUMED_SIZE)
 	    gfc_error ("Assumed size array at %L must be a dummy argument",
diff --git a/gcc/testsuite/gfortran.dg/associate_54.f90 b/gcc/testsuite/gfortran.dg/associate_54.f90
index 680ad5d14a2..8eb95a710b6 100644
--- a/gcc/testsuite/gfortran.dg/associate_54.f90
+++ b/gcc/testsuite/gfortran.dg/associate_54.f90
@@ -24,7 +24,7 @@ contains
   subroutine test_alter_state1 (obj, a)
     class(test_t), intent(inout) :: obj
     integer, intent(in) :: a
-    associate (state => obj%state(TEST_STATES)) ! { dg-error "is used as array" }
+    associate (state => obj%state(TEST_STATES)) ! { dg-error "as array|no IMPLICIT type" }
 !      state = a
       state(TEST_STATE) = a ! { dg-error "array reference of a non-array" }
     end associate
diff --git a/gcc/testsuite/gfortran.dg/pr102109.f90 b/gcc/testsuite/gfortran.dg/pr102109.f90
new file mode 100644
index 00000000000..8f3cecbe239
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr102109.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+!
+! Contributed by Brad Richardson  <everythingfunctional@protonmail.com>
+!
+program main
+    type :: sub_obj_t
+        integer :: val
+    end type
+
+    type :: compound_obj_t
+        type(sub_obj_t) :: sub_obj
+    end type
+
+    associate(initial_sub_obj => sub_obj_t(42))
+!        print *, initial_sub_obj%val           ! Used to work with this uncommented
+        associate(obj => compound_obj_t(initial_sub_obj))
+            if (obj%sub_obj%val .ne. 42) stop 1
+        end associate
+    end associate
+end program
diff --git a/gcc/testsuite/gfortran.dg/pr102112.f90 b/gcc/testsuite/gfortran.dg/pr102112.f90
new file mode 100644
index 00000000000..cde9cbf52e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr102112.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! Contributed by Brad Richardson  <everythingfunctional@protonmail.com>
+!
+program main
+    implicit none
+
+    type :: sub_t
+        integer :: val
+    end type
+
+    type :: obj_t
+        type(sub_t) :: sub_obj
+    end type
+
+    associate(initial_sub => sub_t(42))
+        associate(obj => obj_t(initial_sub))
+            associate(sub_obj => obj%sub_obj)
+                if (sub_obj%val .ne. 42) stop 1
+            end associate
+        end associate
+    end associate
+end program
diff --git a/gcc/testsuite/gfortran.dg/pr102190.f90 b/gcc/testsuite/gfortran.dg/pr102190.f90
new file mode 100644
index 00000000000..48968430161
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr102190.f90
@@ -0,0 +1,74 @@
+! { dg-do run }
+!
+! Contributed by Brad Richardson  <everythingfunctional@protonmail.com>
+!
+module sub_m
+    type :: sub_t
+        private
+        integer :: val
+    end type
+
+    interface sub_t
+        module procedure constructor
+    end interface
+
+    interface sub_t_val
+        module procedure t_val
+    end interface
+contains
+    function constructor(val) result(sub)
+        integer, intent(in) :: val
+        type(sub_t) :: sub
+
+        sub%val = val
+    end function
+
+    function t_val(val) result(res)
+        integer :: res
+        type(sub_t), intent(in) :: val
+        res = val%val
+    end function
+end module
+
+module obj_m
+    use sub_m, only: sub_t
+    type :: obj_t
+        private
+        type(sub_t) :: sub_obj_
+    contains
+        procedure :: sub_obj
+    end type
+
+    interface obj_t
+        module procedure constructor
+    end interface
+contains
+    function constructor(sub_obj) result(obj)
+        type(sub_t), intent(in) :: sub_obj
+        type(obj_t) :: obj
+
+        obj%sub_obj_ = sub_obj
+    end function
+
+    function sub_obj(self)
+        class(obj_t), intent(in) :: self
+        type(sub_t) :: sub_obj
+
+        sub_obj = self%sub_obj_
+    end function
+end module
+
+program main
+    use sub_m, only: sub_t, sub_t_val
+    use obj_m, only: obj_t
+    type(sub_t), allocatable :: z
+
+    associate(initial_sub => sub_t(42))
+        associate(obj => obj_t(initial_sub))
+            associate(sub_obj => obj%sub_obj())
+              allocate (z, source = obj%sub_obj())
+            end associate
+        end associate
+    end associate
+    if (sub_t_val (z) .ne. 42) stop 1
+end program
diff --git a/gcc/testsuite/gfortran.dg/pr102532.f90 b/gcc/testsuite/gfortran.dg/pr102532.f90
new file mode 100644
index 00000000000..714379a6ac2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr102532.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! Contributed by Gerhard Steinmetz  <gscfq@t-online.de>
+!
+subroutine foo
+   character(:), allocatable :: x[:]
+   associate (y => x(:)(2:)) ! { dg-error "Rank mismatch|deferred type parameter" }
+   end associate
+end
+
+subroutine bar
+   character(:), allocatable :: x[:]
+   associate (y => x(:)(:)) ! { dg-error "Rank mismatch|deferred type parameter" }
+   end associate
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/pr109948.f90 b/gcc/testsuite/gfortran.dg/pr109948.f90
new file mode 100644
index 00000000000..4d963539396
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr109948.f90
@@ -0,0 +1,114 @@
+! { dg-do run }
+!
+! Tests the fix for PR109948
+!
+! Contributed by Rimvydas Jasinskas <rimvydas.jas@gmail.com>
+!
+module mm
+  implicit none
+  interface operator(==)
+    module procedure eq_1_2
+  end interface operator(==)
+  private :: eq_1_2
+contains
+  logical function eq_1_2 (x, y)
+    integer, intent(in) :: x(:)
+    real,    intent(in) :: y(:,:)
+    eq_1_2 = .true.
+  end function eq_1_2
+end module mm
+
+program pr109948
+  use mm
+  implicit none
+  type tlap
+    integer,    allocatable :: z(:)
+  end type tlap
+  type ulap
+    type(tlap) :: u(2)
+  end type ulap
+  integer :: pid = 1
+  call comment0         ! Original problem
+  call comment1
+  call comment3 ([5,4,3,2,1])
+  call comment10
+  call comment11 ([5,4,3,2,1])
+contains
+  subroutine comment0
+    type(tlap) :: y_in
+    integer :: x_out(3) =[0.0,0.0,0.0]
+    y_in%z = [1,-2,3]
+    call foo(y_in, x_out)
+    if (any (x_out .ne. [0, -2, 0])) stop 1
+    call foo(y_in, x_out)
+    if (any (x_out .ne. [1, -2, 3])) stop 2
+  end subroutine comment0
+
+  subroutine foo(y, x)
+    type(tlap) :: y
+    integer :: x(:)
+    associate(z=>y%z)
+      if (pid == 1) then
+        where ( z < 0 ) x(:) = z(:)
+      else
+        where ( z > 0 ) x(:) = z(:)
+    endif
+    pid = pid + 1
+    end associate
+  end subroutine foo
+
+  subroutine comment1
+    type(tlap) :: grib
+    integer :: i
+    grib%z = [3,2,1]
+    associate(k=>grib%z)
+      i = k(1)
+      if (any(k==1)) i = 1
+    end associate
+    if (i .eq. 3) stop 3
+  end subroutine comment1
+
+  subroutine comment3(k_2d)
+    implicit none
+    integer :: k_2d(:)
+    integer :: i
+    associate(k=>k_2d)
+      i = k(1)
+      if (any(k==1)) i = 1
+    end associate
+    if (i .eq. 3) stop 4
+  end subroutine comment3
+
+  subroutine comment11(k_2d)
+    implicit none
+    integer :: k_2d(:)
+    integer :: m(1) = 42
+    real    :: r(1,1) = 3.0
+    if ((m == r) .neqv. .true.) stop 5
+    associate (k=>k_2d)
+      if ((k == r) .neqv. .true.) stop 6  ! failed to find user defined operator
+    end associate
+    associate (k=>k_2d(:))
+      if ((k == r) .neqv. .true.) stop 7
+    end associate
+  end subroutine comment11
+
+  subroutine comment10
+    implicit none
+    type(ulap) :: z(2)
+    integer :: i
+    real    :: r(1,1) = 3.0
+    z(1)%u = [tlap([1,2,3]),tlap([4,5,6])]
+    z(2)%u = [tlap([7,8,9]),tlap([10,11,12])]
+    associate (k=>z(2)%u(1)%z)
+      i = k(1)
+      if (any(k==8)) i = 1
+    end associate
+    if (i .ne. 1) stop 8
+    associate (k=>z(1)%u(2)%z)
+      if ((k == r) .neqv. .true.) stop 9
+      if (any (k .ne. [4,5,6])) stop 10
+    end associate
+  end subroutine comment10
+end program pr109948
+
diff --git a/gcc/testsuite/gfortran.dg/pr99326.f90 b/gcc/testsuite/gfortran.dg/pr99326.f90
new file mode 100644
index 00000000000..75d1f50c238
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr99326.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! internal compiler error: in gfc_build_dummy_array_decl, at
+! fortran/trans-decl.cc:1317
+!
+! Contributed by Gerhard Steinmetz  <gscfq@t-online.de>
+!
+program p
+   type t0
+     integer :: i
+   end type
+   type t
+      class(t0), allocatable :: a(:)
+   end type
+   class(t0), allocatable :: arg(:)
+   allocate (arg, source = [t0(1), t0(2)])
+   call s(arg)
+contains
+   subroutine s(x)
+      class(t0) :: x(:)
+      type(t) :: z
+      associate (y => x)
+         z%a = y
+      end associate
+   if (size(z%a) .ne. 2) stop 1
+   end
+end

[-- Attachment #3: Change109948.Logs --]
[-- Type: application/octet-stream, Size: 922 bytes --]

Fortran: Fix some problems blocking associate meta-bug [PR87477]

2023-06-01  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/87477
	* parse.cc (parse_associate): Replace the existing evaluation
	of the target rank with calls to gfc_resolve_ref and
	gfc_expression_rank. Identify untyped target function results
	with structure constructors by finding the appropriate derived
	type.
	* resolve.cc (resolve_symbol): Allow associate variables to be
	assumed shape.

gcc/testsuite/
	PR fortran/87477
	* gfortran.dg/associate_54.f90 : Cope with extra error.

	PR fortran/102109
	* gfortran.dg/pr102109.f90 : New test.

	PR fortran/102112
	* gfortran.dg/pr102112.f90 : New test.

	PR fortran/102190
	* gfortran.dg/pr102190.f90 : New test.

	PR fortran/102532
	* gfortran.dg/pr102532.f90 : New test.

	PR fortran/109948
	* gfortran.dg/pr109948.f90 : New test.

	PR fortran/99326
	* gfortran.dg/pr99326.f90 : New test.

^ permalink raw reply	[flat|nested] 16+ messages in thread

end of thread, other threads:[~2023-06-02  7:46 UTC | newest]

Thread overview: 16+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-03-28 21:04 [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement Paul Richard Thomas
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  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 21:35         ` Paul Richard Thomas
2023-04-07 21:38           ` Paul Richard Thomas
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

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).