Lines
100 %
Functions
Branches
use super::*;
#[tokio::test]
async fn integer_list_if_branches_unify_with_runtime_index_list() {
// An all-integer-literal LIST is an Index chain (ADR-0028), so it
// unifies with a runtime index list instead of widening to AnyRef.
assert_eq!(
eval_value_of(
"(if (> (rpc-protocol-version) 0) \
(list 1 (* 0 (rpc-protocol-version))) (list 1 2))"
)
.await,
"(:id 4 :value \"(1 0)\")"
);
"(let ((xs (if (> (rpc-protocol-version) 0) \
(list 1 2) (list (rpc-protocol-version))))) (car xs))"
"(:id 4 :value 1)"
}
async fn integer_list_local_accepts_runtime_index_stores() {
eval_value_of("(let ((xs (list 1 2))) (setf xs (list (* 0 (rpc-protocol-version)))) xs)")
"(:id 4 :value \"(0)\")"
"(let ((xs (list 1 2))) (when (> (rpc-protocol-version) 0) \
(setf xs (cons (* 0 (rpc-protocol-version)) xs))) xs)"
"(:id 4 :value \"(0 1 2)\")"
async fn cons_runtime_index_onto_integer_lists() {
eval_value_of("(cons (* 0 (rpc-protocol-version)) (list 1 2))").await,
eval_value_of("(cons (* 0 (rpc-protocol-version)) '(1 2))").await,
async fn handler_case_integer_list_arms_agree() {
eval_value_of("(handler-case (list 1 2) (t (e) (list (rpc-protocol-version))))").await,
"(:id 4 :value \"(1 2)\")"
async fn mapcar_over_runtime_index_list() {
eval_value_of("(mapcar (lambda (x) (+ x 1)) (list 1 (* 0 (rpc-protocol-version))))").await,
"(:id 4 :value \"(2 1)\")"
async fn integer_literal_beyond_i31_never_takes_an_index_cell() {
eval_value_of("(list 1073741824 2)").await,
"(:id 4 :value \"(1073741824 2)\")"
eval_value_of("(list 2147483647 2)").await,
"(:id 4 :value \"(2147483647 2)\")"
eval_value_of("(list 1073741823 (* 0 (rpc-protocol-version)))").await,
"(:id 4 :value \"(1073741823 0)\")"
for big in ["1073741824", "2147483647"] {
eval_value_of(&format!("(list {big} (* 0 (rpc-protocol-version)))")).await,
"(:id 4 :value \"(<anyref> <anyref>)\")",
"a {big} literal must widen, not truncate into an index cell"
async fn runtime_index_beyond_i31_throws_index_overflow() {
for form in [
"(list (* 1073741824 (rpc-protocol-version)))",
"(list (* -1073741825 (rpc-protocol-version)))",
"(cons (* 2147483647 (rpc-protocol-version)) (list 1))",
] {
let response = eval_value_of(form).await;
assert!(
response.contains(":code INDEX-OVERFLOW"),
"{form} must raise index-overflow, got: {response}"
async fn index_overflow_is_catchable_by_handler_case() {
"(handler-case (car (list (* 1073741824 (rpc-protocol-version)))) \
(index-overflow (e) -1))"
"(:id 4 :value -1)"
async fn runtime_index_at_i31_bounds_round_trips() {
"(list (* 1073741823 (rpc-protocol-version)) \
(* -1073741824 (rpc-protocol-version)))"
"(:id 4 :value \"(1073741823 -1073741824)\")"
async fn constant_nil_never_becomes_a_zero_cell() {
"(fold (lambda (acc x) (cons x acc)) '(nil) (list (* 0 (rpc-protocol-version))))"
"(:id 4 :value \"(<anyref> nil)\")"
eval_value_of("(cons nil (list (* 0 (rpc-protocol-version))))").await,
"(:id 4 :value \"(nil <anyref>)\")"
async fn null_p_and_not_see_a_nil_in_an_anyref_cell() {
assert_values(&[
(
"(null? (car (cons nil (list (rpc-protocol-version)))))",
"t",
),
"(let ((c (car (cons nil (list (rpc-protocol-version)))))) (null? c))",
("(null? (car (list nil (rpc-protocol-version))))", "t"),
"(null? (car (cdr (cons (rpc-protocol-version) (list nil)))))",
("(not (car (list nil (rpc-protocol-version))))", "t"),
("(null? (car (list \"a\" (rpc-protocol-version))))", "nil"),
("(not (index->scalar (rpc-protocol-version)))", "nil"),
])
.await;
async fn catch_each_binds_an_index_iteration_variable() {
("(length (catch-each (list 1 2) x (+ x 1)))", "2"),
"(let ((xs (list 1 2))) (length (catch-each xs x (+ x 1))))",
"2",
"(catch-each (list 1 2) x (+ x 1))",
"\"(<anyref> <anyref>)\"",
async fn filter_of_an_empty_list_agrees_with_its_closure_predicate() {
assert_values(&[(
"(let ((p (lambda (x) (string= x \"a\")))) (cons \"b\" (filter p '())))",
"\"(\\\"b\\\")\"",
)])
async fn mapcar_and_mapc_accept_let_bound_closures() {
"(let ((f (lambda (x) (* x 2/3)))) (mapcar f '(1 2)))",
"\"(2/3 4/3)\"",
"(let ((f (lambda (x) (* x 2/3)))) (mapc f '(1 2)))",
"(let ((f (lambda (x) (+ x 1)))) \
(map f (list 1/2 (index->scalar (rpc-protocol-version)))))",
"\"(3/2 2)\"",
(mapcar f (list 1/2 (index->scalar (rpc-protocol-version)))))",
"(let ((func 5)) (mapcar (lambda (x) (+ x func)) '(1 1)))",
"\"(6 6)\"",
// A let-bound closure keeps its Scalar parameter, so a runtime index
// list is refused identically through MAP and its MAPCAR alias.
for head in ["map", "mapcar"] {
assert_error_code(
&format!("(let ((f (lambda (x) (+ x 1)))) ({head} f (list 1 (rpc-protocol-version))))"),
"compile",
async fn runtime_index_beyond_i31_throws_in_an_anyref_arm() {
"(if (> (rpc-protocol-version) 0) (* 1073741824 (rpc-protocol-version)) \"a\")",
"INDEX-OVERFLOW",
("(+ 1073741823 (rpc-protocol-version))", "1073741824"),
"(let ((x (* 1073741824 (rpc-protocol-version)))) x)",
"1073741824",
("(+ 1073741822 (rpc-protocol-version))", "1073741823"),
("(- -1073741823 (rpc-protocol-version))", "-1073741824"),
"(null? (if (> (rpc-protocol-version) 0) (* 1073741823 (rpc-protocol-version)) \"a\"))",
"nil",
async fn index_division_by_zero_and_overflow_are_catchable() {
"(handler-case (/ 7 (* 0 (rpc-protocol-version))) (t (e) 0))",
"0",
"(handler-case (mod 7 (* 0 (rpc-protocol-version))) (division-by-zero (e) -1))",
"-1",
("(/ 7 (* 2 (rpc-protocol-version)))", "3"),
("(mod 7 (* 2 (rpc-protocol-version)))", "1"),
assert_error_code("(/ (* 0 (rpc-protocol-version)))", "DIVISION-BY-ZERO").await;
"(/ (- -2147483647 (rpc-protocol-version)) (- 0 (rpc-protocol-version)))",
async fn if_over_differently_typed_lists_stays_a_list() {
"(if (> (rpc-protocol-version) 0) (list 1 2) (list \"a\" \"b\"))",
"(length (if (> (rpc-protocol-version) 0) (list 1 2) (list \"a\" \"b\")))",
async fn filter_and_mapcar_literal_paths_share_the_chain_rule() {
"(filter (lambda (x) (> (rpc-protocol-version) 0)) '(1 1/2))",
"\"(1 1/2)\"",
"(mapcar (lambda (x) (+ x 1/2)) (list 1 1/2))",
"\"(3/2 1)\"",
async fn handler_case_reconciles_literal_and_nil_arms() {
"(handler-case (index->scalar (rpc-protocol-version)) (t (e) 7))",
"1",
"(handler-case (mapcar (lambda (x) (* x 1073741824)) \
(list 1 (rpc-protocol-version))) (index-overflow (e) nil))",
"(handler-case (mapcar (lambda (x) (* x 2)) \
"\"(2 2)\"",
async fn fold_seed_members_widen_the_accumulator() {
"(fold (lambda (acc x) (cons x acc)) '(1) (list (* 0 (rpc-protocol-version))))"
"(:id 4 :value \"(0 1)\")"
for seed in ["'(t)", "'(\"a\")"] {
eval_value_of(&format!(
"(fold (lambda (acc x) (cons x acc)) {seed} (list (rpc-protocol-version)))"
))
"seed {seed}"
async fn list_of_literals_renders_elements_on_eval_path() {
// Regression: an all-literal LIST at stack position defaulted its cells
// to AnyRef, so the host rendered `(<anyref> <anyref>)`.
handle_form_smoke("(:id 4 :form (list 1 2))").await,
handle_form_smoke("(:id 4 :form (list (> 2 1) (= 1 2)))").await,
"(:id 4 :value \"(t nil)\")"
handle_form_smoke("(:id 4 :form (list 1/2 2))").await,
"(:id 4 :value \"(1/2 2)\")"
async fn list_mixing_runtime_and_literal_elements_unifies_cells() {
// An integer literal rides its runtime index neighbor's slot on either
// side; a disagreeing literal tail widens instead of failing to compile.
handle_form_smoke("(:id 4 :form (list (* 0 (rpc-protocol-version)) 2))").await,
"(:id 4 :value \"(0 2)\")"
handle_form_smoke("(:id 4 :form (list 2 (* 0 (rpc-protocol-version))))").await,
"(:id 4 :value \"(2 0)\")"
handle_form_smoke(
"(:id 4 :form (list (* 0 (index->scalar (rpc-protocol-version))) \"a\"))"
"(:id 4 :value \"(<anyref> <anyref>)\")"
handle_form_smoke("(:id 4 :form (list (* 0 (rpc-protocol-version)) nil))").await,
async fn append_runtime_list_onto_constant_list_renders_elements() {
// Regression: the constant suffix was materialized as AnyRef cells under
// a concrete result label, so a ratio label panicked the host decoder.
"(:id 4 :form (append (list (* 0 (index->scalar (rpc-protocol-version)))) '(1 2)))"
handle_form_smoke("(:id 4 :form (append (list (* 0 (rpc-protocol-version))) '(1 2)))")
handle_form_smoke("(:id 4 :form (append (list (> (rpc-protocol-version) 0)) '(t nil)))")
"(:id 4 :value \"(t t nil)\")"
async fn fold_with_constant_list_seed_renders_elements() {
// Regression: the constant seed chain was built as AnyRef cells under the
// accumulator's ratio label, panicking the host decoder.
"(:id 4 :form (fold (lambda (acc x) (cons x acc)) '(1 2) \
(list (* 0 (index->scalar (rpc-protocol-version))))))"
"(:id 4 :form (fold (lambda (acc x) (cons x acc)) '(t) \
(list (> (rpc-protocol-version) 0))))"
"(:id 4 :value \"(t t)\")"