tests/compiler-3.impure-cload.lisp

   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)))))