src/{module-impl,utilities}.lisp: Make `#line' work when pretty-printing.

[sod] / src / codegen-test.lisp

;;; -*-lisp-*-
;;;
;;; Tests for code generator
;;;
;;; (c) 2009 Straylight/Edgeware
;;;

;;;----- Licensing notice ---------------------------------------------------
;;;
;;; This file is part of the Sensible Object Design, an object system for C.
;;;
;;; SOD is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; SOD is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with SOD; if not, write to the Free Software Foundation,
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

(cl:in-package #:sod-test)

;;;--------------------------------------------------------------------------

(defclass gcd-codegen-test (test-case)
  (codegen))
(add-test *sod-test-suite* (get-suite gcd-codegen-test))

(defun make-gcd (codegen)

  (codegen-push codegen)
  (loop for (name init) in '(("aa" 1) ("bb" 0))
	do (ensure-var codegen name (c-type int) init))
  (codegen-push codegen)
  (with-temporary-var (codegen r (c-type int))
    (emit-inst codegen(make-set-inst r "u%v"))
    (with-temporary-var (codegen q (c-type int))
      (emit-inst codegen (make-set-inst q "u/v"))
      (with-temporary-var (codegen a (c-type int))
	(emit-insts codegen
		    (list (make-set-inst a "aa")
			  (make-set-inst "aa" "bb")
			  (make-set-inst "bb"
					 (format nil "~A - ~A*bb" a q))))))
    (emit-insts codegen (list (make-set-inst "u" "v")
			      (make-set-inst "v" r))))
  (emit-inst codegen (make-while-inst "v" (codegen-pop-block codegen)))
  (emit-inst codegen (make-if-inst "a" (make-set-inst "*a" "aa") nil))
  (deliver-expr codegen :return "u")
  (codegen-pop-function codegen "gcd"
			(c-type (fun int
				     ("u" int)
				     ("v" int)
				     ("a" (* int)))))

  (codegen-push codegen)
  (loop for (name init) in '(("u" "atoi(argv[1])")
			     ("v" "atoi(argv[2])")
			     ("a"))
	do (ensure-var codegen name (c-type int) init))
  (ensure-var codegen "g" (c-type int)
	      (make-call-inst "gcd" (list "u" "v" "&a")))
  (emit-inst codegen (make-expr-inst
		      (make-call-inst "printf"
				      (list "\"%d*%d == %d (mod %d)\\n\""
					    "a" "u" "g" "v"))))
  (deliver-expr codegen :return 0)
  (codegen-pop-function codegen "main"
			(c-type (fun int
				     ("argc" int)
				     ("argv" ([] string))))))

(defmethod set-up ((test gcd-codegen-test))
  (with-slots (codegen) test
    (setf codegen (make-instance 'codegen))
    (make-gcd codegen)))

(def-test-method check-output ((test gcd-codegen-test) :run nil)
  (assert-princ (codegen-functions (slot-value test 'codegen))
		"(static int gcd(int u, int v, int *a)
 {
   int aa = 1;
   int bb = 0;

   while (v) {
     int sod__v0;
     int sod__v1;
     int sod__v2;

     sod__v0 = u%v;
     sod__v1 = u/v;
     sod__v2 = aa;
     aa = bb;
     bb = sod__v2 - sod__v1*bb;
     u = v;
     v = sod__v0;
   }
   if (a) *a = aa;
   return (u);
 }


 static int main(int argc, char *argv[])
 {
   int u = atoi(argv[1]);
   int v = atoi(argv[2]);
   int a;
   int g = gcd(u, v, &a);

   printf(\"%d*%d == %d (mod %d)\\n\", a, u, g, v);
   return (0);
 }

 )"))

;;;----- That's all, folks --------------------------------------------------