  -*- coding : utf-8 - unix -*-
;;;
Part of :  / Scheme
Contents : tests for base91 ASCII armor of bytevectors
Date : Mon Mar   8 , 2010
;;;
;;;Abstract
;;;
;;;
;;;
Copyright ( c ) 2010   <  >
;;;
;;;This program 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 3 of the License , or ( at
;;;your option) any later version.
;;;
;;;This program 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 this program.  If not, see </>.
;;;


(import (nausicaa)
  (nausicaa armor base91)
  (nausicaa armor conditions)
  (nausicaa checks))

(check-set-mode! 'report-failed)
(display "*** testing ASCII armor base91\n")


;;;; helpers

(define (subbytevector src start past)
  (let ((dst (make-bytevector (- past start))))
    (do ((i 0 (+ 1 i))
	 (j start (+ 1 j)))
	((= j past)
	 dst)
      (bytevector-u8-set! dst i (bytevector-u8-ref src j)))))


;;;; base91 encoding and decoding routines

(define (encode binary)
  ;;Encode BINARY which  must be a Scheme string  or bytevector.  Return
two values :   ( 1 ) the resulting boolean from   the encoding functions ,
( 2 ) a string representing the encoded data .
  ;;
  (let* ((ctx		(make-<base91-encode-ctx>))
	 (src		(if (string? binary) (string->utf8 binary) binary))
	 (src-len	(bytevector-length src))
	 (dst		(make-bytevector (base91-encode-length src-len) 0)))
    (receive (dst-next src-next)
	(base91-encode-update! ctx dst 0 src 0 src-len)
      (receive (result dst-next src-next)
	  (base91-encode-final! ctx dst dst-next src src-next src-len)
	(list result (utf8->string (subbytevector dst 0 dst-next)))))))

(define (decode binary string-result?)
  ;;Decode BINARY which  must be a Scheme string  or bytevector.  Return
two   values : the   boolean result   from the   decoding   functions , the
  ;;decoded data.
  ;;
  ;;If STRING-RESULT?  is  true, the decoded data is  returned as Scheme
  ;;string; else it is returned as Scheme bytevector.
  ;;
  (define (%output dst dst-past)
    (let ((bv (subbytevector dst 0 dst-past)))
      (if string-result?
	  (utf8->string bv)
	bv)))
  (let* ((ctx		(make-<base91-decode-ctx>))
	 (src		(if (string? binary)
			    (string->utf8 binary)
			  binary))
	 (src-len	(bytevector-length src))
	 (dst		(make-bytevector (base91-decode-length src-len) 0)))
    (receive (result dst-next src-next)
	(base91-decode-update! ctx dst 0 src 0 src-len)
      (if result
	  (list result (%output dst dst-next))
	(receive (result dst-next src-next)
	    (base91-decode-final! ctx dst dst-next src src-next src-len)
	  (list result (%output dst dst-next)))))))


(parametrise ((check-test-name	'one)
	      (debugging	#t))

  (let ((a "") (b ""))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "\x0;") (b "AA"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "\x0;\x0;") (b "AAA"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "\x0;\x0;\x0;") (b "AAAA"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "\x0;\x0;\x0;\x0;") (b "AAAAA"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "h") (b "NB"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "he") (b "TPD"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "hel") (b "TPwJ"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "hell") (b "TPwJb"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "hello") (b "TPwJh>A"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "ciao") (b "laH<b"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "Le Poete est semblable au prince des nuees Qui hante la tempete e se rit de l'archer; Exile sul le sol au milieu des huees, Ses ailes de geant l'empechent de marcher.")
+ $ # /pEzj/1^IY@:Y$F20nu > N$z(Id ,  / Wue$y(&*EOiaBJgW < oe6U : yTmlLU8mfO[}A : dO[eGwS60GFTjKB0ft)_Y$Fp3$8wnyJ!f6 = yC4!ztEQUo2X_18gA " ) )
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  #t)


;;;; done

(check-report)

;;; end of file



Abstract




This program is free software:  you can redistribute it and/or modify
it under the terms of the  GNU General Public License as published by
your option) any later version.

This program 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

along with this program.  If not, see </>.

 helpers
 base91 encoding and decoding routines
Encode BINARY which  must be a Scheme string  or bytevector.  Return

Decode BINARY which  must be a Scheme string  or bytevector.  Return
decoded data.

If STRING-RESULT?  is  true, the decoded data is  returned as Scheme
string; else it is returned as Scheme bytevector.

 done
 end of file
  -*- coding : utf-8 - unix -*-
Part of :  / Scheme
Contents : tests for base91 ASCII armor of bytevectors
Date : Mon Mar   8 , 2010
Copyright ( c ) 2010   <  >
the Free Software Foundation , either version 3 of the License , or ( at
General Public License for more details .
You should   have received   a copy of   the GNU General   Public License


(import (nausicaa)
  (nausicaa armor base91)
  (nausicaa armor conditions)
  (nausicaa checks))

(check-set-mode! 'report-failed)
(display "*** testing ASCII armor base91\n")



(define (subbytevector src start past)
  (let ((dst (make-bytevector (- past start))))
    (do ((i 0 (+ 1 i))
	 (j start (+ 1 j)))
	((= j past)
	 dst)
      (bytevector-u8-set! dst i (bytevector-u8-ref src j)))))



(define (encode binary)
two values :   ( 1 ) the resulting boolean from   the encoding functions ,
( 2 ) a string representing the encoded data .
  (let* ((ctx		(make-<base91-encode-ctx>))
	 (src		(if (string? binary) (string->utf8 binary) binary))
	 (src-len	(bytevector-length src))
	 (dst		(make-bytevector (base91-encode-length src-len) 0)))
    (receive (dst-next src-next)
	(base91-encode-update! ctx dst 0 src 0 src-len)
      (receive (result dst-next src-next)
	  (base91-encode-final! ctx dst dst-next src src-next src-len)
	(list result (utf8->string (subbytevector dst 0 dst-next)))))))

(define (decode binary string-result?)
two   values : the   boolean result   from the   decoding   functions , the
  (define (%output dst dst-past)
    (let ((bv (subbytevector dst 0 dst-past)))
      (if string-result?
	  (utf8->string bv)
	bv)))
  (let* ((ctx		(make-<base91-decode-ctx>))
	 (src		(if (string? binary)
			    (string->utf8 binary)
			  binary))
	 (src-len	(bytevector-length src))
	 (dst		(make-bytevector (base91-decode-length src-len) 0)))
    (receive (result dst-next src-next)
	(base91-decode-update! ctx dst 0 src 0 src-len)
      (if result
	  (list result (%output dst dst-next))
	(receive (result dst-next src-next)
	    (base91-decode-final! ctx dst dst-next src src-next src-len)
	  (list result (%output dst dst-next)))))))


(parametrise ((check-test-name	'one)
	      (debugging	#t))

  (let ((a "") (b ""))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "\x0;") (b "AA"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "\x0;\x0;") (b "AAA"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "\x0;\x0;\x0;") (b "AAAA"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "\x0;\x0;\x0;\x0;") (b "AAAAA"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "h") (b "NB"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "he") (b "TPD"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "hel") (b "TPwJ"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "hell") (b "TPwJb"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "hello") (b "TPwJh>A"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "ciao") (b "laH<b"))
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  (let ((a "Le Poete est semblable au prince des nuees Qui hante la tempete e se rit de l'archer; Exile sul le sol au milieu des huees, Ses ailes de geant l'empechent de marcher.")
+ $ # /pEzj/1^IY@:Y$F20nu > N$z(Id ,  / Wue$y(&*EOiaBJgW < oe6U : yTmlLU8mfO[}A : dO[eGwS60GFTjKB0ft)_Y$Fp3$8wnyJ!f6 = yC4!ztEQUo2X_18gA " ) )
    (check (encode a)		=> `(#t ,b))
    (check (decode b #t)	=> `(#t ,a)))

  #t)



(check-report)

