1;;;; srcprop.test --- test Guile source properties -*- scheme -*- 2;;;; 3;;;; Copyright (C) 2003, 2006, 2009 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-srcprop) 20 :use-module (test-suite lib)) 21 22 23;;; 24;;; source-properties 25;;; 26 27(with-test-prefix "source-properties" 28 29 (pass-if "no props" 30 (null? (source-properties (list 1 2 3)))) 31 32 (read-enable 'positions) 33 (with-test-prefix "read properties" 34 (define (reads-with-srcprops? str) 35 (let ((x (read (open-input-string str)))) 36 (not (null? (source-properties x))))) 37 38 (pass-if "pairs" (reads-with-srcprops? "(1 . 2)")) 39 (pass-if "vectors" (reads-with-srcprops? "#(1 2 3)")) 40 (pass-if "bytevectors" (reads-with-srcprops? "#vu8(1 2 3)")) 41 (pass-if "bitvectors" (reads-with-srcprops? "#*101011")) 42 (pass-if "srfi4 vectors" (reads-with-srcprops? "#f64(3.1415 2.71)")) 43 (pass-if "arrays" (reads-with-srcprops? "#2u32@2@3((1 2) (2 3))")) 44 (pass-if "strings" (reads-with-srcprops? "\"hello\"")) 45 (pass-if "null string" (reads-with-srcprops? "\"\"")) 46 47 (pass-if "floats" (reads-with-srcprops? "3.1415")) 48 (pass-if "fractions" (reads-with-srcprops? "1/2")) 49 (pass-if "complex numbers" (reads-with-srcprops? "1+1i")) 50 (pass-if "bignums" 51 (and (reads-with-srcprops? (number->string (1+ most-positive-fixnum))) 52 (reads-with-srcprops? (number->string (1- most-negative-fixnum))))) 53 54 (pass-if "fixnums (should have none)" 55 (not (or (reads-with-srcprops? "0") 56 (reads-with-srcprops? "1") 57 (reads-with-srcprops? "-1") 58 (reads-with-srcprops? (number->string most-positive-fixnum)) 59 (reads-with-srcprops? (number->string most-negative-fixnum))))) 60 61 (pass-if "symbols (should have none)" 62 (not (reads-with-srcprops? "foo"))) 63 64 (pass-if "keywords (should have none)" 65 (not (reads-with-srcprops? "#:foo"))) 66 67 (pass-if "characters (should have none)" 68 (not (reads-with-srcprops? "#\\c"))) 69 70 (pass-if "booleans (should have none)" 71 (not (or (reads-with-srcprops? "#t") 72 (reads-with-srcprops? "#f")))))) 73 74;;; 75;;; set-source-property! 76;;; 77 78(with-test-prefix "set-source-property!" 79 (read-enable 'positions) 80 81 (pass-if "setting the breakpoint property works" 82 (let ((s (read (open-input-string "(+ 3 4)")))) 83 (throw 'unresolved) 84 (set-source-property! s 'breakpoint #t) 85 (let ((current-trap-opts (evaluator-traps-interface)) 86 (current-debug-opts (debug-options-interface)) 87 (trap-called #f)) 88 (trap-set! enter-frame-handler (lambda _ (set! trap-called #t))) 89 (trap-enable 'traps) 90 (debug-enable 'debug) 91 (debug-enable 'breakpoints) 92 (with-traps (lambda () 93 (primitive-eval s))) 94 (evaluator-traps-interface current-trap-opts) 95 (debug-options-interface current-debug-opts) 96 trap-called)))) 97 98;;; 99;;; set-source-properties! 100;;; 101 102(with-test-prefix "set-source-properties!" 103 (read-enable 'positions) 104 105 (pass-if "setting the breakpoint property works" 106 (let ((s (read (open-input-string "(+ 3 4)")))) 107 (throw 'unresolved) 108 (set-source-properties! s '((breakpoint #t))) 109 (let ((current-trap-opts (evaluator-traps-interface)) 110 (current-debug-opts (debug-options-interface)) 111 (trap-called #f)) 112 (trap-set! enter-frame-handler (lambda _ (set! trap-called #t))) 113 (trap-enable 'traps) 114 (debug-enable 'debug) 115 (debug-enable 'breakpoints) 116 (with-traps (lambda () 117 (primitive-eval s))) 118 (evaluator-traps-interface current-trap-opts) 119 (debug-options-interface current-debug-opts) 120 trap-called))) 121 122 (let ((s (read (open-input-string "(1 . 2)")))) 123 124 (with-test-prefix "copied props" 125 (pass-if "visible to source-property" 126 (let ((t (cons 3 4))) 127 (set-source-properties! t (source-properties s)) 128 (number? (source-property t 'line)))) 129 130 (pass-if "visible to source-properties" 131 (let ((t (cons 3 4))) 132 (set-source-properties! t (source-properties s)) 133 (not (null? (source-properties t)))))))) 134