Verify polymorphic updates, name hygiene, and configuration combinations
This commit is contained in:
3 files changed
+71
No files matched your search
@@ -20,6 +20,8 @@ test: all
|
|||||||
./runtime.byte
|
./runtime.byte
|
||||||
$(OCAMLC) -ppx ./rewrite fieldglass.cma record.ml -o record.byte
|
$(OCAMLC) -ppx ./rewrite fieldglass.cma record.ml -o record.byte
|
||||||
./record.byte
|
./record.byte
|
||||||
|
$(OCAMLC) -ppx ./rewrite fieldglass.cma case.ml -o case.byte
|
||||||
|
./case.byte
|
||||||
OCAMLC=$(OCAMLC) sh error.sh
|
OCAMLC=$(OCAMLC) sh error.sh
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
|
|||||||
@@ -0,0 +1,62 @@
|
|||||||
|
module Parameter = struct
|
||||||
|
type 'a t = { value : 'a; label : string } [@@fieldglass generate]
|
||||||
|
end
|
||||||
|
|
||||||
|
module Private = struct
|
||||||
|
type t = private { value : int }
|
||||||
|
[@@fieldglass generate ~no_set ~no_update ~no_lens]
|
||||||
|
let read : t -> int = value
|
||||||
|
end
|
||||||
|
|
||||||
|
module Universal = struct
|
||||||
|
type t = { apply : 'a. 'a -> 'a }
|
||||||
|
[@@fieldglass generate ~no_set ~no_update ~no_lens]
|
||||||
|
end
|
||||||
|
|
||||||
|
module Flags = struct
|
||||||
|
type t = { count : int }
|
||||||
|
[@@fieldglass generate ~no_get:false ~no_set:false ~no_update:false
|
||||||
|
~no_lens:false ~just_lens:false ~self_arg_first:false
|
||||||
|
~field_prefix_from_type:false ~func_no_named_arg:false]
|
||||||
|
end
|
||||||
|
|
||||||
|
module Group = struct
|
||||||
|
type left = { count : int } [@@fieldglass generate ~get_prefix:read]
|
||||||
|
and right = { size : int } [@@fieldglass generate ~field_prefix_from_type]
|
||||||
|
end
|
||||||
|
|
||||||
|
module Names = struct
|
||||||
|
type t = { __fg_source : int; __fg_value : string; __fg_function : bool }
|
||||||
|
[@@fieldglass generate ~field_prefix:local]
|
||||||
|
end
|
||||||
|
|
||||||
|
module Alias = struct
|
||||||
|
type original = { number : int; label : string }
|
||||||
|
type t = original = { number : int; label : string } [@@fieldglass generate]
|
||||||
|
end
|
||||||
|
|
||||||
|
module Unmarked = struct
|
||||||
|
type t = { number : int }
|
||||||
|
let number _ = 99
|
||||||
|
end
|
||||||
|
|
||||||
|
let () =
|
||||||
|
let original = Parameter.{ value = 3; label = "grey" } in
|
||||||
|
let changed = Parameter.set_value "three" original in
|
||||||
|
assert (changed = Parameter.{ value = "three"; label = "grey" });
|
||||||
|
assert (Parameter.update_value ~f:string_of_int original = Parameter.{ value = "3"; label = "grey" });
|
||||||
|
assert (Fieldglass.set Parameter._value "three" original = changed);
|
||||||
|
let identity = Universal.{ apply = fun value -> value } in
|
||||||
|
assert (Universal.apply identity 3 = 3);
|
||||||
|
assert (Universal.apply identity "grey" = "grey");
|
||||||
|
let count = Flags.{ count = 3 } in
|
||||||
|
assert (Flags.count (Flags.set_count 4 count) = 4);
|
||||||
|
assert (Flags.count (Flags.update_count ~f:succ count) = 4);
|
||||||
|
assert (Fieldglass.view Flags._count count = 3);
|
||||||
|
assert (Group.read_left_count Group.{ count = 3 } = 3);
|
||||||
|
assert (Group.read_right_size Group.{ size = 4 } = 4);
|
||||||
|
let names = Names.{ __fg_source = 3; __fg_value = "grey"; __fg_function = true } in
|
||||||
|
assert (Names.local_source names = 3);
|
||||||
|
assert (Names.local_value (Names.set_local_value "blue" names) = "blue");
|
||||||
|
assert (Alias.number (Alias.set_number 4 Alias.{ number = 3; label = "grey" }) = 4);
|
||||||
|
assert (Unmarked.number Unmarked.{ number = 3 } = 99)
|
||||||
@@ -32,6 +32,13 @@ reject 'type a = { value : int } and b = { value : string } [@@fieldglass genera
|
|||||||
reject 'type t = private { colour : string } [@@fieldglass generate]' 'fieldglass: private records'
|
reject 'type t = private { colour : string } [@@fieldglass generate]' 'fieldglass: private records'
|
||||||
reject "type t = { apply : 'a. 'a -> 'a } [@@fieldglass generate]" 'fieldglass: polymorphic fields'
|
reject "type t = { apply : 'a. 'a -> 'a } [@@fieldglass generate]" 'fieldglass: polymorphic fields'
|
||||||
reject 'module type S = sig type t = { colour : string } [@@fieldglass generate] end' 'fieldglass: generate accessors in an implementation'
|
reject 'module type S = sig type t = { colour : string } [@@fieldglass generate] end' 'fieldglass: generate accessors in an implementation'
|
||||||
|
reject 'type t = { item_type : int; item_value : int } [@@fieldglass generate]' 'fieldglass: invalid generated identifier'
|
||||||
|
reject 'type t = { item_ : int; item_value : int } [@@fieldglass generate]' 'fieldglass: invalid generated identifier'
|
||||||
|
reject 'type t = { value : int } [@@fieldglass generate ?no_get:None]' 'fieldglass: expected a labelled option'
|
||||||
|
reject 'type t = { value : int } [@@fieldglass generate ~just_lens]
|
||||||
|
let _ = set_value' 'Unbound value set_value'
|
||||||
|
reject 'type t = { value : int } [@@fieldglass generate ~just_lens]
|
||||||
|
let _ = update_value' 'Unbound value update_value'
|
||||||
reject 'type t = { colour : string } [@@fieldglass generate ~no_set]
|
reject 'type t = { colour : string } [@@fieldglass generate ~no_set]
|
||||||
let _ = set_colour' 'Unbound value set_colour'
|
let _ = set_colour' 'Unbound value set_colour'
|
||||||
reject 'type t = { colour : string } [@@fieldglass generate ~no_update]
|
reject 'type t = { colour : string } [@@fieldglass generate ~no_update]
|
||||||
|
|||||||
Reference in new issue
Block a user