-
Notifications
You must be signed in to change notification settings - Fork 6
/
Copy pathderived-type_diagnostic.F90
152 lines (120 loc) · 4.23 KB
/
derived-type_diagnostic.F90
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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
module stuff_m
!! Example module with a type that does not extend characterizable_t.
use assert_m, only : assert
implicit none
private
public :: stuff_t
type stuff_t
!! Example type demonstrating how to get diagnostic data from a type
!! that does not extend characterizable_t.
private
complex z_
logical :: defined_=.false.
contains
procedure z
procedure defined
end type
interface
pure module function z(self) result(self_z)
!! Accessor: returns z_ component value
class(stuff_t), intent(in) :: self
complex self_z
end function
pure module function defined(self) result(self_defined)
!! Result is true if the object has been marked as user-defined.
class(stuff_t), intent(in) :: self
logical self_defined
end function
end interface
interface stuff_t
pure module function construct(z) result(new_stuff_t)
!! Constructor: result is a new stuff_t object.
complex, intent(in) :: z
type(stuff_t) new_stuff_t
end function
end interface
contains
pure module function defined(self) result(self_defined)
class(stuff_t), intent(in) :: self
logical self_defined
self_defined = self%defined_
end function
module procedure construct
new_stuff_t%z_ = z
new_stuff_t%defined_ = .true.
call assert(new_stuff_t%defined(), "stuff_t construct(): new_stuff_t%defined()", new_stuff_t%defined_) ! Postcondition
end procedure
module procedure z
call assert(self%defined(), "stuff_t%z(): self%defined()") ! Precondition
self_z = self%z_
end procedure
end module
module characterizable_stuff_m
!! Demonstrate a pattern for getting derived-type diagnostic data output from a type that
!! does not extend characterizable_t.
use stuff_m, only : stuff_t
use characterizable_m, only : characterizable_t
implicit none
private
public :: characterizable_stuff_t
type, extends(characterizable_t) :: characterizable_stuff_t
!! Encapsulate the example type and extend characterizable_t to enable diagnostic-data
!! output in assertions.
private
type(stuff_t) stuff_
contains
procedure as_character
end type
interface
pure module function as_character(self) result(character_self)
!! Produce a character representation of the encapsulated type
implicit none
class(characterizable_stuff_t), intent(in) :: self
character(len=:), allocatable :: character_self
end function
end interface
interface characterizable_stuff_t
pure module function construct(stuff) result(new_characterizable_stuff)
!! Result is a new characterizable_stuff_t object
implicit none
type(stuff_t), intent(in) :: stuff
type(characterizable_stuff_t) :: new_characterizable_stuff
end function
end interface
contains
pure module function as_character(self) result(character_self)
class(characterizable_stuff_t), intent(in) :: self
character(len=:), allocatable :: character_self
integer, parameter :: max_len=256
character(len=max_len) untrimmed_string
write(untrimmed_string,*) self%stuff_%z()
character_self = trim(adjustl(untrimmed_string))
end function
module procedure construct
new_characterizable_stuff%stuff_ = stuff
end procedure
end module
program diagnostic_data_pattern
!! Demonstrate
!! 1. A successful assertion with a derived-type diagnostic_data argument,
!! 2. A failing internal assertion that prevents the use of undefined data.
!! Item 1 also demonstrates the usefulness of a constructor postcondition.
!! Item 2 also demonstrates the usefulness of an accessor precondition.
use assert_m, only : assert
use stuff_m, only : stuff_t
use characterizable_stuff_m, only : characterizable_stuff_t
implicit none
type(stuff_t) stuff
#ifndef _CRAYFTN
associate (i => stuff_t(z=(0.,1.)))
call assert(i%defined(), "main: i%defined()", characterizable_stuff_t(i))!Passes: constructor postcondition ensures defined data
end associate
#else
block
type(stuff_t) stuff
stuff = stuff_t(z=(0.,1.))
call assert(stuff%defined(), "main: i%defined()", characterizable_stuff_t(stuff))
end block
#endif
print *, stuff%z() ! Fails: accessor precondition catches use of undefined data
end program