From 8ea11d00521eafe874e6fb8791ae1de13dca009c Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Wed, 22 Jan 2003 12:59:55 +0000 Subject: [PATCH] More changes to array tests. --- ansi-tests/adjustable-array-p.lsp | 11 ++++++---- ansi-tests/array-dimensions.lsp | 12 ++++++----- ansi-tests/array-displacement.lsp | 12 ++++++----- ansi-tests/array-total-size.lsp | 22 ++++++------------- ansi-tests/fill-pointer.lsp | 36 +++++++++++++++++++++++++++---- 5 files changed, 60 insertions(+), 33 deletions(-) diff --git a/ansi-tests/adjustable-array-p.lsp b/ansi-tests/adjustable-array-p.lsp index e5873a3c..dfc31859 100644 --- a/ansi-tests/adjustable-array-p.lsp +++ b/ansi-tests/adjustable-array-p.lsp @@ -40,8 +40,11 @@ type-error) (deftest adjustable-array-p.error.4 - (loop for e in *mini-universe* - unless (or (typep e 'array) - (eq 'type-error (classify-error** `(adjustable-array-p ',e)))) - collect e) + (let (why) + (loop for e in *mini-universe* + unless (or (typep e 'array) + (eq 'type-error + (setq why (classify-error** + `(adjustable-array-p ',e))))) + collect (list e why))) nil) diff --git a/ansi-tests/array-dimensions.lsp b/ansi-tests/array-dimensions.lsp index 8ceb58e6..73ceddaa 100644 --- a/ansi-tests/array-dimensions.lsp +++ b/ansi-tests/array-dimensions.lsp @@ -50,9 +50,11 @@ program-error) (deftest array-dimensions.error.3 - (loop for e in *mini-universe* - unless (or (typep e 'array) - (eq 'type-error - (classify-error** `(array-dimensions ',e)))) - collect e) + (let (why) + (loop for e in *mini-universe* + unless (or (typep e 'array) + (eq 'type-error + (setq why (classify-error** + `(array-dimensions ',e))))) + collect (list e why))) nil) diff --git a/ansi-tests/array-displacement.lsp b/ansi-tests/array-displacement.lsp index fb08b331..02723d32 100644 --- a/ansi-tests/array-displacement.lsp +++ b/ansi-tests/array-displacement.lsp @@ -105,9 +105,11 @@ program-error) (deftest array-displacement.error.3 - (loop for e in *mini-universe* - unless (or (typep e 'array) - (eq 'type-error - (classify-error** `(array-displacement ',e)))) - collect e) + (let (why) + (loop for e in *mini-universe* + unless (or (typep e 'array) + (eq 'type-error + (setq why (classify-error** + `(array-displacement ',e))))) + collect (list e why))) nil) diff --git a/ansi-tests/array-total-size.lsp b/ansi-tests/array-total-size.lsp index 0830ed98..cf55b392 100644 --- a/ansi-tests/array-total-size.lsp +++ b/ansi-tests/array-total-size.lsp @@ -38,23 +38,15 @@ program-error) (deftest array-total-size.error.3 - (loop for e in *mini-universe* - when (and (not (typep e 'array)) - (not (eql (classify-error** `(array-total-size ',e)) - 'type-error))) - collect e) + (let (why) + (loop for e in *mini-universe* + when (and (not (typep e 'array)) + (not (eql (setq why + (classify-error** `(array-total-size ',e))) + 'type-error))) + collect (list e why))) nil) (deftest array-total-size.error.4 (classify-error (array-total-size 0)) type-error) - - - - - - - - - - diff --git a/ansi-tests/fill-pointer.lsp b/ansi-tests/fill-pointer.lsp index 0fdfe7a5..aa91c42f 100644 --- a/ansi-tests/fill-pointer.lsp +++ b/ansi-tests/fill-pointer.lsp @@ -24,7 +24,35 @@ a)) 5 6 #(1 2 3 4 5 6)) - - - - +;;; Error tests + +(deftest fill-pointer.error.1 + (classify-error (fill-pointer)) + program-error) + +(deftest fill-pointer.error.2 + (classify-error (fill-pointer (make-array '(10) :fill-pointer 4) + nil)) + program-error) + +(deftest fill-pointer.error.3 + (classify-error (fill-pointer (make-array '(10) :fill-pointer nil))) + type-error) + +(deftest fill-pointer.error.4 + (classify-error (fill-pointer #0aNIL)) + type-error) + +(deftest fill-pointer.error.5 + (classify-error (fill-pointer #2a((a b c)(d e f)))) + type-error) + +(deftest fill-pointer.error.6 + (let (why) + (loop for e in *mini-universe* + when (and (or (not (typep e 'vector)) + (not (array-has-fill-pointer-p e))) + (not (eql (setq why (classify-error** `(fill-pointer ',e))) + 'type-error))) + collect (list e why))) + nil) -- GitLab