From c7e9f0a26a3fcef5ea3b243320eacc9fb966a4d6 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Mon, 9 Aug 2004 02:41:37 +0000
Subject: [PATCH] Added tests for ~< ~:>

---
 ansi-tests/format-logical-block.lsp | 258 ++++++++++++++++++++++++++++
 ansi-tests/load-format.lsp          |   2 +
 2 files changed, 260 insertions(+)
 create mode 100644 ansi-tests/format-logical-block.lsp

diff --git a/ansi-tests/format-logical-block.lsp b/ansi-tests/format-logical-block.lsp
new file mode 100644
index 00000000..6bc7ae21
--- /dev/null
+++ b/ansi-tests/format-logical-block.lsp
@@ -0,0 +1,258 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sun Aug  8 12:17:31 2004
+;;;; Contains: Tests of the ~< ~:> format directives
+
+(in-package :cl-test)
+
+(compile-and-load "printer-aux.lsp")
+
+;;; Error cases
+
+;;; Prefix and suffix cannot contain format directives
+
+(deftest format.logical-block.error.1
+  (signals-error (format nil "~<foo~A~;~A~;bar~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.2
+  (signals-error (format nil "~<foo~A~@;~A~;bar~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.3
+  (signals-error (format nil "~<foo~;~A~;bar~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.4
+  (signals-error (format nil "~<foo~@;~A~;bar~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.5
+  (signals-error (format nil "~<foo~A~;~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.6
+  (signals-error (format nil "~<foo~A~@;~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.7
+  (signals-error (format nil "~<~;~A~;bar~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.8
+  (signals-error (format nil "~<~@;~A~;bar~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.9
+  (signals-error (format nil "~:<foo~A~;~A~;bar~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.10
+  (signals-error (format nil "~:<foo~A~@;~A~;bar~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.11
+  (signals-error (format nil "~:<foo~;~A~;bar~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.12
+  (signals-error (format nil "~:<foo~@;~A~;bar~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.13
+  (signals-error (format nil "~:<foo~A~;~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.14
+  (signals-error (format nil "~:<foo~A~@;~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.15
+  (signals-error (format nil "~:<~;~A~;bar~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.16
+  (signals-error (format nil "~:<~@;~A~;bar~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.17
+  (signals-error (format nil "~@<foo~A~;~A~;bar~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.18
+  (signals-error (format nil "~@<foo~A~@;~A~;bar~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.19
+  (signals-error (format nil "~@<foo~;~A~;bar~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.20
+  (signals-error (format nil "~@<foo~@;~A~;bar~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.21
+  (signals-error (format nil "~@<foo~A~;~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.22
+  (signals-error (format nil "~@<foo~A~@;~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.23
+  (signals-error (format nil "~@<~;~A~;bar~A~:>" '(X) '(Y)) error)
+  t)
+
+(deftest format.logical-block.error.24
+  (signals-error (format nil "~@<~@;~A~;bar~A~:>" '(X) '(Y)) error)
+  t)
+
+;;; Non-error tests
+
+(def-pprint-test format.logical-block.1
+  (format nil "~<~A~:>" '(nil))
+  "NIL")
+
+(def-pprint-test format.logical-block.2
+  (format nil "~@<~A~:>" nil)
+  "NIL")
+
+(def-pprint-test format.logical-block.3
+  (format nil "~:<~A~:>" '(nil))
+  "(NIL)")
+
+(def-pprint-test format.logical-block.4
+  (format nil "~:@<~A~:>" nil)
+  "(NIL)")
+
+(def-pprint-test format.logical-block.5
+  (format nil "~@:<~A~:>" nil)
+  "(NIL)")
+
+(def-pprint-test format.logical-block.6
+  (format nil "~<~@{~A~^*~}~:>" '(1 2 3))
+  "1*2*3")
+
+(def-pprint-test format.logical-block.7
+  (format nil "~:<~@{~A~^*~}~:>" '(1 2 3))
+  "(1*2*3)")
+
+(def-pprint-test format.logical-block.8
+  (format nil "~:<~@{~A~^*~}~:>" 1)
+  "1")
+
+(def-pprint-test format.logical-block.9
+  (format nil "~<~;~A~;~:>" '(1 2 3))
+  "1")
+
+(def-pprint-test format.logical-block.10
+  (format nil "~<~;~A~:>" '(1 2 3))
+  "1")
+
+(def-pprint-test format.logical-block.11
+  (format nil "~@<~;~A~;~:>" '(1 2 3))
+  "(1 2 3)")
+
+(def-pprint-test format.logical-block.12
+  (format nil "~@<~;~A~:>" '(1 2 3))
+  "(1 2 3)")
+
+(def-pprint-test format.logical-block.13
+  (format nil "~:<[~;~@{~A~^/~}~:>" '(1 2 3))
+  "[1/2/3)")
+
+(def-pprint-test format.logical-block.14
+  (format nil "~:<~;~@{~A~^/~}~;]~:>" '(1 2 3))
+  "1/2/3]")
+
+(def-pprint-test format.logical-block.15
+  (format nil "~:<[~;~@{~A~^/~}~;]~:>" '(1 2 3))
+  "[1/2/3]")
+
+(def-pprint-test format.logical-block.16
+  (format nil "~@<~@{~A~^*~}~:>" 1 2 3)
+  "1*2*3")
+
+(def-pprint-test format.logical-block.17
+  (format nil "~@<~@{~A~^ ~_~}~:>" 1 2 3)
+  "1 2 3")
+
+(def-pprint-test format.logical-block.18
+  (format nil "~@<~@{~A~^ ~_~}~:>" 1 2 3)
+  "1
+2
+3"
+  :margin 2)
+
+(def-pprint-test format.logical-block.19
+  (format nil "~:@<~@{~A~^ ~_~}~:>" 1 2 3)
+  "(1
+ 2
+ 3)"
+  :margin 2)
+
+(def-pprint-test format.logical-block.20
+  (format nil "~@:<~@{~A~^ ~}~:>" 1 2 3)
+  "(1 2 3)"
+  :margin 2)
+
+(def-pprint-test format.logical-block.21
+  (format nil "~@:<~@{~A~^ ~:_~}~:>" 1 2 3)
+  "(1
+ 2
+ 3)"
+  :margin 2)
+
+(def-pprint-test format.logical-block.22
+  (format nil "~:@<~@{~A~^ ~}~:@>" 1 2 3)
+  "(1
+ 2
+ 3)"
+  :margin 2)
+
+(def-pprint-test format.logical-block.23
+  (format nil "~:@<~@{~A~^/~
+                   ~}~:@>" 1 2 3)
+  "(1/2/3)"
+  :margin 2)
+
+(def-pprint-test format.logical-block.24
+  (format nil "~:@<~@{~A~^            ~:_~}~:>" 1 2 3)
+  "(1
+ 2
+ 3)"
+  :margin 2)
+
+(def-pprint-test format.logical-block.25
+  (format nil "~:@<~@{~A~^            ~}~:@>" 1 2 3)
+  "(1
+ 2
+ 3)"
+  :margin 2)
+
+;;; Circularity detection
+
+(def-pprint-test format.logical-block.26
+  (format nil "~:<~@{~A~^ ~}~:>" (let ((x (list 0))) (list x x)))
+  "(#1=(0) #1#)"
+  :circle t)
+
+(def-pprint-test format.logical-block.27
+  (format nil "~:<~@{~A~^ ~}~:>" (let ((x (list 0))) (cons x x)))
+  "(#1=(0) . #1#)"
+  :circle t)
+
+(def-pprint-test format.logical-block.28
+  (format nil "~:<~@{~A~^ ~}~:>" (let ((x (list 0)))
+				   (setf (cdr x) x)
+				   x))
+  "#1=(0 . #1#)"
+  :circle t)
+
+(def-pprint-test format.logical-block.29
+  (format nil "~:<~@{~A~^ ~}~:>" (let ((x (list 0))) (list x x)))
+  "((0) (0))")
+
+(def-pprint-test format.logical-block.30
+  (format nil "~:<~@{~A~^ ~}~:>" (let ((x (list 0))) (cons x x)))
+  "((0) 0)")
diff --git a/ansi-tests/load-format.lsp b/ansi-tests/load-format.lsp
index 351225ca..637f5dc7 100644
--- a/ansi-tests/load-format.lsp
+++ b/ansi-tests/load-format.lsp
@@ -30,5 +30,7 @@
 
 ;;; 22.3.5
 (load "format-underscore.lsp")
+(load "format-logical-block.lsp")
+
 
 
-- 
GitLab