PageRenderTime 6ms CodeModel.GetById 2ms app.highlight 1ms RepoModel.GetById 1ms app.codeStats 0ms

/test/lib/regular_expression/test_perl_syntax_01.e

http://github.com/tybor/Liberty
Specman e | 305 lines | 257 code | 16 blank | 32 comment | 30 complexity | 3e6331200187a6f114707a3c26c5b604 MD5 | raw file
  1-- This file is part of SmartEiffel The GNU Eiffel Compiler Tools and Libraries.
  2-- See the Copyright notice at the end of this file.
  3--
  4class TEST_PERL_SYNTAX_01
  5   --
  6   -- Testing regular expressions with perl syntax
  7   -- Input test file is from perl project (in perl-5.9.2.devel.tar.gz: perl-5.9.2/t/op/re_tests)
  8   -- It has been renamed as perl_re_tests
  9
 10insert
 11   EIFFELTEST_TOOLS
 12
 13create {}
 14   make
 15
 16feature {}
 17   print_extra_info: BOOLEAN False
 18
 19   comments_allowed: BOOLEAN True
 20
 21   print_ok: BOOLEAN False
 22
 23   print_error: BOOLEAN True
 24
 25   make
 26      local
 27         re_tests: TEXT_FILE_READ
 28      do
 29         pattern := ""
 30         input_text := ""
 31         matching_result := ""
 32         function := ""
 33         function_result := ""
 34         comment := ""
 35         from
 36            create re_tests.connect_to("perl_re_tests")
 37            if not re_tests.is_connected then
 38               io.put_string("Failed to open file re_tests.%N")
 39               crash
 40            end
 41            re_tests.read_line
 42         until
 43            re_tests.end_of_input
 44         loop
 45            line_number := line_number + 1
 46            if comments_allowed and then re_tests.last_string.has_prefix(once "--") then
 47               if print_extra_info then
 48                  io.put_string(once "Warning line skipped (comment): ")
 49                  io.put_integer(line_number)
 50                  io.put_new_line
 51               end
 52            else
 53               substitute_new_lines(re_tests.last_string)
 54               build_one_test(re_tests.last_string)
 55               run_test
 56            end
 57            re_tests.read_line
 58         end
 59         re_tests.disconnect
 60      end
 61
 62   substitute_new_lines (line: STRING)
 63      local
 64         pos: INTEGER
 65      do
 66         from
 67            pos := line.first_substring_index("\n")
 68         until
 69            pos = 0
 70         loop
 71            line.remove(pos)
 72            line.put('%N', pos)
 73            pos := line.first_substring_index("\n")
 74         end
 75      end
 76
 77   build_one_test (line: STRING)
 78      local
 79         first, last, i: INTEGER
 80      do
 81         from
 82            i := line_elements.lower
 83            first := 1
 84         until
 85            i >= line_elements.upper
 86         loop
 87            last := line.index_of('%T', first)
 88            if last = 0 then
 89               last := line.count + 1
 90            end
 91            line_elements.item(i).clear_count
 92            line_elements.item(i).append_substring(line, first, last - 1)
 93            first := last + 1
 94            i := i + 1
 95         end
 96         line_elements.last.clear_count
 97         if first <= line.count then
 98            line_elements.last.append_substring(line, first, line.count)
 99         end
