chiark - git - mdw - sod/blob - src/codegen-test.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Tests for code generator
   4 ;;;
   5 ;;; (c) 2009 Straylight/Edgeware
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This file is part of the Sensible Object Design, an object system for C.
  11 ;;;
  12 ;;; SOD is free software; you can redistribute it and/or modify
  13 ;;; it under the terms of the GNU General Public License as published by
  14 ;;; the Free Software Foundation; either version 2 of the License, or
  15 ;;; (at your option) any later version.
  16 ;;;
  17 ;;; SOD is distributed in the hope that it will be useful,
  18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;;; GNU General Public License for more details.
  21 ;;;
  22 ;;; You should have received a copy of the GNU General Public License
  23 ;;; along with SOD; if not, write to the Free Software Foundation,
  24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 (cl:in-package #:sod-test)
  27
  28 ;;;--------------------------------------------------------------------------
  29
  30 (defclass gcd-codegen-test (test-case)
  31   (codegen))
  32 (add-test *sod-test-suite* (get-suite gcd-codegen-test))
  33
  34 (defun make-gcd (codegen)
  35
  36   (codegen-push codegen)
  37   (loop for (name init) in '(("aa" 1) ("bb" 0))
  38         do (ensure-var codegen name (c-type int) init))
  39   (codegen-push codegen)
  40   (with-temporary-var (codegen r (c-type int))
  41     (emit-inst codegen(make-set-inst r "u%v"))
  42     (with-temporary-var (codegen q (c-type int))
  43       (emit-inst codegen (make-set-inst q "u/v"))
  44       (with-temporary-var (codegen a (c-type int))
  45         (emit-insts codegen
  46                     (list (make-set-inst a "aa")
  47                           (make-set-inst "aa" "bb")
  48                           (make-set-inst "bb"
  49                                          (format nil "~A - ~A*bb" a q))))))
  50     (emit-insts codegen (list (make-set-inst "u" "v")
  51                               (make-set-inst "v" r))))
  52   (emit-inst codegen (make-while-inst "v" (codegen-pop-block codegen)))
  53   (emit-inst codegen (make-if-inst "a" (make-set-inst "*a" "aa") nil))
  54   (deliver-expr codegen :return "u")
  55   (codegen-pop-function codegen "gcd"
  56                         (c-type (fun int
  57                                      ("u" int)
  58                                      ("v" int)
  59                                      ("a" (* int)))))
  60
  61   (codegen-push codegen)
  62   (loop for (name init) in '(("u" "atoi(argv[1])")
  63                              ("v" "atoi(argv[2])")
  64                              ("a"))
  65         do (ensure-var codegen name (c-type int) init))
  66   (ensure-var codegen "g" (c-type int)
  67               (make-call-inst "gcd" (list "u" "v" "&a")))
  68   (emit-inst codegen (make-expr-inst
  69                       (make-call-inst "printf"
  70                                       (list "\"%d*%d == %d (mod %d)\\n\""
  71                                             "a" "u" "g" "v"))))
  72   (deliver-expr codegen :return 0)
  73   (codegen-pop-function codegen "main"
  74                         (c-type (fun int
  75                                      ("argc" int)
  76                                      ("argv" ([] string))))))
  77
  78 (defmethod set-up ((test gcd-codegen-test))
  79   (with-slots (codegen) test
  80     (setf codegen (make-instance 'codegen))
  81     (make-gcd codegen)))
  82
  83 (def-test-method check-output ((test gcd-codegen-test) :run nil)
  84   (assert-princ (codegen-functions (slot-value test 'codegen))
  85                 "(static int gcd(int u, int v, int *a)
  86  {
  87    int aa = 1;
  88    int bb = 0;
  89
  90    while (v) {
  91      int sod__v0;
  92      int sod__v1;
  93      int sod__v2;
  94
  95      sod__v0 = u%v;
  96      sod__v1 = u/v;
  97      sod__v2 = aa;
  98      aa = bb;
  99      bb = sod__v2 - sod__v1*bb;
 100      u = v;
 101      v = sod__v0;
 102    }
 103    if (a) *a = aa;
 104    return (u);
 105  }
 106
 107
 108  static int main(int argc, char *argv[])
 109  {
 110    int u = atoi(argv[1]);
 111    int v = atoi(argv[2]);
 112    int a;
 113    int g = gcd(u, v, &a);
 114
 115    printf(\"%d*%d == %d (mod %d)\\n\", a, u, g, v);
 116    return (0);
 117  }
 118
 119  )"))
 120
 121 ;;;----- That's all, folks --------------------------------------------------