# pmacro testcase #1 -*- shell-script -*-
-test=pmacros-1
+gen_cpu_file() {
+ rtl_version=$1
+ prefix=$2
-source ./test-utils.sh
-
-cpu_file=${test}.test.cpu
-rm -f ${cpu_file}
-
-cat > ${cpu_file} <<EOF
+ cat > ${cpu_file} <<EOF
+(define-rtl-version ${rtl_version})
(include "${srcdir}/../cpu/simplify.inc")
(include "${srcdir}/testsuite.cpu")
(name3 "string3" 3)
)
)
-(.print list-const "\n")
+(${prefix}print list-const "\n")
-(test-name ".ref, .car")
-(.if (.not (.equal? (.ref (.car list-const) 2) 1))
- (.print "FAIL (.not (.equal? (.ref (.car list-const) 2) 1))\n"))
+(test-name "${prefix}ref, ${prefix}car")
+(${prefix}if (${prefix}not (${prefix}equal? (${prefix}ref (${prefix}car list-const) 2) 1))
+ (${prefix}print "FAIL (${prefix}not (${prefix}equal? (${prefix}ref (${prefix}car list-const) 2) 1))\n"))
-(test-name ".for-each, nested .pmacros")
+(test-name "${prefix}for-each, nested ${prefix}pmacros")
(print-match "adgbehcfi")
-(print-thunk (.pmacro ()
- (.begin
- (.for-each (.pmacro (x y z)
- (.print x y z))
+(print-thunk (${prefix}pmacro ()
+ (${prefix}begin
+ (${prefix}for-each (${prefix}pmacro (x y z)
+ (${prefix}print x y z))
(a b c) (d e f) (g h i)))))
-(test-name "nested .pmacros with bindings")
+(test-name "nested ${prefix}pmacros with bindings")
(print-match "(+ 4 3)")
-(print-thunk (.pmacro ()
- (.dump ((.pmacro (arg1 arg2)
- ((.pmacro (bar) (+ arg2 bar)) arg1))
+(print-thunk (${prefix}pmacro ()
+ (${prefix}dump ((${prefix}pmacro (arg1 arg2)
+ ((${prefix}pmacro (bar) (+ arg2 bar)) arg1))
3 4))))
-(test-name ".dump")
+(test-name "${prefix}dump")
(print-match "(name1 \"string1\" 1)(name2 \"string2\" 2)(name3 \"string3\" 3)\n")
-(.print "EXPR: ")
-(.for-each (.pmacro (a) (.dump a)) list-const)
+(${prefix}print "EXPR: ")
+(${prefix}for-each (${prefix}pmacro (a) (${prefix}dump a)) list-const)
(newline)
-(test-name ".sym")
+(test-name "${prefix}sym")
(print-match "abc\n")
-(print-expr (.sym a "b" c))
+(print-expr (${prefix}sym a "b" c))
-(test-name ".str")
+(test-name "${prefix}str")
(print-match "\"def\"\n")
-(print-expr (.str d "e" f))
+(print-expr (${prefix}str d "e" f))
-(test-name ".hex")
+(test-name "${prefix}hex")
(print-match "\"2a\"")
-(print-expr (.hex 42))
+(print-expr (${prefix}hex 42))
-(test-name ".upcase")
+(test-name "${prefix}upcase")
(print-match "\"UPPER\"")
-(print-expr (.upcase "upper"))
+(print-expr (${prefix}upcase "upper"))
(print-match "UPPER")
-(print-expr (.upcase upper))
+(print-expr (${prefix}upcase upper))
-(test-name ".downcase")
+(test-name "${prefix}downcase")
(print-match "\"downer\"")
-(print-expr (.downcase "DOWNER"))
+(print-expr (${prefix}downcase "DOWNER"))
(print-match "downer")
-(print-expr (.downcase DOWNER))
+(print-expr (${prefix}downcase DOWNER))
-(test-name ".substring")
+(test-name "${prefix}substring")
(print-match "\"zz\"")
-(print-expr (.substring "xyzzy" 2 4))
+(print-expr (${prefix}substring "xyzzy" 2 4))
(print-match "zz")
-(print-expr (.substring xyzzy 2 4))
+(print-expr (${prefix}substring xyzzy 2 4))
-(test-name ".splice1")
+(test-name "${prefix}splice1")
(print-match "(now is the time)")
-(print-expr (.splice now (.unsplice (is the time))))
+(print-expr (${prefix}splice now (${prefix}unsplice (is the time))))
-;; Arguments to .splice/.unsplice are evaluated.
-(test-name ".splice2")
+;; Arguments to ${prefix}splice/${prefix}unsplice are evaluated.
+(test-name "${prefix}splice2")
(print-match "(now is the time)")
(define-pmacro splice2-piece now)
-(print-expr (.splice splice2-piece (.unsplice (is the time))))
+(print-expr (${prefix}splice splice2-piece (${prefix}unsplice (is the time))))
-;; Arguments to .splice/.unsplice are evaluated.
-(test-name ".splice3")
+;; Arguments to ${prefix}splice/${prefix}unsplice are evaluated.
+(test-name "${prefix}splice3")
(print-match "(now is the time)")
(define-pmacro splice3-piece the)
-(print-expr (.splice now (.unsplice (is splice3-piece time))))
+(print-expr (${prefix}splice now (${prefix}unsplice (is splice3-piece time))))
-(test-name ".iota")
+(test-name "${prefix}iota")
(print-match "(0 1 2 3)")
-(print-expr (.iota 4))
+(print-expr (${prefix}iota 4))
(print-match "(1 2 3 4)")
-(print-expr (.iota 4 1))
+(print-expr (${prefix}iota 4 1))
(print-match "(2 4 6 8)")
-(print-expr (.iota 4 2 2))
+(print-expr (${prefix}iota 4 2 2))
-(test-name ".map")
+(test-name "${prefix}map")
(print-match "(\"a\" \"b\" \"c\")")
-(print-expr (.map .hex (10 11 12)))
+(print-expr (${prefix}map ${prefix}hex (10 11 12)))
(print-match "(\"a\" \"b\" \"c\")")
-(print-expr (.map (.pmacro (x) (.hex x)) (10 11 12)))
+(print-expr (${prefix}map (${prefix}pmacro (x) (${prefix}hex x)) (10 11 12)))
-(test-name ".apply")
+(test-name "${prefix}apply")
(print-match "ABC")
-(print-expr (.apply .upcase (abc)))
+(print-expr (${prefix}apply ${prefix}upcase (abc)))
-(test-name ".pmacro?")
+(test-name "${prefix}pmacro?")
(print-match "#t")
-(print-expr (.pmacro? .pmacro?))
+(print-expr (${prefix}pmacro? ${prefix}pmacro?))
(print-match "#t")
-(print-expr (.pmacro? test-name))
+(print-expr (${prefix}pmacro? test-name))
(print-match "#t")
-(print-expr (.pmacro? (.pmacro (a) (add a 1))))
+(print-expr (${prefix}pmacro? (${prefix}pmacro (a) (add a 1))))
(print-match "#f")
-(print-expr (.pmacro? 42))
+(print-expr (${prefix}pmacro? 42))
-(test-name ".eval")
+(test-name "${prefix}eval")
(print-match "(explicitly-undefined 42)")
(define-pmacro (eval-test1 a) (explicitly-undefined a))
-(print-expr (.eval (.splice eval-test1 (.unsplice (42)))))
+(print-expr (${prefix}eval (${prefix}splice eval-test1 (${prefix}unsplice (42)))))
-(test-name ".let")
+(test-name "${prefix}let")
(print-match "xyzzy")
-(print-expr (.let ((x xyzzy)) x))
+(print-expr (${prefix}let ((x xyzzy)) x))
;; FIXME: This is the currently defined behaviour, but it's somewhat
;; unintuitive.
;; pmacro expansion re-evaluates the result if it's also a pmacro,
;; so x -> y -> x and y -> x -> y.
(print-match "(x y)")
-(print-expr (.let ((x y) (y x)) (.list x y)))
+(print-expr (${prefix}let ((x y) (y x)) (${prefix}list x y)))
-(test-name ".let*")
+(test-name "${prefix}let*")
(print-match "(1 2)")
-(print-expr (.let* ((x 1) (y (.add x 1))) (.list x y)))
+(print-expr (${prefix}let* ((x 1) (y (${prefix}add x 1))) (${prefix}list x y)))
-(test-name ".if")
+(test-name "${prefix}if")
(print-match "then")
-(print-expr (.if #t then else))
+(print-expr (${prefix}if #t then else))
(print-match "else")
-(print-expr (.if #f then else))
+(print-expr (${prefix}if #f then else))
-(test-name ".case")
+(test-name "${prefix}case")
(print-match "123")
-(print-expr (.case seba ((seba beach) 123) (else 456)))
+(print-expr (${prefix}case seba ((seba beach) 123) (else 456)))
(print-match "123")
-(print-expr (.case beach ((seba beach) 123) (else 456)))
+(print-expr (${prefix}case beach ((seba beach) 123) (else 456)))
(print-match "456")
-(print-expr (.case 0 ((seba beach) 123) (else 456)))
+(print-expr (${prefix}case 0 ((seba beach) 123) (else 456)))
-(test-name ".cond")
+(test-name "${prefix}cond")
(print-match "yep")
-(print-expr (.cond ((.eq 1 1) yep) (else nope)))
+(print-expr (${prefix}cond ((${prefix}eq 1 1) yep) (else nope)))
(print-match "nope")
-(print-expr (.cond ((.eq 1 2) yep) (else nope)))
+(print-expr (${prefix}cond ((${prefix}eq 1 2) yep) (else nope)))
-(test-name ".begin")
+(test-name "${prefix}begin")
(print-match "xyz")
-(print-thunk (.pmacro () (.begin (.print "x") (.print "y") (.print "z"))))
+(print-thunk (${prefix}pmacro () (${prefix}begin (${prefix}print "x") (${prefix}print "y") (${prefix}print "z"))))
-(test-name ".list, .ref")
+(test-name "${prefix}list, ${prefix}ref")
(print-match "grief")
-(print-expr (.ref (.list good grief) 1))
+(print-expr (${prefix}ref (${prefix}list good grief) 1))
-(test-name ".length")
+(test-name "${prefix}length")
(print-match "6")
-(print-expr (.length snoopy))
+(print-expr (${prefix}length snoopy))
(print-match "9")
-(print-expr (.length "woodstock"))
+(print-expr (${prefix}length "woodstock"))
(print-match "4")
-(print-expr (.length (good grief charlie brown)))
+(print-expr (${prefix}length (good grief charlie brown)))
-(test-name ".replicate")
+(test-name "${prefix}replicate")
(print-match "(no no no no)")
-(print-expr (.replicate 4 no))
+(print-expr (${prefix}replicate 4 no))
-(test-name ".find")
+(test-name "${prefix}find")
(print-match "(0 1)")
-(print-expr (.find (.pmacro (n) (.lt n 2)) (.iota 4)))
+(print-expr (${prefix}find (${prefix}pmacro (n) (${prefix}lt n 2)) (${prefix}iota 4)))
-(test-name ".equal?")
+(test-name "${prefix}equal?")
(print-match "#t")
-(print-expr (.equal? (yo yo) (yo yo)))
+(print-expr (${prefix}equal? (yo yo) (yo yo)))
(print-match "#f")
-(print-expr (.equal? (yo yo) (yo x)))
+(print-expr (${prefix}equal? (yo yo) (yo x)))
-(test-name ".andif")
+(test-name "${prefix}andif")
(print-match "andif")
-(print-expr (.andif 1 #t andif))
+(print-expr (${prefix}andif 1 #t andif))
(print-match "#f")
-(print-expr (.andif 1 #f andif))
+(print-expr (${prefix}andif 1 #f andif))
(print-match "#t")
-(print-expr (.andif))
+(print-expr (${prefix}andif))
-(test-name ".orif")
+(test-name "${prefix}orif")
(print-match "orif")
-(print-expr (.orif #f orif))
+(print-expr (${prefix}orif #f orif))
(print-match "#f")
-(print-expr (.orif #f #f))
+(print-expr (${prefix}orif #f #f))
(print-match "#f")
-(print-expr (.orif))
+(print-expr (${prefix}orif))
-(test-name ".not")
+(test-name "${prefix}not")
(print-match "yep")
-(print-expr (.if (.not #f) yep nope))
+(print-expr (${prefix}if (${prefix}not #f) yep nope))
(print-match "nope")
-(print-expr (.if (.not #t) yep nope))
+(print-expr (${prefix}if (${prefix}not #t) yep nope))
-(test-name ".eq")
+(test-name "${prefix}eq")
(print-match "eq")
-(print-expr (.if (.eq foo foo) eq ne))
+(print-expr (${prefix}if (${prefix}eq foo foo) eq ne))
(print-match "eq2")
-(print-expr (.if (.eq 1 1) eq2 ne2))
+(print-expr (${prefix}if (${prefix}eq 1 1) eq2 ne2))
-(test-name ".ne")
+(test-name "${prefix}ne")
(print-match "ne")
-(print-expr (.if (.ne foo bar) ne eq))
+(print-expr (${prefix}if (${prefix}ne foo bar) ne eq))
(print-match "ne2")
-(print-expr (.if (.ne 1 2) ne2 eq2))
+(print-expr (${prefix}if (${prefix}ne 1 2) ne2 eq2))
-(test-name ".lt")
+(test-name "${prefix}lt")
(print-match "lt")
-(print-expr (.if (.lt 1 2) lt nope))
+(print-expr (${prefix}if (${prefix}lt 1 2) lt nope))
-(test-name ".gt")
+(test-name "${prefix}gt")
(print-match "gt")
-(print-expr (.if (.gt 1 0) gt nope))
+(print-expr (${prefix}if (${prefix}gt 1 0) gt nope))
-(test-name ".le")
+(test-name "${prefix}le")
(print-match "le1")
-(print-expr (.if (.le 1 1) le1 nope))
+(print-expr (${prefix}if (${prefix}le 1 1) le1 nope))
(print-match "le2")
-(print-expr (.if (.le 1 2) le2 nope))
+(print-expr (${prefix}if (${prefix}le 1 2) le2 nope))
-(test-name ".ge")
+(test-name "${prefix}ge")
(print-match "ge1")
-(print-expr (.if (.ge 1 1) ge1 nope))
+(print-expr (${prefix}if (${prefix}ge 1 1) ge1 nope))
(print-match "ge2")
-(print-expr (.if (.ge 1 0) ge2 nope))
+(print-expr (${prefix}if (${prefix}ge 1 0) ge2 nope))
-(test-name ".add")
+(test-name "${prefix}add")
(print-match "3")
-(print-expr (.add 1 2))
+(print-expr (${prefix}add 1 2))
-(test-name ".sub")
+(test-name "${prefix}sub")
(print-match "-1")
-(print-expr (.sub 1 2))
+(print-expr (${prefix}sub 1 2))
-(test-name ".mul")
+(test-name "${prefix}mul")
(print-match "6")
-(print-expr (.mul 2 3))
+(print-expr (${prefix}mul 2 3))
-(test-name ".div")
+(test-name "${prefix}div")
(print-match "4")
-(print-expr (.div 8 2))
+(print-expr (${prefix}div 8 2))
-(test-name ".rem")
+(test-name "${prefix}rem")
(print-match "0")
-(print-expr (.rem 8 2))
+(print-expr (${prefix}rem 8 2))
-(test-name ".sll")
+(test-name "${prefix}sll")
(print-match "8")
-(print-expr (.sll 1 3))
+(print-expr (${prefix}sll 1 3))
(print-match "4")
-(print-expr (.sll 4 0))
+(print-expr (${prefix}sll 4 0))
-(test-name ".srl")
+(test-name "${prefix}srl")
(print-match "1")
-(print-expr (.srl 8 3))
+(print-expr (${prefix}srl 8 3))
(print-match "4")
-(print-expr (.srl 4 0))
+(print-expr (${prefix}srl 4 0))
-(test-name ".sra")
+(test-name "${prefix}sra")
(print-match "-1")
-(print-expr (.sra -1 0))
+(print-expr (${prefix}sra -1 0))
(print-match "-1")
-(print-expr (.sra -1 1))
+(print-expr (${prefix}sra -1 1))
(print-match "-2")
-(print-expr (.sra -3 1))
+(print-expr (${prefix}sra -3 1))
-(test-name ".and")
+(test-name "${prefix}and")
(print-match "8")
-(print-expr (.and 15 8))
+(print-expr (${prefix}and 15 8))
-(test-name ".or")
+(test-name "${prefix}or")
(print-match "15")
-(print-expr (.or 15 8))
+(print-expr (${prefix}or 15 8))
-(test-name ".xor")
+(test-name "${prefix}xor")
(print-match "7")
-(print-expr (.xor 15 8))
+(print-expr (${prefix}xor 15 8))
-(test-name ".inv")
+(test-name "${prefix}inv")
(print-match "-6")
-(print-expr (.inv 5))
+(print-expr (${prefix}inv 5))
-(test-name ".car")
+(test-name "${prefix}car")
(print-match "car")
-(print-expr (.car (car cdr)))
+(print-expr (${prefix}car (car cdr)))
-(test-name ".cdr")
+(test-name "${prefix}cdr")
(print-match "(cdr)")
-(print-expr (.cdr (car cdr)))
+(print-expr (${prefix}cdr (car cdr)))
-(test-name ".caar")
+(test-name "${prefix}caar")
(print-match "caar")
-(print-expr (.caar ((caar cdar) cadr cddr)))
+(print-expr (${prefix}caar ((caar cdar) cadr cddr)))
-(test-name ".cadr")
+(test-name "${prefix}cadr")
(print-match "cadr")
-(print-expr (.cadr ((caar cdar) cadr cddr)))
+(print-expr (${prefix}cadr ((caar cdar) cadr cddr)))
-(test-name ".cdar")
+(test-name "${prefix}cdar")
(print-match "(cdar)")
-(print-expr (.cdar ((caar cdar) cadr cddr)))
+(print-expr (${prefix}cdar ((caar cdar) cadr cddr)))
-(test-name ".cddr")
+(test-name "${prefix}cddr")
(print-match "(cddr)")
-(print-expr (.cddr ((caar cdar) cadr cddr)))
+(print-expr (${prefix}cddr ((caar cdar) cadr cddr)))
EOF
+}
+
+# Run the test twice, once for each kind of prefix.
+
+for iter in dot percent
+do
+ test="pmacros-1-${iter}"
+
+ source ./test-utils.sh
+
+ cpu_file=${test}.test.cpu
+ rm -f ${cpu_file}
+
+ case ${iter} in
+ dot) gen_cpu_file "0 8" "." ;;
+ percent) gen_cpu_file "0 9" "%" ;;
+ esac
-run_cgen ${cpu_file}
+ run_cgen ${cpu_file}
-post_process
+ post_process
+done
finish
OSDN Git Service
