Changeset 37269 in project

Timestamp:

02/21/19 08:17:09 (2 years ago)

Author:

Ivan Raikov

Message:

srfi-4-comprehensions: added tests

Location:

release/5/srfi-4-comprehensions/trunk

Files:

• srfi-4-comprehensions.egg (modified) (1 diff)
• srfi-4-comprehensions.scm (modified) (1 diff)
• tests/run.scm (modified) (1 diff)

release/5/srfi-4-comprehensions/trunk/srfi-4-comprehensions.egg

@@ -5 +5 @@
  (license "SRFI")
  (dependencies srfi-42)
+ (test-dependencies srfi-1 test)
  (category data)
  (author "Will Farr")

release/5/srfi-4-comprehensions/trunk/srfi-4-comprehensions.scm

@@ -33 +33 @@
 (module srfi-4-comprehensions 
   (:s8vector :u8vector :s16vector :u16vector :s32vector 
-   :u32vector :f64vector :f32vector
-   :s64vector :u64vector 
+   :u32vector :f64vector :f32vector :s64vector :u64vector 
            
    s8vector-ec u8vector-ec s16vector-ec u16vector-ec s32vector-ec 
-   u32vector-ec f64vector-ec f32vector-ec
+   u32vector-ec s64vector-ec u64vector-ec f64vector-ec f32vector-ec
            
    s8vector-of-length-ec u8vector-of-length-ec s16vector-of-length-ec 
-   u16vector-of-length-ec s32vector-of-length-ec 
-   u32vector-of-length-ec
+   u16vector-of-length-ec s32vector-of-length-ec u32vector-of-length-ec
+   s64vector-of-length-ec u64vector-of-length-ec
    f64vector-of-length-ec f32vector-of-length-ec)
 

release/5/srfi-4-comprehensions/trunk/tests/run.scm

@@ -1 @@
-(import scheme (chicken base) srfi-42 srfi-4-comprehensions)
+(import scheme (chicken base) srfi-1 srfi-4 srfi-42 srfi-4-comprehensions test)
 
-(define n 19)
+(define n 20)
 
-(print (s32vector-ec (: i 0 (+ 1 n)) i))
+(define xlst (list-tabulate n (lambda (x) x)))
 
-(print (f32vector-ec (: i 0. (+ 1 n)) (* 0.1 i)))
+(define (to-4-dp f)
+  (/ (round (* f 10000)) 10000))
+
+(define (=4 n1 n2)
+  (= (to-4-dp n1) (to-4-dp n2)))
+
+(test-group "SRFI-4 vector comprehension"
+            
+            (test (list->f64vector xlst) (f64vector-ec (: i 0 n) i) )
+            (test (list->f32vector xlst) (f32vector-ec (: i 0 n) i) )
+;            (test (list->s64vector xlst) (s64vector-ec (: i 0 n) i) )
+            (test (list->u64vector xlst) (u64vector-ec (: i 0 n) i) )
+            (test (list->s32vector xlst) (s32vector-ec (: i 0 n) i) )
+            (test (list->u32vector xlst) (u32vector-ec (: i 0 n) i) )
+            (test (list->s16vector xlst) (s16vector-ec (: i 0 n) i) )
+            (test (list->u16vector xlst) (u16vector-ec (: i 0 n) i) )
+            (test (list->s8vector xlst) (s8vector-ec (: i 0 n) i) )
+            (test (list->u8vector xlst) (u8vector-ec (: i 0 n) i) )
+
+            )
 
 
-(let ((v (f64vector-ec (: i 0. (+ 1 n)) (* 0.5 i))))
-  (print v)
-  (print (fold-ec 0. (:f64vector x (index i) v) x (lambda (x ax) (+ ax (* x x)))))
-  )
+
+(test-group "SRFI-4 vector fold comprehension"
+            
+            (let ((v (f64vector-ec (: i 0. n) (* 0.5 i))))
+              
+              (test-assert (=4 617.5 (fold-ec 0. (:f64vector x (index i) v) x (lambda (x ax) (+ ax (* x x)))))))
+
+            (let ((v (f32vector-ec (: i 0. n) (* 0.5 i))))
+              
+              (test-assert (=4 617.5 (fold-ec 0. (:f32vector x (index i) v) x (lambda (x ax) (+ ax (* x x))))))
+                    
+  ))