Move COMPILE-FILE-POSITION tests to their own file.
[sbcl.git] / tests / compiler-3.impure-cload.lisp
blobb6748726f5e85da2b294028a2afa665e0d69453a
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.
12 ;;; COMPILE-FILE-LINE and COMPILE-FILE-POSITION
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)))))
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
25 (defmacro more-randomness ()
26 '(progn
27 (let ()
28 (thing))))
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
39 (defun compile-file-pos-sharp-dot (x)
40 (list #.(format nil "Foo line ~D" (compile-file-line)) ; line #40
41 x))
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")))
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")))
59 (eval-when (:compile-toplevel)
60 (let ((stream (sb-c::source-info-stream sb-c::*source-info*)))
61 (assert (pathname stream))))