File: tests.lisp

package info (click to toggle)
acl2 7.2dfsg-3
  • links: PTS
  • area: main
  • in suites: stretch
  • size: 198,968 kB
  • ctags: 182,300
  • sloc: lisp: 2,415,261; ansic: 5,675; perl: 5,577; xml: 3,576; sh: 3,255; cpp: 2,835; makefile: 2,440; ruby: 2,402; python: 778; ml: 763; yacc: 709; csh: 355; php: 171; lex: 162; tcl: 44; java: 24; asm: 23; haskell: 17
file content (79 lines) | stat: -rw-r--r-- 2,966 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
;;;; -*- 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)