2
2
! > author: Jacob Williams
3
3
! license: BSD
4
4
!
5
- ! A simple linked list for storing error messages.
5
+ ! A simple type for storing error messages.
6
6
! Used by the [[function_parser] module.
7
7
!
8
8
! @note The error message is stored internally as an
@@ -19,15 +19,15 @@ module error_module
19
19
! ! A error message in the [[list_of_errors]].
20
20
private
21
21
character (len= :),allocatable :: content ! ! the error message string
22
- type (error),pointer :: next = > null () ! ! next error message in the list
23
22
end type error
24
23
25
24
type,public :: list_of_errors
26
25
! ! A list of errors.
26
+ ! !
27
+ ! ! This is implemented as a simple allocatable
28
+ ! ! array of [[error]] types.
27
29
private
28
- integer :: n_errors = 0 ! ! number of errors in the list
29
- type (error),pointer :: head = > null () ! ! first error in the list
30
- type (error),pointer :: tail = > null () ! ! last error in the list
30
+ type (error),dimension (:),allocatable :: head ! ! the error list
31
31
contains
32
32
private
33
33
procedure ,public :: add = > add_error_to_list
@@ -44,7 +44,7 @@ module error_module
44
44
! >
45
45
! Will be called automatically when the list goes out of scope.
46
46
47
- subroutine list_finalizer (me )
47
+ pure elemental subroutine list_finalizer(me)
48
48
49
49
implicit none
50
50
@@ -59,35 +59,25 @@ end subroutine list_finalizer
59
59
! >
60
60
! To manually destroy the list.
61
61
!
62
- ! This list must be destroyed when finished in order to present a memory leak.
63
- !
64
62
! Also note that there is a finalizer in the [[list_of_errors]],
65
63
! so if the caller doesn't call this routine, it will be destroyed
66
64
! when it goes out of scope, assuming the compiler is standard-conforming.
67
65
68
-
69
- subroutine destroy_list (me )
66
+ pure elemental subroutine destroy_list(me)
70
67
71
68
implicit none
72
69
73
70
class(list_of_errors),intent (inout ) :: me
74
71
75
- type (error),pointer :: p ! ! temp pointer
76
- type (error),pointer :: q ! ! temp pointer
77
-
78
- p = > me% head
79
- do
80
- if (.not. associated (p)) exit
81
- q = > p% next
82
- deallocate (p% content)
83
- deallocate (p)
84
- nullify(p)
85
- p = > q
86
- end do
72
+ integer :: i ! ! counter
87
73
88
- nullify(me% head)
89
- nullify(me% tail)
90
- me% n_errors = 0
74
+ if (allocated (me% head)) then
75
+ do i = 1 , size (me% head)
76
+ if (allocated (me% head(i)% content)) &
77
+ deallocate (me% head(i)% content)
78
+ end do
79
+ deallocate (me% head)
80
+ end if
91
81
92
82
end subroutine destroy_list
93
83
! *******************************************************************************
@@ -103,17 +93,24 @@ subroutine add_error_to_list(me,string)
103
93
class(list_of_errors),intent (inout ) :: me
104
94
character (len=* ),intent (in ) :: string ! ! the error message to add.
105
95
106
- if (.not. associated (me% head)) then
96
+ type (error),dimension (:),allocatable :: tmp ! ! for expanding the array
97
+ integer :: n ! ! number of errors currently in the list
98
+
99
+ if (.not. allocated (me% head)) then
100
+
107
101
! first error in the list
108
- me% n_errors = 1
109
- allocate (me% head)
110
- me% head% content = string
111
- me% tail = > me% head
102
+ allocate (me% head(1 ))
103
+ me% head(1 )% content = string
104
+
112
105
else
113
- me% n_errors = me% n_errors + 1
114
- allocate (me% tail% next)
115
- me% tail% next% content = string
116
- me% tail = > me% tail% next
106
+
107
+ ! add to the list
108
+ n = size (me% head)
109
+ allocate (tmp(n+1 ))
110
+ tmp(1 :n) = me% head
111
+ tmp(n+1 )% content = string
112
+ call move_alloc(tmp,me% head)
113
+
117
114
end if
118
115
119
116
end subroutine add_error_to_list
@@ -123,14 +120,14 @@ end subroutine add_error_to_list
123
120
! >
124
121
! Returns true if the list contains any error messages.
125
122
126
- function list_has_errors (me )
123
+ pure elemental function list_has_errors(me)
127
124
128
125
implicit none
129
126
130
127
class(list_of_errors),intent (in ) :: me
131
128
logical :: list_has_errors
132
129
133
- list_has_errors = associated (me% head)
130
+ list_has_errors = allocated (me% head)
134
131
135
132
end function list_has_errors
136
133
! *******************************************************************************
@@ -147,15 +144,13 @@ subroutine print_errors(me,iunit)
147
144
integer ,intent (in ) :: iunit ! ! unit number for printing
148
145
! ! (assumed to be open)
149
146
150
- type (error),pointer :: p ! ! temp pointer
151
147
integer :: i ! ! counter
152
148
153
- p = > me% head
154
- do
155
- if (.not. associated (p)) exit
156
- write (iunit,fmt= ' (A)' ) p% content
157
- p = > p% next
158
- end do
149
+ if (allocated (me% head)) then
150
+ do i = 1 , size (me% head)
151
+ write (iunit,fmt= ' (A)' ) me% head(i)% content
152
+ end do
153
+ end if
159
154
160
155
end subroutine print_errors
161
156
! *******************************************************************************
0 commit comments