From 17ebaf0bbb7e594f0397286aac4b89ae6ebe61d3 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 8 Nov 2002 08:08:29 +0000 Subject: [PATCH] r3346: *** empty log message *** --- debian/changelog | 5 ++ debian/control | 15 +++++ debian/copyright | 33 ++++++++++ debian/postinst | 48 ++++++++++++++ debian/prerm | 42 ++++++++++++ debian/rt.asd | 38 +++++++++++ debian/rules | 69 ++++++++++++++++++++ rt.lisp | 167 +++++++++++++++++++++++++++++++++++++++++++++++ 8 files changed, 417 insertions(+) create mode 100644 debian/changelog create mode 100644 debian/control create mode 100644 debian/copyright create mode 100755 debian/postinst create mode 100755 debian/prerm create mode 100644 debian/rt.asd create mode 100755 debian/rules create mode 100644 rt.lisp diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 0000000..4e15ed4 --- /dev/null +++ b/debian/changelog @@ -0,0 +1,5 @@ +cl-rt (19901219-1) unstable; urgency=low + + * Initial release. + + -- Kevin M. Rosenberg Fri, 8 Nov 2002 01:08:01 -0700 diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..87dbe83 --- /dev/null +++ b/debian/control @@ -0,0 +1,15 @@ +Source: cl-rt +Section: devel +Priority: optional +Maintainer: Kevin M. Rosenberg +Build-Depends-Indep: debhelper (>= 4.0.0) +Standards-Version: 3.5.7.1 + +Package: cl-rt +Architecture: all +Depends: ${shlibs:Depends}, common-lisp-controller (>= 3.37) +Description: Common Lisp regression tester from MIT + This is MIT's regression tester for Common Lisp programs. It provides a framework for writing + regression tests for Common Lisp packages. + + diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..da07b73 --- /dev/null +++ b/debian/copyright @@ -0,0 +1,33 @@ +This package was debianized by Kevin M. Rosenberg in +Nov 2002. + +It was downloaded from http://cclan.sourceforge.net +Upstream Author: MIT + +Changes compared to upstream: + - Added .asd file for use with Common Lisp Controller + - Changed defpackage to be ompatible with AllegroCL's case-sensitive mode + + +Copyright: + +#|----------------------------------------------------------------------------| + | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. | + | | + | Permission to use, copy, modify, and distribute this software and its | + | documentation for any purpose and without fee is hereby granted, provided | + | that this copyright and permission notice appear in all copies and | + | supporting documentation, and that the name of M.I.T. not be used in | + | advertising or publicity pertaining to distribution of the software | + | without specific, written prior permission. M.I.T. makes no | + | representations about the suitability of this software for any purpose. | + | It is provided "as is" without express or implied warranty. | + | | + | M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING | + | ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL | + | M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR | + | ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, | + | WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, | + | ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS | + | SOFTWARE. | + |----------------------------------------------------------------------------|# diff --git a/debian/postinst b/debian/postinst new file mode 100755 index 0000000..dfd5505 --- /dev/null +++ b/debian/postinst @@ -0,0 +1,48 @@ +#! /bin/sh +# postinst script for cl-rt +# +# see: dh_installdeb(1) + +set -e + +# package name according to lisp +LISP_PKG=rt + +# summary of how this script can be called: +# * `configure' +# * `abort-upgrade' +# * `abort-remove' `in-favour' +# +# * `abort-deconfigure' `in-favour' +# `removing' +# +# for details, see http://www.debian.org/doc/debian-policy/ or +# the debian-policy package +# +# quoting from the policy: +# Any necessary prompting should almost always be confined to the +# post-installation script, and should be protected with a conditional +# so that unnecessary prompting doesn't happen if a package's +# installation fails and the `postinst' is called with `abort-upgrade', +# `abort-remove' or `abort-deconfigure'. + +case "$1" in + configure) + /usr/sbin/register-common-lisp-source ${LISP_PKG} + ;; + abort-upgrade|abort-remove|abort-deconfigure) + ;; + *) + echo "postinst called with unknown argument \`$1'" >&2 + exit 1 + ;; +esac + +# dh_installdeb will replace this with shell code automatically +# generated by other debhelper scripts. + +#DEBHELPER# + +exit 0 + + diff --git a/debian/prerm b/debian/prerm new file mode 100755 index 0000000..ce60e28 --- /dev/null +++ b/debian/prerm @@ -0,0 +1,42 @@ +#! /bin/sh +# prerm script for cl-rt +# +# see: dh_installdeb(1) + +set -e + +# package name according to lisp +LISP_PKG=rt + +# summary of how this script can be called: +# * `remove' +# * `upgrade' +# * `failed-upgrade' +# * `remove' `in-favour' +# * `deconfigure' `in-favour' +# `removing' +# +# for details, see http://www.debian.org/doc/debian-policy/ or +# the debian-policy package + + +case "$1" in + remove|upgrade|deconfigure) + /usr/sbin/unregister-common-lisp-source ${LISP_PKG} + ;; + failed-upgrade) + ;; + *) + echo "prerm called with unknown argument \`$1'" >&2 + exit 1 + ;; +esac + +# dh_installdeb will replace this with shell code automatically +# generated by other debhelper scripts. + +#DEBHELPER# + +exit 0 + + diff --git a/debian/rt.asd b/debian/rt.asd new file mode 100644 index 0000000..f69de9e --- /dev/null +++ b/debian/rt.asd @@ -0,0 +1,38 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: rt.asd +;;;; Purpose: ASDF definition file for Rt +;;;; Programmer: Kevin M. Rosenberg +;;;; Date Started: Sep 2002 +;;;; +;;;; $Id: rt.asd,v 1.1 2002/11/08 08:08:29 kevin Exp $ +;;;; +;;;; This file, part of cl-rt, is Copyright (c) 2002 by Kevin M. Rosenberg +;;;; +;;;; cl-rt users are granted the rights to distribute and use this software +;;;; as governed by the terms of the GNU Lesser General Public License +;;;; (http://www.gnu.org/licenses/lgpl.html) +;;;; ************************************************************************* + +(in-package :asdf) + +(defsystem :rt + :name "cl-rt" + :version "1990.12.19" + :maintainer "Kevin M. Rosenberg " + :licence "MIT" + :description "MIT Regression Tester" + :long-description "RT provides a framework for writing regression test suites" + + :perform (load-op :after (op rt) + (pushnew :rt cl:*features*)) + + :components + ((:file "rt"))) + +(when (ignore-errors (find-class 'load-compiled-op)) + (defmethod perform :after ((op load-compiled-op) (c (eql (find-system :rt)))) + (pushnew :rt cl:*features*))) + diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..3b45265 --- /dev/null +++ b/debian/rules @@ -0,0 +1,69 @@ +#!/usr/bin/make -f + +export DH_COMPAT=4 + +pkg := rt +debpkg := cl-rt + + +clc-source := usr/share/common-lisp/source +clc-systems := usr/share/common-lisp/systems +clc-rt := $(clc-source)/$(pkg) + +doc-dir := usr/share/doc/$(debpkg) + + +configure: configure-stamp +configure-stamp: + dh_testdir + # Add here commands to configure the package. + + touch configure-stamp + + +build: build-stamp + +build-stamp: configure-stamp + dh_testdir + # Add here commands to compile the package. + touch build-stamp + +clean: + dh_testdir + dh_testroot + rm -f build-stamp configure-stamp + # Add here commands to clean up after the build process. + rm -f debian/cl-rt.postinst.* debian/cl-rt.prerm.* + dh_clean + +install: build + dh_testdir + dh_testroot + dh_clean -k + # Add here commands to install the package into debian/rt. + dh_installdirs $(clc-systems) $(clc-rt) + dh_install debian/rt.asd $(shell echo *.lisp) $(clc-rt) + dh_link $(clc-rt)/rt.asd $(clc-systems)/rt.asd + +# Build architecture-independent files here. +binary-indep: build install + + +# Build architecture-dependent files here. +binary-arch: build install + dh_testdir + dh_testroot + dh_installdocs + dh_installchangelogs + dh_strip + dh_compress + dh_fixperms + dh_installdeb + dh_shlibdeps + dh_gencontrol + dh_md5sums + dh_builddeb + +binary: binary-indep binary-arch +.PHONY: build clean binary-indep binary-arch binary install configure + diff --git a/rt.lisp b/rt.lisp new file mode 100644 index 0000000..b24ecf1 --- /dev/null +++ b/rt.lisp @@ -0,0 +1,167 @@ +;-*-syntax:COMMON-LISP;Package:(RT :use "COMMON-LISP" :colon-mode :external)-*- + +#|----------------------------------------------------------------------------| + | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. | + | | + | Permission to use, copy, modify, and distribute this software and its | + | documentation for any purpose and without fee is hereby granted, provided | + | that this copyright and permission notice appear in all copies and | + | supporting documentation, and that the name of M.I.T. not be used in | + | advertising or publicity pertaining to distribution of the software | + | without specific, written prior permission. M.I.T. makes no | + | representations about the suitability of this software for any purpose. | + | It is provided "as is" without express or implied warranty. | + | | + | M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING | + | ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL | + | M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR | + | ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, | + | WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, | + | ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS | + | SOFTWARE. | + |----------------------------------------------------------------------------|# + +;This is the December 19, 1990 version of the regression tester. + +(defpackage #:rt + (:use #:common-lisp) + (:export deftest get-test do-test rem-test + rem-all-tests do-tests pending-tests + continue-testing *test* + *do-tests-when-defined*)) +(in-package :rt) +(defvar *test* nil "Current test name") +(defvar *do-tests-when-defined* nil) +(defvar *entries* '(nil) "Test database") +(defvar *in-test* nil "Used by TEST") +(defvar *debug* nil "For debugging") + +(defstruct (entry (:conc-name nil) + (:type list)) + pend name form) + +(defmacro vals (entry) `(cdddr ,entry)) + +(defmacro defn (entry) `(cdr ,entry)) + +(defun pending-tests () + (do ((l (cdr *entries*) (cdr l)) + (r nil)) + ((null l) (nreverse r)) + (when (pend (car l)) + (push (name (car l)) r)))) + +(defun rem-all-tests () + (setq *entries* (list nil)) + nil) + +(defun rem-test (&optional (name *test*)) + (do ((l *entries* (cdr l))) + ((null (cdr l)) nil) + (when (equal (name (cadr l)) name) + (setf (cdr l) (cddr l)) + (return name)))) + +(defun get-test (&optional (name *test*)) + (defn (get-entry name))) + +(defun get-entry (name) + (let ((entry (find name (cdr *entries*) + :key #'name + :test #'equal))) + (when (null entry) + (report-error t + "~%No test with name ~:@(~S~)." + name)) + entry)) + +(defmacro deftest (name form &rest values) + `(add-entry '(t ,name ,form .,values))) + +(defun add-entry (entry) + (setq entry (copy-list entry)) + (do ((l *entries* (cdr l))) (nil) + (when (null (cdr l)) + (setf (cdr l) (list entry)) + (return nil)) + (when (equal (name (cadr l)) + (name entry)) + (setf (cadr l) entry) + (report-error nil + "Redefining test ~@:(~S~)" + (name entry)) + (return nil))) + (when *do-tests-when-defined* + (do-entry entry)) + (setq *test* (name entry))) + +(defun report-error (error? &rest args) + (cond (*debug* + (apply #'format t args) + (if error? (throw '*debug* nil))) + (error? (apply #'error args)) + (t (apply #'warn args)))) + +(defun do-test (&optional (name *test*)) + (do-entry (get-entry name))) + +(defun do-entry (entry &optional + (s *standard-output*)) + (catch '*in-test* + (setq *test* (name entry)) + (setf (pend entry) t) + (let* ((*in-test* t) + (*break-on-warnings* t) + (r (multiple-value-list + (eval (form entry))))) + (setf (pend entry) + (not (equal r (vals entry)))) + (when (pend entry) + (format s "~&Test ~:@(~S~) failed~ + ~%Form: ~S~ + ~%Expected value~P: ~ + ~{~S~^~%~17t~}~ + ~%Actual value~P: ~ + ~{~S~^~%~15t~}.~%" + *test* (form entry) + (length (vals entry)) + (vals entry) + (length r) r)))) + (when (not (pend entry)) *test*)) + +(defun continue-testing () + (if *in-test* + (throw '*in-test* nil) + (do-entries *standard-output*))) + +(defun do-tests (&optional + (out *standard-output*)) + (dolist (entry (cdr *entries*)) + (setf (pend entry) t)) + (if (streamp out) + (do-entries out) + (with-open-file + (stream out :direction :output) + (do-entries stream)))) + +(defun do-entries (s) + (format s "~&Doing ~A pending test~:P ~ + of ~A tests total.~%" + (count t (cdr *entries*) + :key #'pend) + (length (cdr *entries*))) + (dolist (entry (cdr *entries*)) + (when (pend entry) + (format s "~@[~<~%~:; ~:@(~S~)~>~]" + (do-entry entry s)))) + (let ((pending (pending-tests))) + (if (null pending) + (format s "~&No tests failed.") + (format s "~&~A out of ~A ~ + total tests failed: ~ + ~:@(~{~<~% ~1:;~S~>~ + ~^, ~}~)." + (length pending) + (length (cdr *entries*)) + pending)) + (null pending))) -- 2.34.1