artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mes: string-drop: Error on negative droppings.

Browse source 
* module/srfi/srfi-13.mes (string-drop, string-take,
  string-drop-right): Error on negative droppings.
* tests/srfi-13.test ("string-drop"): Test it.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-29 18:15:04 +02:00
parent 41fe739463
commit 1f216444f6
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
2 changed files with 16 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
module/srfi/srfi-13.mes
View file

@ -54,14 +54,20 @@
(list (list->string (list-head lst (- (length lst) (length rest))))))))))) (list (list->string (list-head lst (- (length lst) (length rest)))))))))))
(define (string-take s n) (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) (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) (define (string-drop-right s n)
(let ((length (string-length s))) (cond ((zero? n) s)
(list->string (list-head (string->list s) (- length n))))) ((> 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) (define (string-delete pred s)
(let ((p (if (procedure? pred) pred (let ((p (if (procedure? pred) pred

6
tests/srfi-13.test
View file

@ -56,4 +56,10 @@ exit $?
"f-o-o-:" "f-o-o-:"
(list->string (string-fold-right (lambda (e p) (cons e (cons #\- p))) '(#\:) "foo"))) (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) (result 'report)