Commit | Line | Data |
---|---|---|
ae07b8e7 AW |
1 | ;;;; dwarf.test -*- scheme -*- |
2 | ;;;; | |
3 | ;;;; Copyright 2013 Free Software Foundation, Inc. | |
4 | ;;;; | |
5 | ;;;; This library is free software; you can redistribute it and/or | |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
8 | ;;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;;; | |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free Software | |
17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
18 | ||
19 | (define-module (test-suite test-dwarf) | |
20 | #:use-module (test-suite lib) | |
21 | #:use-module (ice-9 match) | |
22 | #:use-module (system base compile) | |
23 | #:use-module (system vm debug) | |
24 | #:use-module (system vm program) | |
4cbc95f1 | 25 | #:use-module (system vm loader)) |
ae07b8e7 AW |
26 | |
27 | (define prog | |
28 | (string-concatenate | |
29 | ;; Every open parenthesis is a possible source location. | |
30 | '("(define (qux f)\n" | |
31 | ;^ 0:0 | |
32 | " (+ 32 (f)))\n" | |
33 | ; ^1:2 ^1:8 | |
34 | "\n" | |
35 | "(define bar\n" | |
36 | ;^ 3;0 | |
37 | " (lambda (a)\n" | |
38 | ; ^ 4:2 | |
39 | " 13))\n" | |
40 | "'success\n") | |
41 | )) | |
42 | ||
43 | (let* ((port (open-input-string prog)) | |
44 | (bv (begin | |
45 | (set-port-filename! port "foo.scm") | |
691697de | 46 | (read-and-compile port #:to 'bytecode)))) |
ae07b8e7 AW |
47 | (pass-if-equal 'success |
48 | ((load-thunk-from-memory bv))) | |
49 | ||
50 | (pass-if-equal 13 (bar 10)) | |
51 | ||
d1100525 | 52 | (let ((source (find-source-for-addr (program-code qux)))) |
ae07b8e7 AW |
53 | (pass-if-equal "foo.scm" (source-file source)) |
54 | (pass-if-equal 0 (source-line source)) | |
55 | (pass-if-equal 1 (source-line-for-user source)) | |
56 | (pass-if-equal 0 (source-column source))) | |
57 | ||
d1100525 | 58 | (let ((source (find-source-for-addr (program-code bar)))) |
ae07b8e7 AW |
59 | (pass-if-equal "foo.scm" (source-file source)) |
60 | (pass-if-equal 4 (source-line source)) | |
61 | (pass-if-equal 5 (source-line-for-user source)) | |
62 | (pass-if-equal 2 (source-column source))) | |
63 | ||
d1100525 | 64 | (match (find-program-sources (program-code qux)) |
4b8d21c1 | 65 | ((s1 s2 s3) |
ae07b8e7 AW |
66 | (pass-if-equal "foo.scm" (source-file s1)) |
67 | (pass-if-equal 0 (source-line s1)) | |
68 | (pass-if-equal 1 (source-line-for-user s1)) | |
69 | (pass-if-equal 0 (source-column s1)) | |
70 | ||
ae07b8e7 AW |
71 | (pass-if-equal "foo.scm" (source-file s2)) |
72 | (pass-if-equal 1 (source-line s2)) | |
73 | (pass-if-equal 2 (source-line-for-user s2)) | |
4b8d21c1 AW |
74 | (pass-if-equal 8 (source-column s2)) |
75 | ||
76 | (pass-if-equal "foo.scm" (source-file s3)) | |
77 | (pass-if-equal 1 (source-line s3)) | |
78 | (pass-if-equal 2 (source-line-for-user s3)) | |
79 | (pass-if-equal 2 (source-column s3))) | |
ae07b8e7 AW |
80 | (sources |
81 | (error "unexpected sources" sources))) | |
82 | ||
d1100525 | 83 | (match (find-program-sources (program-code bar)) |
ae07b8e7 AW |
84 | ((source) |
85 | (pass-if-equal "foo.scm" (source-file source)) | |
86 | (pass-if-equal 4 (source-line source)) | |
87 | (pass-if-equal 5 (source-line-for-user source)) | |
88 | (pass-if-equal 2 (source-column source))) | |
89 | (sources | |
90 | (error "unexpected sources" sources)))) |