source: XMLF90/src/sax/m_buffer.f90 @ 295

Last change on this file since 295 was 6, checked in by ymipsl, 12 years ago

Import des sources XMLF90

File size: 5.4 KB
Line 
1module m_buffer
2
3!
4! At this point we use a fixed-size buffer.
5! Note however that buffer overflows will only be
6! triggered by overly long *unbroken* pcdata values, or
7! by overly long attribute values. Hopefully
8! element or attribute names are "short enough".
9! There is code in m_fsm to avoid buffer overflows
10! caused by pcdata with whitespace.
11!
12! In a forthcoming implementation it could be made dynamical...
13!
14integer, parameter, public   :: MAX_BUFF_SIZE  = 10000
15integer, parameter, private  :: BUFF_SIZE_WARNING  = 900
16
17!
18
19type, public  :: buffer_t
20private
21      integer                       :: size
22      character(len=MAX_BUFF_SIZE)  :: str
23end type buffer_t
24
25public :: add_to_buffer
26public :: print_buffer, str, len       !! , char
27public :: operator (.equal.)
28public :: buffer_nearly_full, reset_buffer, init_buffer
29public :: buffer_to_character
30
31
32!----------------------------------------------------------------
33interface add_to_buffer
34      module procedure add_str_to_buffer
35end interface
36private :: add_char_to_buffer, add_str_to_buffer
37
38interface operator (.equal.)
39      module procedure compare_buffers, compare_buffer_str, &
40             compare_str_buffer
41end interface
42private :: compare_buffers, compare_buffer_str, compare_str_buffer
43
44interface str
45      module procedure buffer_to_str
46end interface
47interface char                 ! Experimental
48      module procedure buffer_to_str
49end interface
50private :: buffer_to_str
51
52interface len
53   module procedure buffer_length
54end interface
55private :: buffer_length
56
57CONTAINS
58!==================================================================
59
60!----------------------------------------------------------------
61function compare_buffers(a,b) result(equal)     ! .equal. generic
62type(buffer_t), intent(in)  :: a
63type(buffer_t), intent(in)  :: b
64logical                     :: equal
65
66equal = ((a%size == b%size) .and. (a%str(1:a%size) == b%str(1:b%size)))
67
68end function compare_buffers
69
70!----------------------------------------------------------------
71function compare_buffer_str(buffer,str) result(equal) ! .equal. generic
72type(buffer_t), intent(in)   :: buffer
73character(len=*), intent(in) :: str
74logical                      :: equal
75
76equal = (buffer%str(1:buffer%size) == trim(str))
77
78end function compare_buffer_str
79
80!----------------------------------------------------------------
81function compare_str_buffer(str,buffer) result(equal) ! .equal. generic
82character(len=*), intent(in) :: str
83type(buffer_t), intent(in)   :: buffer
84logical                     :: equal
85
86equal = (buffer%str(1:buffer%size) == trim(str))
87
88end function compare_str_buffer
89
90!----------------------------------------------------------------
91subroutine add_char_to_buffer(c,buffer)
92character(len=1), intent(in)   :: c
93type(buffer_t), intent(inout)  :: buffer
94
95integer   :: n
96buffer%size = buffer%size + 1
97n = buffer%size
98
99if (n> MAX_BUFF_SIZE) then
100!!  RETURN
101!
102!  It will only affect long comments and sgml declarations
103   STOP "sax 1 Buffer overflow: long unbroken string of pcdata or attribute value..."
104endif
105
106buffer%str(n:n) = c
107end subroutine add_char_to_buffer
108
109!----------------------------------------------------------------
110subroutine add_str_to_buffer(s,buffer)
111character(len=*), intent(in)   :: s
112type(buffer_t), intent(inout)  :: buffer
113
114integer   :: n, len_s, last_pos
115
116len_s = len(s)
117last_pos = buffer%size
118buffer%size = buffer%size + len_s
119n = buffer%size
120
121if (n> MAX_BUFF_SIZE) then
122!!  RETURN
123!
124!  It will only affect long comments and sgml declarations
125  STOP "sax 2 Buffer overflow: long unbroken string of pcdata or attribute value..."
126endif
127
128buffer%str(last_pos+1:n) = s
129end subroutine add_str_to_buffer
130
131!----------------------------------------------------------------
132subroutine init_buffer(buffer)
133type(buffer_t), intent(inout)  :: buffer
134
135buffer%size = 0
136buffer%str=""               ! To avoid "undefined" status
137
138end subroutine init_buffer
139!----------------------------------------------------------------
140subroutine reset_buffer(buffer)
141type(buffer_t), intent(inout)  :: buffer
142  buffer%size = 0
143end subroutine reset_buffer
144!----------------------------------------------------------------
145subroutine print_buffer(buffer)
146type(buffer_t), intent(in)  :: buffer
147
148integer :: i
149
150do i = 1, buffer%size
151      write(unit=6,fmt="(a1)",advance="no") buffer%str(i:i)
152enddo
153
154end subroutine print_buffer
155!----------------------------------------------------------------
156! This is better... but could it lead to memory leaks?
157!
158function buffer_to_str(buffer) result(str)
159type(buffer_t), intent(in)          :: buffer
160character(len=buffer%size)          :: str
161
162str = buffer%str(1:buffer%size)
163end function buffer_to_str
164
165!----------------------------------------------------------------
166!
167subroutine buffer_to_character(buffer,str)
168type(buffer_t), intent(in)          :: buffer
169character(len=*), intent(out)       :: str
170
171str = buffer%str(1:buffer%size)
172end subroutine buffer_to_character
173
174!----------------------------------------------------------------
175function buffer_nearly_full(buffer) result(warn)
176type(buffer_t), intent(in)          :: buffer
177logical                             :: warn
178
179warn = buffer%size > BUFF_SIZE_WARNING
180
181end function buffer_nearly_full
182
183!----------------------------------------------------------------
184function buffer_length(buffer) result(length)
185type(buffer_t), intent(in)          :: buffer
186integer                             :: length
187
188length = buffer%size 
189
190end function buffer_length
191
192
193end module m_buffer
194
195
196
197
198
199
200
Note: See TracBrowser for help on using the repository browser.