cl-base64-3.3.3/0000755000175000017500000000000011235221010012175 5ustar kevinkevincl-base64-3.3.3/COPYING0000644000175000017500000000262010667175327013263 0ustar kevinkevinCopyright (c) 2002-2003 by Kevin Rosenberg All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of the Authors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cl-base64-3.3.3/decode.lisp0000644000175000017500000002435210667175327014352 0ustar kevinkevin;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: encode.lisp ;;;; Purpose: cl-base64 encoding routines ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Dec 2002 ;;;; ;;;; $Id$ ;;;; ;;;; This file implements the Base64 transfer encoding algorithm as ;;;; defined in RFC 1521 by Borensten & Freed, September 1993. ;;;; See: http://www.ietf.org/rfc/rfc1521.txt ;;;; ;;;; Based on initial public domain code by Juri Pakaste ;;;; ;;;; Copyright 2002-2003 Kevin M. Rosenberg ;;;; Permission to use with BSD-style license included in the COPYING file ;;;; ************************************************************************* (in-package #:cl-base64) (declaim (inline whitespace-p)) (defun whitespace-p (c) "Returns T for a whitespace character." (or (char= c #\Newline) (char= c #\Linefeed) (char= c #\Return) (char= c #\Space) (char= c #\Tab))) ;;; Decoding #+ignore (defmacro def-base64-stream-to-* (output-type) `(defun ,(intern (concatenate 'string (symbol-name :base64-stream-to-) (symbol-name output-type))) (input &key (uri nil) ,@(when (eq output-type :stream) '(stream))) ,(concatenate 'string "Decode base64 stream to " (string-downcase (symbol-name output-type))) (declare (stream input) (optimize (speed 3) (space 0) (safety 0))) (let ((pad (if uri *uri-pad-char* *pad-char*)) (decode-table (if uri *uri-decode-table* *decode-table*))) (declare (type decode-table decode-table) (type character pad)) (let (,@(case output-type (:string '((result (make-string (* 3 (truncate (length string) 4)))))) (:usb8-array '((result (make-array (* 3 (truncate (length string) 4)) :element-type '(unsigned-byte 8) :fill-pointer nil :adjustable nil))))) (ridx 0)) (declare ,@(case output-type (:string '((simple-string result))) (:usb8-array '((type (simple-array (usigned-byte 8) (*)) result)))) (fixnum ridx)) (do* ((bitstore 0) (bitcount 0) (char (read-char stream nil #\null) (read-char stream nil #\null))) ((eq char #\null) ,(case output-type (:stream 'stream) ((:string :usb8-array) 'result) ;; ((:stream :string) ;; '(subseq result 0 ridx)))) )) (declare (fixnum bitstore bitcount) (character char)) (let ((svalue (aref decode-table (the fixnum (char-code char))))) (declare (fixnum svalue)) (cond ((>= svalue 0) (setf bitstore (logior (the fixnum (ash bitstore 6)) svalue)) (incf bitcount 6) (when (>= bitcount 8) (decf bitcount 8) (let ((ovalue (the fixnum (logand (the fixnum (ash bitstore (the fixnum (- bitcount)))) #xFF)))) (declare (fixnum ovalue)) ,(case output-type (:string '(setf (char result ridx) (code-char ovalue))) (:usb8-array '(setf (aref result ridx) ovalue)) (:stream '(write-char (code-char ovalue) stream))) (incf ridx) (setf bitstore (the fixnum (logand bitstore #xFF)))))) ((char= char pad) ;; Could add checks to make sure padding is correct ;; Currently, padding is ignored ) ((whitespace-p char) ;; Ignore whitespace ) ((minusp svalue) (warn "Bad character ~W in base64 decode" char)) ))))))) ;;(def-base64-stream-to-* :string) ;;(def-base64-stream-to-* :stream) ;;(def-base64-stream-to-* :usb8-array) (defmacro def-base64-string-to-* (output-type) `(defun ,(intern (concatenate 'string (symbol-name :base64-string-to-) (symbol-name output-type))) (input &key (uri nil) ,@(when (eq output-type :stream) '(stream))) ,(concatenate 'string "Decode base64 string to " (string-downcase (symbol-name output-type))) (declare (string input) (optimize (speed 3) (safety 0) (space 0))) (let ((pad (if uri *uri-pad-char* *pad-char*)) (decode-table (if uri *uri-decode-table* *decode-table*))) (declare (type decode-table decode-table) (type character pad)) (let (,@(case output-type (:string '((result (make-string (* 3 (truncate (length input) 4)))))) (:usb8-array '((result (make-array (* 3 (truncate (length input) 4)) :element-type '(unsigned-byte 8) :fill-pointer nil :adjustable nil))))) (ridx 0)) (declare ,@(case output-type (:string '((simple-string result))) (:usb8-array '((type (simple-array (unsigned-byte 8) (*)) result)))) (fixnum ridx)) (loop for char of-type character across input for svalue of-type fixnum = (aref decode-table (the fixnum (char-code char))) with bitstore of-type fixnum = 0 with bitcount of-type fixnum = 0 do (cond ((>= svalue 0) (setf bitstore (logior (the fixnum (ash bitstore 6)) svalue)) (incf bitcount 6) (when (>= bitcount 8) (decf bitcount 8) (let ((ovalue (the fixnum (logand (the fixnum (ash bitstore (the fixnum (- bitcount)))) #xFF)))) (declare (fixnum ovalue)) ,(case output-type (:string '(setf (char result ridx) (code-char ovalue))) (:usb8-array '(setf (aref result ridx) ovalue)) (:stream '(write-char (code-char ovalue) stream))) (incf ridx) (setf bitstore (the fixnum (logand bitstore #xFF)))))) ((char= char pad) ;; Could add checks to make sure padding is correct ;; Currently, padding is ignored ) ((whitespace-p char) ;; Ignore whitespace ) ((minusp svalue) (warn "Bad character ~W in base64 decode" char)) )) ,(case output-type (:stream 'stream) ((:usb8-array :string) '(subseq result 0 ridx))))))) (def-base64-string-to-* :string) (def-base64-string-to-* :stream) (def-base64-string-to-* :usb8-array) ;; input-mode can be :string or :stream ;; input-format can be :character or :usb8 (defun base64-string-to-integer (string &key (uri nil)) "Decodes a base64 string to an integer" (declare (string string) (optimize (speed 3) (safety 0) (space 0))) (let ((pad (if uri *uri-pad-char* *pad-char*)) (decode-table (if uri *uri-decode-table* *decode-table*))) (declare (type decode-table decode-table) (character pad)) (let ((value 0)) (declare (integer value)) (loop for char of-type character across string for svalue of-type fixnum = (aref decode-table (the fixnum (char-code char))) do (cond ((>= svalue 0) (setq value (+ svalue (ash value 6)))) ((char= char pad) (setq value (ash value -2))) ((whitespace-p char) ; ignore whitespace ) ((minusp svalue) (warn "Bad character ~W in base64 decode" char)))) value))) (defun base64-stream-to-integer (stream &key (uri nil)) "Decodes a base64 string to an integer" (declare (stream stream) (optimize (speed 3) (space 0) (safety 0))) (let ((pad (if uri *uri-pad-char* *pad-char*)) (decode-table (if uri *uri-decode-table* *decode-table*))) (declare (type decode-table decode-table) (character pad)) (do* ((value 0) (char (read-char stream nil #\null) (read-char stream nil #\null))) ((eq char #\null) value) (declare (integer value) (character char)) (let ((svalue (aref decode-table (the fixnum (char-code char))))) (declare (fixnum svalue)) (cond ((>= svalue 0) (setq value (+ svalue (ash value 6)))) ((char= char pad) (setq value (ash value -2))) ((whitespace-p char) ; ignore whitespace ) ((minusp svalue) (warn "Bad character ~W in base64 decode" char))))))) cl-base64-3.3.3/encode.lisp0000644000175000017500000003213010667175327014355 0ustar kevinkevin;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: encode.lisp ;;;; Purpose: cl-base64 encoding routines ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Dec 2002 ;;;; ;;;; $Id$ ;;;; ;;;; This file implements the Base64 transfer encoding algorithm as ;;;; defined in RFC 1521 by Borensten & Freed, September 1993. ;;;; See: http://www.ietf.org/rfc/rfc1521.txt ;;;; ;;;; Based on initial public domain code by Juri Pakaste ;;;; ;;;; Copyright 2002-2003 Kevin M. Rosenberg ;;;; Permission to use with BSD-style license included in the COPYING file ;;;; ************************************************************************* ;;;; Extended by Kevin M. Rosenberg : ;;;; - .asd file ;;;; - numerous speed optimizations ;;;; - conversion to and from integers ;;;; - Renamed functions now that supporting integer conversions ;;;; - URI-compatible encoding using :uri key ;;;; ;;;; $Id$ (in-package #:cl-base64) (defun round-next-multiple (x n) "Round x up to the next highest multiple of n." (declare (fixnum n) (optimize (speed 3) (safety 0) (space 0))) (let ((remainder (mod x n))) (declare (fixnum remainder)) (if (zerop remainder) x (the fixnum (+ x (the fixnum (- n remainder))))))) (defmacro def-*-to-base64-* (input-type output-type) `(defun ,(intern (concatenate 'string (symbol-name input-type) (symbol-name :-to-base64-) (symbol-name output-type))) (input ,@(when (eq output-type :stream) '(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." (declare ,@(case input-type (:string '((string input))) (:usb8-array '((type (array (unsigned-byte 8) (*)) input)))) (fixnum columns) (optimize (speed 3) (safety 0) (space 0))) (let ((pad (if uri *uri-pad-char* *pad-char*)) (encode-table (if uri *uri-encode-table* *encode-table*))) (declare (simple-string encode-table) (character pad)) (let* ((string-length (length input)) (complete-group-count (truncate string-length 3)) (remainder (nth-value 1 (truncate string-length 3))) (padded-length (* 4 (truncate (+ string-length 2) 3))) ,@(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 (the fixnum (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)))) (output-char pad)))) (do ((igroup 0 (the fixnum (1+ igroup))) (isource 0 (the fixnum (+ 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 (the fixnum (1+ isource)))))) (:usb8-array '(the fixnum (aref input (the fixnum (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 (the fixnum (1+ isource)))))) (:usb8-array '(aref input (1+ isource))))) 8)) (the fixnum ,(case input-type (:string '(char-code (the character (char input (the fixnum (+ 2 isource)))))) (:usb8-array '(aref input (+ 2 isource)))) ))) 4))))))) (def-*-to-base64-* :string :string) (def-*-to-base64-* :string :stream) (def-*-to-base64-* :usb8-array :string) (def-*-to-base64-* :usb8-array :stream) (defun integer-to-base64-string (input &key (uri nil) (columns 0)) "Encode an integer to base64 format." (declare (integer input) (fixnum columns) (optimize (speed 3) (space 0) (safety 0))) (let ((pad (if uri *uri-pad-char* *pad-char*)) (encode-table (if uri *uri-encode-table* *encode-table*))) (declare (simple-string encode-table) (character pad)) (let* ((input-bits (integer-length input)) (byte-bits (round-next-multiple input-bits 8)) (padded-bits (round-next-multiple byte-bits 6)) (remainder-padding (mod padded-bits 24)) (padding-bits (if (zerop remainder-padding) 0 (- 24 remainder-padding))) (padding-chars (/ padding-bits 6)) (padded-length (/ (+ padded-bits padding-bits) 6)) (last-line-len (if (plusp columns) (- padded-length (* columns (truncate padded-length columns))) 0)) (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)) (last-char (1- strlen)) (str (make-string strlen)) (col (if (zerop last-line-len) columns last-line-len))) (declare (fixnum padded-length num-lines col last-char padding-chars last-line-len)) (unless (plusp columns) (setq col -1)) ;; set to flag to optimize in loop (dotimes (i padding-chars) (declare (fixnum i)) (setf (schar str (the fixnum (- last-char i))) pad)) (do* ((strpos (- last-char padding-chars) (1- strpos)) (int (ash input (/ padding-bits 3)))) ((minusp strpos) str) (declare (fixnum strpos) (integer int)) (cond ((zerop col) (setf (schar str strpos) #\Newline) (setq col columns)) (t (setf (schar str strpos) (schar encode-table (the fixnum (logand int #x3f)))) (setq int (ash int -6)) (decf col))))))) (defun integer-to-base64-stream (input stream &key (uri nil) (columns 0)) "Encode an integer to base64 format." (declare (integer input) (fixnum columns) (optimize (speed 3) (space 0) (safety 0))) (let ((pad (if uri *uri-pad-char* *pad-char*)) (encode-table (if uri *uri-encode-table* *encode-table*))) (declare (simple-string encode-table) (character pad)) (let* ((input-bits (integer-length input)) (byte-bits (round-next-multiple input-bits 8)) (padded-bits (round-next-multiple byte-bits 6)) (remainder-padding (mod padded-bits 24)) (padding-bits (if (zerop remainder-padding) 0 (- 24 remainder-padding))) (padding-chars (/ padding-bits 6)) (padded-length (/ (+ padded-bits padding-bits) 6)) (strlen padded-length) (nonpad-chars (- strlen padding-chars)) (last-nonpad-char (1- nonpad-chars)) (str (make-string strlen))) (declare (fixnum padded-length last-nonpad-char)) (do* ((strpos 0 (the fixnum (1+ strpos))) (int (ash input (/ padding-bits 3)) (ash int -6)) (6bit-value (the fixnum (logand int #x3f)) (the fixnum (logand int #x3f)))) ((= strpos nonpad-chars) (let ((col 0)) (declare (fixnum col)) (dotimes (i nonpad-chars) (declare (fixnum i)) (write-char (schar str i) stream) (when (plusp columns) (incf col) (when (= col columns) (write-char #\Newline stream) (setq col 0)))) (dotimes (ipad padding-chars) (declare (fixnum ipad)) (write-char pad stream) (when (plusp columns) (incf col) (when (= col columns) (write-char #\Newline stream) (setq col 0))))) stream) (declare (fixnum 6bit-value strpos) (integer int)) (setf (schar str (- last-nonpad-char strpos)) (schar encode-table 6bit-value)) )))) cl-base64-3.3.3/package.lisp0000644000175000017500000000437710667175327014527 0ustar kevinkevin;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: package.lisp ;;;; Purpose: Package definition for cl-base64 ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Dec 2002 ;;;; ;;;; $Id$ ;;;; ;;;; ************************************************************************* (defpackage #:cl-base64 (:nicknames #:base64) (:use #:cl) (:export #:base64-stream-to-integer #:base64-string-to-integer #:base64-string-to-string #:base64-stream-to-string #:base64-string-to-stream #:base64-stream-to-stream #:base64-string-to-usb8-array #:base64-stream-to-usb8-array #:string-to-base64-string #:string-to-base64-stream #:usb8-array-to-base64-string #:usb8-array-to-base64-stream #:stream-to-base64-string #:stream-to-base64-stream #:integer-to-base64-string #:integer-to-base64-stream ;; For creating custom encode/decode tables #:*uri-encode-table* #:*uri-decode-table* #:make-decode-table #:test-base64 )) (in-package #:cl-base64) (defvar *encode-table* "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") (declaim (type simple-string *encode-table*)) (defvar *uri-encode-table* "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_") (declaim (type simple-string *uri-encode-table*)) (deftype decode-table () '(simple-array fixnum (256))) (defun make-decode-table (encode-table) (let ((dt (make-array 256 :adjustable nil :fill-pointer nil :element-type 'fixnum :initial-element -1))) (declare (type decode-table dt)) (loop for char of-type character across encode-table for index of-type fixnum from 0 below 64 do (setf (aref dt (the fixnum (char-code char))) index)) dt)) (defvar *decode-table* (make-decode-table *encode-table*)) (defvar *uri-decode-table* (make-decode-table *uri-encode-table*)) (defvar *pad-char* #\=) (defvar *uri-pad-char* #\.) (declaim (type character *pad-char* *uri-pad-char*)) cl-base64-3.3.3/tests.lisp0000644000175000017500000000562610667175327014274 0ustar kevinkevin;;;; -*- 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$ ;;;; ************************************************************************* (in-package #:cl-user) (defpackage #:cl-base64-tests (:use #:cl #:kmrcl #:cl-base64 #:ptester)) (in-package #:cl-base64-tests) (defun do-tests () (with-tests (:name "cl-base64 tests") (let ((*break-on-test-failures* t)) (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=)))))) t) (defun time-routines () (let* ((str "abcdefghijklmnopqwertyu1234589jhwf2ff") (usb8 (string-to-usb8-array str)) (int 12345678901234567890) (n 50000)) (time-iterations n (integer-to-base64-string int)) (time-iterations n (string-to-base64-string str)) #+allego (progn (time-iterations n (excl:integer-to-base64-string int)) (time-iterations n (excl:usb8-array-to-base64-string usb8))))) ;;#+run-test (test-base64) cl-base64-3.3.3/cl-base64.asd0000644000175000017500000000262411235171730014367 0ustar kevinkevin;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: cl-base64.asd ;;;; Purpose: ASDF definition file for Cl-Base64 ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Dec 2002 ;;;; ;;;; $Id$ ;;;; ************************************************************************* (in-package #:cl-user) (defpackage #:cl-base64-system (:use #:asdf #:cl)) (in-package #:cl-base64-system) (defsystem cl-base64 :name "cl-base64" :author "Kevin M. Rosenberg based on initial code by Juri Pakaste" :version "3.1" :maintainer "Kevin M. Rosenberg " :licence "BSD-style" :description "Base64 encoding and decoding with URI support." :components ((:file "package") (:file "encode" :depends-on ("package")) (:file "decode" :depends-on ("package")) )) (defmethod perform ((o test-op) (c (eql (find-system 'cl-base64)))) (operate 'load-op 'cl-base64-tests) (operate 'test-op 'cl-base64-tests :force t)) (defsystem cl-base64-tests :depends-on (cl-base64 ptester kmrcl) :components ((:file "tests"))) (defmethod perform ((o test-op) (c (eql (find-system 'cl-base64-tests)))) (operate 'load-op 'cl-base64-tests) (or (funcall (intern (symbol-name '#:do-tests) (find-package '#:cl-base64-tests))) (error "test-op failed")))