aboutsummaryrefslogtreecommitdiffstats
path: root/test/integration
diff options
context:
space:
mode:
Diffstat (limited to 'test/integration')
-rw-r--r--test/integration/Karuta.ml182
-rw-r--r--test/integration/beam/library.erl19
-rw-r--r--test/integration/beam/rnt.erl97
-rw-r--r--test/integration/beam/shelf.erl22
4 files changed, 320 insertions, 0 deletions
diff --git a/test/integration/Karuta.ml b/test/integration/Karuta.ml
new file mode 100644
index 0000000..2b02e69
--- /dev/null
+++ b/test/integration/Karuta.ml
@@ -0,0 +1,182 @@
+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 fails_with name = function
+ | Ok _ -> fail ("expected " ^ name)
+ | Error c ->
+ check bool name true (BatString.starts_with (Concepts.Condition.to_string_hum c) name)
+
+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 =
+ fails_with "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; _} =
+ fails_with "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) ] )
+ ]
diff --git a/test/integration/beam/library.erl b/test/integration/beam/library.erl
new file mode 100644
index 0000000..b9186ab
--- /dev/null
+++ b/test/integration/beam/library.erl
@@ -0,0 +1,19 @@
+-module(library).
+-export([books/0]).
+
+books() ->
+ from([book(<<"Structure and Interpretation of Computer Programs">>, <<"Harold Abelson">>),
+ book(<<"The Art of Computer Programming">>, <<"Donald Knuth">>),
+ book(<<"An Introduction to Database Systems">>, <<"C. J. Date">>),
+ book(<<"Less Than Words Can Say">>, <<"Richard Mitchell">>),
+ book(<<"The Graves of Academe">>, <<"Richard Mitchell">>),
+ book(<<"The Leaning Tower of Babel">>, <<"Richard Mitchell">>),
+ book(<<"The Gift of Fire">>, <<"Richard Mitchell">>)]).
+
+book(Title, Author) -> {<<"book">>, #{<<"title">> => Title, <<"author">> => Author}}.
+
+from(Books) ->
+ fun(Limit) ->
+ {Now, Later} = lists:split(min(Limit, length(Books)), Books),
+ {Now, case Later of [] -> done; _ -> from(Later) end}
+ end.
diff --git a/test/integration/beam/rnt.erl b/test/integration/beam/rnt.erl
new file mode 100644
index 0000000..702be2d
--- /dev/null
+++ b/test/integration/beam/rnt.erl
@@ -0,0 +1,97 @@
+-module(rnt).
+-export([start/0, define/3, invoke/1, evaluate/2]).
+
+start() ->
+ logger:remove_handler(default),
+ logger:add_handler(default, logger_std_h, #{config => #{type => standard_error}}),
+ put(port, open_port({fd, 0, 1}, [binary, {packet, 4}, eof])),
+ loop().
+
+loop() -> serve(frame()), loop().
+
+frame() ->
+ Port = get(port),
+ receive
+ {Port, {data, Frame}} -> Frame;
+ {Port, eof} -> halt()
+ end.
+
+send(Frame) -> port_command(get(port), Frame).
+
+answering(F) ->
+ try F()
+ catch Class:Reason -> [$e, io_lib:format("~p:~p", [Class, Reason])]
+ end.
+
+%% What RNT asks of the node.
+serve(<<$h>>) ->
+ send(answering(fun() ->
+ [M:rnt_init() || {M, _} <- code:all_loaded(),
+ erlang:function_exported(M, rnt_init, 0)],
+ <<$o>>
+ end));
+serve(<<$i, Id:64, M:16, Module:M/binary, F:16, Function:F/binary, B:32, Beam:B/binary>>) ->
+ put({poll, Id},
+ fun(Limit) ->
+ Name = load(binary_to_atom(Module), Beam),
+ (apply(Name, binary_to_existing_atom(Function), []))(Limit)
+ end);
+serve(<<$f, Id:64, Limit:32>>) ->
+ send(answering(fun() -> fetch(Id, Limit) end));
+serve(<<$c, Id:64>>) ->
+ erase({poll, Id}).
+
+load(Name, Beam) ->
+ {ok, {Name, Md5}} = beam_lib:md5(Beam),
+ case erlang:module_loaded(Name) andalso Name:module_info(md5) =:= Md5 of
+ true -> Name;
+ false ->
+ code:purge(Name),
+ {module, Name} = code:load_binary(Name, atom_to_list(Name) ++ ".beam", Beam),
+ Name
+ end.
+
+fetch(Id, Limit) ->
+ case get({poll, Id}) of
+ done -> batch([], true);
+ Relation ->
+ {Tuples, Rest} = Relation(Limit),
+ put({poll, Id}, Rest),
+ batch(Tuples, Rest =:= done)
+ end.
+
+batch(Tuples, Exhausted) ->
+ [$b, case Exhausted of true -> 1; false -> 0 end
+ | [[<<(byte_size(Term)):32>>, Term] || Tuple <- Tuples, Term <- [term_to_binary(Tuple)]]].
+
+%% What the node asks of RNT.
+define(Path, Evaluator, Source) ->
+ request([$D, path(Path), sized(Evaluator), Source]).
+
+invoke(Path) ->
+ relation(request([$X, path(Path)])).
+
+evaluate(Evaluator, Source) ->
+ relation(request([$E, sized(Evaluator), Source])).
+
+relation(Id) ->
+ fun(Limit) ->
+ {Tuples, Exhausted} = request(<<$N, Id:64, Limit:32>>),
+ {Tuples, case Exhausted of true -> done; false -> relation(Id) end}
+ end.
+
+request(Frame) -> send(Frame), reply().
+
+reply() ->
+ case frame() of
+ <<$o>> -> ok;
+ <<$r, Id:64>> -> Id;
+ <<$b, Exhausted, Tuples/binary>> ->
+ {[binary_to_term(T) || <<N:32, T:N/binary>> <= Tuples], Exhausted =:= 1};
+ <<$e, Message/binary>> -> error({rnt, Message});
+ Frame -> serve(Frame), reply()
+ end.
+
+path(Segments) -> [<<(length(Segments)):16>> | [sized(S) || S <- Segments]].
+
+sized(Bytes) -> <<(byte_size(Bytes)):16, Bytes/binary>>.
diff --git a/test/integration/beam/shelf.erl b/test/integration/beam/shelf.erl
new file mode 100644
index 0000000..a9b6823
--- /dev/null
+++ b/test/integration/beam/shelf.erl
@@ -0,0 +1,22 @@
+-module(shelf).
+-export([rnt_init/0, titles/0, authors/0]).
+
+-define(TITLES, [<<"karuta">>, <<"program">>, <<"titles">>]).
+-define(BOOKS, {$b, [<<"karuta">>, <<"program">>, <<"books">>]}).
+
+%% A FOL program over a beam program RNT holds, defined from the node.
+rnt_init() ->
+ rnt:define(?TITLES, <<"fol">>, project(?BOOKS, [<<"title">>])).
+
+titles() -> rnt:invoke(?TITLES).
+
+authors() -> rnt:evaluate(<<"fol">>, project(?BOOKS, [<<"author">>])).
+
+project(Term, Attributes) ->
+ bencode({$p, #{<<"term">> => Term, <<"attributes">> => Attributes}}).
+
+bencode(Bytes) when is_binary(Bytes) -> [integer_to_binary(byte_size(Bytes)), $:, Bytes];
+bencode(List) when is_list(List) -> [$l, [bencode(X) || X <- List], $e];
+bencode(Map) when is_map(Map) ->
+ [$d, [[bencode(K), bencode(V)] || {K, V} <- lists:sort(maps:to_list(Map))], $e];
+bencode({Tag, Value}) -> [$t, Tag, bencode(Value)].
generated by cgit v1.2.3 (git 2.25.1) at 2026-11-04 18:52:47 +0000