; Test code for word.sch
; 2003-12-14 / lth

(require 'word)

(define (fail token . more)
  (display "Error: test failed: ")
  (display token)
  (newline)
  #f)

(or (equal? (word 0) '(0 . 0))
    (fail 'word-syntax:1))
(or (equal? (word 1) '(0 . 1))
    (fail 'word-syntax:2))
(or (equal? (word 65536) '(1 . 0))
    (fail 'word-syntax:3))
(or (equal? (word -1) '(65535 . 65535))
    (fail 'word-syntax:4))

(or (equal? (integer->word 0) (word 0))
    (fail 'integer->word:1))
(or (equal? (integer->word 1) (word 1))
    (fail 'integer->word:2))
(or (equal? (integer->word 65536) (word 65536))
    (fail 'integer->word:3))
(or (equal? (integer->word -1) (word -1))
    (fail 'integer->word:4))

(or (equal? (word->integer (integer->word 0)) 0)
    (fail 'identity:1))
(or (equal? (word->integer (integer->word 1)) 1)
    (fail 'identity:2))
(or (equal? (word->integer (integer->word 65536)) 65536)
    (fail 'identity:3))
(or (equal? (word->integer (integer->word -1)) (- (expt 2 32) 1))
    (fail 'identity:4))

(or (equal? (word->integer (word+ (word 1) (word 1))) 2)
    (fail 'word+:1))
(or (equal? (word->integer (word+ (word -1) (word 1))) 0)
    (fail 'word+:2))
(or (equal? (word->integer (word+ (word 65535) (word 1))) 65536)
    (fail 'word+:3))

(or (equal? (word->integer (word- (word 2) (word 1))) 1)
    (fail 'word-:1))
(or (equal? (word->integer (word- (word 0) (word 1))) (- (expt 2 32) 1))
    (fail 'word-:2))
(or (equal? (word->integer (word- (word 65536) (word 1))) 65535)
    (fail 'word-:3))

(or (word= (word 1) (word 1))
    (fail 'word=:1))
(or (not (word= (word -1) (word 1)))
    (fail 'word=:2))

(or (word< (word 1) (word 2))
    (fail 'word<:1))
(or (not (word< (word 1) (word 1)))
    (fail 'word<:2))
(or (not (word< (word 2) (word 1)))
    (fail 'word<:3))

(or (word<= (word 1) (word 2))
    (fail 'word<=:1))
(or (word<= (word 1) (word 1))
    (fail 'word<=:2))
(or (not (word<= (word 2) (word 1)))
    (fail 'word<=:3))

(or (word> (word 2) (word 1))
    (fail 'word>:1))
(or (not (word> (word 1) (word 1)))
    (fail 'word>:2))
(or (not (word> (word 1) (word 2)))
    (fail 'word>:3))

(or (word>= (word 2) (word 1))
    (fail 'word>=:1))
(or (word>= (word 1) (word 1))
    (fail 'word>=:2))
(or (not (word>= (word 1) (word 2)))
    (fail 'word>=:3))

(or (word= (word-not (word 0)) (word -1))
    (fail 'word-not:1))
(or (word= (word-not (word-not (word 1234567))) (word 1234567))
    (fail 'word-not:2))

(or (word= (word-ior (word #xFEFE0101) (word #x03033333)) (word #xFFFF3333))
    (fail 'word-ior:1))

(or (word= (word-xor (word #xFEFE0101) (word #x03033333)) (word #xFDFD3232))
    (fail 'word-xor:1))

(or (word= (word-and (word #xFEFE0101) (word #x03033333)) (word #x02020101))
    (fail 'word-and:1))

(or (word= (word-shift (word #x12345678) 4) (word #x23456780))
    (fail 'word-shift:1))
(or (word= (word-shift (word #x12345678) -4) (word #x01234567))
    (fail 'word-shift:2))
(or (word= (word-shift (word #x87654321) -4) (word #xF8765432))
    (fail 'word-shift:3))
(or (word= (word-shift (word #x12345678) 32) (word #x12345678))
    (fail 'word-shift:4))

(or (word= (word-rotate (word #x12345678) 12) (word #x45678123))
    (fail 'word-rotate:1))
(or (word= (word-rotate (word #x12345678) -12) (word #x67812345))
    (fail 'word-rotate:2))
(or (word= (word-rotate (word #x12345678) -68) 
	   (word-rotate (word #x12345678) -4))
    (fail 'word-rotate:3))
