Help language development. Donate to The Perl Foundation

Format::Lisp zef:raku-community-modules last updated on 2022-03-09

t/22-format-logical-block.t
use v6;

use Test;
use lib 't/lib';
use Utils;
use Format::Lisp;

my $*fl = Format::Lisp.new;

# ;;; Error cases
# 
# ;;; Prefix and suffix cannot contain format directives
# 
#`(
# (deftest format.logical-block.error.1
#   (signals-error-always (format nil "~<foo~A~;~A~;bar~:>" '(X) '(Y)) error)
#   t t)
#I 
throws-like {
	$*fl.format( Q{~<foo~A~;~A~;bar~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.1};
)

#`(
# (deftest format.logical-block.error.2
#   (signals-error-always (format nil "~<[email protected];~A~;bar~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~<[email protected];~A~;bar~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.2};
)

#`(
# (deftest format.logical-block.error.3
#   (signals-error-always (format nil "~<foo~;~A~;bar~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~<foo~;~A~;bar~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.3};
)

#`(
# (deftest format.logical-block.error.4
#   (signals-error-always (format nil "~<[email protected];~A~;bar~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~<[email protected];~A~;bar~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.4};
)

#`(
# (deftest format.logical-block.error.5
#   (signals-error-always (format nil "~<foo~A~;~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~<foo~A~;~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.5};
)

#`(
# (deftest format.logical-block.error.6
#   (signals-error-always (format nil "~<[email protected];~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~<[email protected];~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.6};
)

#`(
# (deftest format.logical-block.error.7
#   (signals-error-always (format nil "~<~;~A~;bar~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~<~;~A~;bar~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.7};
)

#`(
# (deftest format.logical-block.error.8
#   (signals-error-always (format nil "~<[email protected];~A~;bar~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~<[email protected];~A~;bar~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.8};
)

#`(
# (deftest format.logical-block.error.9
#   (signals-error-always (format nil "~:<foo~A~;~A~;bar~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~:<foo~A~;~A~;bar~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.9};
)

#`(
# (deftest format.logical-block.error.10
#   (signals-error-always (format nil "~:<[email protected];~A~;bar~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~:<[email protected];~A~;bar~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.10};
)

#`(
# (deftest format.logical-block.error.11
#   (signals-error-always (format nil "~:<foo~;~A~;bar~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~:<foo~;~A~;bar~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.11};
)

#`(
# (deftest format.logical-block.error.12
#   (signals-error-always (format nil "~:<[email protected];~A~;bar~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~:<[email protected];~A~;bar~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.12};
)

#`(
# (deftest format.logical-block.error.13
#   (signals-error-always (format nil "~:<foo~A~;~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~:<foo~A~;~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.13};
)

#`(
# (deftest format.logical-block.error.14
#   (signals-error-always (format nil "~:<[email protected];~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~:<[email protected];~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.14};
)

#`(
# (deftest format.logical-block.error.15
#   (signals-error-always (format nil "~:<~;~A~;bar~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~:<~;~A~;bar~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.15};
)

#`(
# (deftest format.logical-block.error.16
#   (signals-error-always (format nil "~:<[email protected];~A~;bar~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~:<[email protected];~A~;bar~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.16};
)

#`(
# (deftest format.logical-block.error.17
#   (signals-error-always (format nil "[email protected]<foo~A~;~A~;bar~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{[email protected]<foo~A~;~A~;bar~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.17};
)

#`(
# (deftest format.logical-block.error.18
#   (signals-error-always (format nil "[email protected]<[email protected];~A~;bar~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{[email protected]<[email protected];~A~;bar~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.18};
)

#`(
# (deftest format.logical-block.error.19
#   (signals-error-always (format nil "[email protected]<foo~;~A~;bar~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{[email protected]<foo~;~A~;bar~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.19};
)

#`(
# (deftest format.logical-block.error.20
#   (signals-error-always (format nil "[email protected]<[email protected];~A~;bar~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{[email protected]<[email protected];~A~;bar~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.20};
)

#`(
# (deftest format.logical-block.error.21
#   (signals-error-always (format nil "[email protected]<foo~A~;~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{[email protected]<foo~A~;~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.21};
)

#`(
# (deftest format.logical-block.error.22
#   (signals-error-always (format nil "[email protected]<[email protected];~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{[email protected]<[email protected];~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.22};
)

#`(
# (deftest format.logical-block.error.23
#   (signals-error-always (format nil "[email protected]<~;~A~;bar~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{[email protected]<~;~A~;bar~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.23};
)

