1
//! BLOCK / RETURN-FROM lexical labelled exits.
2

            
3
use super::common::{
4
    compile_and_validate, compile_expect_error, wrap_with_runtime_i32, wrap_with_runtime_ratio,
5
};
6

            
7
#[test]
8
1
fn block_returns_body_value_when_no_return_from() {
9
1
    compile_and_validate("(block exit 7)");
10
1
}
11

            
12
#[test]
13
1
fn block_with_multiple_body_forms_returns_last() {
14
1
    compile_and_validate("(block exit 1 2 3)");
15
1
}
16

            
17
#[test]
18
1
fn return_from_skips_remainder() {
19
1
    compile_and_validate("(block exit (return-from exit 7) 99)");
20
1
}
21

            
22
#[test]
23
1
fn return_from_inside_if() {
24
1
    compile_and_validate(&wrap_with_runtime_ratio(
25
1
        "(block exit (if (= X 0) (return-from exit 1) 2))",
26
1
    ));
27
1
}
28

            
29
#[test]
30
1
fn nested_blocks_return_from_inner() {
31
1
    compile_and_validate("(block outer (block inner (return-from inner 7) 99) 8)");
32
1
}
33

            
34
#[test]
35
1
fn nested_blocks_return_from_outer_skips_outer_remainder() {
36
1
    compile_and_validate("(block outer (block inner (return-from outer 7)) 99)");
37
1
}
38

            
39
#[test]
40
1
fn return_from_unknown_block_errors() {
41
1
    let err = compile_expect_error("(block exit (return-from missing 7))");
42
1
    assert!(
43
1
        err.contains("RETURN-FROM") && err.contains("MISSING"),
44
        "expected lexical-scope error mentioning RETURN-FROM and 'MISSING', got: {err}"
45
    );
46
1
}
47

            
48
#[test]
49
1
fn return_from_outside_any_block_errors() {
50
1
    let err = compile_expect_error("(return-from exit 7)");
51
1
    assert!(
52
1
        err.contains("RETURN-FROM") && err.contains("no enclosing"),
53
        "expected error about no enclosing BLOCK, got: {err}"
54
    );
55
1
}
56

            
57
#[test]
58
1
fn block_with_diverging_error_tail_types_from_string_return_from() {
59
    // A `(block done (return-from done <str>) (error ...))` tail diverges
60
    // (throws), so the block's value type must come from the RETURN-FROM
61
    // exit (StringRef), not the `(error)` form's polymorphic I32. Before
62
    // the reachable-exit redesign this was wrongly rejected as
63
    // `string != i32`.
64
1
    compile_and_validate(r#"(block done (return-from done "ok") (error 'boom "x"))"#);
65
1
}
66

            
67
#[test]
68
1
fn block_with_diverging_error_tail_types_from_ratio_return_from() {
69
1
    compile_and_validate("(block done (return-from done 11/10) (error 'boom \"x\"))");
70
1
}
71

            
72
#[test]
73
1
fn block_with_only_error_body_compiles() {
74
1
    compile_and_validate("(block done (error 'boom \"x\"))");
75
1
}
76

            
77
#[test]
78
1
fn block_dead_tail_after_unconditional_return_from_is_typed_by_the_exit() {
79
    // CL semantics: a form after an unconditional `(return-from)` is dead
80
    // code. The block types from the reachable string exit; the ratio tail
81
    // never executes, so this is valid (returns "ok"), not a type error.
82
1
    compile_and_validate(r#"(block done (return-from done "ok") 11/10)"#);
83
1
}
84

            
85
#[test]
86
1
fn block_types_from_live_exits_past_a_non_error_diverging_tail() {
87
    // The tail `(tagbody loop (go loop))` loops forever, but it is dead
88
    // anyway — the leading unconditional `(return-from)` already exits.
89
    // The block must type from the reachable string exit, not the tail's
90
    // `nil`/i32. Regression for the non-`(error)` diverging-tail gap.
91
1
    compile_and_validate(r#"(block done (return-from done "ok") (tagbody loop (go loop)))"#);
92
1
}
93

            
94
#[test]
95
1
fn block_dead_branch_return_from_does_not_taint_live_exit_type() {
96
    // The `(if nil (return-from done "s") (return-from done 1/2))` test is
97
    // statically false, so the string branch is dead; only the ratio exit
98
    // is reachable. The block types as ratio — the dead string exit must
99
    // not provoke a conflict.
100
1
    compile_and_validate(
101
1
        r#"(block done (if nil (return-from done "s") (return-from done 1/2)) (error 'boom "x"))"#,
102
    );
103
1
}
104

            
105
#[test]
106
1
fn block_quoted_return_from_is_data_not_an_exit() {
107
    // A `(return-from foo …)` inside `(quote …)` is data, never compiled
108
    // in value position, so emit-time discovery never records it as an
109
    // exit. Otherwise the quoted ratio would clash with the `nil` tail.
110
1
    compile_and_validate("(block foo (quote (return-from foo 1)) nil)");
111
1
    compile_and_validate("(block foo '(return-from foo 1) nil)");
112
1
}
113

            
114
#[test]
115
1
fn block_return_from_in_lambda_body_is_not_an_outer_exit() {
116
    // A `(return-from foo …)` inside a `(lambda …)` / `(function …)` body
117
    // compiles into a separate helper function, not the block's scratch
118
    // buffer, so it records no exit for this lexical BLOCK (which is
119
    // lexical-only). Its string "exit" must not clash with the numeric tail.
120
1
    compile_and_validate(r#"(block foo (lambda () (return-from foo "x")) 0)"#);
121
1
    compile_and_validate(r#"(block foo (function (lambda () (return-from foo "x"))) 0)"#);
122
1
}
123

            
124
#[test]
125
1
fn block_return_from_in_cond_clause_test_position_is_collected() {
126
    // A `(return-from out V)` in a COND clause's *test* position compiles
127
    // (the test runs first), so emit-time discovery records its ratio exit
128
    // and the block types from it rather than from the tail.
129
1
    compile_and_validate("(block out (cond ((return-from out 1) 2)) 3)");
130
1
}
131

            
132
#[test]
133
1
fn block_return_from_in_diverging_call_arg_types_the_block() {
134
    // `(return-from b V)` as a call argument is compiled (args evaluate
135
    // before the call), so it records an exit. The `(cons …)` never returns
136
    // because its arg exits first; the ratio tail is dead. Emit-time
137
    // discovery types the block from the reachable string exit — the
138
    // syntactic pre-scan could not handle this.
139
1
    compile_and_validate(r#"(block b (cons (return-from b "x") 2) 1)"#);
140
1
}
141

            
142
#[test]
143
1
fn block_return_from_in_diverging_cons_cdr_arg_types_the_block() {
144
    // Same as above but the divergence is in the CDR position: the car `2` is
145
    // evaluated (for effect), then `(return-from b "x")` exits before the pair
146
    // is built — so the non-list car/cdr is never a real cons and must NOT be
147
    // rejected. The block types from the reachable string exit; the i32 tail is
148
    // dead. Twin of the car-divergence case.
149
1
    compile_and_validate(r#"(block b (cons 2 (return-from b "x")) 1)"#);
150
1
}
151

            
152
#[test]
153
1
fn block_return_from_in_inline_lambda_call_arg_diverges() {
154
    // The callee is an inline lambda (non-symbol head) — still an eager
155
    // application, so the `(return-from b "x")` argument exits before the lambda
156
    // body runs. Divergence must propagate through the non-symbol head so the
157
    // i32 tail is recognized as dead and the block types from the string exit.
158
1
    compile_and_validate(r#"(block b (cons ((lambda (x) 2) (return-from b "x")) nil) 1)"#);
159
    // cdr-position twin.
160
1
    compile_and_validate(r#"(block b (cons 2 ((lambda (x) nil) (return-from b "x"))) 1)"#);
161
1
}
162

            
163
#[test]
164
1
fn block_return_from_in_discarded_macro_arg_is_not_an_exit() {
165
    // A macro that discards its argument never compiles the
166
    // `(return-from)` inside it, so no exit is recorded. The syntactic
167
    // pre-scan wrongly rejected this (it could not know the arg was
168
    // discarded without expanding the macro); emit-time discovery is exact.
169
1
    compile_and_validate(
170
1
        r#"(defmacro ignore-arg (x) 0) (block b (ignore-arg (return-from b "x")) 1)"#,
171
    );
172
1
}
173

            
174
#[test]
175
1
fn block_dead_sequential_return_from_does_not_record_an_exit() {
176
    // The second `(return-from)` is dead — the first unconditionally exits
177
    // before it. BLOCK stops compiling at the first diverging form, so the
178
    // dead string exit is never recorded and can't conflict with the live
179
    // ratio exit. CL semantics: returns 1.
180
1
    compile_and_validate(r#"(block b (return-from b 1) (return-from b "x"))"#);
181
1
}
182

            
183
#[test]
184
1
fn block_many_flat_macro_siblings_do_not_exhaust_depth_guard() {
185
    // The divergence walk expands macro heads to classify them. Many flat
186
    // (nesting-depth-1) macro siblings must each start from fresh depth —
187
    // the guard counts nesting, not total expansions — so 65 of them well
188
    // exceed the depth-64 ceiling without wrongly erroring.
189
1
    let calls = "(m) ".repeat(65);
190
1
    compile_and_validate(&format!("(defmacro m () nil) (block x (begin {calls} 0))"));
191
1
}
192

            
193
#[test]
194
1
fn block_macro_expanding_to_return_from_diverges() {
195
    // A macro that expands to a bare `(return-from)` is itself diverging.
196
    // BLOCK classifies divergence with one-step macro expansion (on a
197
    // throwaway symbol table), so it stops before the dead second exit —
198
    // which would otherwise record a conflicting type. CL result: 1.
199
1
    compile_and_validate(
200
1
        r#"(defmacro ret1 () '(return-from b 1)) (block b (ret1) (return-from b "x"))"#,
201
    );
202
1
}
203

            
204
#[test]
205
1
fn block_conflicting_reachable_exits_error() {
206
    // Two reachable `(return-from)` exits with different types (the IF test
207
    // is a runtime value, so both branches are live) is a genuine type
208
    // error, surfaced rather than silently picking one.
209
1
    let err = compile_expect_error(&wrap_with_runtime_i32(
210
1
        r#"(block done (if (= IDX 0) (return-from done "s") (return-from done 1/2)) (error 'boom "x"))"#,
211
1
    ));
212
1
    assert!(
213
1
        err.contains("BLOCK") && err.contains("conflicting exit types"),
214
        "expected a conflicting-exit-types error, got: {err}"
215
    );
216
1
}
217

            
218
#[test]
219
1
fn return_from_inside_wrapped_should_apply_resolves() {
220
    // `should-apply`'s i32 body is wrapped in the Tier 3 boundary
221
    // `try_table` (+3 block_depth). A `(return-from)` inside it must still
222
    // resolve its relative `br` target correctly through the wrapper —
223
    // this exercises the BLOCK machinery (not just a raw `br`) inside the
224
    // wrapped valued entry point. The whole module must validate.
225
1
    compile_and_validate(
226
1
        "(defun should-apply () (block done (if (= 1 1) (return-from done 1) 0)))",
227
    );
228
1
}