gcc/testsuite/gfortran.dg/spread_scalar_source.f90

   1 ! { dg-do run }
   2 ! { dg-options "-O0" }
   3
   4   character*1 :: i, j(10)
   5   character*8 :: buffer
   6   integer(kind=1) :: ii, jj(10)
   7   type :: mytype
   8     real(kind=8) :: x
   9     integer(kind=1) :: i
  10     character*15 :: ch
  11   end type mytype
  12   type(mytype) :: iii, jjj(10)
  13
  14   i = "w"
  15   ii = 42
  16   iii = mytype (41.9999_8, 77, "test_of_spread_")
  17
  18 ! Test constant sources.
  19
  20   j = spread ("z", 1 , 10)
  21   if (any (j /= "z")) call abort ()
  22   jj = spread (19, 1 , 10)
  23   if (any (jj /= 19)) call abort ()
  24
  25 ! Test variable sources.
  26
  27   j = spread (i, 1 , 10)
  28   if (any (j /= "w")) call abort ()
  29   jj = spread (ii, 1 , 10)
  30   if (any (jj /= 42)) call abort ()
  31   jjj = spread (iii, 1 , 10)
  32   if (any (jjj%x /= 41.9999_8)) call abort ()
  33   if (any (jjj%i /= 77)) call abort ()
  34   if (any (jjj%ch /= "test_of_spread_")) call abort ()
  35
  36 ! Check that spread != 1 is OK.
  37
  38   jj(2:10:2) = spread (1, 1, 5)
  39   if (any (jj(1:9:2) /= 42) .or. any (jj(2:10:2) /= 1)) call abort ()
  40
  41 ! Finally, check that temporaries and trans-io.c work correctly.
  42
  43   write (buffer, '(4a1)') spread (i, 1 , 4)
  44   if (trim(buffer) /= "wwww") call abort ()
  45   write (buffer, '(4a1)') spread ("r", 1 , 4)
  46   if (trim(buffer) /= "rrrr") call abort ()
  47   write (buffer, '(4i2)') spread (ii, 1 , 4)
  48   if (trim(buffer) /= "42424242") call abort ()
  49   write (buffer, '(4i2)') spread (31, 1 , 4)
  50   if (trim(buffer) /= "31313131") call abort ()
  51
  52   end