#`(
# (deftest format.logical-block.error.24
#   (signals-error-always (format nil "[email protected]<[email protected];~A~;bar~A~:>" '(X) '(Y)) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{[email protected]<[email protected];~A~;bar~A~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.24};
)

#`(
# (deftest format.logical-block.error.25
#   (signals-error-always (format nil "1~<X~<Y~:>Z~>2" nil nil nil) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{1~<X~<Y~:>Z~>2}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.25};
)

# ;;; "an error is also signaled if the ~<...~:;...~> form of ~<...~> is used
# ;;; in the same format string with ~W, ~_, ~<...~:>, ~I, or ~:T."
# 
#`(
# (deftest format.logical-block.error.26
#   (signals-error-always (format nil "~<~:;~>~<~:>" nil nil nil) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~<~:;~>~<~:>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.26};
)

#`(
# (deftest format.logical-block.error.27
#   (signals-error-always (format nil "~<~:>~<~:;~>" nil nil nil) error)
#   t t)
# 
throws-like {
	$*fl.format( Q{~<~:>~<~:;~>}, [ Q{X} ], [ Q{Y} ] );
}, X::Error, Q{format.logical-block.error.27};
)

# ;;; Non-error tests
# 
# (def-pprint-test format.logical-block.1
#   (format nil "~<~A~:>" '(nil))
#   "NIL")
# 
is $*fl.format( Q{~<~A~:>}, [ Nil ] ), Q{NIL}, Q{format.logical-block.1};

# (def-pprint-test format.logical-block.2
#   (format nil "[email protected]<~A~:>" nil)
#   "NIL")
# 
is $*fl.format( Q{[email protected]<~A~:>} ), Q{NIL}, Q{format.logical-block.2};

#`(
# (def-pprint-test format.logical-block.3
#   (format nil "~:<~A~:>" '(nil))
#   "(NIL)")
# 
is $*fl.format( Q{~:<~A~:>}, [ Nil ] ), Q{(NIL)}, Q{format.logical-block.3};
)

#`(
# (def-pprint-test format.logical-block.4
#   (format nil "~:@<~A~:>" nil)
#   "(NIL)")
# 
is $*fl.format( Q{~:@<~A~:>}, Nil ), Q{(NIL)}, Q{format.logical-block.4};
)

#`(
# (def-pprint-test format.logical-block.5
#   (format nil "[email protected]:<~A~:>" nil)
#   "(NIL)")
# 
is $*fl.format( Q{[email protected]:<~A~:>}, Nil ), Q{(NIL)}, Q{format.logical-block.5};
)

#`(
# (def-pprint-test format.logical-block.6
#   (format nil "~<[email protected]{~A~^*~}~:>" '(1 2 3))
#   "1*2*3")
# 
is $*fl.format(
	Q{~<[email protected]{~A~^*~}~:>},
	1, 2, 3
), Q{1*2*3}, Q{format.logical-block.6};
)

#`(
# (def-pprint-test format.logical-block.7
#   (format nil "~:<[email protected]{~A~^*~}~:>" '(1 2 3))
#   "(1*2*3)")
# 
is $*fl.format(
	Q{~:<[email protected]{~A~^*~}~:>},
	1, 2, 3
), Q{(1*2*3)}, Q{format.logical-block.7};
)

#`(
# (def-pprint-test format.logical-block.8
#   (format nil "~:<[email protected]{~A~^*~}~:>" 1)
#   "1")
# 
is $*fl.format( Q{~:<[email protected]{~A~^*~}~:>}, 1 ), Q{1}, Q{format.logical-block.8};
)

#`(
# (def-pprint-test format.logical-block.9
#   (format nil "~<~;~A~;~:>" '(1 2 3))
#   "1")
# 
is $*fl.format( Q{~<~;~A~;~:>}, 1, 2, 3 ), Q{1}, Q{format.logical-block.9};
)

#`(
# (def-pprint-test format.logical-block.10
#   (format nil "~<~;~A~:>" '(1 2 3))
#   "1")
# 
is $*fl.format( Q{~<~;~A~:>}, 1, 2, 3 ), Q{1}, Q{format.logical-block.10};
)

#`(
# (def-pprint-test format.logical-block.11
#   (format nil "[email protected]<~;~A~;~:>" '(1 2 3))
#   "(1 2 3)")
# 
is $*fl.format(
	Q{[email protected]<~;~A~;~:>},
	1, 2, 3
), Q{(1 2 3)}, Q{format.logical-block.11};
)

#`(
# (def-pprint-test format.logical-block.12
#   (format nil "[email protected]<~;~A~:>" '(1 2 3))
#   "(1 2 3)")
# 
is $*fl.format(
	Q{[email protected]<~;~A~:>},
	1, 2, 3
), Q{(1 2 3)}, Q{format.logical-block.12};
)

