r3750: *** empty log message ***

diff --git a/debian/changelog b/debian/changelog
index 81e12a0c892c96d4fa28741319b2f085ecfc1856..fb13c48003e6636bf34b34525eac444bd03084bc 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,10 +1,11 @@
 cl-base64 (3.0.0-1) unstable; urgency=low
 
 cl-base64 (3.0.0-1) unstable; urgency=low
 

+  * Remove src.lisp and add package.lisp, decode.lisp, encode.lisp     
+  * Add support for usb8-arrays        
+  * Rewrite routines as macros to create efficient functions for
+     converting to and from streams, strings, and usb8-arrays.

   * Fix error in integer-to-base64 when using columns
   * Add base64-test.asd and test.lisp regression suite
   * Fix error in integer-to-base64 when using columns
   * Add base64-test.asd and test.lisp regression suite

-  * Rewrite routines as macros to create efficient functions to
-    converting from strings or streams and converting to streams, strings,
-    and usb8-arrays.

 
  -- Kevin M. Rosenberg <kmr@debian.org>  Sat,  4 Jan 2003 06:40:32 -0700
 
 
  -- Kevin M. Rosenberg <kmr@debian.org>  Sat,  4 Jan 2003 06:40:32 -0700
 

diff --git a/encode.lisp b/encode.lisp
index d079515487c3d222334aa5f833c1bb0c69db9e9e..803c9ce532293c9aa7816c2609c35c843cfbe805 100644 (file)
--- a/encode.lisp
+++ b/encode.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;

-;;;; $Id: encode.lisp,v 1.2 2003/01/12 22:32:40 kevin Exp $
+;;;; $Id: encode.lisp,v 1.3 2003/01/13 21:38:01 kevin Exp $

 ;;;;
 ;;;; This file implements the Base64 transfer encoding algorithm as
 ;;;; defined in RFC 1521 by Borensten & Freed, September 1993.
 ;;;;
 ;;;; This file implements the Base64 transfer encoding algorithm as
 ;;;; defined in RFC 1521 by Borensten & Freed, September 1993.


@@ -28,7 +28,7 @@
 ;;;;   - Renamed functions now that supporting integer conversions
 ;;;;   - URI-compatible encoding using :uri key
 ;;;;
 ;;;;   - Renamed functions now that supporting integer conversions
 ;;;;   - URI-compatible encoding using :uri key
 ;;;;

-;;;; $Id: encode.lisp,v 1.2 2003/01/12 22:32:40 kevin Exp $
+;;;; $Id: encode.lisp,v 1.3 2003/01/13 21:38:01 kevin Exp $

 
 (in-package #:cl-base64)
 
 
 (in-package #:cl-base64)
 


@@ -123,16 +123,23 @@ with a #\Newline."
                 (the fixnum
                   (+
                    (the fixnum
                 (the fixnum
                   (+
                    (the fixnum

-                     (ash (char-code (the character
-                                       (char string isource))) 16))
+                     (ash (the fixnum
+                            (char-code (the character
+                                         (char string isource))))
+                          16))

                    (the fixnum
                    (the fixnum

-                     (ash (char-code (the character
-                                       (char string (1+ isource)))) 8))))
+                     (ash (the fixnum
+                            (char-code (the character
+                                         (char string (1+ isource)))))
+                          8))))

                 3))
               ((= remainder 1)
                (output-group
                 (the fixnum
                 3))
               ((= remainder 1)
                (output-group
                 (the fixnum

-                  (ash (char-code (the character (char string isource))) 16))
+                  (ash
+                   (the fixnum
+                     (char-code (the character (char string isource))))
+                   16))

                 2)))
             result)
          (declare (fixnum igroup isource))
                 2)))
             result)
          (declare (fixnum igroup isource))


