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; 13+ 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] 13+ messages in thread
end of thread, other threads:[~2023-04-08 13:56 UTC | newest]

Thread overview: 13+ 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

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