#`{
# (def-pprint-test format.logical-block.13
#   (format nil "~:<[~;[email protected]{~A~^/~}~:>" '(1 2 3))
#   "[1/2/3)")
# 
is $*fl.format(
	Q{~:<[~;[email protected]{~A~^/~}~:>},
	1, 2, 3
), Q{[1/2/3)}, Q{format.logical-block.13};
}

#`(
# (def-pprint-test format.logical-block.14
#   (format nil "~:<~;[email protected]{~A~^/~}~;]~:>" '(1 2 3))
#   "1/2/3]")
# 
is $*fl.format(
	Q{~:<~;[email protected]{~A~^/~}~;]~:>},
	1, 2, 3
), Q{1/2/3]}, Q{format.logical-block.14};
)

#`(
# (def-pprint-test format.logical-block.15
#   (format nil "~:<[~;[email protected]{~A~^/~}~;]~:>" '(1 2 3))
#   "[1/2/3]")
# 
is $*fl.format(
	Q{~:<[~;[email protected]{~A~^/~}~;]~:>},
	1, 2, 3
), Q{[1/2/3]}, Q{format.logical-block.15};
)

#`(
# (def-pprint-test format.logical-block.16
#   (format nil "[email protected]<[email protected]{~A~^*~}~:>" 1 2 3)
#   "1*2*3")
# 
is $*fl.format(
	Q{[email protected]<[email protected]{~A~^*~}~:>},
	1, 2, 3
), Q{1*2*3}, Q{format.logical-block.16};
)

#`(
# (def-pprint-test format.logical-block.17
#   (format nil "[email protected]<[email protected]{~A~^ ~_~}~:>" 1 2 3)
#   "1 2 3")
# 
is $*fl.format(
	Q{[email protected]<[email protected]{~A~^ ~_~}~:>},
	1, 2, 3
), Q{1 2 3}, Q{format.logical-block.17};
)

#`(
# (def-pprint-test format.logical-block.18
#   (format nil "[email protected]<[email protected]{~A~^ ~_~}~:>" 1 2 3)
#   "1
# 2
# 3"
#   :margin 2)
# 
is $*fl.format(
	Q{[email protected]<[email protected]{~A~^ ~_~}~:>},
	1, 2, 3
), qq{1\n2\n3}, Q{format.logical-block.18};
)

#`(
# (def-pprint-test format.logical-block.19
#   (format nil "~:@<[email protected]{~A~^ ~_~}~:>" 1 2 3)
#   "(1
#  2
#  3)"
#   :margin 2)
# 
is $*fl.format(
	Q{~:@<[email protected]{~A~^ ~_~}~:>},
	1, 2, 3
), qq{(1\n2\n3)}, Q{format.logical-block.19};
)

#`(
# (def-pprint-test format.logical-block.20
#   (format nil "[email protected]:<[email protected]{~A~^ ~}~:>" 1 2 3)
#   "(1 2 3)"
#   :margin 2)
# 
is $*fl.format(
	Q{[email protected]:<[email protected]{~A~^ ~}~:>},
	1, 2, 3
), Q{(1 2 3)}, Q{format.logical-block.20};
)

#`(
# (def-pprint-test format.logical-block.21
#   (format nil "[email protected]:<[email protected]{~A~^ ~:_~}~:>" 1 2 3)
#   "(1
#  2
#  3)"
#   :margin 2)
# 
is $*fl.format(
	Q{[email protected]:<[email protected]{~A~^ ~:_~}~:>},
	1, 2, 3
), qq{(1\n 2\n 3)}, Q{format.logical-block.21};
)

#`(
# (def-pprint-test format.logical-block.22
#   (format nil "~:@<[email protected]{~A~^ ~}~:@>" 1 2 3)
#   "(1
#  2
#  3)"
#   :margin 2)
# 
is $*fl.format(
	Q{~:@<[email protected]{~A~^ ~}~:@>},
	1, 2, 3
), qq{(1\n 2\n 3)}, Q{format.logical-block.22};
)

#`(
# (def-pprint-test format.logical-block.23
#   (format nil "~:@<[email protected]{~A~^/~
#                    ~}~:@>" 1 2 3)
#   "(1/2/3)"
#   :margin 2)
# 
is $*fl.format(
	qq{~:@<[email protected]{~A~^/~\n~}~:@>},
	1, 2, 3
), Q{(1/2/3)}, Q{format.logical-block.23};
)

