« back to all changes in this revision
Viewing changes to semantic/semantic-regtest.el
- browse files at revision 3
- compare with another revision
- download diff
- download tarball
- view history from revision 3
- Committer: Bazaar Package Importer
- Author(s): Masayuki Hatta (mhatta)
- Date: 2006-10-17 05:51:33 UTC
- mfrom: (2.1.1 dapper)
- Revision ID: james.westby@ubuntu.com-20061017055133-dlxjfrmuevx5p7uw
Tags: 1:1.0pre3-6
Made Depends to Pre-Depends in cedet-common. Let's see what happens.
- files added:
- PRERELEASE_CHECKLIST
- files removed:
- debian/speedbar.docs
- files modified:
- INSTALL
added
removed
semantic/semantic-regtest.el
4
4
5
5
;; Author: Klaus Berndl <klaus.berndl@sdm.de>
6
6
;; Keywords: syntax test
7
;; X-RCS: $Id: semantic-regtest.el,v 1.4 2003/11/20 04:11:34 zappo Exp $
7
;; X-RCS: $Id: semantic-regtest.el,v 1.5 2005/02/15 17:00:51 berndl Exp $
8
8
9
9
;; This file is not part of GNU Emacs.
10
10
37
37
;; - `semantic-regtest-cmp-results'
38
38
;; for a first description what this library can do with this respect.
39
39
;;
40
;; It should not be hard to run these functions from within a Makefile to
41
;; run all regression-tests in batch-mode - e.g. before releasing a new
42
;; release.
40
;; Because for each of these three commands a function *--internal exists
41
;; (which is meant to be used from within elisp) it should not be hard to
42
;; run these functions from within a Makefile to run all regression-tests
43
;; in batch-mode - e.g. before releasing a new release.
43
44
;;
44
45
;; 2. A new major-mode `semantic-regtest-mode' which is added to the
45
;; `auto-mode-alist' for files ending with "*.regtest.result' (e.g. the
46
;; command `semantic-regtest-run-test' creates autom. a result-file with
47
;; such a extension). This new major-mode makes a lot of stuff in the
48
;; result-file clickable - for details and keybindings see
49
;; `semantic-regtest-mode'.
50
;;
51
;;
52
;; Currently this code is tested with GNU Emacs 21.2 and CVS semantic v1p4
46
;; `auto-mode-alist' for files ending with "*.res' (e.g. the command
47
;; `semantic-regtest-run-test' creates autom. a result-file with such an
48
;; extension). This new major-mode makes a lot of stuff in the result-file
49
;; clickable - for details and keybindings see `semantic-regtest-mode'.
50
;;
51
;;
52
;; Currently this code is tested with GNU Emacs 21.X and the current CVS
53
;; cedet-suite
53
54
54
55
;;; TODO:
55
56
;;
56
57
;; - testing with XEmacs
57
;; - writing a new token-output-function which is used instead of
58
;; `semantic-prin1-nonterminal' and which produces a
59
;; token-structure-independent output-string so it can be used to run with
60
;; semantic 1.4.X and semantic 2.X and so test-runs between different
61
;; semantic-versions are possible.
62
58
;; - defining some constants, e.g. for the separtor-string " |###| " and some
63
59
;; other currently hard coded stuff.
64
60
;; - maybe using another parent-major-mode instead of `view-mode'?
75
71
:prefix "semantic-regtest-")
76
72
77
73
(defcustom semantic-regtest-functions
78
'(semantic-regtest-prin1-nonterminal)
74
'(semantic-regtest-prin1)
79
75
"*Functions used for the grammar/parser regression-test.
80
81
Every element must be a function which gets one token-argument and must return
82
a string which is the printed information about this token.
83
84
If nil then always `semantic-regtest-prin1-nonterminal' is used."
76
Every element must be a function which gets one tag-argument and must return
77
a string which is the printed information about this tag. The function must
78
take into accout the value of `semantic-regtest-print-tag-boundaries'.
79
80
If nil then always `semantic-format-tag-prin1' is used; then of course the
81
value of `semantic-regtest-print-tag-boundaries' is automatically considered."
85
82
:group 'semantic-regtest
86
83
:type '(repeat (function :tag "Regression-test function")))
87
84
88
(defcustom semantic-regtest-highlight-token t
89
"*Highlight token in the source-file.
90
91
This highlights the token jumped to by `semantic-regtest-open-source-file' or
85
(defcustom semantic-regtest-print-tag-boundaries nil
86
"*The generic regression-tag-format contains tag-boundaries.
87
88
The default-value is nil because normally it is not senseful to include
89
tag-boundaries into the printed generic tag-format because it prevents the
90
parsing check being independent from changing whitespace or comments in the
91
testfiles - which would not changing the tag-data itself but the
92
data-locations. But if this option is not nil then for each tag the
93
tag-boundaries are included in the output - if the tag is not positionless."
94
:group 'semantic-regtest
95
:type 'boolean)
96
97
(defcustom semantic-regtest-highlight-tag t
98
"*Highlight tag in the source-file.
99
This highlights the tag jumped to by `semantic-regtest-open-source-file' or
92
100
`semantic-regtest-mouse-open-source-file'."
93
101
:group 'semantic-regtest
94
102
:type 'boolean)
95
103
96
104
(defcustom semantic-regtest-find-file-function 'find-file-other-window
97
105
"*Displayfunction for the files of `semantic-regtest-mode'.
98
99
106
This function is used to display a file in a window if one of the commands of
100
107
`semantic-regtest-mode' is used. The function gets one argument - a filename -
101
108
and has to display this file in a window.
121
128
"*Face used to show clickable buttons for the reference file."
122
129
:group 'semantic-regtest)
123
130
131
;;;###autoload
132
(defun semantic-regtest-run-test ()
133
(interactive)
134
"Run a regression-test for a semantic-supported source-file.
135
The user will be asked for the file-name of that file for which the test
136
should be performed. If the current buffer is a semantic-supported buffer then
137
its file-name will be offered as default. For more details see the function
138
`semantic-regtest-run-test--internal'."
139
(let* ((source-file (if (semantic-active-p) (buffer-file-name)))
140
(file (read-file-name "Source-file: " nil source-file nil
141
(and source-file
142
(file-name-nondirectory source-file)))))
143
(if (semantic-regtest-run-test--internal file)
144
(message "Regressiontest fails - see the generated result-file for the diff!")
145
(message "Regressiontest succeeds - no differences to the reference-file!"))))
124
146
125
(defun semantic-regtest-run-test (test-source-file)
126
"Run a regression test for TEST-SOURCE-FILE and opens the result in another
127
window. If the regression-tests fails - i.e. if there are differences to the
128
reference-file - then the result will be displayed in another window with
129
active `semantic-regtest-mode'.
147
(defun semantic-regtest-run-test--internal (test-source-file)
148
"Run a regression test for TEST-SOURCE-FILE.
149
If the regression-tests fails - i.e. if there are differences to the
150
reference-file - then the generated result-file will be displayed in another
151
window with active `semantic-regtest-mode'.
130
152
131
153
`semantic-regtest-run-test' is a regression test function which uses all the
132
154
utility functions of this library to run a regression test for a source-file.
133
155
The function assumes the following dir- and file-structure:
134
156
- all files reside in the same subdir
135
- Name of the reference output-file: TEST-SOURCE-FILE.reference.output
136
(Must already be generated with `semantic-regtest-create-output'!)
137
- Name of the test output-file: TEST-SOURCE-FILE.regtest.output
138
(Will be generated with `semantic-regtest-create-output')
139
- Name of the result file of the test: TEST-SOURCE-FILE.regtest.result (Will
140
be generated with `semantic-regtest-cmp-results' by comparing
141
TEST-SOURCE-FILE.regtest.output with TEST-SOURCE-FILE.reference.output
157
- Name of the reference output-file: TEST-SOURCE-FILE.ro
158
\(Must already be generated with `semantic-regtest-create-output'!)
159
- Name of the test output-file: TEST-SOURCE-FILE.to
160
\(Will be generated with `semantic-regtest-create-output')
161
- Name of the result file of the test: TEST-SOURCE-FILE.res \(Will be
162
generated with `semantic-regtest-cmp-results' by comparing
163
TEST-SOURCE-FILE.to with TEST-SOURCE-FILE.ro.
142
164
143
165
Example for test.cpp:
144
- Reference output-file: test.cpp.reference.output
145
- Test output-file: test.cpp.regtest.output
146
- Result file of the regression-test: test.cpp.regtest.result
147
148
The format of the file TEST-SOURCE-FILE.regtest.result is described in
166
- Reference output-file: test.cpp.ro
167
- Test output-file: test.cpp.to
168
- Result file of the regression-test: test.cpp.res
169
170
Return nil if the are no differences in the test-outputs, i.e. if the test
171
succeeds. If the test fails \(i.e. there are differences between the
172
test-outputs) then the name of the generated result-file is returned.
173
174
The format of the file TEST-SOURCE-FILE.res is described at the command
149
175
`semantic-regtest-cmp-results'. Also how to interpret and use the file
150
TEST-SOURCE-FILE.regtest.result."
151
(interactive "FTest Sourcefile: ")
152
176
TEST-SOURCE-FILE.res."
153
177
(let* ((test-file (expand-file-name test-source-file))
154
(ref-output-file (concat test-file ".reference.output"))
155
(test-output-file (concat test-file ".regtest.output"))
156
(result-file (concat test-file ".regtest.result")))
178
(ref-output-file (concat test-file ".ro"))
179
(test-output-file (concat test-file ".to"))
180
(result-file (concat test-file ".res")))
157
181
;; opening the test source-file
158
182
(save-excursion
159
183
(set-buffer (find-file-noselect test-file))
160
184
;; generating the output of the grammar/parser test
161
(semantic-regtest-create-output test-output-file))
185
(semantic-regtest-create-output--internal test-output-file))
162
186
;; comparing with the reference output and writing a result-file.
163
(if (semantic-regtest-cmp-results test-file test-output-file
164
ref-output-file result-file)
187
(when (semantic-regtest-cmp-results--internal test-file test-output-file
188
ref-output-file result-file)
165
189
;; now opening the result file in `semantic-regtest-mode'
166
(find-file-other-window result-file)
167
(message "Regressiontest succeeds - no differences to the reference-file!"))))
168
169
190
(find-file-other-window result-file)
191
result-file)))
192
193
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: These pure utility-function should
194
;; be placed elsewhere!
195
(defun semantic-regtest-excessive-trim (str)
196
"Return a string where all double-and-more whitespaces in STR are replaced
197
with a single space-character."
198
(let ((s str))
199
(save-match-data
200
(while (string-match "[ \t][ \t]+" s)
201
(setq s (concat (substring s 0 (match-beginning 0))
202
" "
203
(substring s (match-end 0))))))
204
s))
205
206
(defun semantic-regtest-normalize-whitespace (text)
207
"Replace all newlines with one single space and run the function
208
`semantic-regtest-excessive-trim' onto the result."
209
(semantic-regtest-excessive-trim (subst-char-in-string ?\n 32 text)))
210
211
212
;;;###autoload
213
(defun semantic-regtest-create-output ()
214
"Creates the test-output for the current buffer.
215
The user will be asked for the file-name of the created test-output-file \(see
216
`semantic-regtest-create-output--internal')."
217
(interactive)
218
(let ((file (if (file-exists-p (concat (buffer-file-name) ".ro"))
219
(concat (buffer-file-name) ".to")
220
(concat (buffer-file-name) ".ro"))))
221
(setq file (read-file-name "Test-output: " nil file nil
222
(file-name-nondirectory file)))
223
(semantic-regtest-create-output--internal file)))
170
224
171
(defun semantic-regtest-create-output (file &optional with-location-info)
172
"Runs the functions in `semantic-regtest-functions' \(if nil then
173
`semantic-prin1-nonterminal' is used) on every token in current buffer and
174
writes the output to FILE. This gives a regression-able test of a
175
grammar/parser because you can run this function on a testfile F before
176
grammar-changes and after grammar-changes and compare the two output-files
177
with diff.
178
179
IMPORTANT: ALL information about a token is written in ONE line. This is for
225
226
(defun semantic-regtest-create-output--internal (test-output-file)
227
"Runs the functions in `semantic-regtest-functions' on every tag in current
228
buffer and writes the output to TEST-OUTPUT-FILE. This gives a regression-able
229
test of a grammar/parser because this function can run on a testfile F before
230
grammar-changes and after grammar-changes and after that the two output-files
231
can be compared with a tool like diff \(but recommended is to use
232
`semantic-regtest-cmp-results').
233
234
IMPORTANT: ALL information about a tag is written in ONE line. This is for
180
235
better comparsion with line-oriented tools like diff. The format of a line is:
181
236
182
<token-name> |###| <token-type> |###| <full token-text> |###|
237
<tag-name> |###| <tag-type> |###| <full tag-text> |###|
183
238
<output of print-function-1> |###| <output of print-function-2> |###|
184
239
... |###|
185
240
186
whereas <output of print-function-1> is \"<print-function-1>: <print-text>\"
187
188
Return the number of tokens.
189
190
Normally the position-informations in form of the #<overlay from X to Y> are
191
filtered out by this function so the parsing check is independent from
192
changing whitespace or comments in the testfiles - which would not changing
193
the token-data itself but the data-locations. But if WITH-LOCATION-INFO is not
194
nil \(i.e. if called with a prefix arg) the location-informations of the
195
token-data are preserved also in the outputfile - in form of
196
\[<token-start> <token-end>]."
197
(interactive "FInsert file-name for test-output: \nP")
241
whereas <tag-name>, <full tag-text> and <output of print-function-X> are
242
normalized concerning whitespace \(`semantic-regtest-normalize-whitespace'),
243
<output of print-function-1> is \"<print-function-1>: <print-text>\" whereas
244
<print-function-X> is part of `semantic-regtest-functions'.
245
246
Return the number of tags."
198
247
(goto-char (point-min))
199
248
(let ((buf (get-buffer-create "*Semantic regression test*"))
200
249
(test-functions (or semantic-regtest-functions
201
'(semantic-prin1-nonterminal)))
202
(token-counter 0)
203
token token-extend token-text output-str)
250
'(semantic-format-tag-prin1)))
251
(tag-counter 0)
252
tag tag-extend tag-text output-str)
204
253
254
(unless (semantic-active-p)
255
(error "Sorry, regression-test are only possible for semantic supported sources!"))
256
205
257
;; clean the output buffer
206
258
(save-excursion
207
259
(set-buffer buf)
208
260
(erase-buffer))
209
261
210
;; reparse the whole source-buffer
211
(semantic-bovinate-toplevel t)
262
;; reparse the whole source-buffer so we have fresh-parsed tags
263
(semantic-fetch-tags)
212
264
213
;; print out the token informations of all tokens. IMPORTANT: ALL
214
;; information about a token is written in ONE line. This is for better
265
;; print out the tag informations of all tags. IMPORTANT: ALL
266
;; information about a tag is written in ONE line. This is for better
215
267
;; comparsion with line-oriented tools like diff.
216
268
;; The format of a line is:
217
;; <token-name> |###| <full token-text> |###| <output of print-function-1>
269
;; <tag-name> |###| <full tag-text> |###| <output of print-function-1>
218
270
;; |###| <output of print-function-2> |###| ... |###|
219
271
;; whereas <output of print-function-1> is "<print-function-1>: <print-text>"
220
272
;; (all in one single line without linebreaks!)
221
273
222
(while (setq token (semantic-find-nonterminal-by-overlay-next))
223
(setq token-counter (1+ token-counter))
224
(if (not (semantic-token-with-position-p token))
225
(setq token-text "This is a positionless token")
226
(setq token-extend (semantic-token-extent token))
227
(setq token-text (buffer-substring-no-properties (nth 0 token-extend)
228
(nth 1 token-extend))))
229
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: maybe we should use a more
230
;; unique separator than " |###| "
274
(while (setq tag (semantic-find-tag-by-overlay-next))
275
(setq tag-counter (1+ tag-counter))
276
(if (not (semantic-tag-with-position-p tag))
277
(setq tag-text "This is a positionless tag")
278
(setq tag-extend (semantic-tag-bounds tag))
279
(setq tag-text (buffer-substring-no-properties (nth 0 tag-extend)
280
(nth 1 tag-extend))))
231
281
(setq output-str (format "%s |###| %s |###| %s |###|"
232
(semantic-token-name token)
233
(symbol-name (semantic-token-token token))
234
(subst-char-in-string ?\n 32 token-text)))
282
;; we have to normalize also the whitespace of
283
;; a tag-name because because there is nowhere
284
;; forbidden that a tag-name can contain spaces
285
;; or newlines (e.g. the python-parser produces
286
;; such tag-names)
287
(semantic-regtest-normalize-whitespace
288
(semantic-tag-name tag))
289
(symbol-name (semantic-tag-class tag))
290
;; to make testresults whitespace-independend
291
;; we remove all newlines and then we trim all
292
;; spaces to exactly one space
293
(semantic-regtest-normalize-whitespace tag-text)))
294
235
295
(dolist (fnc test-functions)
236
296
(setq output-str
237
297
(concat output-str (format " %s: %s |###|"
238
298
(symbol-name fnc)
239
(funcall fnc token)))))
240
(save-excursion
299
;; we normalize the whitespace of the
300
;; returned string because there can
301
;; be tags with a tagname which
302
;; contains spaces or newlines (e.g.
303
;; with python)
304
(semantic-regtest-normalize-whitespace
305
(funcall fnc tag))))))
306
(save-excursion
241
307
(set-buffer buf)
242
308
(goto-char (point-max))
243
309
(insert output-str)
244
310
(insert "\n"))
245
(goto-char (semantic-token-start token)))
311
(goto-char (semantic-tag-start tag)))
246
312
247
;; write the generated token-informations into FILE
313
;; write the generated tag-informations into TEST-OUTPUT-FILE
248
314
(save-excursion
249
315
(set-buffer buf)
250
316
;; maybe removing the overlay-positions
251
317
(goto-char (point-min))
252
(if with-location-info
318
(if semantic-regtest-print-tag-boundaries
253
319
(while (re-search-forward
254
320
"#<overlay from \\([0-9]+\\) to \\([0-9]+\\) in [^>]+>"
255
321
nil t)
257
323
(while (re-search-forward "#<overlay from [0-9]+ to [0-9]+ in [^>]+>"
258
324
nil t)
259
325
(replace-match "[Location info filtered out]")))
260
(write-region (point-min) (point-max) file))
326
(write-region (point-min) (point-max) test-output-file))
261
327
262
328
;; clean up
263
329
(kill-buffer buf)
264
330
(goto-char (point-min))
265
331
266
;; return number of printed tokens
267
token-counter))
332
;; return number of printed tags
333
tag-counter))
268
334
269
335
(defun semantic-regtest-convert-difference (buffer start end)
270
336
"Parse the diff-difference located in BUFFER between START and END. Cause of
271
337
the facts that each line in the output of `semantic-regtest-create-output'
272
represents exactly one token and \[START, END] always define a
273
set of complete lines of BUFFER \(and therefore a set of token-outputs) the
338
represents exactly one tag and \[START, END] always define a
339
set of complete lines of BUFFER \(and therefore a set of tag-outputs) the
274
340
text between START and END can be splitted in lines and each of these lines is
275
341
splitted by the separator \" |###| \".
276
342
277
343
Result is either nil \(if START = END) or a list of sublists whereas each
278
sublist represents one line resp. token between START and END and consist
344
sublist represents one line resp. tag between START and END and consist
279
345
therefore of the following elements:
280
0. token-number of token in the test-file (= line-number in the test-file)
281
1. name of the token
282
2. type of the token \(function, variable, type, include etc...)
283
3. the complete token text
284
4. the token-string of the first token-print-function. This string looks like
285
\"<print-function>: <print-output>\", e.g. \"semantic-prin1-nonterminal:
346
0. tag-number of tag in the test-file (= line-number in the test-file)
347
1. name of the tag
348
2. type of the tag \(function, variable, type, include etc...)
349
3. the complete tag text
350
4. the tag-string of the first tag-print-function. This string looks like
351
\"<print-function>: <print-output>\", e.g. \"semantic-format-tag-prin1:
286
352
\(\\\"c++-test.hh\\\" include nil nil nil \[Location info filtered out])\"
287
\(all output of a token is in one line - no linebreaks!)
288
5. the token-string of the second token-print-function
353
\(all output of a tag is in one line - no linebreaks!)
354
5. the tag-string of the second tag-print-function
289
355
6. ...
290
356
If a list then every sublist contains at least 5 elements \(0. to 4.)."
291
357
(and (not (= start end))
306
372
(nreverse result)))))
307
373
308
374
;; The following two function are examples how to print the data of one
309
;; diff-difference (can contain data for more than 1 line (resp. token)!).
375
;; diff-difference (can contain data for more than 1 line (resp. tag)!).
310
376
(defun semantic-regtest-1-diffdata2str (diff-data file &optional prefix)
311
377
"Convert the data of DIFF-DATA into a suitable string-representation where
312
378
each element of DIFF-DATA is separated by a newline within this string. PREFIX
315
381
(dolist (elem diff-data output-str)
316
382
(setq output-str
317
383
(concat output-str
318
(format "%s%s (token-type: %s, [%d. token of %s file])\n"
384
(format "%s%s (tag-type: %s, [%d. tag of %s file])\n"
319
385
(or prefix
320
386
"")
321
387
(nth 1 elem) (nth 2 elem) (nth 0 elem) file))))))
325
391
"Convert the data of A-DIFF-DATA into a suitable string-representation by
326
392
comparing each elem of A-DIFF-DATA with the related elem of B-DIFF-DATA where
327
393
each element of A-DIFF-DATA is printed by two lines whereas the first line
328
contains the token-name of the A-DIFF-DATA-elem and the token-numbers and the
394
contains the tag-name of the A-DIFF-DATA-elem and the tag-numbers and the
329
395
second line contains the kind of difference between the two elements \(
330
different token-name, token-type, token-text and/or token-output). PREFIX is
396
different tag-name, tag-type, tag-text and/or tag-output). PREFIX is
331
397
the prefix for the first line of such a two-line-block - the second line gets
332
398
a prefix with same length as PREFIX but filled with spaces.
333
399
340
406
(dolist (elem a-diff-data str)
341
407
(setq str
342
408
(concat str
343
(format "%s%s (type: %s, [%d. token of test file], [%d. token of reference file])\n"
409
(format "%s%s (type: %s, [%d. tag of test file], [%d. tag of reference file])\n"
344
410
(or prefix
345
411
"")
346
412
(nth 1 elem)
351
417
(make-string (length prefix) 32)
352
418
(if (not (string= (nth 1 elem)
353
419
(nth 1 (car b-diff-data-copy))))
354
"Different token-name, "
420
"Different tag-name, "
355
421
"")
356
422
(if (not (string= (nth 2 elem)
357
423
(nth 2 (car b-diff-data-copy))))
358
"Different token-type, "
424
"Different tag-type, "
359
425
"")
360
426
(if (not (string= (nth 3 elem)
361
427
(nth 3 (car b-diff-data-copy))))
362
"Different token-text, "
428
"Different tag-text, "
363
429
"")
364
430
(if (not (string= (nth 4 elem)
365
431
(nth 4 (car b-diff-data-copy))))
366
"Different token-output"
432
"Different tag-output"
367
433
""))))
368
434
(setq b-diff-data-copy (cdr b-diff-data-copy))))))
369
435
375
441
376
442
What is the \"semantic\" of such a difference-result-vector:
377
443
378
If \(a-start = a-end) Then lines \(= tokens) between b-start and b-end of
444
If \(a-start = a-end) Then lines \(= tags) between b-start and b-end of
379
445
FILE-B are missed in FILE-A
380
ElseIf \(b-start = b-end) Then lines \(= tokens between a-start and a-end are
446
ElseIf \(b-start = b-end) Then lines \(= tags between a-start and a-end are
381
447
new in FILE-A (missed in the FILE-B)
382
Else lines \(= tokens between a-start and a-end are parsed differently.
448
Else lines \(= tags between a-start and a-end are parsed differently.
383
449
384
450
If there are no differences between FILE-A and FILE-B then nil is returned."
385
451
(require 'ediff)
402
468
(cdr (ediff-extract-diffs ediff-diff-buffer nil nil))))
403
469
404
470
405
(defun semantic-regtest-cmp-results (source-file
406
test-file
407
ref-file
408
result-file
409
&optional use-full-path-name)
410
"Compare TEST-FILE and REF-FILE and write the results in proper format to
411
RESULT-FILE. SOURCE-FILE is only used to write it into RESULT-FILE.
412
413
Return nil if there no differences between TEST-FILE and REF-FILE otherwise
414
return not nil.
471
;;;###autoload
472
(defun semantic-regtest-cmp-results (&optional use-full-path-name)
473
"Compare two test-outputs and create a suitable formatted result-file.
474
475
The user will be asked for four file-names:
476
477
SOURCE-FILE: The underlying source-file for which the test-outputs have
478
been created. If current buffer is a semantic-supported buffer then the
479
file-name of the current buffer is offered as default.
480
481
TEST-FILE: The regression-testoutput for SOURCE-FILE. It must be an already
482
existing file which has been created by `semantic-regtest-create-output' or
483
the function `semantic-regtest-create-output--internal'. If a file
484
SOURCE-FILE.to exists already in current directory then this file is
485
offered as default.
486
487
REF-FILE: The reference testoutput for SOURCE-FILE. TEST-FILE will be
488
compared against this file. It must be an already existing file which has
489
been created by the command `semantic-regtest-create-output' or the
490
function `semantic-regtest-create-output--internal'. If a file
491
SOURCE-FILE.ro exists already in current directory then this file is
492
offered as default.
493
494
RESULT-FILE: That file will contain the comparisson-result generated by
495
`semantic-regtest-cmp-results--internal'. Per default the filename
496
SOURCE-FILE.res is offered.
497
498
This command calls `semantic-regtest-cmp-results--internal' with that four
499
file-names. See this function for details about the optional argument
500
`use-full-path-name' and a description of the format of RESULT-FILE."
501
(interactive "P")
502
(let* ((source-file (if (semantic-active-p) (buffer-file-name)))
503
(test-file (and source-file
504
(file-exists-p (concat source-file ".to"))
505
(concat source-file ".to")))
506
(ref-file (and source-file
507
(file-exists-p (concat source-file ".ro"))
508
(concat source-file ".ro")))
509
(result-file (and source-file (concat source-file ".res"))))
510
(setq source-file (read-file-name "Source-file: " nil source-file nil
511
(and source-file
512
(file-name-nondirectory source-file))))
513
(setq test-file (read-file-name "Test-output: " nil test-file nil
514
(and test-file
515
(file-name-nondirectory test-file))))
516
(setq ref-file (read-file-name "Reference-output: " nil ref-file nil
517
(and ref-file
518
(file-name-nondirectory ref-file))))
519
(setq result-file (read-file-name "Test-result: " nil result-file nil
520
(and result-file
521
(file-name-nondirectory result-file))))
522
(semantic-regtest-cmp-results--internal source-file test-file ref-file
523
result-file use-full-path-name)))
524
525
526
(defun semantic-regtest-cmp-results--internal (source-file
527
test-file
528
ref-file
529
result-file
530
&optional use-full-path-name)
531
"Compare TEST-FILE and REF-FILE and write the results to RESULT-FILE.
532
533
SOURCE-FILE is only used to write the file-name into RESULT-FILE.
534
535
Return nil if there are no differences between TEST-FILE and REF-FILE
536
otherwise return not nil.
415
537
416
538
Format of RESULT-FILE is:
417
539
422
544
Test output file: TEST-FILE
423
545
Reference file: REF-FILE
424
546
425
<Here are listed all token-parsing differences: This can be missed tokens
426
\(i.e. token which are only in REF-FILE), new tokens \(token which are only in
427
TEST-FILE) and differently parsed tokens. Each type can occur multiple times
547
<Here are listed all tag-parsing differences: This can be missed tags
548
\(i.e. tag which are only in REF-FILE), new tags \(tag which are only in
549
TEST-FILE) and differently parsed tags. Each type can occur multiple times
428
550
and the sequence follows the original sequence of the differences detected by
429
551
the ediff-comparison>
430
552
------------------------------------------------------------------------
431
553
432
554
If USE-FULL-PATH-NAME is nil then these three filesnames are without
433
path-information because normally all four files \(SOURCE-FILE TEST-FILE
555
path-informations because normally all four files \(SOURCE-FILE TEST-FILE
434
556
REF-FILE and RESULT-FILE) should reside in the same directory so the path-info
435
557
is not needed to open these files from within `semantic-regtest-mode'. If
436
558
USE-FULL-PATH-NAME is not nil \(called with a prefix arg) filenames include
439
561
How to interpret and use the created RESULT-FILE:
440
562
441
563
For all differences reported in RESULT-FILE the number N of the each missed,
442
new or differently parsed token is printed out. With this number you can
443
- use `semantic-regtest-goto-token' to jump to the N-th token in the
444
source-file for which TEST-FILE is generated to check the token in the
564
new or differently parsed tag is printed out. With this number you can
565
- use `semantic-regtest-goto-tag' to jump to the N-th tag in the
566
source-file for which TEST-FILE is generated to check the tag in the
445
567
source-code
446
568
- use `goto-line' to go to the N-th line in either TEST-FILE or REF-FILE to
447
check the output of `semantic-regtest-create-output' for this token."
448
449
(interactive "FSource-file: \nFTest output file: \nFReference file: \nFResult file: \nP")
450
569
check the output of `semantic-regtest-create-output' for this tag.
570
- Open the file in `semantic-regtest-mode' and use the offered buttons and
571
keybindings."
451
572
(let ((diff-result (semantic-regtest-ediff test-file ref-file))
452
573
(test-buffer (find-file-noselect (expand-file-name test-file)))
453
574
(ref-buffer (find-file-noselect (expand-file-name ref-file)))
490
611
;; this is not a problem, because we have all data we need in the
491
612
;; a-diff-data resp. b-diff-data.
492
613
493
(cond ((null a-diff-data) ;; tokens are missed
614
(cond ((null a-diff-data) ;; tags are missed
494
615
(setq output-str
495
(concat "These tokens are only in the reference file:\n"
616
(concat "These tags are only in the reference file:\n"
496
617
(semantic-regtest-1-diffdata2str b-diff-data
497
618
"reference"
498
619
"- "))))
499
((null b-diff-data) ;; tokens are new
620
((null b-diff-data) ;; tags are new
500
621
(setq output-str
501
(concat "These tokens are only in the test file:\n"
622
(concat "These tags are only in the test file:\n"
502
623
(semantic-regtest-1-diffdata2str a-diff-data
503
624
"test"
504
625
"+ "))))
505
(t ;; token are parsed differently
626
(t ;; tag are parsed differently
506
627
;; if a-diff-data and b-diff-data contain the same number of
507
;; elements then we can compare the tokens of a-diff-data and
628
;; elements then we can compare the tags of a-diff-data and
508
629
;; b-diff-data on a pair-basis. Otherwise we simply list the
509
;; tokens of a-diff-data and then the tokens of b-diff-data.
630
;; tags of a-diff-data and then the tags of b-diff-data.
510
631
(if (= (length a-diff-data) (length b-diff-data))
511
632
(setq output-str
512
(concat "These tokens are parsed differently:\n"
633
(concat "These tags are parsed differently:\n"
513
634
(semantic-regtest-2-diffdata2str a-diff-data
514
635
b-diff-data
515
636
"* ")))
516
637
(setq output-str
517
(concat "These token of a the test- and the reference-file are parsed differently:\n"
638
(concat "These tag of a the test- and the reference-file are parsed differently:\n"
518
639
(semantic-regtest-1-diffdata2str a-diff-data
519
640
"test"
520
641
"-t- ")
530
651
(kill-buffer ref-buffer)
531
652
diff-result))
532
653
533
(defun semantic-regtest-goto-token (token-number)
534
"Jump to the token with number TOKEN-NUMBER in current buffer. Counting
535
starts always at the beginning of current buffer.
654
(defun semantic-regtest-goto-tag (tag-number)
655
"Jump to the tag with number TAG-NUMBER in current buffer.
656
Counting starts always at the beginning of current buffer.
536
657
537
658
This function can be used for fast and easy jumping to the differences
538
659
reported by `semantic-regtest-cmp-results'."
539
(interactive "nNumber of token to jump: ")
660
(interactive "nNumber of tag to jump: ")
540
661
(goto-char (point-min))
541
(let ((token-counter 0)
542
token)
543
(while (and (< token-counter token-number)
544
(setq token (semantic-find-nonterminal-by-overlay-next)))
545
(setq token-counter (1+ token-counter))
546
(goto-char (semantic-token-start token)))))
662
(let ((tag-counter 0)
663
tag)
664
(while (and (< tag-counter tag-number)
665
(setq tag (semantic-find-tag-by-overlay-next)))
666
(setq tag-counter (1+ tag-counter))
667
(goto-char (semantic-tag-start tag)))))
547
668
548
669
549
670
;; ------ code for the new major-mode semantic-regtest-mode -----------------
562
683
563
684
(defun semantic-regtest-open-source-file ()
564
685
"Open the source-file of this button in another window. If the button is a
565
token-number then jump also to this token."
686
tag-number then jump also to this tag."
566
687
(interactive)
567
688
(semantic-regtest-goto-file 'source))
568
689
569
690
(defun semantic-regtest-open-output-file ()
570
691
"Open the output-file of this button in another window. If the button is a
571
token-number then jump also to this line in the output-file."
692
tag-number then jump also to this line in the output-file."
572
693
(interactive)
573
694
(semantic-regtest-goto-file 'output))
574
695
578
699
TYPE can be one of the symbols `output' or `source'. In case of the former one
579
700
it tries to open the right output-file in the other-window and tries to jump
580
701
to the right line. In case of the latter one it opens the source-file in the
581
other window and tries to jump to the right token."
702
other window and tries to jump to the right tag."
582
703
(let ((file (if (equal type 'output)
583
704
(or (get-text-property (point)
584
705
'semantic-regtest-mode-test-file)
586
707
'semantic-regtest-mode-ref-file))
587
708
(get-text-property (point)
588
709
'semantic-regtest-mode-source-file)))
589
(token-number (ignore-errors
710
(tag-number (ignore-errors
590
711
(string-to-number
591
712
(get-text-property
592
713
(point)
593
'semantic-regtest-mode-token-number)))))
714
'semantic-regtest-mode-tag-number)))))
594
715
(when file
595
716
(message "Opening file: %s" (file-name-nondirectory file))
596
717
(funcall semantic-regtest-find-file-function file)
597
(when token-number
718
(when tag-number
598
719
(if (equal type 'output)
599
(goto-line token-number)
600
(semantic-regtest-goto-token token-number)
601
(if semantic-regtest-highlight-token
602
(semantic-momentary-highlight-token
603
(semantic-current-nonterminal))))))))
720
(goto-line tag-number)
721
(semantic-regtest-goto-tag tag-number)
722
(if semantic-regtest-highlight-tag
723
(semantic-momentary-highlight-tag
724
(semantic-current-tag))))))))
604
725
605
726
606
727
(defun semantic-regtest-mode-init ()
607
"Initializes `semantic-regtest-mode'. This means making all token-numbers
728
"Initializes `semantic-regtest-mode'. This means making all tag-numbers
608
729
and the source-file, the test output file and the reference file clickable."
609
730
(let ((buffer-read-only nil)
610
731
regtest-mode-source-file
621
742
(1+ (match-end 1))
622
743
`(mouse-face
623
744
highlight
745
help-echo
746
,(format "Mouse-2 opens the file %s"
747
regtest-mode-source-file)
624
748
face
625
749
semantic-regtest-test-button-face
626
750
semantic-regtest-mode-source-file
634
758
(1+ (match-end 1))
635
759
`(mouse-face
636
760
highlight
761
help-echo
762
,(format "Mouse-1 opens the file %s"
763
regtest-mode-test-file)
637
764
face
638
765
semantic-regtest-test-button-face
639
766
semantic-regtest-mode-test-file
647
774
(1+ (match-end 1))
648
775
`(mouse-face
649
776
highlight
777
help-echo
778
,(format "Mouse-1 opens the file %s"
779
regtest-mode-ref-file)
650
780
face
651
781
semantic-regtest-reference-button-face
652
782
semantic-regtest-mode-ref-file
653
783
,regtest-mode-ref-file)))
654
784
(error "No reference-file file found in the regtest result!"))
655
785
656
;; now make all token-numbers clickable
786
;; now make all tag-numbers clickable
657
787
658
788
(goto-char (point-min))
659
(while (re-search-forward "\\([0-9]+\\)\\. token of test file" nil t)
789
(while (re-search-forward "\\([0-9]+\\)\\. tag of test file" nil t)
660
790
(add-text-properties (1- (match-beginning 0))
661
791
(1+ (match-end 0))
662
792
`(mouse-face
663
793
highlight
794
help-echo
795
,(format "Mouse-1 jumps to line %s in %s, mouse-2 jumps to this tag in %s"
796
(match-string 1) regtest-mode-test-file
797
regtest-mode-source-file)
664
798
face
665
799
semantic-regtest-test-button-face
666
semantic-regtest-mode-token-number
800
semantic-regtest-mode-tag-number
667
801
,(match-string 1)
668
802
semantic-regtest-mode-source-file
669
803
,regtest-mode-source-file
671
805
,regtest-mode-test-file))
672
806
)
673
807
(goto-char (point-min))
674
(while (re-search-forward "\\([0-9]+\\)\\. token of reference file" nil t)
808
(while (re-search-forward "\\([0-9]+\\)\\. tag of reference file" nil t)
675
809
(add-text-properties (1- (match-beginning 0))
676
810
(1+ (match-end 0))
677
811
`(mouse-face
678
812
highlight
813
help-echo
814
,(format "Mouse-1 jumps to line %s in %s"
815
(match-string 1) regtest-mode-ref-file)
679
816
face
680
817
semantic-regtest-reference-button-face
681
semantic-regtest-mode-token-number
818
semantic-regtest-mode-tag-number
682
819
,(match-string 1)
683
820
semantic-regtest-mode-ref-file
684
821
,regtest-mode-ref-file))
690
827
(define-derived-mode semantic-regtest-mode
691
828
view-mode "se-re-te"
692
829
"Major mode for viewing result files of semantic regression tests. The main
693
purpose of this mode is to make all token-numbers and the source-file, the
830
purpose of this mode is to make all tag-numbers and the source-file, the
694
831
test output file and the reference file clickable.
695
832
\\{semantic-regtest-mode-map}"
696
833
(semantic-regtest-mode-init))
714
851
'semantic-regtest-open-source-file)
715
852
716
853
717
;; adding result-files to the auto-mode-alist
718
(setq auto-mode-alist
719
(append '(("\\.regtest\\.result\\'" . semantic-regtest-mode))
720
auto-mode-alist))
854
;; adding reference- and regtest-output- and result-files to the
855
;; auto-mode-alist. We open the *.to and *.ro-files in text-mode to avoid
856
;; parsing this files by semantic.
857
(setq auto-mode-alist (append '(("\\.res\\'" . semantic-regtest-mode))
858
auto-mode-alist))
859
(setq auto-mode-alist (append '(("\\.to\\'" . text-mode)) auto-mode-alist))
860
(setq auto-mode-alist (append '(("\\.ro\\'" . text-mode)) auto-mode-alist))
721
861
722
862
723
863
;;; Generic format
724
;;
725
;; Most tags have data in them unrelated to the details parsed out of
726
;; a file. Remove that, and format them in a simple way.
727
728
;; some code if this library runs with semantic 1.4
729
(or (fboundp 'semantic-tag-name)
730
(defun semantic-tag-name (tag)
731
"See semantic 2.X for a description of this function."
732
(car tag)))
733
734
(or (fboundp 'semantic-tag-class)
735
(defun semantic-tag-class (tag)
736
"See semantic 2.X for a description of this function."
737
(nth 1 tag)))
738
739
(or (fboundp 'semantic-tag-attributes)
740
(defun semantic-tag-attributes (tag)
741
"See semantic 2.X for a description of this function."
742
(nth 2 tag)))
743
744
(or (fboundp 'semantic-tag-p)
745
(defun semantic-tag-p (tag)
746
"See semantic 2.X for a description of this function."
747
(and (consp tag)
748
(stringp (car tag))
749
(symbolp (nth 1 tag)) (nth 1 tag)
750
(listp (nth 2 tag))
751
(listp (nth 3 tag))
752
)))
753
754
(or (fboundp 'semantic-tag-make-plist)
755
(defun semantic-tag-make-plist (args)
756
"See semantic 2.X for a description of this function."
757
(let (plist key val)
758
(while args
759
(setq key (car args)
760
val (nth 1 args)
761
args (nthcdr 2 args))
762
(or (null key)
763
(overlayp key)
764
(overlayp val)
765
(member val '("" nil))
766
(and (numberp val) (zerop val))
767
(setq plist (cons key (cons val plist)))))
768
;; It is not useful to reverse the new plist.
769
plist)))
770
771
(or (fboundp 'semantic-tag)
772
(defun semantic-tag (name class &rest attributes)
773
"See semantic 2.X for a description of this function."
774
(list name class (semantic-tag-make-plist attributes) nil nil)))
775
776
(or (fboundp 'semantic-tag-new-variable)
777
(defun semantic-tag-new-variable (name type default-value &rest attributes)
778
"See semantic 2.X for a description of this function."
779
(apply 'semantic-tag name 'variable
780
:type type
781
:default-value default-value
782
attributes)))
783
784
(or (fboundp 'semantic-tag-new-function)
785
(defun semantic-tag-new-function (name type arg-list &rest attributes)
786
"See semantic 2.X for a description of this function."
787
(apply 'semantic-tag name 'function
788
:type type
789
:arguments arg-list
790
attributes)))
791
792
(or (fboundp 'semantic-tag-new-type)
793
(defun semantic-tag-new-type (name type members parents &rest attributes)
794
"See semantic 2.X for a description of this function."
795
(apply 'semantic-tag name 'type
796
:type type
797
:members members
798
:superclasses (car parents)
799
:interfaces (cdr parents)
800
attributes)))
801
802
(or (fboundp 'semantic-tag-new-include)
803
(defun semantic-tag-new-include (name system-flag &rest attributes)
804
"See semantic 2.X for a description of this function."
805
(apply 'semantic-tag name 'include
806
:system-flag system-flag
807
attributes)))
808
809
(or (fboundp 'semantic-tag-new-package)
810
(defun semantic-tag-new-package (name detail &rest attributes)
811
"See semantic 2.X for a description of this function."
812
(apply 'semantic-tag name 'package
813
:detail detail
814
attributes)))
815
816
(or (fboundp 'semantic-tag-new-code)
817
(defun semantic-tag-new-code (name detail &rest attributes)
818
"See semantic 2.X for a description of this function."
819
(apply 'semantic-tag name 'code
820
:detail detail
821
attributes)))
822
823
824
(defconst semantic-regtest-new-tag-alist
825
'((type . semantic-tag-new-type)
826
(function . semantic-tag-new-function)
827
(variable . semantic-tag-new-variable)
828
(include . semantic-tag-new-include)
829
(package . semantic-tag-new-package)
830
(code . semantic-tag-new-code)))
831
832
(defun semantic-regtest-convert-tag-14-to-20 (tag)
833
(if (semantic-token-p tag)
834
(let ((token-name (semantic-token-name tag))
835
(tag-creation-fcn (cdr (assoc (semantic-token-token tag)
836
semantic-regtest-new-tag-alist))))
837
(if tag-creation-fcn
838
(apply tag-creation-fcn token-name (cdr (cdr tag)))
839
;; there is no predefined tag-creation function, so we use the generic
840
;; one.
841
(semantic-tag token-name (semantic-token-token tag)
842
(cdr (cdr tag)))))
843
tag))
844
864
845
865
(defun semantic-regtest-convert-tag-table (table)
846
866
"Convert the tag table TABLE to a generic format."
847
867
(mapcar #'semantic-regtest-convert-tag table))
848
868
849
869
(defun semantic-regtest--convert-tag (tag)
850
"Convert TAG into a generic format.
851
Recurses over children when they are found."
852
(let* ((version-2 (not (semantic-require-version 2 0 1)))
853
(normed-tag (or (and version-2
854
tag)
855
(semantic-regtest-convert-tag-14-to-20 tag)))
856
(name (semantic-tag-name normed-tag))
857
(class (semantic-tag-class normed-tag))
858
(attr (semantic-tag-attributes normed-tag))
870
"Default tag-conversion of TAG into a generic format.
871
Recurses over children when they are found. If the value of the option
872
`semantic-regtest-print-tag-boundaries' is not nil then the tag-boundaries are
873
added at the beginning of the generic tag-format."
874
(let* ((name (semantic-tag-name tag))
875
(class (semantic-tag-class tag))
876
(bounds (if (and semantic-regtest-print-tag-boundaries
877
(semantic-tag-with-position-p tag))
878
(semantic-tag-bounds tag)))
879
(attr (semantic-tag-attributes tag))
859
880
(generic nil))
860
881
(while attr
861
882
(let ((sym (car attr))
862
(val (if version-2
863
(car (cdr attr))
864
(semantic-regtest-convert-tag-14-to-20 (car (cdr attr))))))
883
(val (car (cdr attr))))
865
884
(cond ((semantic-tag-p val)
866
885
;; This attribute is a tag (ie, a type perhaps?)
867
886
(setq val (semantic-regtest-convert-tag val)))
868
((and (listp val)
869
(semantic-tag-p (if version-2 (car val)
870
(semantic-regtest-convert-tag-14-to-20 (car val)))))
887
((and (listp val) (semantic-tag-p (car val)))
871
888
;; List of more tags in this property. Children/members
872
889
(setq val (semantic-regtest-convert-tag-table val)))
873
890
(t nil))
879
896
(setq generic (sort generic (lambda (a b)
880
897
(string< (symbol-name (car a))
881
898
(symbol-name (car b))))))
882
(append (list name class)
899
(append (delq nil (list bounds name class))
883
900
(apply 'append generic))
884
901
))
885
902
886
887
(if (fboundp 'define-overload)
888
(define-overload semantic-regtest-convert-tag (tag)
889
"Convert TAG into a generic format.
890
Recurses over children when they are found."
891
(semantic-regtest--convert-tag tag))
892
(defun semantic-regtest-convert-tag (tag)
893
"Convert TAG into a generic format.
894
Recurses over children when they are found."
895
(semantic-regtest--convert-tag tag)))
896
897
898
(defun semantic-regtest-prin1-nonterminal (tag)
903
(define-overload semantic-regtest-convert-tag (tag)
904
"Convert TAG into a generic format.
905
Recurses over children when they are found."
906
(semantic-regtest--convert-tag tag))
907
908
(defun semantic-regtest-prin1 (tag)
909
"Dump TAG to a string and return this string."
899
910
(prin1-to-string (semantic-regtest-convert-tag tag)))
900
911
901
912
Loggerhead is a web-based interface for Breezy
Version: 2.0.1