summaryrefslogtreecommitdiff
path: root/sid_test.ml
diff options
context:
space:
mode:
authorPhilipp Gesang <phg@phi-gamma.net>2018-11-14 00:15:33 +0100
committerPhilipp Gesang <phg@phi-gamma.net>2018-11-29 00:06:53 +0100
commit039f4068c0e991b79769426486147d7851d5d6fd (patch)
treeacafb4b294817e3c71050ceec6a525d0df2555aa /sid_test.ml
parent7b3d8e1d13bab22c82b38012cfcb8cbfe67ed7e5 (diff)
downloadocaml-sid-039f4068c0e991b79769426486147d7851d5d6fd.tar.gz
sid: sid_test: add conformance mode imitating MS API
Add a conformance handler “Con_MS” to achieve a behavior that mimicks that of MS’s implementation bug-for-bug. Aspects of reading and formatting governd by the conformance: - Validation of ident auths, - validation of subauths, - validation of leading zeros in decimal numbers, - zero-padding of hex numbers.
Diffstat (limited to 'sid_test.ml')
-rw-r--r--sid_test.ml95
1 files changed, 93 insertions, 2 deletions
diff --git a/sid_test.ml b/sid_test.ml
index 26a125b..b339190 100644
--- a/sid_test.ml
+++ b/sid_test.ml
@@ -255,6 +255,91 @@ let sf_print_iaxx_ok () =
~msg:(Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string sid) str)
(Sid.to_string sid) str
+let ms_unwrap_of_string s =
+ match Sid.MSStringFmt.decode s with
+ | Error e ->
+ assert_failure
+ (Printf.sprintf "error parsing assumed well-formed sid [%s]: %s" s e)
+ | Ok r -> r
+
+let mssf_parse_ok () =
+ (* accept well-formed input *)
+ let s = ms_unwrap_of_string "S-1-1-0"
+ and z = Sid.create_unsafe U64.one [| U32.zero |] in
+ assert_bool
+ (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s) (Sid.to_string z))
+ (Sid.equal s z);
+ let w = Sid.WellKnown.world in
+ assert_bool
+ (Printf.sprintf "[%s] ≠ [well known: %s]"
+ (Sid.to_string s) (Sid.to_string w))
+ (Sid.equal s w)
+
+let mssf_parse_hex_junk_ok () =
+ (* accept certain kinds of malformed input; note: we expect hex digit
+ to be lowercase *)
+ let samples =
+ [ "S-1-0x000000000000-1" , false, Some ("S-1-0-1" , true )
+ ; "S-1-0x0000000000ff-1" , false, Some ("S-1-255-1" , true )
+ ; "S-1-0x0001000000ff-1" , true , Some ("S-1-0x1000000ff-1" , false)
+ ; "S-1-0xffffffffffff-1" , true , Some ("S-1-0xffffffffffff-1", true )
+ ; "S-1-0xff00ff00ff-1" , false, Some ("S-1-0xff00ff00ff-1" , false)
+ ; "S-1-0xff00ff00ff00ff-1", false, None
+ ; "S-1-4294967296-1" , false, Some ("S-1-0x100000000-1" , false)
+ ; "S-1-01-1" , false, Some ("S-1-1-1" , true )
+ ; "S-1-08-1" , false, Some ("S-1-8-1" , true )
+ ; "S-1-001-1" , false, Some ("S-1-1-1" , true )
+ ; "S-1-1" , false, None
+ ; "S-1-5" , false, None
+ ]
+ in
+ let is_wellformed s =
+ match Sid.StringFmt.decode s with Ok _ -> true | Error _ -> false in
+ let check (input, inwell, output) =
+ let () =
+ if is_wellformed input then
+ assert_bool
+ (Printf.sprintf "Sid [%s] parsed a-ok despite strict mode" input)
+ inwell
+ else
+ assert_bool
+ (Printf.sprintf "Sid [%s] failed to parse with strict mode" input)
+ (not inwell)
+ in
+ let () =
+ match Sid.MSStringFmt.decode input, output with
+ | Ok s, None ->
+ assert_bool
+ (Printf.sprintf "Sid [%s] unexpectedly parsed a-ok with MS mode"
+ input)
+ false
+ | Ok s, Some (output, outwell) -> (* test round-trip results *)
+ let reenc = Sid.MSStringFmt.encode s in
+ let () =
+ assert_bool
+ (Printf.sprintf "Sid [%s] re-encoded as [%s] failed to match \
+ expected value of [%s]"
+ input reenc output)
+ (output = reenc)
+ in (* finally: validate behavior of strict parse against output *)
+ assert_bool
+ (Printf.sprintf "Sid [%s] re-encoded as [%s] unexpectedly \
+ %s in strict mode"
+ input reenc
+ (if outwell then "failed to parse" else "parsed ok"))
+ (is_wellformed reenc = outwell)
+ | Error _, None -> () (* bad even by MS standards *)
+ | Error e, Some (output, _) ->
+ assert_bool
+ (Printf.sprintf "Sid [%s] failed to parse in MS mode (%s), \
+ expected [%s] after reconversion"
+ input e output)
+ false
+ in ()
+ in
+ List.iter check samples
+
+
let pr_encode_null_ok () =
let x =
Sid.WellKnown.null
@@ -455,6 +540,11 @@ let string_format_test = "string-format-syntax" >:::
; "print-iaxx-ok" >:: sf_print_iaxx_ok
]
+let ms_string_format_test = "ms-string-format-syntax" >:::
+ [ "parse-ok" >:: mssf_parse_ok
+ ; "parse-hex-junk-ok" >:: mssf_parse_hex_junk_ok
+ ]
+
let packet_rep_test = "packet-rep" >:::
[ "encode-null-ok" >:: pr_encode_null_ok
; "encode-all-ok" >:: pr_encode_all_ok
@@ -476,6 +566,7 @@ let toplevel_test = "toplevel" >:::
let () =
ignore (run_test_tt_main string_format_test);
- ignore (run_test_tt_main packet_rep_test );
- ignore (run_test_tt_main toplevel_test )
+ ignore (run_test_tt_main ms_string_format_test);
+ ignore (run_test_tt_main packet_rep_test);
+ ignore (run_test_tt_main toplevel_test)