source: XMLF90/src/wxml/m_wxml_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: 4.8 KB
Line 
1module m_wxml_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 the parser module  m_fsm to avoid buffer overflows
10! caused by pcdata values.
11!
12! This module is re-used from the parser package.
13! Most of the routines are superfluous at this point.
14!
15! In a forthcoming implementation it could be made dynamical...
16!
17integer, parameter, public   :: MAX_BUFF_SIZE  = 2000
18integer, parameter, private  :: BUFF_SIZE_WARNING  = 1750
19!
20type, public  :: buffer_t
21private
22      integer                       :: size
23      character(len=MAX_BUFF_SIZE)  :: str
24end type buffer_t
25
26public :: add_to_buffer
27public :: print_buffer, str, char, len
28public :: operator (.equal.)
29public :: buffer_nearly_full, reset_buffer
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  stop "wxml Buffer overflow: long unbroken string of pcdata or attribute value..."
101!  RETURN
102!
103endif
104
105buffer%str(n:n) = c
106end subroutine add_char_to_buffer
107
108!----------------------------------------------------------------
109subroutine add_str_to_buffer(s,buffer)
110character(len=*), intent(in)   :: s
111type(buffer_t), intent(inout)  :: buffer
112
113integer   :: n, len_s, last_pos
114
115len_s = len(s)
116last_pos = buffer%size
117buffer%size = buffer%size + len_s
118n = buffer%size
119
120if (n> MAX_BUFF_SIZE) then
121  stop "wxml Buffer overflow: long unbroken string of pcdata or attribute value..."
122!  RETURN
123endif
124
125buffer%str(last_pos+1:n) = s
126end subroutine add_str_to_buffer
127
128!----------------------------------------------------------------
129subroutine reset_buffer(buffer)
130type(buffer_t), intent(inout)  :: buffer
131
132buffer%size = 0
133
134end subroutine reset_buffer
135
136!----------------------------------------------------------------
137subroutine print_buffer(buffer)
138type(buffer_t), intent(in)  :: buffer
139
140integer :: i
141
142do i = 1, buffer%size
143      write(unit=6,fmt="(a1)",advance="no") buffer%str(i:i)
144enddo
145
146end subroutine print_buffer
147!----------------------------------------------------------------
148! This is better... but could it lead to memory leaks?
149!
150function buffer_to_str(buffer) result(str)
151type(buffer_t), intent(in)          :: buffer
152character(len=buffer%size)          :: str
153
154str = buffer%str(1:buffer%size)
155end function buffer_to_str
156
157!----------------------------------------------------------------
158function buffer_nearly_full(buffer) result(warn)
159type(buffer_t), intent(in)          :: buffer
160logical                             :: warn
161
162warn = buffer%size > BUFF_SIZE_WARNING
163
164end function buffer_nearly_full
165
166!----------------------------------------------------------------
167function buffer_length(buffer) result(length)
168type(buffer_t), intent(in)          :: buffer
169integer                             :: length
170
171length = buffer%size 
172
173end function buffer_length
174
175
176end module m_wxml_buffer
Note: See TracBrowser for help on using the repository browser.