<commit_before>(in-package #:serapeum.tests)

(defun run-tests ()
  (5am:run! 'serapeum))

(defun debug-test (test)
  (let ((5am:*debug-on-error* t)
        (5am:*debug-on-failure* t))
    (run! test)))

(defun a-fixnum ()
  (lambda ()
    (random-in-range most-negative-fixnum most-positive-fixnum)))

(defun an-iota (n)
  (lambda ()
    (iota n)))

(defun a-list-of (len fn)
  (lambda ()
    (map-into (make-list len) fn)))

(def-suite serapeum)
(in-suite serapeum)

(defmacro suite (name &body tests)
  `(progn
     (def-suite ,name :in serapeum)
     (in-suite ,name)
     ,@tests))

(suite macro-tools)

(suite types)

(suite definitions
  
  (test local
    (is (eql 2
             (local
               (def x 1)
               (def y (1+ x))
               y)))

    (is (eql 3
             (local
               (defun adder (y)
                 (+ x y))
               (def x 2)
               (adder 1))))

    (is (eql 3
             (funcall
              (local
                (defun adder (y)
                  (+ x y))
                (def x 2)
                #'adder)
              1)))

    (is (eql 'plus
             (local
               (plus 2 2)
               (defun plus (x y)
                 (+ x y)))))

    (is (null
         (let ((y 2))
           (local
             ;; Check that we don't hoist the constant binding of X.
             (def ret nil)
             (setq ret x)
             (def x y)
             (def x 1)
             ret))))

    ;; Closures in vars.
    (is (eql 4
             (funcall
              (local
                (def adder (lambda (x) (+ x y)))
                (def y 2)
                adder)
              2)))
    
    (is (eql 1
             (local
               (let ((x 1))
                 (defun fn ()
                   x))
               (fn))))

    (is (eql 1
             (local
               (let* ((x 1))
                 (defun fn ()
                   (values x)))
               (fn))))

    (is (eql 1
             (local
               (multiple-value-bind (x) (values 1)
                 (defun fn ()
                   x))
               (fn))))

    (is (eql 4
             (local
               (defconst x (+ 2 2))
               x))))

  (test local+macros
    (is (eql 'x
             (local
               (declaim (ignorable x))
               (def x 1)
               
               (defmacro q (x)
                 `(quote ,x))

               (q x))))
    
    ;; Ensure that forms are partially expanded in the right env.

    (is (eql 'defined
             (local
               (defmacro define-function (name args &body body)
                 `(defun ,name ,args
                    ,@body))
               (define-function fn () 'defined)
               (fn))))
    
    (is (equal '(1 2)
               (flet ((foo () 1))
                 (local
                   (def x (foo))
                   (defmacro foo () 2)
                   (def y (foo))

                   (list x y)))))

    ;; When the value of `def' is contant in the environment.
    (is (equal '(1 2)
               (macrolet ((foo () 1))
                 (local
                   (def x (foo))
                   (defmacro foo () 2)
                   (def y (foo))

                   (list x y)))))

    ;; When the value of `def' is not constant.
    (let ((d (random 3)))
      (is (equal (list (+ 1 d) (+ 2 d))
                 (macrolet ((foo () 1))
                   (local
                     (def x (+ (foo) d))
                     (defmacro foo () 2)
                     (def y (+ (foo) d))

                     (list x y))))))

    (is (equal '(1 2)
               (let ((x 1))
                 (local
                   (def old-x x)
                   (define-symbol-macro x 2)
                   (list old-x x)))))

    (is (equal 1
               (local
                 (defmacro always-1 () 1)
                 (defun fn () (always-1))
                 (fn))))

    (is (equal 1
               (local
                 (defun fn1 () 2)
                 (defmacro always-1 () 1)
                 (defun fn2 () (always-1))
                 (fn2))))

    (is (equal '(foo x y z)
               (local
                 (def x 1)
                 (declaim (ignorable x))
                 (defmacro bar (&whole whole y z)
                   (cons 'x whole))
                 (bar y z))))

    ))

(suite binding

  (test letrec
    "Check that `letrec' and `letrec*' behave differently."
    ;; The exact error depends on the implementation.
    (signals error
      (letrec ((f (constantly t))
               (a (funcall f)))<commit_msg>Test no longer applies.<commit_after>(in-package #:serapeum.tests)

(defun run-tests ()
  (5am:run! 'serapeum))

(defun debug-test (test)
  (let ((5am:*debug-on-error* t)
        (5am:*debug-on-failure* t))
    (run! test)))

(defun a-fixnum ()
  (lambda ()
    (random-in-range most-negative-fixnum most-positive-fixnum)))

(defun an-iota (n)
  (lambda ()
    (iota n)))

(defun a-list-of (len fn)
  (lambda ()
    (map-into (make-list len) fn)))

(def-suite serapeum)
(in-suite serapeum)

(defmacro suite (name &body tests)
  `(progn
     (def-suite ,name :in serapeum)
     (in-suite ,name)
     ,@tests))

(suite macro-tools)

(suite types)

(suite definitions
  
  (test local
    (is (eql 2
             (local
               (def x 1)
               (def y (1+ x))
               y)))

    (is (eql 3
             (local
               (defun adder (y)
                 (+ x y))
               (def x 2)
               (adder 1))))

    (is (eql 3
             (funcall
              (local
                (defun adder (y)
                  (+ x y))
                (def x 2)
                #'adder)
              1)))

    (is (eql 'plus
             (local
               (plus 2 2)
               (defun plus (x y)
                 (+ x y)))))

    (is (null
         (let ((y 2))
           (local
             ;; Check that we don't hoist the constant binding of X.
             (def ret nil)
             (setq ret x)
             (def x y)
             (def x 1)
             ret))))

    ;; Closures in vars.
    (is (eql 4
             (funcall
              (local
                (def adder (lambda (x) (+ x y)))
                (def y 2)
                adder)
              2)))
    
    (is (eql 1
             (local
               (let ((x 1))
                 (defun fn ()
                   x))
               (fn))))

    (is (eql 1
             (local
               (let* ((x 1))
                 (defun fn ()
                   (values x)))
               (fn))))

    (is (eql 1
             (local
               (multiple-value-bind (x) (values 1)
                 (defun fn ()
                   x))
               (fn))))

    (is (eql 4
             (local
               (defconst x (+ 2 2))
               x))))

  (test local+macros
    (is (eql 'x
             (local
               (declaim (ignorable x))
               (def x 1)
               
               (defmacro q (x)
                 `(quote ,x))

               (q x))))
    
    ;; Ensure that forms are partially expanded in the right env.

    (is (eql 'defined
             (local
               (defmacro define-function (name args &body body)
                 `(defun ,name ,args
                    ,@body))
               (define-function fn () 'defined)
               (fn))))
    
    (is (equal '(1 2)
               (flet ((foo () 1))
                 (local
                   (def x (foo))
                   (defmacro foo () 2)
                   (def y (foo))

                   (list x y)))))

    ;; When the value of `def' is not constant.
    (let ((d (random 3)))
      (is (equal (list (+ 1 d) (+ 2 d))
                 (macrolet ((foo () 1))
                   (local
                     (def x (+ (foo) d))
                     (defmacro foo () 2)
                     (def y (+ (foo) d))

                     (list x y))))))

    (is (equal '(1 2)
               (let ((x 1))
                 (local
                   (def old-x x)
                   (define-symbol-macro x 2)
                   (list old-x x)))))

    (is (equal 1
               (local
                 (defmacro always-1 () 1)
                 (defun fn () (always-1))
                 (fn))))

    (is (equal 1
               (local
                 (defun fn1 () 2)
                 (defmacro always-1 () 1)
                 (defun fn2 () (always-1))
                 (fn2))))))

(suite binding

  (test letrec
    "Check that `letrec' and `letrec*' behave differently."
    ;; The exact error depends on the implementation.
    (signals error
      (letrec ((f (constantly t))
               (a (funcall f)))
{'fraction_non_alphanumeric': 0.1308026526412074, 'fraction_numerical': 0.012920192087811571, 'mean_word_length': 0.9356052223943351, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, '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': '1498970', 'n_tokens_mistral': 2774, 'n_tokens_neox': 2549, 'n_words': 819}