gcc/testsuite/gfortran.dg/array_constructor_17.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR31219, in which the character length of
   3 ! the functions in the array constructor was not being obtained
   4 ! correctly and this caused an ICE.
   5 !
   6 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
   7 !
   8   INTEGER :: J
   9   CHARACTER(LEN = 8) :: str
  10   J = 3
  11   write (str,'(2A4)') (/( F(I, J), I = 1, 2)/)
  12   IF (str .NE. " ODD EVE") STOP 1
  13
  14 ! Comment #1 from F-X Coudert (noted by T. Burnus) that
  15 ! actually exercises a different part of the bug.
  16   call gee( (/g (3)/) )
  17
  18 CONTAINS
  19   FUNCTION F (K,J) RESULT(I)
  20     INTEGER :: K, J
  21     CHARACTER(LEN = J) :: I
  22     IF (MODULO (K, 2) .EQ. 0) THEN
  23        I = "EVEN"
  24     ELSE
  25        I = "ODD"
  26     ENDIF
  27   END FUNCTION
  28
  29   function g(k) result(i)
  30     integer :: k
  31     character(len = k) :: i
  32     i = '1234'
  33   end function
  34   subroutine gee(a)
  35     character(*),dimension(1) :: a
  36     if(len (a) /= 3) STOP 2
  37     if(a(1) /= '123') STOP 3
  38   end subroutine gee
  39
  40 END