diff --git a/ansi-tests/adjustable-array-p.lsp b/ansi-tests/adjustable-array-p.lsp index e5873a3c764755908e0735083ed2b838a1dc5f04..dfc318593f09b68bdf1ad9bd7e7282e1b25edb9d 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 8ceb58e629d26576ea20c4b61ff526869e8ab443..73ceddaa92af454c7110ef79092d3863e4d9e05b 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 fb08b331908650c410197fe555cabf2edc0bc403..02723d32ae143deeb1712190f5d1f5162ec811ad 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 0830ed98a8550cb6285fb16a45de6463367999c8..cf55b392f24552e71a9098cbba9a82c35e7c9fa4 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 0fdfe7a55f47e4958523dcd5f795a763abdd3392..aa91c42f95eb21933f4d6fc8e7285953dea54b36 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)