Commit 5fd2ffcb authored by pfdietz's avatar pfdietz

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
......@@ -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))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment