gcc/testsuite/gfortran.dg/actual_array_constructor_2.f90

   1 ! { dg-do run }
   2 ! Tests the fix for pr28167, in which character array constructors\r
   3 ! with an implied do loop would cause an ICE, when used as actual\r
   4 ! arguments.
   5 !
   6 ! Based on the testscase by Harald Anlauf  <anlauf@gmx.de>
   7 !
   8   character(4), dimension(4) :: c1, c2
   9   integer m
  10   m = 4
  11 ! Test the original problem
  12   call foo ((/( 'abcd',i=1,m )/), c2)
  13   if (any(c2(:) .ne. (/'abcd','abcd', &
  14                             'abcd','abcd'/))) call abort ()
  15
  16 ! Now get a bit smarter
  17   call foo ((/"abcd", "efgh", "ijkl", "mnop"/), c1) ! worked previously
  18   call foo ((/(c1(i), i = m,1,-1)/), c2)            ! was broken
  19   if (any(c2(4:1:-1) .ne. c1)) call abort ()
  20
  21 ! gfc_todo: Not Implemented: complex character array constructors
  22   call foo ((/(c1(i)(i/2+1:i/2+2), i = 1,4)/), c2)  ! Ha! take that..!
  23   if (any (c2 .ne. (/"ab  ","fg  ","jk  ","op  "/))) call abort ()
  24
  25 ! Check functions in the constructor
  26   call foo ((/(achar(64+i)//achar(68+i)//achar(72+i)// &
  27                achar(76+i),i=1,4 )/), c1)           ! was broken
  28   if (any (c1 .ne. (/"AEIM","BFJN","CGKO","DHLP"/))) call abort ()
  29 contains
  30   subroutine foo (chr1, chr2)
  31     character(*), dimension(:) :: chr1, chr2
  32     chr2 = chr1
  33   end subroutine foo
  34 end