100      end
101
102   run_test
103      local
104         factory: REGULAR_EXPRESSION_BUILDER; reg_exp: REGULAR_EXPRESSION
105      do
106         if pattern.first = '%'' then
107            pattern.remove_head(1)
108            from
109            until
110               pattern.last = '%''
111            loop
112               inspect
113                  pattern.last
114               when 'i' then
115                  factory.set_case_insensitive
116               when 'x' then
117                  factory.set_extended_legibility
118               when 'm' then
119                  factory.set_match_line_boundary
120               when 's' then
121                  factory.set_any_match_newline
122               end
123               pattern.remove_tail(1)
124            end
125            pattern.remove_tail(1)
126         end
127         reg_exp := factory.convert_perl_pattern(pattern)
128         if reg_exp = Void then
129            if not matching_result.is_equal(once "c") then
130               if print_error then
131                  io.put_string(once "Failed to understand pattern for line ")
132                  io.put_integer(line_number)
133                  io.put_new_line
134                  io.put_string(once "%TError is : %"")
135                  io.put_string(factory.last_error_message)
136                  io.put_string(once "%"%N")
137               end
138               assert(False)
139            else
140               if print_extra_info then
141                  if print_ok then
142                     io.put_string(once "Ligne OK: ")
143                     io.put_integer(line_number)
144                     io.put_string(once "%Terror message: ")
145                     io.put_string(factory.last_error_message)
146                     io.put_new_line
147                  end
148               end
149               assert(True)
150            end
151         else
152            if matching_result.is_equal(once "c") then
153               if print_error then
154                  io.put_string(once "Undetected syntax error for pattern line ")
155                  io.put_integer(line_number)
156                  io.put_new_line
157               end
158               assert(False)
159            elseif reg_exp.match(input_text) then
160               if matching_result.is_equal(once "n") then
161                  if print_error then
162                     io.put_string(once "Wrong match success for input line ")
163                     io.put_integer(line_number)
164                     io.put_new_line
165                  end
166                  assert(False)
167               else
168                  eval_perl_function(function, function_result, reg_exp, input_text)
169               end
170            elseif matching_result.is_equal(once "y") then
171               if print_error then
172                  io.put_string(once "Wrong match failure for input line ")
173                  io.put_integer(line_number)
174                  io.put_new_line
175               end
176               assert(False)
177            else
178               if print_extra_info then
179                  if print_ok then
180                     io.put_string(once "Ligne OK: ")
181                     io.put_integer(line_number)
182                     io.put_new_line
183                  end
184               end
185               assert(True)
186            end
187         end
188      end
189
190   eval_perl_function (perl_function, expected_result: STRING; reg_exp: REGULAR_EXPRESSION; text: STRING)
191      local
192         build_result, buffer: STRING; i: INTEGER
193      do
194         build_result := once ""
195         build_result.copy(perl_function)
196         buffer := once ""
197         -- $&
198         buffer.clear_count
199         reg_exp.append_pattern_text(text, buffer)
200         substitute(build_result, "$&", buffer)
201         -- $i
202         from
203            i := reg_exp.group_count.max(9)
204         until
205            i < 1
206         loop
207            buffer.clear_count
208            if i <= reg_exp.group_count and then reg_exp.ith_group_matched(i) then
209               reg_exp.append_ith_group(text, buffer, i)
210            end
211            --memory leak
212            substitute(build_result, once "$" + i.to_string, buffer)
213            i := i - 1
214         end
215         -- $-[i]
216         from
217            i := 0
218         until
219            i > reg_exp.group_count
220         loop
221            --memory leak
222            if reg_exp.ith_group_matched(i) then
223               substitute(build_result, once "$-[" + i.to_string + once "]", (reg_exp.ith_group_first_index(i) - 1).to_string)
224            else
225               substitute(build_result, once "$-[" + i.to_string + once "]", once "")
226            end
227            i := i + 1
228         end
229         -- $+[0]
230         from
231            i := 0
232         until
233            i > reg_exp.group_count
234         loop
235            --memory leak
236            if reg_exp.ith_group_matched(i) then
237               substitute(build_result, once "$+[" + i.to_string + once "]", reg_exp.ith_group_last_index(i).to_string)
238            else
239               substitute(build_result, once "$+[" + i.to_string + once "]", once "")
240            end
241            i := i + 1
242         end
243         if not expected_result.is_equal(build_result) then
244            if print_error then
245               io.put_string(once "Error in function evaluation for input line ")
246               io.put_integer(line_number)
247               io.put_string("%N%TFunction is: %"")
248               io.put_string(perl_function)
249               io.put_string(once "%"%N%TExpected is: %"")
250               io.put_string(expected_result)
251               io.put_string(once "%"%N%TFound result is: %"")
252               io.put_string(build_result)
253               io.put_string(once "%"%N")
254            end
255            assert(False)
256         else
257            if print_ok then
258               io.put_string(once "Ligne OK: ")
259               io.put_integer(line_number)
260               io.put_new_line
261            end
262            assert(True)
263         end
264      end
265
266   substitute (text, search, replacement: STRING)
267      local
268         pos: INTEGER
269      do
270         pos := text.first_substring_index(search)
271         if pos /= 0 then
272            text.replace_substring(replacement, pos, pos + search.count - 1)
273         end
274      end
275
276   line_number: INTEGER
277
278   pattern, input_text, matching_result, function, function_result, comment: STRING
279
280   line_elements: FAST_ARRAY[STRING]
281      require
282         pattern /= Void
283      once
284         Result := {FAST_ARRAY[STRING] << pattern, input_text, matching_result, function, function_result, comment >> }
285      end
286
287end -- class TEST_PERL_SYNTAX_01
288--
289-- ------------------------------------------------------------------------------------------------------------------------------
290-- Copyright notice below. Please read.
291--
292-- SmartEiffel is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License,
293-- as published by the Free Software Foundation; either version 2, or (at your option) any later version.
294-- SmartEiffel is distributed in the hope that it will be useful but WITHOUT ANY WARRANTY; without even the implied warranty
295-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have
296-- received a copy of the GNU General Public License along with SmartEiffel; see the file COPYING. If not, write to the Free
297-- Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
298--
299-- Copyright(C) 1994-2002: INRIA - LORIA (INRIA Lorraine) - ESIAL U.H.P.       - University of Nancy 1 - FRANCE
300-- Copyright(C) 2003-2006: INRIA - LORIA (INRIA Lorraine) - I.U.T. Charlemagne - University of Nancy 2 - FRANCE
301--
302-- Authors: Dominique COLNET, Philippe RIBET, Cyril ADRIAN, Vincent CROIZIER, Frederic MERIZEN
303--
304-- http://SmartEiffel.loria.fr - SmartEiffel@loria.fr
305-- ------------------------------------------------------------------------------------------------------------------------------