1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
module class_78_module
public :: fpm_registry_settings, fpm_global_settings
type :: fpm_global_settings
type(fpm_registry_settings), allocatable :: registry_settings
end type
type :: fpm_registry_settings
integer :: tag = 0
end type
end module class_78_module
program class_78
use class_78_module
implicit none
type(fpm_global_settings) :: global_settings
type(fpm_registry_settings) :: tmp
logical :: ok
if (allocated(global_settings%registry_settings)) then
print *, "FAIL: registry_settings should start unallocated."
stop 1
else
print *, "PASS: registry_settings initially unallocated."
end if
allocate(global_settings%registry_settings)
if (.not. allocated(global_settings%registry_settings)) then
print *, "FAIL: allocation failed."
stop 1
else
print *, "PASS: allocation succeeded."
end if
tmp%tag = 42
global_settings%registry_settings = tmp
if (global_settings%registry_settings%tag /= 42) then
print *, "FAIL: assignment into allocatable component did not propagate value."
stop 1
else
print *, "PASS: assignment propagated correctly."
end if
call validate_settings(global_settings, ok)
if (.not. ok) then
print *, "FAIL: validate_settings detected incorrect state."
stop 1
else
print *, "PASS: validate_settings confirmed correct state."
end if
deallocate(global_settings%registry_settings)
if (allocated(global_settings%registry_settings)) then
print *, "FAIL: deallocation failed."
stop 1
else
print *, "PASS: deallocation succeeded."
end if
contains
subroutine validate_settings(gs, ok)
type(fpm_global_settings), intent(in) :: gs
logical, intent(out) :: ok
ok = .true.
if (.not. allocated(gs%registry_settings)) ok = .false.
if (gs%registry_settings%tag /= 42) ok = .false.
end subroutine validate_settings
end program class_78
|
