blob: f03e25e0b109cf02003d406fc35e3af11ce545b6 (
plain) (
blame)
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
|
open Alcotest
open Rnt
module Beam = Subsystem.Karuta.Beam
let fixtures = "integration/beam"
(* rnt and shelf boot with the node; library is only ever loaded from
the images that carry it. *)
let booted = ["rnt"; "shelf"]
let carried = ["library"]
type node = {root: Protocols.Handle.t; image: string -> string}
let term image module_ function_ heading =
let buffer = Buffer.create 64 in
let binary s =
Buffer.add_uint8 buffer 109;
Buffer.add_int32_be buffer (Int32.of_int (String.length s));
Buffer.add_string buffer s
in
Buffer.add_uint8 buffer 131;
Buffer.add_uint8 buffer 104;
Buffer.add_uint8 buffer 4;
binary module_;
binary function_;
binary (image module_);
Buffer.add_uint8 buffer 116;
Buffer.add_int32_be buffer (Int32.of_int (List.length heading));
List.iter (fun name -> binary name; binary "string") heading;
Buffer.contents buffer
(* \system\evaluator\fol, so the node can define FOL programs. *)
let mount_fol root =
let open Utilities.Result in
let evaluators = Kernel.Namespace.make () in
let system = Kernel.Namespace.make () in
let* _ =
Kernel.Path.update evaluators Kernel.Path.this "fol" None (Some (Evaluators.FOL.make ()))
in
let* _ = Kernel.Path.update system Kernel.Path.this "evaluator" None (Some evaluators) in
let* _ = Kernel.Path.update root Kernel.Path.this "system" None (Some system) in
Ok ()
let with_node test () =
if Sys.command "command -v erl > /dev/null 2>&1 && command -v erlc > /dev/null 2>&1" <> 0 then
skip ();
Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
Helpers.with_temporary_directory "beam" (fun directory ->
let boot = Filename.concat directory "boot" and images = Filename.concat directory "images" in
let compile into modules =
Unix.mkdir into 0o755;
let sources = List.map (fun m -> Filename.concat fixtures (m ^ ".erl")) modules in
if Sys.command (Filename.quote_command "erlc" (["-o"; into] @ sources)) <> 0 then
fail "the fixtures did not compile"
in
compile boot booted;
compile images carried;
let image module_ =
let at = if List.mem module_ booted then boot else images in
In_channel.with_open_bin (Filename.concat at (module_ ^ ".beam")) In_channel.input_all
in
let root = Kernel.Namespace.make () in
Fun.protect
~finally:(fun () -> Protocols.Handle.release root)
(fun () ->
Helpers.condition_as_failure (mount_fol root);
Helpers.condition_as_failure (Beam.register root [boot]);
test {root; image} ) )
let run {root; image} module_ function_ heading =
let open Utilities.Result in
let* program =
Kernel.Program.load root ~evaluator:"karuta:beam" ~source:(term image module_ function_ heading)
in
let* executable = Protocols.Executable.require program in
Protocols.Executable.invoke executable [] ~within:root
let titles batch =
BatFingerTree.to_list batch.Protocols.Cursor.tuples
|> List.map (fun {Concepts.Tuple.attributes; _} ->
Concepts.Value.to_string (BatMap.String.find "title" attributes) )
let reads_in_batches node =
let batches =
begin
let open Utilities.Result in
let* relation = run node "library" "books" ["title"; "author"] in
Protocols.Handle.releasing relation (fun () ->
let* heading = Protocols.Relation.heading relation in
check (list string) "the heading the term declares" ["author"; "title"]
(BatMap.String.bindings heading |> List.map fst);
Protocols.Enumerable.scan relation (fun scan ->
let rec pull read =
let* batch = Protocols.Cursor.fetch scan 4 in
let read = (titles batch, batch.exhausted) :: read in
if batch.exhausted then Ok (List.rev read) else pull read
in
pull [] ) )
end
|> Helpers.condition_as_failure
in
check
(list (pair (list string) bool))
"four, then the rest"
[ ( [ "Structure and Interpretation of Computer Programs";
"The Art of Computer Programming";
"An Introduction to Database Systems";
"Less Than Words Can Say" ],
false );
["The Graves of Academe"; "The Leaning Tower of Babel"; "The Gift of Fire"], true ]
batches
let reads_back_through_the_kernel ({root; image} as node) =
begin
let open Utilities.Result in
let* books =
Kernel.Program.load root ~evaluator:"karuta:beam"
~source:(term image "library" "books" ["title"; "author"])
in
let* bound =
Kernel.Path.update root Kernel.Path.("karuta" @/ "program" @/ this) "books" None (Some books)
in
check bool "the books are defined beside what the node defined" true bound;
let* relation = run node "shelf" "titles" ["title"] in
Protocols.Handle.releasing relation (fun () -> Helpers.titles relation)
end
|> Helpers.condition_as_failure
|> check (list Helpers.value) "the node read its FOL program over the books"
(List.map
(fun title -> Concepts.Value.String title)
[ "An Introduction to Database Systems";
"Less Than Words Can Say";
"Structure and Interpretation of Computer Programs";
"The Art of Computer Programming";
"The Gift of Fire";
"The Graves of Academe";
"The Leaning Tower of Babel" ] )
let reads_a_program_of_no_path ({root; image} as node) =
begin
let open Utilities.Result in
let* books =
Kernel.Program.load root ~evaluator:"karuta:beam"
~source:(term image "library" "books" ["title"; "author"])
in
let* _ =
Kernel.Path.update root Kernel.Path.("karuta" @/ "program" @/ this) "books" None (Some books)
in
let* relation = run node "shelf" "authors" ["author"] in
Protocols.Handle.releasing relation (fun () -> Protocols.Relation.read relation)
end
|> Helpers.condition_as_failure
|> snd
|> List.map (fun {Concepts.Tuple.attributes; _} -> BatMap.String.find "author" attributes)
|> List.sort compare
|> check (list Helpers.value) "each author once"
(List.map
(fun author -> Concepts.Value.String author)
["C. J. Date"; "Donald Knuth"; "Harold Abelson"; "Richard Mitchell"] )
let a_missing_function_fails node =
Helpers.refuses "a missing function fails the call" "beam-failed"
(Result.bind (run node "library" "nope" ["title"]) (fun relation ->
Protocols.Handle.releasing relation (fun () -> Protocols.Relation.read relation) ) )
let a_malformed_term_is_refused {root; _} =
Helpers.refuses "a term that is not a program is refused" "malformed-beam-program"
(Kernel.Program.load root ~evaluator:"karuta:beam" ~source:"not a term")
let suites () =
[ ( "integration/karuta",
[ test_case "reads-in-batches" `Quick (with_node reads_in_batches);
test_case "reads-back-through-the-kernel" `Quick (with_node reads_back_through_the_kernel);
test_case "reads-a-program-of-no-path" `Quick (with_node reads_a_program_of_no_path);
test_case "a-missing-function-fails" `Quick (with_node a_missing_function_fails);
test_case "a-malformed-term-is-refused" `Quick (with_node a_malformed_term_is_refused) ] )
]
|