#`(
# (def-pprint-test format.logical-block.24
#   (format nil "~:@<[email protected]{~A~^            ~:_~}~:>" 1 2 3)
#   "(1
#  2
#  3)"
#   :margin 2)
# 
is $*fl.format(
	Q{~:@<[email protected]{~A~^            ~:_~}~:>},
	1, 2, 3
), qq{(1\n 2\n 3)}, Q{format.logical-block.24};
)

#`(
# (def-pprint-test format.logical-block.25
#   (format nil "~:@<[email protected]{~A~^            ~}~:@>" 1 2 3)
#   "(1
#  2
#  3)"
#   :margin 2)
# 
is $*fl.format(
	Q{~:@<[email protected]{~A~^            ~}~:@>},
	1, 2, 3
), qq{(1\n 2\n 3)}, Q{format.logical-block.25};
)

#`(
# (def-pprint-test format.logical-block.26
#   (format nil "~:@<[email protected]{~A~^~}~:@>" "1 2 3")
#   "(1 2 3)"
#   :margin 2)
# 
is $*fl.format(
	Q{~:@<[email protected]{~A~^~}~:@>},
	"1 2 3"
), Q{(1 2 3)}, Q{format.logical-block.26};
)

#`(
# (def-pprint-test format.logical-block.27
#   (format nil "[email protected]<**[email protected];[email protected]{~A~^       ~}~:@>" 1 2 3)
#   "**1
# **2
# **3"
#   :margin 3)
# 
is $*fl.format(
	Q{[email protected]<**[email protected];[email protected]{~A~^       ~}~:@>},
	1, 2, 3
), qq{**1\n**2\n**3}, Q{format.logical-block.27};
)

#`(
# (def-pprint-test format.logical-block.28
#   (format nil "[email protected]<**[email protected];[email protected]{~A~^       ~}~;XX~:@>" 1 2 3)
#   "**1
# **2
# **3XX"
#   :margin 3)
# 
is $*fl.format(
	Q{[email protected]<**[email protected];[email protected]{~A~^       ~}~;XX~:@>},
	1, 2, 3
), qq{**1\n**2\n**3XX}, Q{format.logical-block.28};
)

#`[
# (def-pprint-test format.logical-block.29
#   (format nil "~:@<**[email protected];[email protected]{~A~^       ~}~:@>" 1 2 3)
#   "**1
# **2
# **3)"
#   :margin 3)
# 
is $*fl.format(
	Q{~:@<**[email protected];[email protected]{~A~^       ~}~:@>},
	1, 2, 3
), qq{**1\n**2\n**3}, Q{format.logical-block.29};
]

# ;;; Circularity detection
# 
#`(
# (def-pprint-test format.logical-block.circle.1
#   (format nil "~:<[email protected]{~A~^ ~}~:>" (let ((x (list 0))) (list x x)))
#   "(#1=(0) #1#)"
#   :circle t)
# 
)

#`(
# (def-pprint-test format.logical-block.circle.2
#   (format nil "~:<[email protected]{~A~^ ~}~:>" (let ((x (list 0))) (cons x x)))
#   "(#1=(0) . #1#)"
#   :circle t)
# 
)

#`(
# (def-pprint-test format.logical-block.circle.3
#   (format nil "~:<[email protected]{~A~^ ~}~:>" (let ((x (list 0)))
#                                    (setf (cdr x) x)
#                                    x))
#   "#1=(0 . #1#)"
#   :circle t
#   :len 500)
# 
)

#`(
# (def-pprint-test format.logical-block.circle.4
#   (format nil "~:<[email protected]{~A~^ ~}~:>" (let ((x (list 0))) (list x x)))
#   "((0) (0))")
# 
)

#`(
# (def-pprint-test format.logical-block.circle.5
#   (format nil "~:<[email protected]{~A~^ ~}~:>" (let ((x (list 0))) (cons x x)))
#   "((0) 0)")
# 
)

# ;;; ~^ terminates a logical block
# 
#`(
# (def-pprint-test format.logical-block.escape.1
#   (format nil "~<~A~^xxxx~:>" '(1))
#   "1")
# 
is $*fl.format(
	Q{~<~A~^xxxx~:>},
	[ 1 ]
), Q{1}, Q{format.logical-block.escape.1};
)

#`(
# (def-pprint-test format.logical-block.escape.2
#   (format nil "~<~<~A~^xxx~:>yyy~:>" '((1)))
#   "1yyy")
# 
is $*fl.format(
	Q{~<~<~A~^xxx~:>yyy~:>},
	[ [ 1 ] ]
), Q{1yyy}, Q{format.logical-block.escape.2};
)

done-testing;

# vim: ft=perl6