Update automatically managed build utilities.
[sod] / 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 Sensble 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 --------------------------------------------------