1;;;; This software is part of the SBCL system. See the README file for
2;;;; more information.
3;;;;
4;;;; While most of SBCL is derived from the CMU CL system, the test
5;;;; files (like this one) were written from scratch after the fork
6;;;; from CMU CL.
7;;;;
8;;;; This software is in the public domain and is provided with
9;;;; absolutely no warranty. See the COPYING and CREDITS files for
10;;;; more information.
11
12;;; COMPILE-FILE-LINE and COMPILE-FILE-POSITION
13
14(macrolet ((line () `(multiple-value-call 'cons (compile-file-line))))
15  (defun more-foo (x)
16    (if x
17        (format nil "Great! ~D" (line)) ; <-- this is line 17
18        (format nil "Yikes ~D" (line)))))
19
20(declaim (inline thing))
21(defun thing ()
22  (format nil "failed to frob a knob at line #~D"
23          (compile-file-line))) ; <-- this is line 23
24
25(defmacro more-randomness ()
26  '(progn
27    (let ()
28      (thing))))
29
30(macrolet ()
31  (progn
32    (defun bork (x)
33      (flet ()
34        (if x
35            (locally (declare (notinline thing))
36              (more-randomness))
37            (progn (more-randomness))))))) ; <-- this is line 37
38
39(defun compile-file-pos-sharp-dot (x)
40  (list #.(format nil "Foo line ~D" (compile-file-line)) ; line #40
41        x))
42
43(defun compile-file-pos-eval-in-macro ()
44  (macrolet ((macro (x)
45               (format nil "hi ~A at ~D" x
46                       (compile-file-line)))) ; line #46
47    (macro "there")))
48
49(with-test (:name :compile-file-line)
50  (assert (string= (more-foo t) "Great! (17 . 32)"))
51  (assert (string= (more-foo nil) "Yikes (18 . 31)"))
52  (assert (string= (bork t) "failed to frob a knob at line #23"))
53  (assert (string= (bork nil) "failed to frob a knob at line #37"))
54  (assert (string= (car (compile-file-pos-sharp-dot nil))
55                    "Foo line 40"))
56  (assert (string= (compile-file-pos-eval-in-macro)
57                    "hi there at 46")))
58
59(eval-when (:compile-toplevel)
60  (let ((stream (sb-c::source-info-stream sb-c::*source-info*)))
61    (assert (pathname stream))))
62
63(eval-when (:compile-toplevel :load-toplevel :execute)
64  (set-dispatch-macro-character
65   #\# #\@
66   (lambda (stream char arg)
67     (declare (ignore char arg) (optimize (speed 0)))
68     ;; return the column where the '#' was
69     `'(,(- (stream-line-column stream) 2)))))
70
71(defun foo-char-macro () (list #@
72                          #@))
73
74(with-test (:name :compile-file-stream-line-column)
75  (assert (equal (foo-char-macro) '((31) (26)))))
76