1! { dg-do run }
2!
3! PR fortran/58793
4!
5! Contributed by  Vladimir Fuka
6!
7! Had the wrong value for the storage_size for complex
8!
9module m
10  use iso_fortran_env
11  implicit none
12  integer, parameter :: c1 = real_kinds(1)
13  integer, parameter :: c2 = real_kinds(2)
14  integer, parameter :: c3 = real_kinds(size(real_kinds)-1)
15  integer, parameter :: c4 = real_kinds(size(real_kinds))
16  real(c1) :: r1
17  real(c2) :: r2
18  real(c3) :: r3
19  real(c4) :: r4
20contains
21 subroutine s(o, k)
22    class(*) :: o
23    integer :: k
24    integer :: sz
25
26    sz = 0
27    select case (k)
28     case (4)
29      sz = storage_size(r1)*2
30    end select
31    select case (k)
32     case (8)
33      sz = storage_size(r2)*2
34    end select
35    select case (k)
36     case (real_kinds(size(real_kinds)-1))
37      sz = storage_size(r3)*2
38    end select
39    select case (k)
40     case (real_kinds(size(real_kinds)))
41      sz = storage_size(r4)*2
42    end select
43    if (sz .eq. 0) STOP 1
44
45    if (storage_size(o) /= sz) STOP 2
46
47! Break up the SELECT TYPE to pre-empt collisions in the value of 'cn'
48    select type (o)
49      type is (complex(c1))
50        if (storage_size(o) /= sz) STOP 3
51    end select
52    select type (o)
53      type is (complex(c2))
54        if (storage_size(o) /= sz) STOP 4
55    end select
56    select type (o)
57      type is (complex(c3))
58        if (storage_size(o) /= sz) STOP 5
59     end select
60    select type (o)
61     type is (complex(c4))
62        if (storage_size(o) /= sz) STOP 6
63    end select
64  end subroutine s
65end module m
66
67program p
68 use m
69 call s((1._c1, 2._c1), c1)
70 call s((1._c2, 2._c2), c2)
71 call s((1._c3, 2._c3), c3)
72 call s((1._c4, 2._c4), c4)
73end program p
74