gcc/testsuite/gfortran.dg/associate_68.f90

   1 ! { dg-do run }
   2 ! Test the fix for PR114280 in which inquiry references of associate names
   3 ! of as yet unparsed function selectors failed.
   4 ! Contributed by Steve Kargl  <>
   5 program paul2
   6   implicit none
   7   type t
   8      real :: re
   9   end type t
  10   real :: comp = 1, repart = 10, impart =100
  11   call foo
  12 contains
  13   subroutine foo ()
  14     associate (x => bar1())
  15 ! 'x' identified as complex from outset
  16       if (int(x%im) .ne. 100) stop 1         ! Has no IMPLICIT type
  17       if (int(x%re) .ne. 10) stop 2
  18     end associate
  19
  20     associate (x => bar1())
  21 ! 'x' identified as derived then corrected to complex
  22       if (int(x%re) .ne. 11) stop 3          ! Has no IMPLICIT type
  23       if (int(x%im) .ne. 101) stop 4
  24       if (x%kind .ne. kind(1.0)) stop 5
  25     end associate
  26
  27     associate (x => bar1())
  28       if (x%kind .ne. kind(1.0)) stop 6      ! Invalid character in name
  29     end associate
  30
  31     associate (x => bar2())
  32       if (int(x%re) .ne. 1) stop 7           ! Invalid character in name
  33     end associate
  34
  35     associate (xx => bar3())
  36       if (xx%len .ne. 8) stop 8               ! Has no IMPLICIT type
  37       if (trim (xx) .ne. "Nice one") stop 9
  38       if (xx(6:8) .ne. "one") stop 10
  39     end associate
  40
  41 ! Now check the array versions
  42     associate (x => bar4())
  43       if (any (int(abs (x(:) + 2.0)) .ne. [104,105])) stop 0
  44       if (int(x(2)%re) .ne. 14) stop 11
  45       if (any (int(x%im) .ne. [103,104])) stop 12
  46       if (any (int(abs(x)) .ne. [103,104])) stop 13
  47     end associate
  48
  49     associate (x => bar5())
  50       if (x(:)%kind .ne. kind("A")) stop 14
  51       if (x(2)%len .ne. 4) stop 15
  52       if (x%len .ne. 4) stop 16
  53       if (x(2)(1:3) .ne. "two") stop 17
  54       if (any(x .ne. ["one ", "two "])) stop 18
  55     end associate
  56   end
  57   complex function bar1 ()
  58     bar1 = cmplx(repart, impart)
  59     repart = repart + 1
  60     impart = impart + 1
  61   end
  62   type(t) function bar2 ()
  63     bar2% re = comp
  64     comp = comp + 1
  65   end
  66   character(8) function bar3 ()
  67     bar3 = "Nice one!"
  68   end
  69   function bar4 () result (res)
  70     complex, allocatable, dimension(:) :: res
  71     res = [cmplx(repart, impart),cmplx(repart+1, impart+1)]
  72     repart = repart + 2
  73     impart = impart + 2
  74   end
  75   function bar5 () result (res)
  76     character(4), allocatable, dimension(:) :: res
  77     res = ["one ", "two "]
  78   end
  79 end