diff options
author | LaMont Jones <lamont@debian.org> | 2003-05-07 08:36:40 -0600 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:27 -0800 |
commit | e21d47d7813159bb71e0671df9b52ec0470c358d (patch) | |
tree | 3c7770ea846123c291f599044e9f234ac17616bb /syntest1.scm | |
parent | 8cfce36c6a4fc2e0a0ab6ef2db66a23cbe462693 (diff) | |
parent | deda2c0fd8689349fea2a900199a76ff7ecb319e (diff) | |
download | scm-e21d47d7813159bb71e0671df9b52ec0470c358d.tar.gz scm-e21d47d7813159bb71e0671df9b52ec0470c358d.zip |
Import Debian changes 5d6-3.2debian/5d6-3.2
scm (5d6-3.2) unstable; urgency=low
* Fix hppa compile. Closes: #144062
scm (5d6-3.1) unstable; urgency=low
* NMU with patch from James Troup, to fix FTBFS on sparc. Closes: #191171
scm (5d6-3) unstable; urgency=low
* Add build depend on xlibs-dev (Closes: #148020)
scm (5d6-2) unstable; urgency=low
* Remove libregexx-dev from build-depends.
* Change build to use ./scmlit rather than scmlit (should fix some build
problems) (looks like alpha is mostly building)
* New release (Closes: #140175)
* Built with turtlegraphics last time (Closes: #58515)
scm (5d6-1) unstable; urgency=low
* New upstream.
* Add xlib and turtlegr to requested list of features. (closes
some bug)
* Make clean actually clean most everything up.
* Remove hacks renaming build to something else and just set build as a
.PHONY target in debian/rules.
* Add the turtlegr code.
scm (5d5-1) unstable; urgency=low
* New upstream
* Has fixes for 64 bit archs. May fix alpha compile problem. Does fix
(Closes: #140175)
* Take out -O2 arg.
scm (5d4-3) unstable; urgency=low
* Don't link with regexx, but just use libc6's regular expression
functions.
* Define (terms) to output /usr/share/common-licenses/GPL (Closes:
#119321)
scm (5d4-2) unstable; urgency=low
* Add texinfo to build depends (Closes: #107011)
scm (5d4-1) unstable; urgency=low
* New upstream release.
* Move install-info --remove to prerm.
scm (5d3-5) unstable; urgency=low
* Move scm info files to section "The Algorithmic Language Scheme" to
match up with guile.
scm (5d3-4) unstable; urgency=low
* Fix build depends (Closes: #76691)
scm (5d3-3) unstable; urgency=low
* Fix path in scm dhelp file.
scm (5d3-2) unstable; urgency=low
* Actually put the header files in the package. Oops.
scm (5d3-1) unstable; urgency=low
* New upstream. (Closes: #74761)
* Make (terms) use new license location.
* Make use libregexx rather than librx.
* Fix build depends for above.
* Using new regex lib seems to fix crash (Closes: #66787)
* Consider adding scm-dev package with headers, but instead just add the
headers to the scm package. (Closes: #70787)
* Add doc-base support.
Diffstat (limited to 'syntest1.scm')
-rw-r--r-- | syntest1.scm | 166 |
1 files changed, 166 insertions, 0 deletions
diff --git a/syntest1.scm b/syntest1.scm new file mode 100644 index 0000000..f10be86 --- /dev/null +++ b/syntest1.scm @@ -0,0 +1,166 @@ +;Most of the tests themselves are taken from William Clinger's reference +;implementation of syntax-rules, `macros.will' in the Scheme repository +;at ftp.cs.indiana.edu + +;Copyright 1992 William Clinger + +;Permission to copy this software, in whole or in part, to use this +;software for any lawful purpose, and to redistribute this software +;is granted subject to the restriction that all copies made of this +;software must include this copyright notice in full. + +;I also request that you send me a copy of any improvements that you +;make to this software so that they may be incorporated within it to +;the benefit of the Scheme community. + + +(require 'macro) + +(define synerrs '()) + +(define-syntax test + (syntax-rules () + ((test ?exp ?ans) + (begin + (display '?exp) + (display " ==> ") + (let* ((exp (copy-tree '?exp)) + (x ?exp) + #+f(x (eval (macro:expand '?exp))) + ) + (display x) + (newline) + (or (equal? x ?ans) + (begin + (set! synerrs + (cons (list x ?ans '?exp) synerrs)) + (display "ERROR: expected ") + (display ?ans) + (newline)))))) + ((test ?exp0 ?exp1 ?exp2 ...) + (begin (display '?exp0) + (newline) + ?exp0 (test ?exp1 ?exp2 ...))))) + +(test (let ((x 'outer)) + (let-syntax ((m (syntax-rules () ((m) x)))) + (let ((x 'inner)) + (m)))) + 'outer) + +(test (let-syntax ((when (syntax-rules + () + ((when ?test ?stmt1 ?stmt2 ...) + (if ?test (begin ?stmt1 ?stmt2 ...)))))) + (let ((if #t)) + (when if (set! if 'now)) + if)) + 'now) + +(test (letrec-syntax + ((or (syntax-rules + () + ((or) #f) + ((or ?e) ?e) + ((or ?e1 ?e2 ...) + (let ((temp ?e1)) + (if temp temp (or ?e2 ...))))))) + (let ((x #f) + (y 7) + (temp 8) + (let odd?) + (if even?)) + (or x + (let temp) + (if y) + y))) + 7) + +(test (let ((=> #f)) + (cond (#t => 'ok))) + 'ok) + +; This syntax of set*! matches that of an example in the R4RS. +; That example was put forth as an example of a hygienic macro +; that supposedly couldn't be written using syntax-rules. Hah! + +(test (define-syntax set*! + (syntax-rules + () + ((set*! (?var ?val) ...) + (set*!-help (?val ...) () (?var ?val) ...)))) + (define-syntax set*!-help + (syntax-rules + () + ((set*!-help () (?temp ...) (?var ?val) ...) + (let ((?temp ?val) ...) + (set! ?var ?temp) ...)) + ((set*!-help (?var1 ?var2 ...) ?temps ?assignments ...) + (set*!-help (?var2 ...) (temp . ?temps) ?assignments ...)))) + (let ((x 3) + (y 4) + (z 5)) + (set*! (x (+ x y z)) + (y (- x y z)) + (z (* x y z))) + (list x y z)) + + '(12 -6 60)) + +(test (let ((else #f)) + (cond (#f 3) + (else 4) + (#t 5))) + 5) + +(test (define-syntax push + (syntax-rules () + ((push item place) + (set! place (cons item place))))) + (let* ((cons (lambda (name) + (case name + ((phil) '("three-card monte")) + ((dick) '("secret plan to end the war" + "agnew" + "not a crook")) + ((jimmy) '("why not the best")) + ((ron) '("abolish the draft" + "balance the budget")) + (else '())))) + (scams (cons 'phil))) + (push (car (cons 'jimmy)) scams) + (push (cadr (cons 'ron)) scams) + scams) + '("balance the budget" "why not the best" "three-card monte")) + +(test (define-syntax replic + (syntax-rules () + ((_ (?x ...) (?y ...)) + (let ((?x (list ?y ...)) ...) + (list ?x ...))))) + (replic (x y z) (1 2)) + '((1 2) (1 2) (1 2))) + +;; The behavior of this one is one is not specified by R5RS, below +;; is what SCM does. +;(test (define-syntax spread +; (syntax-rules () +; ((_ ?x (?y ...)) +; '(((?x ?y) ...))))) +; (spread x (1 2 3)) +; '(((x 1) (x 2) (x 3)))) + +(cond + ((null? synerrs) + (newline) + (display "Passed all tests\n") + (display "Load \"syntest2\" to rewrite derived expressions and test\n")) + (else + (newline) + (display "FAILED, errors were:") + (newline) + (display "(got expected call)") + (newline) + (for-each (lambda (l) (write l) (newline)) synerrs) + (newline))) + |