From 1f216444f68a8c8c39b93e79e081e9fca2f6a1dc Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 29 Apr 2018 18:15:04 +0200 Subject: [PATCH] mes: string-drop: Error on negative droppings. * 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 | 14 ++++++++++---- tests/srfi-13.test | 6 ++++++ 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/module/srfi/srfi-13.mes b/module/srfi/srfi-13.mes index bf6a06e9..859e5160 100644 --- a/module/srfi/srfi-13.mes +++ b/module/srfi/srfi-13.mes @@ -54,14 +54,20 @@ (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 diff --git a/tests/srfi-13.test b/tests/srfi-13.test index 5fc9d689..1e6a9851 100755 --- a/tests/srfi-13.test +++ b/tests/srfi-13.test @@ -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)