Skip to content
Snippets Groups Projects
Commit 5fd2ffcb authored by pfdietz's avatar pfdietz
Browse files

Fixed problem with RT: prefix in lispworks. Fixed bug in method combination...

Fixed problem with RT: prefix in lispworks.  Fixed bug in method combination error tests (spotted by JJGR): methods with bad method qualifiers produce late errors, not errors at method definition time.  Moved some aux functions to their own files.  Began adding long form define-method-combination tests (not yet loaded by default, however.)
parent 88b88cf5
No related branches found
No related tags found
No related merge requests found
Showing
with 209 additions and 96 deletions
......@@ -114,7 +114,7 @@ Results: ~A~%" expected-number form n results))))
(typep a2 'array)
(= (array-rank a1) (array-rank a2))
(if (= (array-rank a1) 0)
(equal (rt::my-aref a1) (rt::my-aref a2))
(equal (regression-test::my-aref a1) (regression-test::my-aref a2))
(let ((ad (array-dimensions a1)))
(and (equal ad (array-dimensions a2))
(locally
......@@ -123,13 +123,17 @@ Results: ~A~%" expected-number form n results))))
(let ((as (first ad)))
(loop
for i from 0 below as
always (equal (rt::my-aref a1 i) (rt::my-aref a2 i))))
always (equal (regression-test::my-aref a1 i)
(regression-test::my-aref a2 i))))
(let ((as (array-total-size a1)))
(and (= as (array-total-size a2))
(loop
for i from 0 below as
always (equal (rt::my-row-major-aref a1 i)
(rt::my-row-major-aref a2 i))))))))))))
always
(equal
(regression-test::my-row-major-aref a1 i)
(regression-test::my-row-major-aref a2 i))
))))))))))
;;; *universe* is defined elsewhere -- it is a list of various
;;; lisp objects used when stimulating things in various tests.
......
......@@ -167,19 +167,23 @@
:error)
(deftest defgeneric-method-combination.and.10
(handler-case
(eval '(defgeneric dg-mc.and.10 (x)
(:method-combination and)
(:method ((x t)) t)))
(error () :error))
(progn
(eval '(defgeneric dg-mc.and.10 (x)
(:method-combination and)
(:method ((x t)) t)))
(handler-case
(dg-mc.and.10 'a)
(error () :error)))
:error)
(deftest defgeneric-method-combination.and.11
(handler-case
(eval '(defgeneric dg-mc.and.11 (x)
(:method-combination and)
(:method nonsense ((x t)) t)))
(error () :error))
(progn
(eval '(defgeneric dg-mc.and.11 (x)
(:method-combination and)
(:method nonsense ((x t)) t)))
(handler-case
(dg-mc.and.11 0)
(error () :error)))
:error)
(deftest defgeneric-method-combination.and.12
......@@ -191,7 +195,3 @@
(handler-case (funcall fn 'x)
(error () :error)))
:error)
......@@ -7,6 +7,8 @@
(declaim (special *x*))
(compile-and-load "defgeneric-method-combination-aux.lsp")
(deftest defgeneric-method-combination.append.1
(let ((*x* nil)
(fn
......@@ -170,19 +172,23 @@
:error)
(deftest defgeneric-method-combination.append.10
(handler-case
(eval '(defgeneric dg-mc.append.10 (x)
(:method-combination append)
(:method ((x t)) '(a))))
(error () :error))
(progn
(eval '(defgeneric dg-mc.append.10 (x)
(:method-combination append)
(:method ((x t)) '(a))))
(handler-case
(dg-mc.append.10 'x)
(error () :error)))
:error)
(deftest defgeneric-method-combination.append.11
(handler-case
(eval '(defgeneric dg-mc.append.11 (x)
(:method-combination append)
(:method nonsense ((x t)) '(a))))
(error () :error))
(progn
(eval '(defgeneric dg-mc.append.11 (x)
(:method-combination append)
(:method nonsense ((x t)) '(a))))
(handler-case
(dg-mc.append.11 0)
(error () :error)))
:error)
(deftest defgeneric-method-combination.append.12
......
......@@ -170,19 +170,23 @@
:error)
(deftest defgeneric-method-combination.list.10
(handler-case
(eval '(defgeneric dg-mc.list.10 (x)
(:method-combination list)
(:method ((x t)) (list 'a))))
(error () :error))
(progn
(eval '(defgeneric dg-mc.list.10 (x)
(:method-combination list)
(:method ((x t)) (list 'a))))
(handler-case
(dg-mc.list.10 'a)
(error () :error)))
:error)
(deftest defgeneric-method-combination.list.11
(handler-case
(eval '(defgeneric dg-mc.list.11 (x)
(:method-combination list)
(:method nonsense ((x t)) (list 'a))))
(error () :error))
(progn
(eval '(defgeneric dg-mc.list.11 (x)
(:method-combination list)
(:method nonsense ((x t)) (list 'a))))
(handler-case
(dg-mc.list.11 0)
(error () :error)))
:error)
(deftest defgeneric-method-combination.list.12
......
......@@ -158,19 +158,23 @@
:error)
(deftest defgeneric-method-combination.max.10
(handler-case
(eval '(defgeneric dg-mc.max.10 (x)
(:method-combination max)
(:method ((x t)) 0)))
(error () :error))
(progn
(eval '(defgeneric dg-mc.max.10 (x)
(:method-combination max)
(:method ((x t)) 0)))
(handler-case
(dg-mc.max.10 'a)
(error () :error)))
:error)
(deftest defgeneric-method-combination.max.11
(handler-case
(eval '(defgeneric dg-mc.max.11 (x)
(:method-combination max)
(:method nonsense ((x t)) 0)))
(error () :error))
(progn
(eval '(defgeneric dg-mc.max.11 (x)
(:method-combination max)
(:method nonsense ((x t)) 0)))
(handler-case
(dg-mc.max.11 0)
(error () :error)))
:error)
(deftest defgeneric-method-combination.max.12
......
......@@ -158,19 +158,23 @@
:error)
(deftest defgeneric-method-combination.min.10
(handler-case
(eval '(defgeneric dg-mc.min.10 (x)
(:method-combination min)
(:method ((x t)) 0)))
(error () :error))
(progn
(eval '(defgeneric dg-mc.min.10 (x)
(:method-combination min)
(:method ((x t)) 0)))
(handler-case
(dg-mc.min.10 'a)
(error () :error)))
:error)
(deftest defgeneric-method-combination.min.11
(handler-case
(eval '(defgeneric dg-mc.min.11 (x)
(:method-combination min)
(:method nonsense ((x t)) 0)))
(error () :error))
(progn
(eval '(defgeneric dg-mc.min.11 (x)
(:method-combination min)
(:method nonsense ((x t)) 0)))
(handler-case
(dg-mc.min.11 0)
(error () :error)))
:error)
(deftest defgeneric-method-combination.min.12
......
......@@ -182,19 +182,23 @@
:error)
(deftest defgeneric-method-combination.nconc.10
(handler-case
(eval '(defgeneric dg-mc.nconc.10 (x)
(:method-combination nconc)
(:method ((x t)) (list 'a))))
(error () :error))
(progn
(eval '(defgeneric dg-mc.nconc.10 (x)
(:method-combination nconc)
(:method ((x t)) (list 'a))))
(handler-case
(dg-mc.nconc.10 'a)
(error () :error)))
:error)
(deftest defgeneric-method-combination.nconc.11
(handler-case
(eval '(defgeneric dg-mc.nconc.11 (x)
(progn
(eval '(defgeneric dg-mc.nconc.11 (x)
(:method-combination nconc)
(:method nonsense ((x t)) (list 'a))))
(error () :error))
(handler-case
(dg-mc.nconc.11 0)
(error () :error)))
:error)
(deftest defgeneric-method-combination.nconc.12
......
......@@ -161,19 +161,23 @@
:error)
(deftest defgeneric-method-combination.or.10
(handler-case
(eval '(defgeneric dg-mc.or.10 (x)
(:method-combination or)
(:method ((x t)) 0)))
(error () :error))
(progn
(eval '(defgeneric dg-mc.or.10 (x)
(:method-combination or)
(:method ((x t)) 0)))
(handler-case
(dg-mc.or.10 'a)
(error () :error)))
:error)
(deftest defgeneric-method-combination.or.11
(handler-case
(eval '(defgeneric dg-mc.or.11 (x)
(:method-combination or)
(:method nonsense ((x t)) 0)))
(error () :error))
(progn
(eval '(defgeneric dg-mc.or.11 (x)
(:method-combination or)
(:method nonsense ((x t)) 0)))
(handler-case
(dg-mc.or.11 0)
(error () :error)))
:error)
(deftest defgeneric-method-combination.or.12
......
......@@ -158,19 +158,23 @@
:error)
(deftest defgeneric-method-combination.+.10
(handler-case
(eval '(defgeneric dg-mc.+.10 (x)
(:method-combination +)
(:method ((x t)) 0)))
(error () :error))
(progn
(eval '(defgeneric dg-mc.+.10 (x)
(:method-combination +)
(:method ((x t)) 0)))
(handler-case
(dg-mc.+.10 'a)
(error () :error)))
:error)
(deftest defgeneric-method-combination.+.11
(handler-case
(eval '(defgeneric dg-mc.+.11 (x)
(:method-combination +)
(:method nonsense ((x t)) 0)))
(error () :error))
(progn
(eval '(defgeneric dg-mc.+.11 (x)
(:method-combination +)
(:method nonsense ((x t)) 0)))
(handler-case
(dg-mc.+.11 0)
(error () :error)))
:error)
(deftest defgeneric-method-combination.+.12
......
......@@ -244,19 +244,23 @@
:error)
(deftest defgeneric-method-combination.progn.10
(handler-case
(eval '(defgeneric dg-mc.progn.10 (x)
(:method-combination progn)
(:method ((x t)) 0)))
(error () :error))
(progn
(eval '(defgeneric dg-mc.progn.10 (x)
(:method-combination progn)
(:method ((x t)) 0)))
(handler-case
(dg-mc.progn.10 'a)
(error () :error)))
:error)
(deftest defgeneric-method-combination.progn.11
(handler-case
(eval '(defgeneric dg-mc.progn.11 (x)
(:method-combination progn)
(:method nonsense ((x t)) 0)))
(error () :error))
(progn
(eval '(defgeneric dg-mc.progn.11 (x)
(:method-combination progn)
(:method nonsense ((x t)) 0)))
(handler-case
(dg-mc.progn.11 0)
(error () :error)))
:error)
(deftest defgeneric-method-combination.progn.12
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Jul 13 08:26:41 2003
;;;; Contains: Tests of DEFINE-METHOD-COMBINATION (long form)
(in-package :cl-test)
(eval-when (:load-toplevel :compile-toplevel :execute)
(report-and-ignore-errors
(defparameter *dmc-long-01*
(define-method-combination mc-long-01 nil nil)))
(report-and-ignore-errors
(defgeneric dmc-long-gf-01 (x y) (:method-combination mc-long-01)))
)
(deftest define-method-combination-long.01.1
(eqt *dmc-long-01* 'mc-long-01)
t)
;;; The list of method groups specifiers for this method combination
;;; is empty, so no methods are valid.
(deftest define-method-combination-long.01.2
(progn
(eval '(defmethod dmc-long-gf-01 ((x t) (y t)) :foo))
(handler-case
(dmc-long-gf-01 'a 'b)
(error () :caught)))
:caught)
\ No newline at end of file
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Thu Jul 17 06:42:27 2003
;;;; Contains: Routines for testing SORT, NSORT
(in-package :cl-test)
(defun my-numeric-sort (list)
"Sort (nondestructively) a list of reals."
(if (null (cdr list))
list
(let* ((len2 (ash (length list) -1))
(l1 (my-numeric-sort (subseq list 0 len2)))
(l2 (my-numeric-sort (subseq list len2))))
(my-numeric-merge l1 l2))))
(defun my-numeric-merge (l1 l2)
(cond
((null l1) l2)
((null l2) l1)
((<= (car l1) (car l2))
(cons (car l1) (my-numeric-merge (cdr l1) l2)))
(t
(cons (car l2) (my-numeric-merge l1 (cdr l2))))))
(defun generate-random-sort-test (n m)
(loop for i below n collect (random m)))
(defun random-sort-test (n m reps)
(loop
for i below reps
for list = (generate-random-sort-test (random n) m)
unless (equal (my-numeric-sort list)
(sort (copy-seq list) #'<))
collect list))
(defun random-stable-sort-test (n m reps)
(loop
for i below reps
for list = (generate-random-sort-test (random n) m)
unless (equal (my-numeric-sort list)
(stable-sort (copy-seq list) #'<))
collect list))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment