Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge pull request #920 from gambiteer/231-test

Browse source 
SRFI 231: Add index-* tests
This commit is contained in:
Alex Shinn 2023-06-03 10:43:38 +09:00 • committed by GitHub
commit 13812f8749
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 54 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
lib/srfi/231/base.scm
View file

@ -22,19 +22,33 @@
(lp (+ i 1))))))))) (lp (+ i 1)))))))))
(define (index-rotate n k) (define (index-rotate n k)
(assert (and (exact-integer? n)
(exact-integer? k)
(< -1 k n)))
(list->vector (append (iota (- n k) k) (iota k)))) (list->vector (append (iota (- n k) k) (iota k))))
(define (index-first n k) (define (index-first n k)
(assert (and (exact-integer? n)
(exact-integer? k)
(< -1 k n)))
(list->vector (cons k (list->vector (cons k
(append (iota k) (append (iota k)
(iota (- n (+ k 1)) (+ k 1)))))) (iota (- n (+ k 1)) (+ k 1))))))
(define (index-last n k) (define (index-last n k)
(assert (and (exact-integer? n)
(exact-integer? k)
(< -1 k n)))
(list->vector (append (iota k) (list->vector (append (iota k)
(iota (- n (+ k 1)) (+ k 1)) (iota (- n (+ k 1)) (+ k 1))
(list k)))) (list k))))
(define (index-swap n i j) (define (index-swap n i j)
(assert (and (exact-integer? n)
(exact-integer? i)
(exact-integer? j)
(< -1 i n)
(< -1 j n)))
(let ((result (vector-iota n 0))) (let ((result (vector-iota n 0)))
(vector-set! result i j) (vector-set! result i j)
(vector-set! result j i) (vector-set! result j i)

39
lib/srfi/231/test.sld
View file

@ -1,6 +1,6 @@
;; Adapted from original SRFI reference test suite: ;; Adapted from original SRFI reference test suite:
;; SRFI 179: Nonempty Intervals and Generalized Arrays (Updated) ;; SRFI 231: Intervals and Generalized Arrays
;; Copyright 2016, 2018, 2020 Bradley J Lucier. ;; Copyright 2016, 2018, 2020 Bradley J Lucier.
;; All Rights Reserved. ;; All Rights Reserved.
@ -29,8 +29,8 @@
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;; OTHER DEALINGS IN THE SOFTWARE. ;; OTHER DEALINGS IN THE SOFTWARE.
;;; A test program for SRFI 179: ;;; A test program for SRFI 231:
;;; Nonempty Intervals and Generalized Arrays (Updated) ;;; Intervals and Generalized Arrays
(define-library (srfi 231 test) (define-library (srfi 231 test)
(import (scheme base) (scheme cxr) (scheme complex) (import (scheme base) (scheme cxr) (scheme complex)
@ -903,7 +903,38 @@
(random-source-pseudo-randomize! default-random-source 7 23) (random-source-pseudo-randomize! default-random-source 7 23)
(test-begin "srfi-179: nonempty intervals and generalized arrays") (test-begin "srfi-231: nonempty intervals and generalized arrays")
(test-group "index-* and miscellaneous tests"
(test-error (index-first 'a 3))
(test-error (index-first 5 'a))
(test-error (index-first -1 5))
(test-error (index-first 0 -2))
(test-error (index-first 3 5))
(test '#(3 0 1 2 4) (index-first 5 3))
(test-error (index-last 'a 3))
(test-error (index-last 5 'a))
(test-error (index-last -1 5))
(test-error (index-last 0 -2))
(test-error (index-last 3 5))
(test '#(0 1 2 4 3) (index-last 5 3))
(test-error (index-rotate 'a 3))
(test-error (index-rotate 5 'a))
(test-error (index-rotate -1 5))
(test-error (index-rotate 0 -2))
(test-error (index-rotate 3 5))
(test '#(3 4 0 1 2) (index-rotate 5 3))
(test-error (index-swap 'a 3 0))
(test-error (index-swap 5 'a 0))
(test-error (index-swap -1 5 0))
(test-error (index-swap 0 -2 0))
(test-error (index-swap 3 5 0))
(test '#(3 1 2 0 4) (index-swap 5 3 0))
)
(test-group "interval tests" (test-group "interval tests"
(test-error (make-interval 1 '#(3 4))) (test-error (make-interval 1 '#(3 4)))