shithub: sl

Info  •  Files  •  Log  •  Branches

*print-length*: fix misbehavior

Fixes: https://todo.sr.ht/~ft/sl/72

--- a/src/print.c

+++ b/src/print.c

@@ -317,7 +317,7 @@

 	int n_unindented = 1;

 	while(1){

 		cd = cdr_(v);

-		if(sl.print_length >= 0 && n >= sl.print_length && cd != sl_nil){

+		if(sl.print_length >= 0 && n >= sl.print_length){

 			outsc(f, "...)");

 			break;

 		}

@@ -494,14 +494,11 @@

 		if(!sl.print_princ && print_circle_prefix(f, v))

 			break;

 		if(isvec(v)){

-			if(isstruct(v))

-				outs(f, "#S(");

-			else

-				outs(f, "#(");

+			outs(f, isstruct(v) ? "#S(" : "#(");

 			int newindent = sl.hpos, est;

 			int i, sz = vec_size(v);

 			for(i = 0; i < sz; i++){

-				if(sl.print_length >= 0 && i >= sl.print_length && i < sz-1){

+				if(sl.print_length >= 0 && i >= sl.print_length){

 					outsc(f, "...");

 					break;

 				}

--- a/test/unittest.sl

+++ b/test/unittest.sl

@@ -624,10 +624,27 @@

   (with-output-to b (for-each print "йцукен"))

   (assert (equal? (io->str b) "#\\й#\\ц#\\у#\\к#\\е#\\н")))

-(let ((b (buffer)))

+(let {[b (buffer)]}

   (write "a\x0a\x09\\\x07\x08\x1b\x0c\x0d\x0b" b)

   (assert (equal? (io->str b) «"a\n\t\\\a\b\e\f\r\v"»)))

+(defmacro (print-with-length n . args)

+  `(with-bindings ((*print-length* ,n))

+     (print-to-str ,@args)))

+

+(assert (equal? (print-with-length 2 '(1)) "(1)"))

+(assert (equal? (print-with-length 2 '(1 2)) "(1 2)"))

+(assert (equal? (print-with-length 2 '(1 2 3)) "(1 2 ...)"))

+(assert (equal? (print-with-length 2 '(1 2 3 4)) "(1 2 ...)"))

+(assert (equal? (print-with-length 2 #(1)) "#(1)"))

+(assert (equal? (print-with-length 2 #(1 2)) "#(1 2)"))

+(assert (equal? (print-with-length 2 #(1 2 3)) "#(1 2 ...)"))

+(assert (equal? (print-with-length 2 #(1 2 3 4)) "#(1 2 ...)"))

+(assert (equal? (print-with-length 2 (arr 'u8 1)) "#vu8(1)"))

+(assert (equal? (print-with-length 2 (arr 'u8 1 2)) "#vu8(1 2)"))

+(assert (equal? (print-with-length 2 (arr 'u8 1 2 3)) "#vu8(1 2 ...)"))

+(assert (equal? (print-with-length 2 (arr 'u8 1 2 3 4)) "#vu8(1 2 ...)"))

+

 (assert (= 10 (str-width s)))

 (assert (= 0 (str-width "")))

 (assert (= 1 (str-width #\q)))

@@ -811,9 +828,12 @@

 (assert-fail (table 1))

 (assert-fail (table 1 2 3))

 (def ta (table 1 2 "3" 4 'foo 'bar))

-(let ((b (buffer)))

-  (write ta b)

-  (assert (equal? (io->str b) "#table(1 2  \"3\" 4  foo bar)")))

+(def (with-output-to-str nada thunk)

+  (let ((b (buffer)))

+    (with-output-to b (thunk))

+    (io->str b)))

+(assert (equal? (with-output-to-str NIL (λ () (write ta)))

+                "#table(1 2  \"3\" 4  foo bar)"))

 (assert (table? ta))

 (assert (not (table? "nope")))

 (assert-fail (get ta 3))