andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
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)))))))))))
(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

6
tests/srfi-13.test
View File

@ -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)