src/parser/floc-proto.lisp: Use correct function for constructing conditions.
[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 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")))
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" "u" "v" "&a"))
68 (deliver-call codegen :void "printf"
69 "\"%d*%d == %d (mod %d)\\n\"" "a" "u" "g" "v")
70 (deliver-expr codegen :return 0)
71 (codegen-pop-function codegen "main"
72 (c-type (fun int
73 ("argc" int)
74 ("argv" ([] string))))))
75
76 (defmethod set-up ((test gcd-codegen-test))
77 (with-slots (codegen) test
78 (setf codegen (make-instance 'codegen))
79 (make-gcd codegen)))
80
81 (def-test-method check-output ((test gcd-codegen-test) :run nil)
82 (assert-princ (codegen-functions (slot-value test 'codegen))
83 "(static int gcd(int u, int v, int *a)
84 {
85 int aa = 1;
86 int bb = 0;
87
88 while (v) {
89 int sod__v0;
90 int sod__v1;
91 int sod__v2;
92
93 sod__v0 = u%v;
94 sod__v1 = u/v;
95 sod__v2 = aa;
96 aa = bb;
97 bb = sod__v2 - sod__v1*bb;
98 u = v;
99 v = sod__v0;
100 }
101 if (a) *a = aa;
102 return (u);
103 }
104
105
106 static int main(int argc, char *argv[])
107 {
108 int u = atoi(argv[1]);
109 int v = atoi(argv[2]);
110 int a;
111 int g = gcd(u, v, &a);
112
113 printf(\"%d*%d == %d (mod %d)\\n\", a, u, g, v);
114 return (0);
115 }
116
117 )"))
118
119 ;;;----- That's all, folks --------------------------------------------------