diff --git a/test-suite/tests/srcprop.test b/test-suite/tests/srcprop.test new file mode 100644 index 000000000..bd58fb531 --- /dev/null +++ b/test-suite/tests/srcprop.test @@ -0,0 +1,55 @@ +;;;; srcprop.test --- test Guile source properties -*- scheme -*- +;;;; +;;;; Copyright (C) 2003 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 2.1 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +(define-module (test-suite test-srcprop) + :use-module (test-suite lib)) + + +;;; +;;; source-properties +;;; + +(with-test-prefix "source-properties" + + (pass-if "no props" + (null? (source-properties (list 1 2 3)))) + + (read-enable 'positions) + (let ((s (read (open-input-string "(1 . 2)")))) + + (pass-if "read properties" + (not (null? (source-properties s)))))) + +;;; +;;; set-source-properties! +;;; + +(with-test-prefix "set-source-properties!" + (read-enable 'positions) + (let ((s (read (open-input-string "(1 . 2)")))) + + (with-test-prefix "copied props" + (pass-if "visible to source-property" + (let ((t (cons 3 4))) + (set-source-properties! t (source-properties s)) + (number? (source-property t 'line)))) + + (pass-if "visible to source-properties" + (let ((t (cons 3 4))) + (set-source-properties! t (source-properties s)) + (not (null? (source-properties t))))))))