(test-begin "string")
(test 'ok (bitmatch "ABC" (("A" 66 #\C) 'ok)))
(test 'ok (bitmatch "ABC" (("AB" #\C) 'ok)))
(test-end)

(test 1.5
  (bitmatch `#( #x38 #x00 #x3f #x80 #x00 #x00 )
    (((a 16 float) (b 32 float))
     (print "a=" a " b=" b) (+ a b))))

(bitmatch `#(5 1 2 3 4 5)
  (((count 8) (rest (* count 8) bitstring))
   (print " count=" count " rest=" (bitstring-length rest))))

(bitmatch `#(#x45 #x00 #x00 #x6c #x92 #xcc #x00 #x00
             #x38 #x06 #x00 #x00 #x92 #x95 #xba #x14 #xa9 #x7c #x15 #x95)
  (((Version 4)
    (IHL 4)
    (TOS 8)
    (TL 16)
    (Identification 16)
    (Reserved 1)
    (DF 1)
    (MF 1)
    (FramgentOffset 13)
    (TTL 8)
    (and (Protocol 8)
         (? (lambda (Protocol)
              (or (= Protocol 1)
                  (= Protocol 2)
                  (= Protocol 6)
                  (= Protocol 17)))))
    (CheckSum 16)
    (SourceAddr 32 bitstring)
    (DestinationAddr 32 bitstring)
    (Optional bitstring))
   (print "Version " Version)
   (print "IHL " IHL)
   (print "TL " TL)
   (print "Identification " Identification)
   (print "Reserver " Reserved " DF " DF " MF " MF)
   (print "FramgentOffset " FramgentOffset)
   (print "TTL " TTL)
   (print "Protocol " (case Protocol
                        ((1) "ICMP")
                        ((2) "IGMP")
                        ((6) "TCP")
                        ((17) "UDP")))
   (print "CheckSum " (sprintf "~X" CheckSum))
   (print "SourceAddr " (bitmatch SourceAddr
                                  ((let a 8)(let b 8)(let c 8)(let d 8) ->
                                   (sprintf "~A.~A.~A.~A" a b c d))))
   (print "DestinationAddr " (bitmatch DestinationAddr
                                       ((let a)(let b)(let c)(let d) ->
                                        (sprintf "~A.~A.~A.~A" a b c d)))))
  (else
   (print "bad datagram")))




(test-begin "match")
(test (list 1 15)
  (bitmatch `#(#x8F)
    (((flagBit 1 big) (restValue 7))
     (list flagBit restValue))))

(test 'ok
  (bitmatch `#( #x8F )
    (((1 1) rest) 'fail)
    (((and (x 1) (? (lambda (x) (= x 0)))) (rest bitstring)) 'fail2)
    (((1 1) (rest bitstring)) 'ok)))

(test 'ok
  (bitmatch `#( #x8F )
    ((#x8E) 'fail1)
    ((#x8C) 'fail2)
    ((#x8F) 'ok)))

(test 'ok
  (bitmatch `#( #x8F )
    ((#x8E) 'fail1)
    ((#x8C) 'fail2)
    (else 'ok)))

(test-error
  (bitmatch `#( #x8F )
    ((#x8E) 'fail1)
    ((#x8C) 'fail2)
    (else 'ok)
    ((#x8F) 'fail3)))
    	
(test-end)