mes: string-drop: Error on negative droppings.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 29 Apr 2018 16:15:04 +0000 (18:15 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 29 Apr 2018 16:15:04 +0000 (18:15 +0200)
* module/srfi/srfi-13.mes (string-drop, string-take,
  string-drop-right): Error on negative droppings.
* tests/srfi-13.test ("string-drop"): Test it.

module/srfi/srfi-13.mes
tests/srfi-13.test

index bf6a06e930b3a689bd3c7405a0fc1e9bbcd15d9c..859e51601e1cf199aedde5bab153efb52aec370c 100644 (file)
                         (list (list->string (list-head lst (- (length lst) (length rest)))))))))))
 
 (define (string-take s n)
-  (list->string (list-head (string->list s) n)))
+  (cond ((zero? n) s)
+        ((> n 0) (list->string (list-head (string->list s) n)))
+        (else (error "string-take: not supported: n=" n))))
 
 (define (string-drop s n)
-  (list->string (list-tail (string->list s) n)))
+  (cond ((zero? n) s)
+        ((> n 0) (list->string (list-tail (string->list s) n)))
+        (else s (error "string-drop: not supported: (n s)=" (cons n s)))))
 
 (define (string-drop-right s n)
-  (let ((length (string-length s)))
-    (list->string (list-head (string->list s) (- length n)))))
+  (cond ((zero? n) s)
+        ((> n 0) (let ((length (string-length s)))
+                   (list->string (list-head (string->list s) (- length n)))))
+        (else (error "string-drop-right: not supported: n=" n))))
 
 (define (string-delete pred s)
   (let ((p (if (procedure? pred) pred
index 5fc9d6891b3a0a44256805be4303b70100583e8f..1e6a98514e4b4b50e9d161186c89394fbc88c921 100755 (executable)
@@ -56,4 +56,10 @@ exit $?
     "f-o-o-:"
   (list->string (string-fold-right (lambda (e p) (cons e (cons #\- p))) '(#\:) "foo")))
 
+(pass-if-equal "string-drop" "bar"
+  (string-drop "foobar" 3))
+
+(pass-if-equal "string-drop-right" "foo"
+  (string-drop-right "foobar" 3))
+
 (result 'report)