guile-ploy/test/test-cat.scm

; Tests for (ploy cat).
; (c) Daniel Llorens - 2012-2013

; This library is free software; you can redistribute it and/or modify it under
; the terms of the GNU General Public License as published by the Free
; Software Foundation; either version 3 of the License, or (at your option) any
; later version.

(import (srfi srfi-1) (srfi srfi-9) (srfi srfi-26) (ploy test) (ploy ploy) (ploy cat))

; ---------------------------------------------------------------------
; cat
; ---------------------------------------------------------------------

(define A #2f64((0 1) (2 3) (4 5)))
(define B #2f64((10 11) (12 13) (14 15)))
(define C #2f64((20) (21) (22)))
(assert (equal? (cat 0 A) A) "bad cat 0")
(T-msg "bad cat 0"
   (cat 0 A B A)
   #2f64((0 1) (2 3) (4 5) (10 11) (12 13) (14 15) (0 1) (2 3) (4 5)))
(T-msg "bad cat 1"
   (cat 1 A B C)
   #2f64((0 1 10 11 20) (2 3 12 13 21) (4 5 14 15 22)))

(define A #2f64((0 1) (2 3) (4 5)))
(define B #2f64((10 11) (12 13) (14 15)))
(define C #2f64((20) (21) (22)))
(T-msg "bad cat 2"
   #3f64(((0 10) (1 11)) ((2 12) (3 13)) ((4 14) (5 15)))
   (cat 2 A B))
(T-msg "bad cat 3"
   #4f64((((0 10)) ((1 11))) (((2 12)) ((3 13))) (((4 14)) ((5 15))))
   (cat 3 A B))
(T-msg "bad cat 3"
   #5f64(((((0 10 0))) (((1 11 1)))) ((((2 12 2))) (((3 13 3)))) ((((4 14 4))) (((5 15 5)))))
   (cat 4 A B A))

(T-msg "bad example a) with cat 0" (cat 0 (i. 1 2) (i. 2 2)) #2((0 1) (0 1) (2 3)))
(T-msg "bad example b) with cat 0" (cat 0 #(1 2) #(3 4 5)) #(1 2 3 4 5))
(T-msg "bad example c) with cat -1" (cat -1 #(1 2) #(4 5)) #2((1 2) (4 5)))
(T-msg "bad example d) with cat 1" (cat 1 #(1 2) #(4 5)) #2((1 4) (2 5)))

(define a (i. 2 2))
(cat! -1 a #(3 7) #(4 5))
(T-msg "bad example c) with cat! -1" a #2((3 7) (4 5)))

(T #(a 0 1)                    (cat 0 'a #(0 1)))
(T #2((a 0) (a 1))             (cat 1 'a #(0 1)))
(T #2((a a) (0 1))             (cat -1 'a #(0 1)))
(T #2((a 0 1) (b 2 3))         (cat 1 #(a b) #2((0 1) (2 3))))
(T #2((a a) (b b) (0 1) (2 3)) (cat 0 #(a b) #2((0 1) (2 3))))

; ---------------------------------------------------------------------
; icat
; ---------------------------------------------------------------------

(T #(a b c) (icat 0 'a 'b 'c))
(T #2((a) (b) (c)) (icat 1 'a 'b 'c))
(T #(1 2 3 4 5 6) (icat 0 #(1 2 3) 4 #(5 6)))
(T #2((0 1 a b) (2 3 a b)) (icat 0 #2((0 1) (2 3)) #(a b)))
(T #2((0 1) (2 3) (a b)) (icat 1 #2((0 1) (2 3)) #(a b)))
(assert-fail (icat 1 #2((0 1)) #(a)))
(T #2((0 1 a)) (icat 0 #2((0 1)) #(a)))
(T '(7 6 5 7 3 2) ($ (icat 2 (i. 7 6 5 4 3 2) (i. 3 2) (i. 5 2 3 2))))
(T #2((1 a) (2 b) (3 c)) (icat -1 #(1 2 3) #(a b c)))
(T #2((a x) (a y) (a z)) (icat -1 'a #(x y z)))