1 ;;;; srcprop.test --- test Guile source properties -*- scheme -*-
3 ;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
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.
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.
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
19 (define-module (test-suite test-srcprop)
20 :use-module (test-suite lib))
27 (with-test-prefix "source-properties"
30 (null? (source-properties (list 1 2 3))))
32 (read-enable 'positions)
33 (let ((s (read (open-input-string "(1 . 2)"))))
35 (pass-if "read properties"
36 (not (null? (source-properties s))))))
39 ;;; set-source-property!
42 (with-test-prefix "set-source-property!"
43 (read-enable 'positions)
45 (pass-if "setting the breakpoint property works"
46 (let ((s (read (open-input-string "(+ 3 4)"))))
47 (set-source-property! s 'breakpoint #t)
48 (let ((current-trap-opts (evaluator-traps-interface))
49 (current-debug-opts (debug-options-interface))
51 (trap-set! enter-frame-handler (lambda _ (set! trap-called #t)))
54 (debug-enable 'breakpoints)
55 (with-traps (lambda ()
57 (evaluator-traps-interface current-trap-opts)
58 (debug-options-interface current-debug-opts)
62 ;;; set-source-properties!
65 (with-test-prefix "set-source-properties!"
66 (read-enable 'positions)
68 (pass-if "setting the breakpoint property works"
69 (let ((s (read (open-input-string "(+ 3 4)"))))
70 (set-source-properties! s '((breakpoint #t)))
71 (let ((current-trap-opts (evaluator-traps-interface))
72 (current-debug-opts (debug-options-interface))
74 (trap-set! enter-frame-handler (lambda _ (set! trap-called #t)))
77 (debug-enable 'breakpoints)
78 (with-traps (lambda ()
80 (evaluator-traps-interface current-trap-opts)
81 (debug-options-interface current-debug-opts)
84 (let ((s (read (open-input-string "(1 . 2)"))))
86 (with-test-prefix "copied props"
87 (pass-if "visible to source-property"
89 (set-source-properties! t (source-properties s))
90 (number? (source-property t 'line))))
92 (pass-if "visible to source-properties"
94 (set-source-properties! t (source-properties s))
95 (not (null? (source-properties t))))))))