Skip to content

Commit 98d7716

Browse files
committed
error list type now uses allocatables rather than pointers.
added higher-level access to errors.
1 parent 6680cde commit 98d7716

File tree

2 files changed

+234
-107
lines changed

2 files changed

+234
-107
lines changed

src/error_module.f90

Lines changed: 38 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
!> author: Jacob Williams
33
! license: BSD
44
!
5-
! A simple linked list for storing error messages.
5+
! A simple type for storing error messages.
66
! Used by the [[function_parser] module.
77
!
88
!@note The error message is stored internally as an
@@ -19,15 +19,15 @@ module error_module
1919
!! A error message in the [[list_of_errors]].
2020
private
2121
character(len=:),allocatable :: content !! the error message string
22-
type(error),pointer :: next => null() !! next error message in the list
2322
end type error
2423

2524
type,public :: list_of_errors
2625
!! A list of errors.
26+
!!
27+
!! This is implemented as a simple allocatable
28+
!! array of [[error]] types.
2729
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
3131
contains
3232
private
3333
procedure,public :: add => add_error_to_list
@@ -44,7 +44,7 @@ module error_module
4444
!>
4545
! Will be called automatically when the list goes out of scope.
4646

47-
subroutine list_finalizer(me)
47+
pure elemental subroutine list_finalizer(me)
4848

4949
implicit none
5050

@@ -59,35 +59,25 @@ end subroutine list_finalizer
5959
!>
6060
! To manually destroy the list.
6161
!
62-
! This list must be destroyed when finished in order to present a memory leak.
63-
!
6462
! Also note that there is a finalizer in the [[list_of_errors]],
6563
! so if the caller doesn't call this routine, it will be destroyed
6664
! when it goes out of scope, assuming the compiler is standard-conforming.
6765

68-
69-
subroutine destroy_list(me)
66+
pure elemental subroutine destroy_list(me)
7067

7168
implicit none
7269

7370
class(list_of_errors),intent(inout) :: me
7471

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
8773

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
9181

9282
end subroutine destroy_list
9383
!*******************************************************************************
@@ -103,17 +93,24 @@ subroutine add_error_to_list(me,string)
10393
class(list_of_errors),intent(inout) :: me
10494
character(len=*),intent(in) :: string !! the error message to add.
10595

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+
107101
!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+
112105
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+
117114
end if
118115

119116
end subroutine add_error_to_list
@@ -123,14 +120,14 @@ end subroutine add_error_to_list
123120
!>
124121
! Returns true if the list contains any error messages.
125122

126-
function list_has_errors(me)
123+
pure elemental function list_has_errors(me)
127124

128125
implicit none
129126

130127
class(list_of_errors),intent(in) :: me
131128
logical :: list_has_errors
132129

133-
list_has_errors = associated(me%head)
130+
list_has_errors = allocated(me%head)
134131

135132
end function list_has_errors
136133
!*******************************************************************************
@@ -147,15 +144,13 @@ subroutine print_errors(me,iunit)
147144
integer,intent(in) :: iunit !! unit number for printing
148145
!! (assumed to be open)
149146

150-
type(error),pointer :: p !! temp pointer
151147
integer :: i !! counter
152148

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
159154

160155
end subroutine print_errors
161156
!*******************************************************************************

0 commit comments

Comments
 (0)