Hi Paul,

your approach sounds entirely reasonable.

But as the following addition to the testcase shows, there seem to
be loopholes left.

When I add the following to function f:

         integer :: l1(size(y))
         integer :: l2(size(z))
         print *, size (l1), size (l2), size (z)

I get:

           0           0           3

Expected:

           2           3           3

Can you please check?

Thanks,
Harald


Am 09.06.24 um 17:57 schrieb Paul Richard Thomas:
Hi All,

I have extended the testcase - see below and have
s/dependent_decls_2/dependent_decls_2.f90/ in the ChnageLog.

Cheers

Paul

! { dg-do run }
!
! Fix for PR59104 in which the dependence on the old style function result
! was not taken into account in the ordering of auto array allocation and
! characters with dependent lengths.
!
! Contributed by Tobias Burnus  <bur...@gcc.gnu.org>
!
module m
    implicit none
    integer, parameter :: dp = kind([double precision::])
    contains
       function f(x)
          integer, intent(in) :: x
          real(dp) f(x/2)
          real(dp) g(x/2)
          integer y(size (f)+1)         ! This was the original problem
          integer z(size (f) + size (y)) ! Found in development of the fix
          integer w(size (f) + size (y) + x) ! Check dummy is OK
          f = 10.0
          y = 1                        ! Stop -Wall from complaining
          z = 1
          g = 1
          w = 1
          if (size (f) .ne. 1) stop 1
          if (size (g) .ne. 1) stop 2
          if (size (y) .ne. 2) stop 3
          if (size (z) .ne. 3) stop 4
          if (size (w) .ne. 5) stop 5
       end function f
       function e(x) result(f)
          integer, intent(in) :: x
          real(dp) f(x/2)
          real(dp) g(x/2)
          integer y(size (f)+1)
          integer z(size (f) + size (y)) ! As was this.
          integer w(size (f) + size (y) + x)
          f = 10.0
          y = 1
          z = 1
          g = 1
          w = 1
          if (size (f) .ne. 2) stop 6
          if (size (g) .ne. 2) stop 7
          if (size (y) .ne. 3) stop 8
          if (size (z) .ne. 5) stop 9
          if (size (w) .ne. 9) stop 10
       end function
       function d(x)  ! After fixes to arrays, what was needed was known!
         integer, intent(in) :: x
         character(len = x/2) :: d
         character(len = len (d)) :: line
         character(len = len (d) + len (line)) :: line2
         character(len = len (d) + len (line) + x) :: line3
         line = repeat ("a", len (d))
         line2 = repeat ("b", x)
         line3 = repeat ("c", len (line3))
         if (len (line2) .ne. x) stop 11
         if (line3 .ne. "cccccccc") stop 12
         d = line
       end
end module m

program p
    use m
    implicit none
    real(dp) y

    y = sum (f (2))
    if (int (y) .ne. 10) stop 13
    y = sum (e (4))
    if (int (y) .ne. 20) stop 14
    if (d (4) .ne. "aa") stop 15
end program p



On Sun, 9 Jun 2024 at 07:14, Paul Richard Thomas <
paul.richard.tho...@gmail.com> wrote:

Hi All,

The attached fixes a problem that, judging by the comments, has been
looked at periodically over the last ten years but just looked to be too
fiendishly complicated to fix. This is not in small part because of the
confusing ordering of dummies in the tlink chain and the unintuitive
placement of all deferred initializations to the front of the init chain in
the wrapped block.

The result of the existing ordering is that the initialization code for
non-dummy variables that depends on the function result occurs before any
initialization code for the function result itself. The fix ensures that:
(i) These variables are placed correctly in the tlink chain, respecting
inter-dependencies; and (ii) The dependent initializations are placed at
the end of the wrapped block init chain.  The details appear in the
comments in the patch. It is entirely possible that a less clunky fix
exists but I failed to find it.

OK for mainline?

Regards

Paul







Reply via email to