@@ -150,22 +157,22 @@ with a #\Newline."
 
 (defmacro def-*-to-base64-* (input-type output-type)
   `(defun ,(intern (concatenate 'string (symbol-name input-type)
 
 (defmacro def-*-to-base64-* (input-type output-type)
   `(defun ,(intern (concatenate 'string (symbol-name input-type)

-                               (symbol-name :-to-base-64-)
+                               (symbol-name :-to-base64-)

                                (symbol-name output-type)))
        (input
        ,@(when (eq output-type :stream)
                                (symbol-name output-type)))
        (input
        ,@(when (eq output-type :stream)

-               'output)
+               '(output))

        &key (uri nil) (columns 0))
      "Encode a string array to base64. If columns is > 0, designates
 maximum number of columns in a line and the string will be terminated
 with a #\Newline."
        &key (uri nil) (columns 0))
      "Encode a string array to base64. If columns is > 0, designates
 maximum number of columns in a line and the string will be terminated
 with a #\Newline."

-     (declare (,@(case input-type
-                      (:string
-                       '((string input)))
-                      (:usb8-array)
-                      '((type (array fixnum (*))) input))
-                (fixnum columns)
-                (optimize (speed 3))))
+     (declare ,@(case input-type
+                     (:string
+                      '((string input)))
+                     (:usb8-array
+                      '((type (array fixnum (*)) input))))
+             (fixnum columns)
+             (optimize (speed 3)))

      (let ((pad (if uri *uri-pad-char* *pad-char*))
           (encode-table (if uri *uri-encode-table* *encode-table*)))
        (declare (simple-string encode-table)
      (let ((pad (if uri *uri-pad-char* *pad-char*))
           (encode-table (if uri *uri-encode-table* *encode-table*)))
        (declare (simple-string encode-table)


@@ -174,126 +181,137 @@ with a #\Newline."
              (complete-group-count (truncate string-length 3))
              (remainder (nth-value 1 (truncate string-length 3)))
              (padded-length (* 4 (truncate (+ string-length 2) 3)))
              (complete-group-count (truncate string-length 3))
              (remainder (nth-value 1 (truncate string-length 3)))
              (padded-length (* 4 (truncate (+ string-length 2) 3)))

-             (num-lines (if (plusp columns)
-                            (truncate (+ padded-length (1- columns)) columns)
-                            0))
-             (num-breaks (if (plusp num-lines)
-                             (1- num-lines)
-                             0))
-          (strlen (if stream
+             ,@(when (eq output-type :string)
+                     '((num-lines (if (plusp columns)
+                                      (truncate (+ padded-length (1- columns)) columns)
+                                      0))
+                       (num-breaks (if (plusp num-lines)
+                                       (1- num-lines)
+                                       0))
+                       (strlen (+ padded-length num-breaks))
+                       (result (make-string strlen))
+                       (ioutput 0)))
+             (col (if (plusp columns)

                       0
                       0

-                      (+ padded-length num-breaks)))
-          (result (make-string strlen))
-          (col (if (plusp columns)
-                   0
-                   (1+ padded-length)))
-          (ioutput 0))
-      (declare (fixnum string-length padded-length col ioutput)
-              (simple-string result))
-      (macrolet ((output-char (ch)
-                  (if (= col columns)
-                      (progn
-                        (if stream
-                            (write-char #\Newline stream)
-                            (progn
-                              (setf (schar result ioutput) #\Newline)
-                              (incf ioutput)))
-                        (setq col 1))
-                      (incf col))
-                  ,@(case output-type
-                          (:stream
-                           '((write-char ch stream))
-                           (:string
-                            '((setf (schar result ioutput) ch)
-                              (incf ioutput)))))))
-       (labels ((output-group (svalue chars)
-                  (declare (fixnum svalue chars))
-                  (output-char
-                   (schar encode-table
-                          (the fixnum
-                            (logand #x3f
-                                    (the fixnum (ash svalue -18))))))
-                  (output-char
-                   (schar encode-table
-                          (the fixnum
-                            (logand #x3f
-                                    (the fixnum (ash svalue -12))))))
-                  (if (> chars 2)
-                      (output-char
-                       (schar encode-table
-                          (the fixnum
-                            (logand #x3f
-                                    (the fixnum (ash svalue -6))))))
-                      (output-char pad))
+                      (1+ padded-length))))
+        (declare (fixnum string-length padded-length col
+                         ,@(when (eq output-type :string)
+                                 '(ioutput)))
+                 ,@(when (eq output-type :string)
+                         '((simple-string result))))
+        (labels ((output-char (ch)
+                   (if (= col columns)
+                       (progn
+                         ,@(case output-type
+                                 (:stream
+                                  '((write-char #\Newline output)))
+                                (:string
+                                 '((setf (schar result ioutput) #\Newline)
+                                   (incf ioutput))))
+                         (setq col 1))
+                    (incf col))
+                ,@(case output-type
+                        (:stream
+                         '((write-char ch output)))
+                        (:string
+                         '((setf (schar result ioutput) ch)
+                           (incf ioutput)))))
+              (output-group (svalue chars)
+                (declare (fixnum svalue chars))
+                (output-char
+                 (schar encode-table
+                        (the fixnum
+                          (logand #x3f
+                                  (the fixnum (ash svalue -18))))))
+                (output-char
+                 (schar encode-table
+                        (the fixnum
+                          (logand #x3f
+                                       (the fixnum (ash svalue -12))))))
+                (if (> chars 2)
+                    (output-char
+                     (schar encode-table
+                            (the fixnum
+                              (logand #x3f
+                                      (the fixnum (ash svalue -6))))))
+                    (output-char pad))

                   (if (> chars 3)
                       (output-char
                        (schar encode-table
                               (the fixnum
                                 (logand #x3f svalue))))
                   (if (> chars 3)
                       (output-char
                        (schar encode-table
                               (the fixnum
                                 (logand #x3f svalue))))

-                (output-char pad))))
-         (do ((igroup 0 (1+ igroup))
-              (isource 0 (+ isource 3)))
-             ((= igroup complete-group-count)
-              (cond
-                ((= remainder 2)
-                 (output-group
-                  (the fixnum
+                      (output-char pad))))
+       (do ((igroup 0 (1+ igroup))
+            (isource 0 (+ isource 3)))
+           ((= igroup complete-group-count)
+            (cond
+              ((= remainder 2)
+               (output-group
+                (the fixnum

                     (+
                     (+

-                   (the fixnum
-                     (ash
-                      ,(case input-type
-                             (:string
-                              '(char-code (the character (char input isource))))
-                             (:usb8-array
-                              '(the fixnum (aref input isource))))
-                      16))
-                   (the fixnum
-                     (ash
-                      ,(case input-type
-                             (:string
-                              '(char-code (the character (char input (1+ isource)))))
-                             (:usb8-array
-                              '(the fixnum (aref input (1+ isource)))))
-                      8))))
-                  3))
-                ((= remainder 1)
-                 (output-group
-                  (the fixnum
-                    ,(case input-type
-                           (:string
-                            '(char-code (the character (char input isource))))
-                           (:usb8-array
-                            '(the fixnum (aref input isource)))))
-                  2)))
-              result)
-           (declare (fixnum igroup isource))
-           (output-group 
-            (the fixnum
-              (+
-               (the fixnum
-                 (ash
-                  ,(case input-type
-                         (:string
-                          '(char-code (the character (char input isource))))
-                         (:usb8-array
-                          '(the fixnum (aref input isource))))
-                  16))
-               (the fixnum
-                 (ash
+                     (the fixnum
+                       (ash
+                        ,(case input-type
+                               (:string
+                                '(char-code (the character (char input isource))))
+                               (:usb8-array
+                                '(the fixnum (aref input isource))))
+                        16))
+                     (the fixnum
+                       (ash
+                        ,(case input-type
+                               (:string
+                                '(char-code (the character (char input (1+ isource)))))
+                               (:usb8-array
+                                '(the fixnum (aref input (1+ isource)))))
+                        8))))
+                3))
+              ((= remainder 1)
+               (output-group
+                (the fixnum
+                  (ash
+                   ,(case input-type
+                          (:string
+                           '(char-code (the character (char input isource))))
+                          (:usb8-array
+                           '(the fixnum (aref input isource))))
+                   16))
+                2)))
+            ,(case output-type
+                   (:string
+                    'result)
+                   (:stream
+                    'output)))
+         (declare (fixnum igroup isource))
+         (output-group 
+          (the fixnum
+            (+
+             (the fixnum
+               (ash
+                (the fixnum
+                ,(case input-type
+                       (:string
+                        '(char-code (the character (char input isource))))
+                       (:usb8-array
+                        '(aref input isource))))
+                16))
+             (the fixnum
+               (ash
+                (the fixnum

                   ,(case input-type
                          (:string
                           '(char-code (the character (char input (1+ isource)))))
                   ,(case input-type
                          (:string
                           '(char-code (the character (char input (1+ isource)))))

-                         (:usb8-array
-                          '(the fixnum (aref input (1+ isource)))))
-                  8))
-               (the fixnum
-                 ,(case input-type
-                        (:string
-                         '(char-code (the character (char input (+ 2 isource)))))
-                        (:usb8-array
-                         '(the fixnum (aref input (+ 2 isource)))))
-                 )))
-            4))))))))
+                       (:usb8-array
+                        '(aref input (1+ isource)))))
+                8))
+             (the fixnum
+               ,(case input-type
+                      (:string
+                       '(char-code (the character (char input (+ 2 isource)))))
+                      (:usb8-array
+                       '(aref input (+ 2 isource))))
+               )))
+          4)))))))

 
 (def-*-to-base64-* :string :string)
 (def-*-to-base64-* :string :stream)
 
 (def-*-to-base64-* :string :string)
 (def-*-to-base64-* :string :stream)

diff --git a/test.lisp b/test.lisp
new file mode 100644 (file)
index 0000000..a21da95
--- /dev/null
+++ b/test.lisp
@@ -0,0 +1,75 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          test.lisp
+;;;; Purpose:       Regression tests for cl-base64
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Jan 2003
+;;;;
+;;;; $Id: test.lisp,v 1.1 2003/01/13 21:39:46 kevin Exp $
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(defpackage #:base64-test
+  (:use #:cl #:kmrcl #:base64 #:util.test))
+
+(in-package #:base64-test)
+
+(defun test-base64 ()
+  (with-tests (:name "cl-base64 tests")
+    (do* ((length 0 (+ 3 length))
+         (string (make-string length) (make-string length))
+         (usb8 (make-usb8-array length) (make-usb8-array length))
+         (integer (random (expt 10 length)) (random (expt 10 length))))
+        ((>= length 300))
+    (dotimes (i length)
+      (declare (fixnum i))
+      (let ((code (random 256)))
+       (setf (schar string i) (code-char code))
+       (setf (aref usb8 i) code)))
+
+      (do* ((columns 0 (+ columns 4)))
+          ((> columns length))
+      ;; Test against cl-base64 routines
+       (test integer (base64-string-to-integer
+                                (integer-to-base64-string integer :columns columns)))
+       (test string (base64-string-to-string
+                               (string-to-base64-string string :columns columns))
+                     :test #'string=)
+      
+      ;; Test against AllegroCL built-in routines
+      #+allegro
+      (progn
+      (test integer (excl:base64-string-to-integer
+                              (integer-to-base64-string integer :columns columns)))
+      (test integer (base64-string-to-integer
+                              (excl:integer-to-base64-string integer)))
+      (test (string-to-base64-string string :columns columns)
+           (excl:usb8-array-to-base64-string usb8
+                                             (if (zerop columns)
+                                                 nil
+                                                 columns))
+           :test #'string=)
+      (test string (base64-string-to-string
+                   (excl:usb8-array-to-base64-string
+                    usb8
+                    (if (zerop columns)
+                        nil
+                        columns)))
+           :test #'string=))))))
+
+
+(defun time-routines ()
+  (let* ((str "abcdefghijklmnopqwertyu1234589jhwf2ff")
+        (usb8 (string-to-usb8-array str))
+        (int 12345678901234567890)
+        (n 50000))
+    (time-iterations n (integer-to-base64 int))
+    (time-iterations n (excl:integer-to-base64-string int))
+    (time-iterations n (string-to-base64 str))
+    (time-iterations n (excl:usb8-array-to-base64-string usb8))))
+
+      
+;;#+run-test (test-base64)