cgen/testsuite/pmacros-1.test

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