<commit_before>(import (scheme base)
        (scheme char)
        (scheme file)
        (scheme lazy)
        (scheme read)
        (scheme write)
        (scheme eval)
        ;(srfi 9)
)

(define *num-passed* 0)
(define (assert:equal msg actual expected)
  (if (not (equal? actual expected))
      (error "Unit test failed [" msg "] actual [" actual "] expected [" expected "]")
      (set! *num-passed* (+ *num-passed* 1))))

(define (assert:not-equal msg x y)
  (assert:equal msg (not (equal? x y)) #t))

(define (assert msg val)
  (assert:equal msg (not val) #f))

(assert "Testing assert function" #t)
(assert "Testing assert function" 1)

;; Quotation / Quasi-quotes
(assert:equal "quasi-quote #1" `(read ,(+ 1 2 3)) '(read 6))
(assert:equal "quasi-quote #2" `(read ,(list 1 2 3)) '(read (1 2 3)))
(assert:equal "quasi-quote splicing" `(read ,@(list 1 2 3)) '(read 1 2 3))

;; Lists
(define l (list 'a 'b 'c))
; TODO: seems to break eval below, is there a GC problem with a circular list?
;(set-cdr! l l)
(set-cdr! l '(c b)) ; Above seems to break if it replaces this line
(assert:equal "list? on circular list" (list? l) #t)

;; Circular data structures
(define v1 (vector #f))
(define v2 (vector v1))
(vector-set! v1 0 v2)
(let ((fp (open-output-string)))
  (display v1 fp)
  (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))
(assert:equal "equality on circular vectors" (equal? v1 v2) #t)
(newline)

(define v1 (vector 1 2 3))
(define v2 (vector 1 v1 3))
(vector-set! v1 1 v2)
(let ((fp (open-output-string)))
  (write v1 fp)
  (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))
(assert:equal "equality on circular vectors, test 2" (equal? v1 v2) #t)
(newline)

(define l1 (list #f))
(define l2 (list l1))
(set-cdr! l1 l2)
(let ((fp (open-output-string)))
  (display l1 fp)
  (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))
(assert:equal "equality on circular lists" (equal? l1 l2) #f)

(define l1 (list 1 2 3))
(define l2 (list 1 l1 3))
(set-cdr! (cdr l1) l2)
(let ((fp (open-output-string)))
  (write l1 fp)
  (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))
(assert:equal "equality on circular lists, test 2" (equal? l1 l2) #f)

;; Adder example
(define (make-adder x)
  (lambda (y) (+ x  y)))
(define increment (make-adder +1))
(assert:equal "Adder #1" (increment 41) 42)
(define decrement (make-adder -1))
(assert:equal "Adder #2" (decrement 42) 41)

(assert:equal "Application example"
  ((lambda (x) x) (+ 41 1))
  42)

;; Apply section
(assert:equal "" (apply length '((#t #f))) 2)
(assert:equal "" (apply cons '(#t #f)) '(#t . #f))
(assert:equal "" (apply cadr (list (list 1 2 3 4))) 2)
(assert:equal "" (apply null? (list '())) #t)
;; Varargs
(define (list2 a b . objs) objs)
(assert:equal "apply varargs" (list 42 1) '(42 1))
(assert:equal "apply varargs" (list 42 1 2) '(42 1 2))
(assert:equal "apply varargs" (list2 42 1) '())
(assert:equal "apply varargs" (list2 42 1 2) '(2))

(assert:equal "begin" (begin 1 2 (+ 1 2) (+ 3 4)) 7)<commit_msg>Conditionally expand memory stream tests<commit_after>(import (scheme base)
        (scheme char)
        (scheme file)
        (scheme lazy)
        (scheme read)
        (scheme write)
        (scheme eval)
        ;(srfi 9)
)

(define *num-passed* 0)
(define (assert:equal msg actual expected)
  (if (not (equal? actual expected))
      (error "Unit test failed [" msg "] actual [" actual "] expected [" expected "]")
      (set! *num-passed* (+ *num-passed* 1))))

(define (assert:not-equal msg x y)
  (assert:equal msg (not (equal? x y)) #t))

(define (assert msg val)
  (assert:equal msg (not val) #f))

(assert "Testing assert function" #t)
(assert "Testing assert function" 1)

;; Quotation / Quasi-quotes
(assert:equal "quasi-quote #1" `(read ,(+ 1 2 3)) '(read 6))
(assert:equal "quasi-quote #2" `(read ,(list 1 2 3)) '(read (1 2 3)))
(assert:equal "quasi-quote splicing" `(read ,@(list 1 2 3)) '(read 1 2 3))

;; Lists
(define l (list 'a 'b 'c))
; TODO: seems to break eval below, is there a GC problem with a circular list?
;(set-cdr! l l)
(set-cdr! l '(c b)) ; Above seems to break if it replaces this line
(assert:equal "list? on circular list" (list? l) #t)

;; Circular data structures
(define v1 (vector #f))
(define v2 (vector v1))
(vector-set! v1 0 v2)
(cond-expand
  (memory-streams
   (let ((fp (open-output-string)))
     (display v1 fp)
     (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular vectors" (equal? v1 v2) #t)
(newline)

(define v1 (vector 1 2 3))
(define v2 (vector 1 v1 3))
(vector-set! v1 1 v2)
(cond-expand
 (memory-streams
  (let ((fp (open-output-string)))
    (write v1 fp)
    (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular vectors, test 2" (equal? v1 v2) #t)
(newline)

(define l1 (list #f))
(define l2 (list l1))
(set-cdr! l1 l2)
(cond-expand
  (memory-streams
   (let ((fp (open-output-string)))
     (display l1 fp)
     (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular lists" (equal? l1 l2) #f)

(define l1 (list 1 2 3))
(define l2 (list 1 l1 3))
(set-cdr! (cdr l1) l2)
(cond-expand
  (memory-streams
   (let ((fp (open-output-string)))
     (write l1 fp)
     (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular lists, test 2" (equal? l1 l2) #f)

;; Adder example
(define (make-adder x)
  (lambda (y) (+ x  y)))
(define increment (make-adder +1))
(assert:equal "Adder #1" (increment 41) 42)
(define decrement (make-adder -1))
(assert:equal "Adder #2" (decrement 42) 41)

(assert:equal "Application example"
  ((lambda (x) x) (+ 41 1))
  42)

;; Apply section
(assert:equal "" (apply length '((#t #f))) 2)
(assert:equal "" (apply cons '(#t #f)) '(#t . #f))
(assert:equal "" (apply cadr (list (list 1 2 3 4))) 2)
(assert:equal "" (apply null? (list '())) #t)
;; Varargs
(define (list2 a b . objs) objs)
(assert:equal "apply varargs" (list 42 1) '(42 1))
(assert:equal "apply varargs" (list 42 1 2) '(42 1 2))
(assert:equal "apply varargs" (list2 42 1) '())
(assert:equal "apply varargs" (list2 42 1 2) '(2))

(assert:equal "begin" (begin 1 2 (+ 1 2) (+ 3 4)) 7)
{'fraction_non_alphanumeric': 0.1822698338767272, 'fraction_numerical': 0.03943487036174507, 'mean_word_length': 3.9745173745173745, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5590908', 'n_tokens_mistral': 2599, 'n_tokens_neox': 2403, 'n_words': 875}