[Tinyos-commits] CVS: tinyos-1.x/tos/lib/VM/languages/motlle/src regress-errors.mt, NONE, 1.1 regress.mt, NONE, 1.1

[David Gay]

Update of /cvsroot/tinyos/tinyos-1.x/tos/lib/VM/languages/motlle/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27250/src

Added Files:
	regress-errors.mt regress.mt 
Log Message:
regression tests and bug fixes


--- NEW FILE: regress-errors.mt ---
schemefile
(define (x args) 0) ;; use to avoid dropping effect-free exprs
(x blah)
(x (lambda))
(x (lambda (a)))
(x (lambda (a1 a2 a3 a4 a5 a6 a17 a18 a19 a10 a110 a111 a112 a113 a114 a115) 1))
(x (lambda (a a) 1))
(x (lambda (a b . c) 1))
(x (lambda "aa" 1))
(x (lambda (1 a 2) 1))
(x (x 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8))
(x (set!))
(x (set! a))
(x (set! a 1 2))
(x (set! 1 2))
(x (define "aa" 11))
(x (let))
(x (let ((a 0)) 1 . 2))
(x (let 11 1))
(x (let (11) 1))
(x (let ((11)) 1))
(x (let ((a . 11)) 1))
(x (let ((a 1 2)) 1))
(x (let ((c 1) (c 2)) c))
(x (let loop 11 1))
(x (let loop (11) 1))
(x (let loop ((11)) 1))
(x (let loop ((a . 11)) 1))
(x (let loop ((a 1 2)) 1))
(x (let loop ((a1 1) (a2 1) (a3 1) (a4 1) (a5 1) (a6 1) (a17 1) (a18 1) (a19 1) (a10 1) (a110 1) (a111 1) (a112 1) (a113 1) (a114 1) (a115 1)) 1))
(x (define))
(x (define a))
(x (define a b c))
(x (define (fun a1 a2 a3 a4 a5 a6 a17 a18 a19 a10 a110 a111 a112 a113 a114 a115) 1))
(x (define (foo x) (define a 1) (define a 1) 2))
(x (define (foo b b) 1))
(x (let*))
(x (let* ((a 0)) 1 . 2))
(x (let* 11 1))
(x (let* (11) 1))
(x (let* ((11)) 1))
(x (let* ((a . 11)) 1))
(x (let* ((a 1 2)) 1))
;; (x (let* ((c 1) (c 2)) c))  -- not an error
(x (letrec))
(x (letrec ((a 0)) 1 . 2))
(x (letrec 11 1))
(x (letrec (11) 1))
(x (letrec ((11)) 1))
(x (letrec ((a . 11)) 1))
(x (letrec ((a 1 2)) 1))
(x (letrec ((c 1) (c 2)) c))
(x (do))
(x (do ((i 0 1))))
(x (do 11 (1)))
(x (do (11) (1)))
(x (do ((11)) (1)))
(x (do ((a . 11)) (1)))
(x (do ((a 11 2) . 3) (1)))
(x (do ((a 11 2)) 1))
(x (do ((a 11 2)) (1 . 2)))
(x (cond))
(x (cond 11))
(x (cond (11)))
(x (cond (11 . 1)))
(x (cond (11 =>)))
(x (cond (11 => 2 3)))
(x (cond (else)))
(x (cond (else 11) (1 2)))
(x (case))
(x (case 1))
(x (case 1 1))
(x (case 1 (1)))
(x (case 1 ((1))))
(x (case 1 ((1) 2 . 3)))
(x (case 1 (else)))
(x (case 1 (else 11) ((1) 2)))

