From 22d63e2a5e4b096e4420305698ed00e95084387d Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Mon, 14 Oct 2002 03:53:42 +0000 Subject: [PATCH] Removed test types-4, which was all screwed up. --- ansi-tests/types-and-class.lsp | 231 ++++++++++++++++++--------------- 1 file changed, 124 insertions(+), 107 deletions(-) diff --git a/ansi-tests/types-and-class.lsp b/ansi-tests/types-and-class.lsp index 2ebae61f..175e9eb9 100644 --- a/ansi-tests/types-and-class.lsp +++ b/ansi-tests/types-and-class.lsp @@ -35,113 +35,124 @@ ;; These should get removed when I get a more up to date ;; image for that platform -- pfd -(defvar *subtype-table* -'( -(symbol t) -#-(and cmu (not sparc)) (boolean symbol) -(standard-object t) -(function t) -(compiled-function function) -(generic-function function) -(standard-generic-function generic-function) -(class standard-object) -(built-in-class class) -(structure-class class) -(standard-class class) -(method standard-object) -(standard-method method) -(structure-object t) -(method-combination t) -(condition t) -(serious-condition condition) -(error serious-condition) -(type-error error) -(simple-type-error type-error) -(simple-condition condition) -(simple-type-error simple-condition) -(parse-error error) -(hash-table t) -(cell-error error) -(unbound-slot cell-error) -(warning condition) -(style-warning warning) -(storage-condition serious-condition) -(simple-warning warning) -(simple-warning simple-condition) -(keyword symbol) -(unbound-variable cell-error) -(control-error error) -(program-error error) -(undefined-function cell-error) -(package t) -(package-error error) -(random-state t) -(number t) -(real number) -(complex number) -(float real) -(short-float float) -(single-float float) -(double-float float) -(long-float float) -(rational real) -(integer rational) -(ratio rational) -(signed-byte integer) -(integer signed-byte) -(unsigned-byte signed-byte) -(bit unsigned-byte) -(fixnum integer) -(bignum integer) -(bit fixnum) -(arithmetic-error error) -(division-by-zero arithmetic-error) -(floating-point-invalid-operation arithmetic-error) -(floating-point-inexact arithmetic-error) -(floating-point-overflow arithmetic-error) -(floating-point-underflow arithmetic-error) -(character t) -(base-char character) -(standard-char base-char) -(extended-char character) -(sequence t) -(list sequence) -(null list) -#-(and cmu (not sparc)) (null boolean) -(cons list) -(array t) -(simple-array array) -(vector sequence) -(vector array) -(string vector) -(bit-vector vector) -(simple-vector vector) -(simple-vector simple-array) -(simple-bit-vector bit-vector) -(simple-bit-vector simple-array) -(base-string string) -(simple-string string) -(simple-string simple-array) -(simple-base-string base-string) -(simple-base-string simple-string) -(pathname t) -(logical-pathname pathname) -(file-error error) -(stream t) -(broadcast-stream stream) -(concatenated-stream stream) -(echo-stream stream) -(file-stream stream) -(string-stream stream) -(synonym-stream stream) -(two-way-stream stream) -(stream-error error) -(end-of-file stream-error) -(print-not-readable error) -(readtable t) -(reader-error parse-error) -(reader-error stream-error) -)) +(defparameter *subtype-table* +(let ((table + '( + (null symbol) + (symbol t) + #-(and cmu (not sparc)) (boolean symbol) + (standard-object t) + (function t) + (compiled-function function) + (generic-function function) + (standard-generic-function generic-function) + (class standard-object) + (built-in-class class) + (structure-class class) + (standard-class class) + (method standard-object) + (standard-method method) + (structure-object t) + (method-combination t) + (condition t) + (serious-condition condition) + (error serious-condition) + (type-error error) + (simple-type-error type-error) + (simple-condition condition) + (simple-type-error simple-condition) + (parse-error error) + (hash-table t) + (cell-error error) + (unbound-slot cell-error) + (warning condition) + (style-warning warning) + (storage-condition serious-condition) + (simple-warning warning) + (simple-warning simple-condition) + (keyword symbol) + (unbound-variable cell-error) + (control-error error) + (program-error error) + (undefined-function cell-error) + (package t) + (package-error error) + (random-state t) + (number t) + (real number) + (complex number) + (float real) + (short-float float) + (single-float float) + (double-float float) + (long-float float) + (rational real) + (integer rational) + (ratio rational) + (signed-byte integer) + (integer signed-byte) + (unsigned-byte signed-byte) + (bit unsigned-byte) + (fixnum integer) + (bignum integer) + (bit fixnum) + (arithmetic-error error) + (division-by-zero arithmetic-error) + (floating-point-invalid-operation arithmetic-error) + (floating-point-inexact arithmetic-error) + (floating-point-overflow arithmetic-error) + (floating-point-underflow arithmetic-error) + (character t) + (base-char character) + (standard-char base-char) + (extended-char character) + (sequence t) + (list sequence) + (null list) + #-(and cmu (not sparc)) (null boolean) + (cons list) + (array t) + (simple-array array) + (vector sequence) + (vector array) + (string vector) + (bit-vector vector) + (simple-vector vector) + (simple-vector simple-array) + (simple-bit-vector bit-vector) + (simple-bit-vector simple-array) + (base-string string) + (simple-string string) + (simple-string simple-array) + (simple-base-string base-string) + (simple-base-string simple-string) + (pathname t) + (logical-pathname pathname) + (file-error error) + (stream t) + (broadcast-stream stream) + (concatenated-stream stream) + (echo-stream stream) + (file-stream stream) + (string-stream stream) + (synonym-stream stream) + (two-way-stream stream) + (stream-error error) + (end-of-file stream-error) + (print-not-readable error) + (readtable t) + (reader-error parse-error) + (reader-error stream-error) + ))) + (when (subtypep 'character 'base-char) + (setq table + (append + '((character base-char) + (string base-string) + (simple-string simple-base-string)) + table))) + + table)) (deftest types-3 (count-if @@ -159,6 +170,11 @@ (defparameter +float-types+ '(long-float double-float short-float single-float)) + +;;; This next test is all screwed up. Basically, it assumes +;;; incorrectly that certain subtype relationships that are +;;; not specified in the spec cannot occur. +#| (defun types-4-body () (let ((parent-table (make-hash-table :test #'equal)) (types nil)) @@ -201,6 +217,7 @@ (deftest types-4 (types-4-body) 0) +|# (deftest types-5 (subtypep* 'simple-base-string 'sequence) -- GitLab