A table for the importer, against a header that does not move
Nothing in dune test exercised cimport.ml or cjson.ml. The raylib case is the
better evidence and the worse coverage: it needs raylib installed, at the
version whose .so is linked, with FLAN_RAYLIB_H set, so as the only test of
this it would skip everywhere and cover nothing.
test/headers/sample.h is one function per decision the importer makes, and the
table asserts on the reasons rather than the counts — a refusal that fires for
the wrong cause still refuses, and a count still matches. Accepted: an
aggregate in and out, const char * as a string, a pointer parameter, a second
typedef name for a record described once, a C enum against a defenum. Refused,
each by reason: a returned char *, a non-const char * C may write through, a
variadic, a callback, a long, a struct with no defstruct, and a kebab
collision. Plus that nothing is in both lists, which is the bug the collision
case found.
check_structs and diff_bound get a row each for agreeing, for a permuted field
order, for a widened field, and for a symbol the header does not have — the
last being how a package pinned to the wrong release announces itself. The
name rule and the JSON reader get their own rows.
Checked by breaking two of them on purpose and watching both fail.
test/programs/raylib-imported.flan is the end-to-end evidence, back and in the
new struct-literal spelling: four bindings the package does not bind by hand.
ColorToInt of {17,34,51,68} is 0x11223344 and ColorTint by white hands the four
bytes back separately, so field order is pinned by arithmetic and not by a
round trip, which is the trap BUILT.md records.
This commit is contained in:
parent
ef7650ec99
commit
e12e3e11c5
@ -31,6 +31,11 @@
|
||||
; examples/digits.flan, so the directory has to be here whole.
|
||||
(glob_files %{workspace_root}/examples/*)
|
||||
(glob_files programs/*.flan)
|
||||
; The synthetic C header the importer's table reads. Committed rather than
|
||||
; reached for on the machine: the raylib case needs raylib installed, at the
|
||||
; right version, with a variable set, so it skips everywhere and covers
|
||||
; nothing. This one does not move.
|
||||
(glob_files headers/*.h)
|
||||
; The files programs/embed.flan bakes in. An embed reads them at *compile*
|
||||
; time, so they are a dependency of the checker run and not of the program.
|
||||
(glob_files programs/assets/*)
|
||||
|
||||
36
test/programs/raylib-imported.flan
Normal file
36
test/programs/raylib-imported.flan
Normal file
@ -0,0 +1,36 @@
|
||||
;;;; Every binding called here came out of raylib's header, not out of
|
||||
;;;; raylib.flan. The package binds none of these four by hand, so if this
|
||||
;;;; program runs at all the importer produced working declarations — and
|
||||
;;;; what it prints pins rather more than that.
|
||||
;;;;
|
||||
;;;; Needs FLAN_RAYLIB_H pointing at a raylib 5.5 header; the acceptance case
|
||||
;;;; skips without it.
|
||||
|
||||
(import rl "vendor:raylib")
|
||||
|
||||
(defn main [] i32
|
||||
;; A scalar in, a scalar out. Seeded, and a range of one, so the answer is
|
||||
;; the bound rather than anything random.
|
||||
(rl/set-random-seed 12345)
|
||||
(println (rl/get-random-value 10 10))
|
||||
|
||||
;; A string parameter. A Flan string is ptr+len and never NUL-terminated, so
|
||||
;; this only answers 5 if the generated wrapper made the terminated copy.
|
||||
(println (rl/text-length "hello"))
|
||||
|
||||
;; A struct by value in, a scalar out. 0x11223344 is 287454020, and it is
|
||||
;; the four fields read in r,g,b,a order — swap any two and the number
|
||||
;; changes, which a round trip could not have told us.
|
||||
(println (rl/color-to-int (rl/Color {.r 17 .g 34 .b 51 .a 68})))
|
||||
|
||||
;; A struct in and a struct out, which is the whole flattening path: the
|
||||
;; argument goes by pointer and the result comes back through an
|
||||
;; out-parameter. Tinting by white is the identity, so the four bytes come
|
||||
;; back separately and in order.
|
||||
(let [t (rl/color-tint (rl/Color {.r 255 .g 255 .b 255 .a 255})
|
||||
(rl/Color {.r 17 .g 34 .b 51 .a 68}))]
|
||||
(println (.r t))
|
||||
(println (.g t))
|
||||
(println (.b t))
|
||||
(println (.a t)))
|
||||
0)
|
||||
@ -1091,6 +1091,231 @@ let () =
|
||||
"(defn f [] i32 (let [xs [1 2]] (destructure~nth xs 0 2 1)))"
|
||||
~needle:"means nothing outside a quasiquote";
|
||||
|
||||
(* ── Reading a C header (cimport.ml, cjson.ml) ─────────────────── *)
|
||||
|
||||
(* Against test/headers/sample.h, which is one function per decision the
|
||||
importer makes and is committed so that it cannot move. The raylib case
|
||||
is better evidence and worse coverage: it needs raylib installed, at the
|
||||
version whose .so is linked, with FLAN_RAYLIB_H set, so as the only test
|
||||
of this it would skip everywhere.
|
||||
|
||||
The assertions are on the *reasons*, not on the counts, for the reason the
|
||||
acceptance table gives: a refusal that fires for the wrong cause still
|
||||
refuses, and a count still matches. *)
|
||||
let imported, dump, env, fixture_ds =
|
||||
let fixture =
|
||||
"(defstruct Pair [x f32 y f32])\n\
|
||||
(defstruct Shade [r u8 g u8 b u8 a u8])\n\
|
||||
(defenum Mood [calm 0 cross 1])\n"
|
||||
in
|
||||
let ds = program fixture in
|
||||
let taken = Hashtbl.create 16 in
|
||||
List.iter
|
||||
(fun d ->
|
||||
match Ast.declared_name d with
|
||||
| Some n -> Hashtbl.replace taken n ()
|
||||
| None -> ())
|
||||
ds;
|
||||
let known_structs =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with Ast.Defstruct (n, _) -> Some n | _ -> None)
|
||||
ds
|
||||
and known_enums =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with Ast.Defenum (n, _) -> Some n | _ -> None)
|
||||
ds
|
||||
in
|
||||
let i, d, e =
|
||||
Cimport.header ~loc:Loc.unknown ~header:"headers/sample.h" ~flags:[]
|
||||
~known_structs ~known_enums ~taken ~bound_syms:[]
|
||||
in
|
||||
(i, d, e, ds)
|
||||
in
|
||||
|
||||
(* What came out, as source, so a wrong type is visible as the line somebody
|
||||
would otherwise have had to write by hand. *)
|
||||
let produced = List.map Cimport.decl_source imported.Cimport.decls in
|
||||
let emits name line =
|
||||
check ("import-c emits " ^ name) (List.mem line produced)
|
||||
in
|
||||
emits "a scalar signature" "(declare-c set-seed [seed u32] \"set_seed\")";
|
||||
emits "two scalars and a return"
|
||||
"(declare-c add-ints [a i32 b i32] i32 \"add_ints\")";
|
||||
(* An aggregate return is the flattening path: Shim turns it into an
|
||||
out-pointer, and the declaration it starts from has to say the struct. *)
|
||||
emits "an aggregate return"
|
||||
"(declare-c make-pair [x f32 y f32] Pair \"make_pair\")";
|
||||
emits "an aggregate parameter" "(declare-c pair-len [p Pair] f32 \"pair_len\")";
|
||||
(* const char * is a string going in — the one C spelling that means
|
||||
something different in a parameter than it does anywhere else. *)
|
||||
emits "const char * as a string parameter"
|
||||
"(declare-c name-length [text string] i32 \"name_length\")";
|
||||
emits "a pointer parameter"
|
||||
"(declare-c count-at [values (Ptr i32) n i32] i32 \"count_at\")";
|
||||
(* struct Pair is both Pair and Point in the header and the package
|
||||
describes it once, so both names have to land on the one defstruct —
|
||||
raylib does exactly this with Texture2D and TextureCubemap. *)
|
||||
emits "a second typedef name for a described record"
|
||||
"(declare-c point-of [p Pair] Pair \"point_of\")";
|
||||
(* A C enum is an int, and so is a Flan defenum at the boundary; matching by
|
||||
name is what keeps the nicer face. *)
|
||||
emits "a C enum against a defenum of the same name"
|
||||
"(declare-c mood-value [m Mood] i32 \"mood_value\")";
|
||||
emits "a function of no arguments" "(declare-c take-nothing [] \"take_nothing\")";
|
||||
|
||||
(* And the refusals, each by its reason rather than by a count. *)
|
||||
let refused name needle =
|
||||
check
|
||||
("import-c refuses " ^ name ^ ": " ^ needle)
|
||||
(List.exists
|
||||
(fun (n, why) -> n = name && contains why needle)
|
||||
imported.Cimport.hidden)
|
||||
in
|
||||
refused "name-of" "returns char *";
|
||||
refused "fill-buffer" "C may write through";
|
||||
refused "printf-like" "is variadic";
|
||||
refused "on-event" "is a function pointer";
|
||||
refused "file-time" "width that differs";
|
||||
refused "make-undescribed" "the package does not describe";
|
||||
(* The order-dependent one. Spin2D and spin2d both kebab to spin-2d, so
|
||||
neither may have it: whichever won would depend on the order the header
|
||||
declares them in, and moving two lines in somebody else's header would
|
||||
rebind a name a program is already calling. *)
|
||||
refused "spin-2d" "would depend on the order";
|
||||
check "a colliding name is not imported after all"
|
||||
(not (List.exists (fun l -> contains l "\"Spin2D\"") produced));
|
||||
check "nor is the other half of the collision"
|
||||
(not (List.exists (fun l -> contains l "\"spin2d\"") produced));
|
||||
|
||||
(* A refused name is a name that exists and cannot be had — Zig's failDecl,
|
||||
which Load.refuse_hidden already implements for main. Nothing may be in
|
||||
both lists, or asking for a name that works would report that it does
|
||||
not. *)
|
||||
check "nothing is both imported and refused"
|
||||
(not
|
||||
(List.exists
|
||||
(fun (d : Ast.decl) ->
|
||||
match Ast.declared_name d with
|
||||
| Some n -> List.mem_assoc n imported.Cimport.hidden
|
||||
| None -> false)
|
||||
imported.Cimport.decls));
|
||||
|
||||
(* The struct check, which is the point of reading a header the generator
|
||||
does not otherwise need: the defstruct and the header's record have
|
||||
different authors, so a disagreement is real information. A
|
||||
_Static_assert was rejected in BUILT.md as circular for want of exactly
|
||||
that. *)
|
||||
let structs_of ds =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with Ast.Defstruct (n, fs) -> Some (n, fs) | _ -> None)
|
||||
ds
|
||||
in
|
||||
check "a defstruct that matches the header is not reported"
|
||||
(Cimport.check_structs ~env ~structs:(structs_of fixture_ds) dump = []);
|
||||
(* Permuted: the failure BUILT.md says only a test can catch, because every
|
||||
field still reads as a plausible number. *)
|
||||
check "a permuted defstruct is reported"
|
||||
(match
|
||||
Cimport.check_structs ~env
|
||||
~structs:(structs_of (program "(defstruct Pair [y f32 x f32])\n")) dump
|
||||
with
|
||||
| [ ("Pair", why) ] -> contains why "field order"
|
||||
| _ -> false);
|
||||
(* Widened: the other half of the same hazard and the one BUILT.md names —
|
||||
f64 where the library says float lays out eight bytes where there are
|
||||
four, and every field after it moves. *)
|
||||
check "a widened field is reported"
|
||||
(match
|
||||
Cimport.check_structs ~env
|
||||
~structs:(structs_of (program "(defstruct Pair [x f32 y f64])\n")) dump
|
||||
with
|
||||
| [ ("Pair", why) ] -> contains why "f64" && contains why "f32"
|
||||
| _ -> false);
|
||||
(* A struct the header says nothing about is not a disagreement: a package
|
||||
may describe something the library does not name. *)
|
||||
check "a struct the header does not describe is left alone"
|
||||
(Cimport.check_structs ~env
|
||||
~structs:(structs_of (program "(defstruct Nowhere [q i32])\n")) dump
|
||||
= []);
|
||||
|
||||
(* diff_bound: a hand-written declare-c against the header's own signature.
|
||||
This is the check with no other source — a wrong declare-c is wrong in the
|
||||
generated prototype too, so the two halves agree with each other and only
|
||||
the library knows better. *)
|
||||
let bound_of src =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with Ast.DeclareC (fn, sym) -> Some (fn, sym) | _ -> None)
|
||||
(program src)
|
||||
in
|
||||
let differs name src needle =
|
||||
check ("declare-c against the header: " ^ name)
|
||||
(match Cimport.diff_bound ~env ~bound:(bound_of src) dump with
|
||||
| [ d ] -> contains d.Cimport.dwhy needle
|
||||
| _ -> false)
|
||||
in
|
||||
check "a declare-c that matches the header is not reported"
|
||||
(Cimport.diff_bound ~env
|
||||
~bound:(bound_of "(declare-c add [a i32 b i32] i32 \"add_ints\")") dump
|
||||
= []);
|
||||
differs "a wrong parameter width"
|
||||
"(declare-c add [a f64 b i32] i32 \"add_ints\")" "parameter a is f64";
|
||||
differs "a wrong arity" "(declare-c add [a i32] i32 \"add_ints\")"
|
||||
"the header says 2";
|
||||
differs "a wrong return type"
|
||||
"(declare-c add [a i32 b i32] f32 \"add_ints\")" "returns f32";
|
||||
(* A symbol the header does not have at all is the version-drift case, and
|
||||
it is how a package pinned to the wrong release announces itself. *)
|
||||
differs "a symbol the header does not declare"
|
||||
"(declare-c gone [] \"no_such_function\")" "does not declare";
|
||||
(* An enum face against a plain int is the expected difference and not a
|
||||
finding: that is what a defenum is at the boundary. *)
|
||||
check "an enum face against the header's int is not a difference"
|
||||
(Cimport.diff_bound ~env
|
||||
~bound:(bound_of "(declare-c mv [m Mood] i32 \"mood_value\")") dump
|
||||
= []);
|
||||
|
||||
(* The name rule. Reversibility is by storage — the C symbol is kept verbatim
|
||||
in the declaration — so what the rule has to be is injective over one
|
||||
header, which the collision case above asserts. These pin its shape. *)
|
||||
List.iter
|
||||
(fun (c, flan) ->
|
||||
check
|
||||
(Printf.sprintf "kebab %s -> %s" c flan)
|
||||
(String.equal (Cimport.kebab c) flan))
|
||||
[ ("InitWindow", "init-window");
|
||||
(* An acronym stays one word rather than becoming separate letters. *)
|
||||
("SetTargetFPS", "set-target-fps");
|
||||
("ColorToHSV", "color-to-hsv");
|
||||
("UnloadUTF8", "unload-utf8");
|
||||
(* A digit run takes the uppercase after it, so 2D is one word. *)
|
||||
("BeginMode2D", "begin-mode-2d");
|
||||
("GetScreenToWorld2D", "get-screen-to-world-2d");
|
||||
("snake_case_already", "snake-case-already") ];
|
||||
|
||||
(* cjson.ml, on the shapes clang's dump actually contains. *)
|
||||
check "json: an escaped string"
|
||||
(match Cjson.parse "{\"a\":\"x\\ny\"}" with
|
||||
| Cjson.Obj [ ("a", Cjson.Str "x\ny") ] -> true
|
||||
| _ -> false);
|
||||
check "json: nesting, numbers, booleans and null"
|
||||
(match Cjson.parse "{\"i\":[1,-2,3.5e2],\"b\":true,\"n\":null}" with
|
||||
| Cjson.Obj
|
||||
[ ("i", Cjson.Arr [ _; _; _ ]); ("b", Cjson.Bool true);
|
||||
("n", Cjson.Null) ] -> true
|
||||
| _ -> false);
|
||||
check "json: empty containers"
|
||||
(match Cjson.parse "{\"a\":{},\"b\":[]}" with
|
||||
| Cjson.Obj [ ("a", Cjson.Obj []); ("b", Cjson.Arr []) ] -> true
|
||||
| _ -> false);
|
||||
check "json: trailing bytes are refused"
|
||||
(match Cjson.parse "{} x" with
|
||||
| _ -> false
|
||||
| exception Cjson.Bad _ -> true);
|
||||
|
||||
(* ── The acceptance program checks end to end ──────────────────── *)
|
||||
accepts "calc-me.flan type checks"
|
||||
(In_channel.with_open_bin "../calc-me.flan" In_channel.input_all);
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user