cgen/testsuite/pmacros-1.test

   1 # pmacro testcase #1 -*- shell-script -*-
   2
   3 test=pmacros-1
   4
   5 source ./test-utils.sh
   6
   7 cpu_file=${test}.test.cpu
   8 rm -f ${cpu_file}
   9
  10 cat > ${cpu_file} <<EOF
  11 (include "${srcdir}/../cpu/simplify.inc")
  12 (include "${srcdir}/testsuite.cpu")
  13
  14 (define-pmacro sym-const name1)
  15 (define-pmacro str-const "string1")
  16 (define-pmacro int-const 1)
  17
  18 (define-pmacro list-const
  19   (
  20    (name1 "string1" 1)
  21    (name2 "string2" 2)
  22    (name3 "string3" 3)
  23    )
  24 )
  25 (.print list-const "\n")
  26
  27 (test-name ".ref, .car")
  28 (.if (.not (.equal? (.ref (.car list-const) 2) 1))
  29      (.print "FAIL (.not (.equal? (.ref (.car list-const) 2) 1))\n"))
  30
  31 (test-name ".for-each, nested .pmacros")
  32 (print-match "adgbehcfi")
  33 (print-thunk (.pmacro ()
  34                (.begin
  35                  (.for-each (.pmacro (x y z)
  36                               (.print x y z))
  37                             (a b c) (d e f) (g h i)))))
  38 (test-name "nested .pmacros with bindings")
  39 (print-match "(+ 4 3)")
  40 (print-thunk (.pmacro ()
  41                (.dump ((.pmacro (arg1 arg2)
  42                          ((.pmacro (bar) (+ arg2 bar)) arg1))
  43                        3 4))))
  44
  45 (test-name ".dump")
  46 (print-match "(name1 \"string1\" 1)(name2 \"string2\" 2)(name3 \"string3\" 3)\n")
  47 (.print "EXPR: ")
  48 (.for-each (.pmacro (a) (.dump a)) list-const)
  49 (newline)
  50
  51 (test-name ".sym")
  52 (print-match "abc\n")
  53 (print-expr (.sym a "b" c))
  54
  55 (test-name ".str")
  56 (print-match "\"def\"\n")
  57 (print-expr (.str d "e" f))
  58
  59 (test-name ".hex")
  60 (print-match "\"2a\"")
  61 (print-expr (.hex 42))
  62
  63 (test-name ".upcase")
  64 (print-match "\"UPPER\"")
  65 (print-expr (.upcase "upper"))
  66 (print-match "UPPER")
  67 (print-expr (.upcase upper))
  68
  69 (test-name ".downcase")
  70 (print-match "\"downer\"")
  71 (print-expr (.downcase "DOWNER"))
  72 (print-match "downer")
  73 (print-expr (.downcase DOWNER))
  74
  75 (test-name ".substring")
  76 (print-match "\"zz\"")
  77 (print-expr (.substring "xyzzy" 2 4))
  78 (print-match "zz")
  79 (print-expr (.substring xyzzy 2 4))
  80
  81 (test-name ".splice1")
  82 (print-match "(now is the time)")
  83 (print-expr (.splice now (.unsplice (is the time))))
  84
  85 ;; Arguments to .splice/.unsplice are evaluated.
  86 (test-name ".splice2")
  87 (print-match "(now is the time)")
  88 (define-pmacro splice2-piece now)
  89 (print-expr (.splice splice2-piece (.unsplice (is the time))))
  90
  91 ;; Arguments to .splice/.unsplice are evaluated.
  92 (test-name ".splice3")
  93 (print-match "(now is the time)")
  94 (define-pmacro splice3-piece the)
  95 (print-expr (.splice now (.unsplice (is splice3-piece time))))
  96
  97 (test-name ".iota")
  98 (print-match "(0 1 2 3)")
  99 (print-expr (.iota 4))
 100 (print-match "(1 2 3 4)")
 101 (print-expr (.iota 4 1))
 102 (print-match "(2 4 6 8)")
 103 (print-expr (.iota 4 2 2))
 104
 105 (test-name ".map")
 106 (print-match "(\"a\" \"b\" \"c\")")
 107 (print-expr (.map .hex (10 11 12)))
 108 (print-match "(\"a\" \"b\" \"c\")")
 109 (print-expr (.map (.pmacro (x) (.hex x)) (10 11 12)))
 110
 111 (test-name ".apply")
 112 (print-match "ABC")
 113 (print-expr (.apply .upcase (abc)))
 114
 115 (test-name ".pmacro?")
 116 (print-match "#t")
 117 (print-expr (.pmacro? .pmacro?))
 118 (print-match "#t")
 119 (print-expr (.pmacro? test-name))
 120 (print-match "#t")
 121 (print-expr (.pmacro? (.pmacro (a) (add a 1))))
 122 (print-match "#f")
 123 (print-expr (.pmacro? 42))
 124
 125 (test-name ".eval")
 126 (print-match "(explicitly-undefined 42)")
 127 (define-pmacro (eval-test1 a) (explicitly-undefined a))
 128 (print-expr (.eval (.splice eval-test1 (.unsplice (42)))))
 129
 130 (test-name ".let")
 131 (print-match "xyzzy")
 132 (print-expr (.let ((x xyzzy)) x))
 133 ;; FIXME: This is the currently defined behaviour, but it's somewhat
 134 ;; unintuitive.
 135 ;; pmacro expansion re-evaluates the result if it's also a pmacro,
 136 ;; so x -> y -> x and y -> x -> y.
 137 (print-match "(x y)")
 138 (print-expr (.let ((x y) (y x)) (.list x y)))
 139
 140 (test-name ".let*")
 141 (print-match "(1 2)")
 142 (print-expr (.let* ((x 1) (y (.add x 1))) (.list x y)))
 143
 144 (test-name ".if")
 145 (print-match "then")
 146 (print-expr (.if #t then else))
 147 (print-match "else")
 148 (print-expr (.if #f then else))
 149
 150 (test-name ".case")
 151 (print-match "123")
 152 (print-expr (.case seba ((seba beach) 123) (else 456)))
 153 (print-match "123")
 154 (print-expr (.case beach ((seba beach) 123) (else 456)))
 155 (print-match "456")
 156 (print-expr (.case 0 ((seba beach) 123) (else 456)))
 157
 158 (test-name ".cond")
 159 (print-match "yep")
 160 (print-expr (.cond ((.eq 1 1) yep) (else nope)))
 161 (print-match "nope")
 162 (print-expr (.cond ((.eq 1 2) yep) (else nope)))
 163
 164 (test-name ".begin")
 165 (print-match "xyz")
 166 (print-thunk (.pmacro () (.begin (.print "x") (.print "y") (.print "z"))))
 167
 168 (test-name ".list, .ref")
 169 (print-match "grief")
 170 (print-expr (.ref (.list good grief) 1))
 171
 172 (test-name ".length")
 173 (print-match "6")
 174 (print-expr (.length snoopy))
 175 (print-match "9")
 176 (print-expr (.length "woodstock"))
 177 (print-match "4")
 178 (print-expr (.length (good grief charlie brown)))
 179
 180 (test-name ".replicate")
 181 (print-match "(no no no no)")
 182 (print-expr (.replicate 4 no))
 183
 184 (test-name ".find")
 185 (print-match "(0 1)")
 186 (print-expr (.find (.pmacro (n) (.lt n 2)) (.iota 4)))
 187
 188 (test-name ".equal?")
 189 (print-match "#t")
 190 (print-expr (.equal? (yo yo) (yo yo)))
 191 (print-match "#f")
 192 (print-expr (.equal? (yo yo) (yo x)))
 193
 194 (test-name ".andif")
 195 (print-match "andif")
 196 (print-expr (.andif 1 #t andif))
 197 (print-match "#f")
 198 (print-expr (.andif 1 #f andif))
 199 (print-match "#t")
 200 (print-expr (.andif))
 201
 202 (test-name ".orif")
 203 (print-match "orif")
 204 (print-expr (.orif #f orif))
 205 (print-match "#f")
 206 (print-expr (.orif #f #f))
 207 (print-match "#f")
 208 (print-expr (.orif))
 209
 210 (test-name ".not")
 211 (print-match "yep")
 212 (print-expr (.if (.not #f) yep nope))
 213 (print-match "nope")
 214 (print-expr (.if (.not #t) yep nope))
 215
 216 (test-name ".eq")
 217 (print-match "eq")
 218 (print-expr (.if (.eq foo foo) eq ne))
 219 (print-match "eq2")
 220 (print-expr (.if (.eq 1 1) eq2 ne2))
 221
 222 (test-name ".ne")
 223 (print-match "ne")
 224 (print-expr (.if (.ne foo bar) ne eq))
 225 (print-match "ne2")
 226 (print-expr (.if (.ne 1 2) ne2 eq2))
 227
 228 (test-name ".lt")
 229 (print-match "lt")
 230 (print-expr (.if (.lt 1 2) lt nope))
 231
 232 (test-name ".gt")
 233 (print-match "gt")
 234 (print-expr (.if (.gt 1 0) gt nope))
 235
 236 (test-name ".le")
 237 (print-match "le1")
 238 (print-expr (.if (.le 1 1) le1 nope))
 239 (print-match "le2")
 240 (print-expr (.if (.le 1 2) le2 nope))
 241
 242 (test-name ".ge")
 243 (print-match "ge1")
 244 (print-expr (.if (.ge 1 1) ge1 nope))
 245 (print-match "ge2")
 246 (print-expr (.if (.ge 1 0) ge2 nope))
 247
 248 (test-name ".add")
 249 (print-match "3")
 250 (print-expr (.add 1 2))
 251
 252 (test-name ".sub")
 253 (print-match "-1")
 254 (print-expr (.sub 1 2))
 255
 256 (test-name ".mul")
 257 (print-match "6")
 258 (print-expr (.mul 2 3))
 259
 260 (test-name ".div")
 261 (print-match "4")
 262 (print-expr (.div 8 2))
 263
 264 (test-name ".rem")
 265 (print-match "0")
 266 (print-expr (.rem 8 2))
 267
 268 (test-name ".sll")
 269 (print-match "8")
 270 (print-expr (.sll 1 3))
 271 (print-match "4")
 272 (print-expr (.sll 4 0))
 273
 274 (test-name ".srl")
 275 (print-match "1")
 276 (print-expr (.srl 8 3))
 277 (print-match "4")
 278 (print-expr (.srl 4 0))
 279
 280 (test-name ".sra")
 281 (print-match "-1")
 282 (print-expr (.sra -1 0))
 283 (print-match "-1")
 284 (print-expr (.sra -1 1))
 285 (print-match "-2")
 286 (print-expr (.sra -3 1))
 287
 288 (test-name ".and")
 289 (print-match "8")
 290 (print-expr (.and 15 8))
 291
 292 (test-name ".or")
 293 (print-match "15")
 294 (print-expr (.or 15 8))
 295
 296 (test-name ".xor")
 297 (print-match "7")
 298 (print-expr (.xor 15 8))
 299
 300 (test-name ".inv")
 301 (print-match "-6")
 302 (print-expr (.inv 5))
 303
 304 (test-name ".car")
 305 (print-match "car")
 306 (print-expr (.car (car cdr)))
 307
 308 (test-name ".cdr")
 309 (print-match "(cdr)")
 310 (print-expr (.cdr (car cdr)))
 311
 312 (test-name ".caar")
 313 (print-match "caar")
 314 (print-expr (.caar ((caar cdar) cadr cddr)))
 315
 316 (test-name ".cadr")
 317 (print-match "cadr")
 318 (print-expr (.cadr ((caar cdar) cadr cddr)))
 319
 320 (test-name ".cdar")
 321 (print-match "(cdar)")
 322 (print-expr (.cdar ((caar cdar) cadr cddr)))
 323
 324 (test-name ".cddr")
 325 (print-match "(cddr)")
 326 (print-expr (.cddr ((caar cdar) cadr cddr)))
 327
 328 EOF
 329
 330 run_cgen ${cpu_file}
 331
 332 post_process
 333
 334 finish