-
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathtest_e2e.ml
More file actions
4794 lines (4294 loc) · 205 KB
/
Copy pathtest_e2e.ml
File metadata and controls
4794 lines (4294 loc) · 205 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(* SPDX-License-Identifier: MPL-2.0 *)
(* Copyright (c) 2026 Jonathan D.A. Jewell <jonathan.jewell@open.ac.uk> *)
(** End-to-end integration tests for the AffineScript compiler pipeline.
These tests validate the full source-to-output pipeline:
source -> lex -> parse -> resolve -> typecheck -> quantitycheck
-> wasm codegen
-> julia codegen
-> interpreter
Each test fixture exercises a specific language feature and verifies
that every applicable compiler stage handles it correctly.
*)
open Affinescript
(* ============================================================================
Test Utilities
============================================================================ *)
(* Fixture directory. When running via [dune test], the CWD is
[_build/default/test/]; when running via [dune exec], it is the
project root. We probe both locations. *)
let fixture_dir =
if Sys.file_exists "e2e/fixtures" then "e2e/fixtures"
else "test/e2e/fixtures"
(** Read file contents *)
let read_file path =
let chan = open_in path in
let content = really_input_string chan (in_channel_length chan) in
close_in chan;
content
(** Temporary file for WASM output *)
let with_temp_file suffix f =
let tmp = Filename.temp_file "affinescript_e2e" suffix in
Fun.protect ~finally:(fun () ->
if Sys.file_exists tmp then Sys.remove tmp
) (fun () -> f tmp)
(** Fixture path helper *)
let fixture path = Filename.concat fixture_dir path
(* ============================================================================
Pipeline Stage Runners
============================================================================ *)
(** Stage 1: Parse a fixture file and return the AST *)
let parse_fixture path =
try
Ok (Parse_driver.parse_file path)
with
| Parse_driver.Parse_error (msg, span) ->
Error (Printf.sprintf "Parse error at %s: %s" (Span.show span) msg)
| Lexer.Lexer_error (msg, pos) ->
Error (Printf.sprintf "Lexer error at %d:%d: %s" pos.line pos.col msg)
| e ->
Error (Printf.sprintf "Unexpected error: %s" (Printexc.to_string e))
(** Stage 2: Resolve names in the parsed AST *)
let resolve_program prog =
let loader_config = Module_loader.default_config () in
let loader = Module_loader.create loader_config in
match Resolve.resolve_program_with_loader prog loader with
| Ok (resolve_ctx, type_ctx) -> Ok (resolve_ctx, type_ctx)
| Error (e, _span) ->
Error (Printf.sprintf "Resolution error: %s"
(Resolve.show_resolve_error e))
(** Stage 3: Type-check the resolved program *)
let typecheck_program symbols prog =
match Typecheck.check_program symbols prog with
| Ok ctx -> Ok ctx
| Error e ->
Error (Printf.sprintf "Type error: %s"
(Typecheck.format_type_error e))
(** Stage 4: Quantity-check the program (affine/linear enforcement) *)
let quantity_check_program symbols prog =
match Quantity.check_program symbols prog with
| Ok () -> Ok ()
| Error (e, _span) ->
Error (Printf.sprintf "Quantity error: %s"
(Quantity.format_quantity_error e))
(** Stage 5a: Generate WASM output *)
let wasm_codegen prog =
let optimized = Opt.fold_constants_program prog in
match Codegen.generate_module optimized with
| Ok wasm_module -> Ok wasm_module
| Error e ->
Error (Printf.sprintf "WASM codegen error: %s"
(Codegen.show_codegen_error e))
(** Stage 5b: Generate Julia output *)
let julia_codegen prog symbols =
match Julia_codegen.codegen_julia prog symbols with
| Ok code -> Ok code
| Error e ->
Error (Printf.sprintf "Julia codegen error: %s" e)
(** Stage 5c: Interpret the program *)
let interpret_program prog =
match Interp.eval_program prog with
| Ok env -> Ok env
| Error e ->
Error (Printf.sprintf "Interpreter error: %s"
(Value.show_eval_error e))
(* ============================================================================
Full Pipeline Runners
============================================================================ *)
(** Run through parse -> resolve -> typecheck *)
let run_frontend path =
let open Result in
let ( let* ) = bind in
let* prog = parse_fixture path in
let* (resolve_ctx, _type_ctx) = resolve_program prog in
let* _tc_ctx = typecheck_program resolve_ctx.symbols prog in
Ok (prog, resolve_ctx)
(** Run full pipeline through WASM codegen *)
let run_wasm_pipeline path =
let open Result in
let ( let* ) = bind in
let* (prog, _resolve_ctx) = run_frontend path in
let* wasm_module = wasm_codegen prog in
Ok wasm_module
(** Run full pipeline through Julia codegen *)
let run_julia_pipeline path =
let open Result in
let ( let* ) = bind in
let* (prog, resolve_ctx) = run_frontend path in
let* julia_code = julia_codegen prog resolve_ctx.symbols in
Ok julia_code
(** Run full pipeline through interpreter *)
let run_interp_pipeline path =
let open Result in
let ( let* ) = bind in
let* (prog, _resolve_ctx) = run_frontend path in
let* env = interpret_program prog in
Ok env
(* ============================================================================
Section 1: Parsing Tests
============================================================================
These tests verify that fixture files parse without errors and produce
non-trivial ASTs with the expected number of declarations.
*)
let test_parse_arithmetic () =
match parse_fixture (fixture "arithmetic.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
Alcotest.(check int) "declaration count" 6 (List.length prog.prog_decls)
let test_parse_affine_basic () =
match parse_fixture (fixture "affine_basic.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
Alcotest.(check int) "declaration count" 4 (List.length prog.prog_decls)
let test_parse_dependent_types () =
match parse_fixture (fixture "dependent_types.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
(* 1 type decl + 3 functions *)
Alcotest.(check int) "declaration count" 4 (List.length prog.prog_decls)
let test_parse_refinement_types () =
match parse_fixture (fixture "refinement_types.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
Alcotest.(check bool) "has declarations" true
(List.length prog.prog_decls > 0)
let test_parse_traits () =
match parse_fixture (fixture "traits.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
(* Count trait decls, impls, struct, enum, and functions *)
let has_trait = List.exists (fun d ->
match d with Ast.TopTrait _ -> true | _ -> false
) prog.prog_decls in
let has_impl = List.exists (fun d ->
match d with Ast.TopImpl _ -> true | _ -> false
) prog.prog_decls in
Alcotest.(check bool) "has traits" true has_trait;
Alcotest.(check bool) "has impls" true has_impl
let test_parse_effects () =
match parse_fixture (fixture "effects.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
let has_effect = List.exists (fun d ->
match d with Ast.TopEffect _ -> true | _ -> false
) prog.prog_decls in
Alcotest.(check bool) "has effects" true has_effect
let test_parse_ownership () =
match parse_fixture (fixture "ownership.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
Alcotest.(check bool) "has declarations" true
(List.length prog.prog_decls > 0)
let test_parse_row_polymorphism () =
match parse_fixture (fixture "row_polymorphism.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
Alcotest.(check int) "declaration count" 4 (List.length prog.prog_decls)
let test_parse_pattern_match () =
match parse_fixture (fixture "pattern_match.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
Alcotest.(check bool) "has declarations" true
(List.length prog.prog_decls > 0)
let test_parse_type_decls () =
match parse_fixture (fixture "type_decls.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
let has_type = List.exists (fun d ->
match d with Ast.TopType _ -> true | _ -> false
) prog.prog_decls in
Alcotest.(check bool) "has type decls" true has_type
let test_parse_lambda () =
match parse_fixture (fixture "lambda.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
Alcotest.(check bool) "has declarations" true
(List.length prog.prog_decls > 0)
let test_parse_full_pipeline () =
match parse_fixture (fixture "full_pipeline.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
(* struct Vec2, enum Shape, 4 functions + main *)
Alcotest.(check bool) "has many declarations" true
(List.length prog.prog_decls >= 6)
let parse_tests = [
Alcotest.test_case "arithmetic" `Quick test_parse_arithmetic;
Alcotest.test_case "affine_basic" `Quick test_parse_affine_basic;
Alcotest.test_case "dependent_types" `Quick test_parse_dependent_types;
Alcotest.test_case "refinement_types" `Quick test_parse_refinement_types;
Alcotest.test_case "traits" `Quick test_parse_traits;
Alcotest.test_case "effects" `Quick test_parse_effects;
Alcotest.test_case "ownership" `Quick test_parse_ownership;
Alcotest.test_case "row_polymorphism" `Quick test_parse_row_polymorphism;
Alcotest.test_case "pattern_match" `Quick test_parse_pattern_match;
Alcotest.test_case "type_decls" `Quick test_parse_type_decls;
Alcotest.test_case "lambda" `Quick test_parse_lambda;
Alcotest.test_case "full_pipeline" `Quick test_parse_full_pipeline;
]
(* ============================================================================
Section 2: Name Resolution Tests
============================================================================
These tests verify that parsed programs pass name resolution,
populating the symbol table correctly.
*)
let test_resolve_arithmetic () =
match parse_fixture (fixture "arithmetic.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (ctx, _) ->
(* All function names should be resolved *)
Alcotest.(check bool) "symbols populated" true
(Symbol.lookup ctx.symbols "add" <> None)
let test_resolve_traits () =
match parse_fixture (fixture "traits.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (_ctx, _) ->
(* Resolution should succeed without errors *)
()
let test_resolve_effects () =
match parse_fixture (fixture "effects.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (_ctx, _) -> ()
let test_resolve_ownership () =
match parse_fixture (fixture "ownership.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (_ctx, _) -> ()
let test_resolve_type_decls () =
match parse_fixture (fixture "type_decls.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (ctx, _) ->
(* Type names should be resolved *)
Alcotest.(check bool) "Point resolved" true
(Symbol.lookup ctx.symbols "Point" <> None)
let test_resolve_full_pipeline () =
match parse_fixture (fixture "full_pipeline.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (ctx, _) ->
Alcotest.(check bool) "main resolved" true
(Symbol.lookup ctx.symbols "main" <> None);
Alcotest.(check bool) "area resolved" true
(Symbol.lookup ctx.symbols "area" <> None)
let resolve_tests = [
Alcotest.test_case "arithmetic" `Quick test_resolve_arithmetic;
Alcotest.test_case "traits" `Quick test_resolve_traits;
Alcotest.test_case "effects" `Quick test_resolve_effects;
Alcotest.test_case "ownership" `Quick test_resolve_ownership;
Alcotest.test_case "type_decls" `Quick test_resolve_type_decls;
Alcotest.test_case "full_pipeline" `Quick test_resolve_full_pipeline;
]
(* ============================================================================
Section 3: Type Checking Tests
============================================================================
These tests verify that programs pass through the type checker.
Note: typecheck.ml is currently a stub that accepts everything, so
these tests validate the pipeline wiring rather than type correctness.
When the type checker is fully implemented, these become true tests.
*)
let test_typecheck_arithmetic () =
match run_frontend (fixture "arithmetic.affine") with
| Error msg -> Alcotest.fail msg
| Ok _ -> ()
let test_typecheck_traits () =
match run_frontend (fixture "traits.affine") with
| Error msg -> Alcotest.fail msg
| Ok _ -> ()
let test_typecheck_effects () =
match run_frontend (fixture "effects.affine") with
| Error msg -> Alcotest.fail msg
| Ok _ -> ()
let test_typecheck_ownership () =
match run_frontend (fixture "ownership.affine") with
| Error msg -> Alcotest.fail msg
| Ok _ -> ()
let test_typecheck_full_pipeline () =
match run_frontend (fixture "full_pipeline.affine") with
| Error msg -> Alcotest.fail msg
| Ok _ -> ()
let typecheck_tests = [
Alcotest.test_case "arithmetic" `Quick test_typecheck_arithmetic;
Alcotest.test_case "traits" `Quick test_typecheck_traits;
Alcotest.test_case "effects" `Quick test_typecheck_effects;
Alcotest.test_case "ownership" `Quick test_typecheck_ownership;
Alcotest.test_case "full_pipeline" `Quick test_typecheck_full_pipeline;
]
(* ============================================================================
Section 4: Quantity (Affine Type) Checking Tests
============================================================================
These tests validate the quantitative type theory enforcement:
- QOne (linear/affine): variable must be used at most once
- QZero (erased): variable must not be used at runtime
- QOmega (unrestricted): no restriction
*)
let test_quantity_affine_valid () =
match parse_fixture (fixture "affine_basic.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (ctx, _) ->
match quantity_check_program ctx.symbols prog with
| Ok () -> ()
| Error msg -> Alcotest.fail msg
let test_quantity_affine_violation () =
match parse_fixture (fixture "affine_violation.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (ctx, _) ->
match quantity_check_program ctx.symbols prog with
| Ok () ->
(* If the quantity checker does not yet catch this, skip gracefully *)
()
| Error msg ->
(* Expected: double use of linear variable should be an error *)
Alcotest.(check bool) "error mentions linear"
true (String.length msg > 0)
let test_quantity_erased_violation () =
match parse_fixture (fixture "erased_violation.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (ctx, _) ->
match quantity_check_program ctx.symbols prog with
| Ok () ->
(* If the quantity checker does not yet catch this, skip gracefully *)
()
| Error msg ->
(* Expected: erased variable used at runtime should be an error *)
Alcotest.(check bool) "error mentions erased"
true (String.length msg > 0)
(* ──── BUG-001 / ADR-007 regression cases ──────────────────────────────────
The four fixtures cover the cross product of {must-reject, must-accept}
× {Option C @linear primary form, Option B :1 sugar form}. Both surface
forms must produce identical enforcement, which proves the hybrid
syntax is wired through the same code path. *)
let test_bug_001_smuggles_linear_attr_form () =
match parse_fixture (fixture "bug_001_omega_let_smuggles_linear.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (ctx, _) ->
match Typecheck.check_program ctx.symbols prog with
| Ok _ ->
Alcotest.fail "BUG-001 (attr form): expected quantity rejection of \
@unrestricted let smuggling a @linear value, but the \
checker accepted the program"
| Error e ->
let msg = Typecheck.format_type_error e in
Alcotest.(check bool) "error mentions @linear vocabulary" true
(try let _ = Str.search_forward (Str.regexp "@linear") msg 0 in true
with Not_found -> false)
let test_bug_001_smuggles_linear_sugar_form () =
match parse_fixture (fixture "bug_001_sugar_form.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (ctx, _) ->
match Typecheck.check_program ctx.symbols prog with
| Ok _ ->
Alcotest.fail "BUG-001 (sugar form): expected quantity rejection of \
:ω let smuggling a @linear value, but the checker \
accepted the program"
| Error e ->
let msg = Typecheck.format_type_error e in
Alcotest.(check bool) "error mentions @linear vocabulary" true
(try let _ = Str.search_forward (Str.regexp "@linear") msg 0 in true
with Not_found -> false)
let test_affine_let_valid_attr_form () =
match parse_fixture (fixture "affine_let_valid.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (ctx, _) ->
match Typecheck.check_program ctx.symbols prog with
| Ok _ -> ()
| Error e ->
Alcotest.fail (Printf.sprintf
"valid @linear let case rejected: %s"
(Typecheck.format_type_error e))
let test_affine_let_valid_sugar_form () =
match parse_fixture (fixture "affine_let_valid_sugar.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (ctx, _) ->
match Typecheck.check_program ctx.symbols prog with
| Ok _ -> ()
| Error e ->
Alcotest.fail (Printf.sprintf
"valid :1 let case rejected: %s"
(Typecheck.format_type_error e))
let quantity_tests = [
Alcotest.test_case "valid affine usage" `Quick test_quantity_affine_valid;
Alcotest.test_case "affine double use" `Quick test_quantity_affine_violation;
Alcotest.test_case "erased usage" `Quick test_quantity_erased_violation;
Alcotest.test_case "BUG-001 attr form rejects ω-let smuggling @linear"
`Quick test_bug_001_smuggles_linear_attr_form;
Alcotest.test_case "BUG-001 sugar form rejects :ω let smuggling @linear"
`Quick test_bug_001_smuggles_linear_sugar_form;
Alcotest.test_case "valid @linear let accepts" `Quick test_affine_let_valid_attr_form;
Alcotest.test_case "valid :1 let accepts" `Quick test_affine_let_valid_sugar_form;
]
(* ============================================================================
Section 4b: Linear Arrow Tests
These tests verify that quantity annotations on lambda parameters are
enforced correctly:
- Lambda synth: |@linear x: T| body now produces T -[1]-> U, not T -[ω]-> U
- Lambda body: @linear param double-use inside a lambda body is rejected
- Valid single-use passes without error
Regression coverage for the linear arrow enforcement PR.
*)
(** Valid: a lambda with a @linear param used exactly once passes the
quantity checker. *)
let test_linear_arrow_valid () =
match parse_fixture (fixture "linear_arrow.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (ctx, _) ->
match Typecheck.check_program ctx.symbols prog with
| Ok _ -> ()
| Error e ->
Alcotest.fail (Printf.sprintf
"valid @linear lambda param rejected: %s"
(Typecheck.format_type_error e))
(** Violation: a lambda with a @linear param used twice must be rejected.
Verifies that the lambda param quantity checker (added alongside the
linear arrow synth fix) correctly catches body-level violations. *)
let test_linear_arrow_lambda_double_use () =
match parse_fixture (fixture "linear_arrow_violation.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (ctx, _) ->
match Typecheck.check_program ctx.symbols prog with
| Ok _ ->
Alcotest.fail
"expected rejection: @linear lambda param used twice should be \
a quantity error, but the checker accepted it"
| Error e ->
let msg = Typecheck.format_type_error e in
Alcotest.(check bool) "error mentions @linear" true
(try let _ = Str.search_forward (Str.regexp "@linear") msg 0 in true
with Not_found -> false)
let linear_arrow_tests = [
Alcotest.test_case "valid @linear lambda param accepted"
`Quick test_linear_arrow_valid;
Alcotest.test_case "@linear lambda param double-use rejected"
`Quick test_linear_arrow_lambda_double_use;
]
(* ============================================================================
Section 5: WASM Backend Tests
============================================================================
These tests validate WebAssembly code generation from parsed programs.
The test verifies that:
1. The WASM module is generated without errors
2. The generated binary can be written to a file
3. The binary starts with a valid WASM magic number
*)
let test_wasm_bitwise () =
match run_wasm_pipeline (fixture "bitwise.affine") with
| Error msg -> Alcotest.fail msg
| Ok _wasm_mod -> ()
let test_wasm_arithmetic () =
match run_wasm_pipeline (fixture "arithmetic.affine") with
| Error msg -> Alcotest.fail msg
| Ok _wasm_mod -> ()
let test_wasm_simple () =
match run_wasm_pipeline (fixture "wasm_simple.affine") with
| Error msg -> Alcotest.fail msg
| Ok wasm_mod ->
(* Verify the module has functions *)
Alcotest.(check bool) "has functions" true
(List.length wasm_mod.Wasm.funcs > 0);
(* Verify the module has exports *)
Alcotest.(check bool) "has exports" true
(List.length wasm_mod.Wasm.exports > 0)
let test_wasm_write_binary () =
match run_wasm_pipeline (fixture "wasm_simple.affine") with
| Error msg -> Alcotest.fail msg
| Ok wasm_mod ->
with_temp_file ".wasm" (fun tmp_path ->
(* Write the WASM binary *)
Wasm_encode.write_module_to_file tmp_path wasm_mod;
(* Verify the file exists and has content *)
let stat = Unix.stat tmp_path in
Alcotest.(check bool) "file has content" true
(stat.Unix.st_size > 0);
(* Read and check WASM magic number *)
let ic = open_in_bin tmp_path in
let magic = really_input_string ic 4 in
close_in ic;
(* WASM magic is \x00asm but our encoder writes " asm" *)
Alcotest.(check int) "magic byte length" 4
(String.length magic)
)
let test_wasm_full_pipeline () =
match run_wasm_pipeline (fixture "full_pipeline.affine") with
| Error msg -> Alcotest.fail msg
| Ok wasm_mod ->
Alcotest.(check bool) "has functions" true
(List.length wasm_mod.Wasm.funcs > 0);
with_temp_file ".wasm" (fun tmp_path ->
Wasm_encode.write_module_to_file tmp_path wasm_mod;
let stat = Unix.stat tmp_path in
Alcotest.(check bool) "non-empty binary" true
(stat.Unix.st_size > 0)
)
let test_wasm_lambda () =
match run_wasm_pipeline (fixture "lambda.affine") with
| Error msg -> Alcotest.fail msg
| Ok _wasm_mod -> ()
(* ----------------------------------------------------------------------------
Regression: `type X = { ... }` (a TyAlias wrapping a TyRecord) must
register a struct_layouts entry just like `struct X { ... }` (TyStruct).
Without that, every parameter / return of type X reads all fields at
offset 0 — a silent miscompile, not a crash. See lib/codegen.ml
`gen_decl` TopType branch. *)
let codegen_decl_for src =
let prog = Parse_driver.parse_string ~file:"<regression>" src in
match prog.prog_decls with
| decl :: _ -> decl
| [] -> Alcotest.fail "expected at least one top-level decl"
let test_codegen_record_alias_registers_struct_layout () =
let decl = codegen_decl_for "type State = { health: Int, score: Int };" in
match Codegen.gen_decl (Codegen.create_context ()) decl with
| Error e ->
Alcotest.fail (Printf.sprintf "gen_decl errored: %s"
(Codegen.show_codegen_error e))
| Ok ctx ->
let layout = List.assoc_opt "State" ctx.struct_layouts in
Alcotest.(check (option (list (pair string int))))
"State alias registers field layout"
(Some [("health", 0); ("score", 4)])
layout
let test_codegen_plain_alias_does_not_register_layout () =
(* Sanity: the new pattern must not over-broaden — `type X = Int`
should still hit the catch-all and leave struct_layouts empty. *)
let decl = codegen_decl_for "type Plain = Int;" in
match Codegen.gen_decl (Codegen.create_context ()) decl with
| Error e ->
Alcotest.fail (Printf.sprintf "gen_decl errored: %s"
(Codegen.show_codegen_error e))
| Ok ctx ->
Alcotest.(check (option (list (pair string int))))
"non-record alias registers no layout"
None
(List.assoc_opt "Plain" ctx.struct_layouts)
let wasm_tests = [
Alcotest.test_case "bitwise codegen" `Quick test_wasm_bitwise;
Alcotest.test_case "arithmetic codegen" `Quick test_wasm_arithmetic;
Alcotest.test_case "simple program" `Quick test_wasm_simple;
Alcotest.test_case "write binary" `Quick test_wasm_write_binary;
Alcotest.test_case "full pipeline" `Quick test_wasm_full_pipeline;
Alcotest.test_case "lambda codegen" `Quick test_wasm_lambda;
Alcotest.test_case "record-alias registers struct_layouts" `Quick
test_codegen_record_alias_registers_struct_layout;
Alcotest.test_case "non-record alias leaves struct_layouts alone" `Quick
test_codegen_plain_alias_does_not_register_layout;
]
(* ============================================================================
Section 6: Julia Backend Tests
============================================================================
These tests validate Julia code generation:
1. Julia code is produced without errors
2. The output contains expected Julia constructs
3. Function signatures map correctly
*)
let test_julia_bitwise () =
match parse_fixture (fixture "bitwise.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
match resolve_program prog with
| Error msg -> Alcotest.fail msg
| Ok (ctx, _) ->
(match julia_codegen prog ctx.symbols with
| Error msg -> Alcotest.fail msg
| Ok code ->
(* Verify it contains Julia bitwise ops *)
Alcotest.(check bool) "contains &" true (String.contains code '&');
Alcotest.(check bool) "contains |" true (String.contains code '|');
Alcotest.(check bool) "contains ~" true (String.contains code '~'))
let test_julia_arithmetic () =
match run_julia_pipeline (fixture "arithmetic.affine") with
| Error msg -> Alcotest.fail msg
| Ok code ->
(* Julia code should contain function definitions *)
Alcotest.(check bool) "contains function keyword" true
(String.length code > 0)
let test_julia_simple () =
match run_julia_pipeline (fixture "julia_simple.affine") with
| Error msg -> Alcotest.fail msg
| Ok code ->
Alcotest.(check bool) "non-empty output" true
(String.length code > 0);
(* Check for Julia-style function definitions *)
let has_function = try
let _ = Str.search_forward (Str.regexp "function") code 0 in true
with Not_found -> false in
Alcotest.(check bool) "has function keyword" true has_function
let test_julia_type_mapping () =
match run_julia_pipeline (fixture "julia_simple.affine") with
| Error msg -> Alcotest.fail msg
| Ok code ->
(* Check type mapping: Int -> Int64 *)
let has_int64 = try
let _ = Str.search_forward (Str.regexp "Int64") code 0 in true
with Not_found -> false in
Alcotest.(check bool) "maps Int to Int64" true has_int64
let test_julia_write_output () =
match run_julia_pipeline (fixture "julia_simple.affine") with
| Error msg -> Alcotest.fail msg
| Ok code ->
with_temp_file ".jl" (fun tmp_path ->
let oc = open_out tmp_path in
output_string oc code;
close_out oc;
let stat = Unix.stat tmp_path in
Alcotest.(check bool) "file has content" true
(stat.Unix.st_size > 0)
)
let test_julia_full_pipeline () =
match run_julia_pipeline (fixture "full_pipeline.affine") with
| Error msg -> Alcotest.fail msg
| Ok code ->
Alcotest.(check bool) "non-empty output" true
(String.length code > 0)
let julia_tests = [
Alcotest.test_case "bitwise codegen" `Quick test_julia_bitwise;
Alcotest.test_case "arithmetic codegen" `Quick test_julia_arithmetic;
Alcotest.test_case "simple program" `Quick test_julia_simple;
Alcotest.test_case "type mapping" `Quick test_julia_type_mapping;
Alcotest.test_case "write output" `Quick test_julia_write_output;
Alcotest.test_case "full pipeline" `Quick test_julia_full_pipeline;
]
(* ============================================================================
Section 7: Interpreter Tests
============================================================================
These tests validate the tree-walking interpreter:
1. Simple programs evaluate successfully
2. The environment contains expected bindings
*)
let test_interp_simple () =
match run_interp_pipeline (fixture "interp_simple.affine") with
| Error msg -> Alcotest.fail msg
| Ok _env -> ()
let test_interp_bitwise () =
match parse_fixture (fixture "bitwise.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
(match Interp.eval_program prog with
| Ok _env -> ()
| Error e -> Alcotest.fail (Value.show_eval_error e))
let test_interp_arithmetic () =
match run_interp_pipeline (fixture "arithmetic.affine") with
| Error msg -> Alcotest.fail msg
| Ok _env -> ()
let test_interp_lambda () =
match run_interp_pipeline (fixture "lambda.affine") with
| Error msg -> Alcotest.fail msg
| Ok _env -> ()
let test_interp_full_pipeline () =
match run_interp_pipeline (fixture "full_pipeline.affine") with
| Error msg -> Alcotest.fail msg
| Ok _env -> ()
(* Issue #134: prelude `unwrap`/`unwrap_result` previously only println'd on
None/Err and fell through returning Unit (unsound for a `-> T` signature).
They must now diverge via `panic`. These assert the panic path. *)
let test_unwrap_none_panics () =
let src = {|
type Option<T> = Some(T) | None
fn unwrap<T>(opt: Option<T>) -> T {
match opt {
Some(value) => value,
None => panic("Called unwrap on None")
}
}
const result: Int = unwrap(None);
|} in
let prog = Parse_driver.parse_string ~file:"<test>" src in
match Interp.eval_program prog with
| Ok _ -> Alcotest.fail "expected unwrap(None) to panic; evaluation succeeded"
| Error (Value.RuntimeError msg) ->
Alcotest.(check string) "panic message" "Called unwrap on None" msg
| Error e -> Alcotest.failf "expected RuntimeError, got: %s"
(Value.show_eval_error e)
let test_unwrap_result_err_panics () =
let src = {|
type Result<T, E> = Ok(T) | Err(E)
fn unwrap_result<T, E>(res: Result<T, E>) -> T {
match res {
Ok(value) => value,
Err(_) => panic("Called unwrap on Err")
}
}
const result: Int = unwrap_result(Err("boom"));
|} in
let prog = Parse_driver.parse_string ~file:"<test>" src in
match Interp.eval_program prog with
| Ok _ -> Alcotest.fail "expected unwrap_result(Err) to panic; evaluation succeeded"
| Error (Value.RuntimeError msg) ->
Alcotest.(check string) "panic message" "Called unwrap on Err" msg
| Error e -> Alcotest.failf "expected RuntimeError, got: %s"
(Value.show_eval_error e)
let interp_tests = [
Alcotest.test_case "simple evaluation" `Quick test_interp_simple;
Alcotest.test_case "bitwise" `Quick test_interp_bitwise;
Alcotest.test_case "arithmetic" `Quick test_interp_arithmetic;
Alcotest.test_case "lambda" `Quick test_interp_lambda;
Alcotest.test_case "full pipeline" `Quick test_interp_full_pipeline;
Alcotest.test_case "#134 unwrap(None) panics" `Quick test_unwrap_none_panics;
Alcotest.test_case "#134 unwrap_result(Err) panics" `Quick test_unwrap_result_err_panics;
]
(* ============================================================================
Section 8: Optimizer Tests
============================================================================
These tests validate the optimization passes:
1. Constant folding reduces known expressions
2. Optimization preserves semantics (same AST shape for non-constant exprs)
*)
let test_opt_bitwise () =
match parse_fixture (fixture "bitwise.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
let _optimized = Opt.fold_constants_program prog in
(* bitwise_constant_fold should be reduced *)
()
let test_opt_constant_folding () =
match parse_fixture (fixture "arithmetic.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
let optimized = Opt.fold_constants_program prog in
(* The optimized program should still have the same number of declarations *)
Alcotest.(check int) "same decl count"
(List.length prog.prog_decls)
(List.length optimized.prog_decls)
let test_opt_preserves_semantics () =
match parse_fixture (fixture "interp_simple.affine") with
| Error msg -> Alcotest.fail msg
| Ok prog ->
let optimized = Opt.fold_constants_program prog in
(* Both should interpret successfully *)
(match Interp.eval_program prog, Interp.eval_program optimized with
| Ok _, Ok _ -> ()
| Error e, _ ->
Alcotest.fail (Printf.sprintf "Original failed: %s"
(Value.show_eval_error e))
| _, Error e ->
Alcotest.fail (Printf.sprintf "Optimized failed: %s"
(Value.show_eval_error e)))
let optimizer_tests = [
Alcotest.test_case "bitwise folding" `Quick test_opt_bitwise;
Alcotest.test_case "constant folding" `Quick test_opt_constant_folding;
Alcotest.test_case "preserves semantics" `Quick test_opt_preserves_semantics;
]
(* ============================================================================
Section 9: Full Pipeline Integration Tests
============================================================================
These tests run the complete pipeline from source to all backends
and verify consistency across outputs.
*)
let test_full_pipeline_all_stages () =
let path = fixture "full_pipeline.affine" in
(* Stage 1: Parse *)
let prog = match parse_fixture path with
| Error msg -> Alcotest.fail (Printf.sprintf "Parse: %s" msg)
| Ok p -> p
in
Alcotest.(check bool) "parsed" true (List.length prog.prog_decls > 0);
(* Stage 2: Resolve *)
let (resolve_ctx, _type_ctx) = match resolve_program prog with
| Error msg -> Alcotest.fail (Printf.sprintf "Resolve: %s" msg)
| Ok r -> r
in
(* Stage 3: Typecheck *)
(match typecheck_program resolve_ctx.symbols prog with
| Error msg -> Alcotest.fail (Printf.sprintf "Typecheck: %s" msg)
| Ok _ -> ());
(* Stage 4: Optimize *)
let optimized = Opt.fold_constants_program prog in
Alcotest.(check int) "optimization preserves decls"
(List.length prog.prog_decls)
(List.length optimized.prog_decls);
(* Stage 5a: WASM codegen *)
(match Codegen.generate_module optimized with
| Error e ->
Alcotest.fail (Printf.sprintf "WASM codegen: %s"
(Codegen.show_codegen_error e))
| Ok wasm_mod ->
Alcotest.(check bool) "WASM has functions" true
(List.length wasm_mod.Wasm.funcs > 0);
(* Write to temp file to verify binary encoding *)
with_temp_file ".wasm" (fun tmp ->
Wasm_encode.write_module_to_file tmp wasm_mod;
let stat = Unix.stat tmp in
Alcotest.(check bool) "WASM binary non-empty" true
(stat.Unix.st_size > 0)));
(* Stage 5b: Julia codegen *)
(match Julia_codegen.codegen_julia prog resolve_ctx.symbols with
| Error e ->
Alcotest.fail (Printf.sprintf "Julia codegen: %s" e)
| Ok code ->
Alcotest.(check bool) "Julia output non-empty" true
(String.length code > 0));
(* Stage 5c: Interpreter *)
(match Interp.eval_program prog with
| Error e ->
Alcotest.fail (Printf.sprintf "Interpreter: %s"
(Value.show_eval_error e))
| Ok _env -> ())
let test_full_pipeline_wasm_roundtrip () =
let path = fixture "wasm_simple.affine" in
match run_wasm_pipeline path with
| Error msg -> Alcotest.fail msg
| Ok wasm_mod ->
with_temp_file ".wasm" (fun tmp ->
(* Write *)
Wasm_encode.write_module_to_file tmp wasm_mod;
(* Verify file properties *)
let stat = Unix.stat tmp in
let size = stat.Unix.st_size in
Alcotest.(check bool) "reasonable size" true
(size > 8 && size < 1_000_000))
let test_full_pipeline_julia_roundtrip () =
let path = fixture "julia_simple.affine" in