1178476Sjb! { dg-do run }
2178476Sjb! { dg-require-effective-target fortran_large_real }
3178476Sjb! Test that the internal pack and unpack routines work OK
4178476Sjb! for our large real type.
5178476Sjb
6178476Sjbprogram main
7178476Sjb  implicit none
8178476Sjb  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
9178476Sjb  real(kind=k), dimension(3) :: rk
10178476Sjb  complex(kind=k), dimension(3) :: ck
11178476Sjb
12178476Sjb  rk = (/ -1.0_k, 1.0_k, -3.0_k /)
13178476Sjb  call sub_rk(rk(1:3:2))
14178476Sjb  if (any(rk /= (/ 3.0_k, 1.0_k, 2.0_k/))) call abort
15178476Sjb
16178476Sjb  ck = (/ (-1.0_k, 0._k), (1.0_k, 0._k), (-3.0_k, 0._k) /)
17178476Sjb  call sub_ck(ck(1:3:2))
18178476Sjb  if (any(real(ck) /= (/ 3.0_k, 1.0_k, 2.0_k/))) call abort
19178476Sjb  if (any(aimag(ck) /= 0._k)) call abort
20178476Sjb
21178476Sjbend program main
22178476Sjb
23178476Sjbsubroutine sub_rk(r)
24178476Sjb  implicit none
25178476Sjb  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
26178476Sjb  real(kind=k), dimension(2) :: r
27178476Sjb  if (r(1) /= -1._k) call abort
28178476Sjb  if (r(2) /= -3._k) call abort
29178476Sjb  r(1) = 3._k
30178476Sjb  r(2) = 2._k
31178476Sjbend subroutine sub_rk
32178476Sjb
33178476Sjbsubroutine sub_ck(r)
34178476Sjb  implicit none
35178476Sjb  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
36178476Sjb  complex(kind=k), dimension(2) :: r
37178476Sjb  if (r(1) /= (-1._k,0._k)) call abort
38178476Sjb  if (r(2) /= (-3._k,0._k)) call abort
39178476Sjb  r(1) = 3._k
40178476Sjb  r(2) = 2._k
41178476Sjbend subroutine sub_ck
42178476Sjb