gcc/testsuite/gfortran.dg/internal_pack_2.f90

   1 ! { dg-do run }
   2 ! { dg-require-effective-target fortran_large_real }
   3 ! Test that the internal pack and unpack routines work OK
   4 ! for our large real type.
   5
   6 program main
   7   implicit none
   8   integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
   9   real(kind=k), dimension(3) :: rk
  10   complex(kind=k), dimension(3) :: ck
  11
  12   rk = (/ -1.0_k, 1.0_k, -3.0_k /)
  13   call sub_rk(rk(1:3:2))
  14   if (any(rk /= (/ 3.0_k, 1.0_k, 2.0_k/))) STOP 1
  15
  16   ck = (/ (-1.0_k, 0._k), (1.0_k, 0._k), (-3.0_k, 0._k) /)
  17   call sub_ck(ck(1:3:2))
  18   if (any(real(ck) /= (/ 3.0_k, 1.0_k, 2.0_k/))) STOP 2
  19   if (any(aimag(ck) /= 0._k)) STOP 3
  20
  21 end program main
  22
  23 subroutine sub_rk(r)
  24   implicit none
  25   integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
  26   real(kind=k), dimension(2) :: r
  27   if (r(1) /= -1._k) STOP 4
  28   if (r(2) /= -3._k) STOP 5
  29   r(1) = 3._k
  30   r(2) = 2._k
  31 end subroutine sub_rk
  32
  33 subroutine sub_ck(r)
  34   implicit none
  35   integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
  36   complex(kind=k), dimension(2) :: r
  37   if (r(1) /= (-1._k,0._k)) STOP 6
  38   if (r(2) /= (-3._k,0._k)) STOP 7
  39   r(1) = 3._k
  40   r(2) = 2._k
  41 end subroutine sub_ck