--- NEW FILE: regress.mt ---
schemefile
;; Some regression tests for the scheme compiler
(define (not x) (if x #f #t)) ;; global not is missing in motlle
(define (equal? v1 v2)
  (define (pair-equal? v1 v2) 
    (and (equal? (car v1) (car v2)) (equal? (cdr v1) (cdr v2))))
  (define (vector-equal? v1 v2)
    (let ((l1 (vector_length v1))
	  (l2 (vector_length v2)))
      (and (eq? l1 l2)
	   (let loop ((i 0))
	     (cond ((eq? i l1) #t)
		   ((not (equal? (any-ref v1 i) (any-ref v2 i))) #f)
		   (else (loop (+ i 1))))))))

  (cond ((and (pair? v1) (pair? v2)) (pair-equal? v1 v2))
	((and (vector? v1) (vector? v2)) (vector-equal? v1 v2))
	((and (string? v1) (string? v2)) (eq? (string_cmp v1 v2) 0))
	(else (eq? v1 v2))))

(define (expect name value got)
  (if (equal? value got)
      (display (format "%s: passed\n" name))
      (display (format "%s: FAILED, got %w, expected %w\n"
		       name got value))))

(define x 33)
(define y 44)
(define z #f)
(define v1 '#(3 4 5))
(define s1 "azgt")

(expect "builtin1" #t (eq? 3 3))
(expect "builtin2" #f (eq? "aa" 3))
(expect "if-and1" "yes" (if (and (string? s1) x) "yes" "no"))
(expect "if-and2" "no" (if (and (string? s1) (not x)) "yes" "no"))
(expect "if-and3" "yes" (if (and) "yes" "no"))
(expect "if-or1" "no" (if (or (not (string? s1)) (not x)) "yes" "no"))
(expect "if-or2" "yes" (if (or (not (string? s1)) x) "yes" "no"))
(expect "if-or3" "no" (if (or) "yes" "no"))
(expect "if-not1" 1 (if (not z) 1 0))
(expect "if-not2" 0 (if (not x) 1 0))

(expect "quote1" '3 '3)
(expect "quote2" (cons 'a 'b) '(a . b))
(expect "begin" x (begin (+ y x) x))

(define (map fn l)
  (cond ((null? l) '())
	(else (cons (fn (car l)) (map fn (cdr l))))))

(expect "lambda1" '(2 3 4) (map (lambda (x) (+ x 1)) '(1 2 3)))
(expect "lambda2" '(#(2) #(3) #(4)) (map (lambda x x) '(2 3 4)))

(expect "set!" 11 (set! x 11))
(expect "let1" x (let ((y x)) y))
(expect "let2" y (let ((y x) (x y)) x))
(expect "namedlet1" 120 (let fac ((prod 1) (n 1) (max 5))
			  (if (> n max) prod
			      (fac (* prod n) (+ n 1) max))))
(expect "let*1" 4 (let* ((c 1) (c (+ c 3))) c))
(expect "letrec1" 5 (letrec ((add1 (lambda (x) (+ x 1)))
			     (fun (lambda (x) (add1 (add1 x)))))
		      (fun 3)))
(expect "do1" 55 (do ((i 0 (+ i 1)) (sum 0 (+ sum i))) ((> i 10) sum)))
(expect "do2" 66 (do ((i 0 (+ i 1)) (sum 0 (+ sum i))) ((> i 10) sum)
		   (set! sum (+ sum 1))))
(expect "cond1" y (cond (x y)))
(expect "cond2" s1 (cond ((not x) y) (else s1)))
(expect "cond3" (vector s1) (cond (s1 => (lambda x x))))
(expect "cond4" (vector #t) (cond ((not z) => (lambda x x))))
(expect "and1" #t (and))
(expect "and2" #f (and z y))
(expect "and3" #f (and y z))
(expect "and4" y (and x s1 y))
(expect "or1" #f (or))
(expect "or2" y (or y z))
(expect "or3" y (or z y))
(expect "case1" x (case 1 ((2 3 1 4) x) (else y)))
(expect "case2" y (case 5 ((2 3 1 4) x) (else y)))
(expect "case3" y (case "aa" ((2 3 "aa" 4) x) (else y)))
(expect "case4" y (case 5 ((2 3 1 4) x) (() x) (else y)))