# HG changeset patch
# User Malcolm Matalka <malcolm.matalka@acsl.se>
# Date 1595668086 -7200
#      Sat Jul 25 11:08:06 2020 +0200
# Node ID e7a3831e9da8c9d288ef81ff1fea20fa3df9412f
# Parent  3045e4de2691a006007dc23c9db5cf507d86b898
ADD uritmpl RFC 6570

diff --git a/src/uritmpl/uritmpl.ml b/src/uritmpl/uritmpl.ml
new file mode 100644
--- /dev/null
+++ b/src/uritmpl/uritmpl.ml
@@ -0,0 +1,242 @@
+module Var = struct
+  type v =
+    | S of string
+    | A of string list
+    | M of (string * string) list
+
+  type t = string * v
+end
+
+module Expandspec = struct
+  type t = {
+    kv : bool;
+    sep : string;
+    lead_char : char option;
+    encode : string -> string;
+  }
+end
+
+type varspec = {
+  name : string;
+  prefix : int option;
+  explode : bool;
+}
+
+type expr =
+  | Literal of string
+  | Expr    of {
+      op : char option;
+      vars : varspec list;
+    }
+
+type t = expr list
+
+type parse_err = [ `Error ]
+
+let rec exprs_of_tokens =
+  let module T = Uritmpl_lexer.Token in
+  function
+  | []                -> []
+  | T.Literal s :: ts -> Literal s :: exprs_of_tokens ts
+  | T.Open_expr :: ts -> expr_of_tokens ts
+  | _                 -> assert false
+
+and expr_of_tokens =
+  let module T = Uritmpl_lexer.Token in
+  function
+  | T.Op op :: ts ->
+      let (vars, ts) = vars_of_tokens [] ts in
+      Expr { op = Some op; vars } :: exprs_of_tokens ts
+  | ts            ->
+      let (vars, ts) = vars_of_tokens [] ts in
+      Expr { op = None; vars } :: exprs_of_tokens ts
+
+and vars_of_tokens acc =
+  let module T = Uritmpl_lexer.Token in
+  function
+  | T.Close_expr :: ts -> (List.rev acc, ts)
+  | T.Var_sep :: ts -> vars_of_tokens acc ts
+  | T.Var name :: T.Prefix prefix :: T.Explode :: ts ->
+      vars_of_tokens ({ name; prefix = Some prefix; explode = true } :: acc) ts
+  | T.Var name :: T.Prefix prefix :: ts ->
+      vars_of_tokens ({ name; prefix = Some prefix; explode = false } :: acc) ts
+  | T.Var name :: T.Explode :: ts ->
+      vars_of_tokens ({ name; prefix = None; explode = true } :: acc) ts
+  | T.Var name :: ts -> vars_of_tokens ({ name; prefix = None; explode = false } :: acc) ts
+  | _ -> assert false
+
+let of_string s =
+  match Uritmpl_lexer.tokenize s with
+    | Ok tokens -> Ok (exprs_of_tokens tokens)
+    | Error err -> Error `Error
+
+let varspec_to_string buf vars =
+  let strs =
+    List.map
+      (function
+        | { name; prefix = Some n; explode = true } -> Printf.sprintf "%s:%d*" name n
+        | { name; prefix = Some n; _ } -> Printf.sprintf "%s:%d" name n
+        | { name; prefix = None; explode = true } -> name ^ "*"
+        | { name; _ } -> name)
+      vars
+  in
+  Buffer.add_string buf (String.concat "," strs)
+
+let to_string t =
+  let buf = Buffer.create 20 in
+  List.iter
+    (function
+      | Literal s                   -> Buffer.add_string buf s
+      | Expr { op = Some op; vars } ->
+          Buffer.add_char buf '{';
+          Buffer.add_char buf op;
+          varspec_to_string buf vars;
+          Buffer.add_char buf '}'
+      | Expr { vars; _ }            ->
+          Buffer.add_char buf '{';
+          varspec_to_string buf vars;
+          Buffer.add_char buf '}')
+    t;
+  Buffer.contents buf
+
+let expand_value spec v value =
+  let open Expandspec in
+  match value with
+    | Var.S s -> (
+        match (spec, v) with
+          | ({ kv = true; encode; _ }, { name; prefix = Some prefix; _ }) ->
+              Printf.sprintf "%s=%s" name (encode (String.sub s 0 (min prefix (String.length s))))
+          | ({ kv = false; encode; _ }, { name; prefix = Some prefix; _ }) ->
+              encode (String.sub s 0 (min prefix (String.length s)))
+          | ({ kv = true; encode; lead_char; _ }, { name; _ }) -> (
+              match lead_char with
+                | Some ';' when s = "" -> name
+                | _ -> Printf.sprintf "%s=%s" name (encode s) )
+          | ({ kv = false; encode; _ }, _) -> encode s )
+    | Var.A l -> (
+        match (spec, v) with
+          | ({ kv = true; encode; _ }, { name; explode = false; _ }) ->
+              Printf.sprintf "%s=%s" name (String.concat "," (List.map encode l))
+          | ({ kv = true; encode; sep; lead_char; _ }, { name; explode = true; _ }) ->
+              String.concat sep (List.map (fun v -> Printf.sprintf "%s=%s" name (encode v)) l)
+          | ({ kv = false; encode; _ }, { name; explode = false; _ }) ->
+              String.concat "," (List.map encode l)
+          | ({ kv = false; encode; sep; _ }, { name; explode = true; _ }) ->
+              String.concat sep (List.map encode l) )
+    | Var.M m -> (
+        match (spec, v) with
+          | ({ kv = true; encode; _ }, { name; explode = false; _ }) ->
+              Printf.sprintf
+                "%s=%s"
+                name
+                (String.concat "," (List.map (fun (k, v) -> encode k ^ "," ^ encode v) m))
+          | ({ kv = true; encode; sep; _ }, { name; explode = true; _ }) ->
+              String.concat sep (List.map (fun (k, v) -> encode k ^ "=" ^ encode v) m)
+          | ({ kv = false; encode; _ }, { name; explode = false; _ }) ->
+              String.concat "," (List.map (fun (k, v) -> encode k ^ "," ^ encode v) m)
+          | ({ kv = false; encode; sep; _ }, { name; explode = true; _ }) ->
+              String.concat sep (List.map (fun (k, v) -> encode k ^ "=" ^ encode v) m) )
+
+let expand_var spec vars v =
+  match List.assoc_opt v.name vars with
+    | Some (Var.M []) -> None
+    | Some value      -> Some (expand_value spec v value)
+    | None            -> None
+
+let expand t vars =
+  let buf = Buffer.create 20 in
+  List.iter
+    (function
+      | Literal s              -> Buffer.add_string buf s
+      | Expr { op; vars = vs } -> (
+          let expand_spec =
+            match op with
+              | None     ->
+                  Expandspec.
+                    {
+                      kv = false;
+                      sep = ",";
+                      lead_char = None;
+                      encode = (fun s -> Uri.pct_encode ~component:`Authority s);
+                    }
+              | Some '+' ->
+                  Expandspec.
+                    {
+                      kv = false;
+                      sep = ",";
+                      lead_char = None;
+                      encode =
+                        (fun s ->
+                          Uri.pct_encode ~component:(`Custom (`Path, ":/?#[]@!$&'()*+,;=", "")) s);
+                    }
+              | Some '#' ->
+                  Expandspec.
+                    {
+                      kv = false;
+                      sep = ",";
+                      lead_char = Some '#';
+                      encode = (fun s -> Uri.pct_encode s);
+                    }
+              | Some '.' ->
+                  Expandspec.
+                    {
+                      kv = false;
+                      sep = ".";
+                      lead_char = Some '.';
+                      encode = (fun s -> Uri.pct_encode ~component:`Authority s);
+                    }
+              | Some '/' ->
+                  Expandspec.
+                    {
+                      kv = false;
+                      sep = "/";
+                      lead_char = Some '/';
+                      encode = (fun s -> Uri.pct_encode ~component:`Authority s);
+                    }
+              | Some ';' ->
+                  Expandspec.
+                    {
+                      kv = true;
+                      sep = ";";
+                      lead_char = Some ';';
+                      encode = (fun s -> Uri.pct_encode ~component:`Authority s);
+                    }
+              | Some '?' ->
+                  Expandspec.
+                    {
+                      kv = true;
+                      sep = "&";
+                      lead_char = Some '?';
+                      encode = (fun s -> Uri.pct_encode ~component:`Query_value s);
+                    }
+              | Some '&' ->
+                  Expandspec.
+                    {
+                      kv = true;
+                      sep = "&";
+                      lead_char = Some '&';
+                      encode = (fun s -> Uri.pct_encode ~component:`Query_value s);
+                    }
+              | _        -> assert false
+          in
+          let res =
+            vs
+            |> List.map (fun v ->
+                   match expand_var expand_spec vars v with
+                     | Some r -> [ r ]
+                     | None   -> [])
+            |> List.flatten
+          in
+          match res with
+            | [] -> ()
+            | r  ->
+                let s = String.concat expand_spec.Expandspec.sep r in
+                let lead =
+                  Option.value
+                    (Option.map (String.make 1) expand_spec.Expandspec.lead_char)
+                    ~default:""
+                in
+                Buffer.add_string buf lead;
+                Buffer.add_string buf s ))
+    t;
+  Buffer.contents buf
diff --git a/src/uritmpl/uritmpl.mli b/src/uritmpl/uritmpl.mli
new file mode 100644
--- /dev/null
+++ b/src/uritmpl/uritmpl.mli
@@ -0,0 +1,18 @@
+module Var : sig
+  type v =
+    | S of string
+    | A of string list
+    | M of (string * string) list
+
+  type t = string * v
+end
+
+type t
+
+type parse_err = [ `Error ]
+
+val of_string : string -> (t, [> parse_err ]) result
+
+val to_string : t -> string
+
+val expand : t -> Var.t list -> string
diff --git a/src/uritmpl/uritmpl_lexer.ml b/src/uritmpl/uritmpl_lexer.ml
new file mode 100644
--- /dev/null
+++ b/src/uritmpl/uritmpl_lexer.ml
@@ -0,0 +1,97 @@
+module Token = struct
+  type token =
+    | Literal    of string
+    | Open_expr
+    | Close_expr
+    | Op         of char
+    | Var        of string
+    | Prefix     of int
+    | Explode
+    | Var_sep
+  [@@deriving show, eq]
+
+  type t = token list [@@deriving show, eq]
+end
+
+module Tb : sig
+  type t
+
+  val create : unit -> t
+
+  val add : Token.token -> t -> t
+
+  val build : t -> Token.t
+end = struct
+  type t = Token.t
+
+  let create () = []
+
+  let add v t = v :: t
+
+  let build t = List.rev t
+end
+
+type err =
+  [ `Premature_end
+  | `Error
+  | `Invalid_prefix
+  ]
+[@@deriving show, eq]
+
+open Token
+
+let rec token bldr buf =
+  match%sedlex buf with
+    | "{"                   -> expr (Tb.add Open_expr bldr) buf
+    | Star (Sub (any, "{")) ->
+        let str = Sedlexing.Utf8.lexeme buf in
+        token (Tb.add (Literal str) bldr) buf
+    | eof                   -> Ok (Tb.build bldr)
+    | _                     -> assert false
+
+and expr bldr buf =
+  match%sedlex buf with
+    | Chars "+#./;?&" ->
+        let op = Sedlexing.Utf8.lexeme buf in
+        variable (Tb.add (Op op.[0]) bldr) buf
+    | eof             -> Error `Premature_end
+    | _               ->
+        Sedlexing.rollback buf;
+        variable bldr buf
+
+and variable bldr buf =
+  match%sedlex buf with
+    | Star (Sub (any, Chars "-:*,}")) ->
+        let name = Sedlexing.Utf8.lexeme buf in
+        varspec (Tb.add (Var name) bldr) buf
+    | _                               -> assert false
+
+and varspec bldr buf =
+  match%sedlex buf with
+    | ':' -> prefix bldr buf
+    | '*' -> maybe_next_var (Tb.add Explode bldr) buf
+    | _   ->
+        Sedlexing.rollback buf;
+        maybe_next_var bldr buf
+
+and prefix bldr buf =
+  match%sedlex buf with
+    | Plus '0' .. '9' ->
+        let len = int_of_string (Sedlexing.Utf8.lexeme buf) in
+        maybe_next_var (Tb.add (Prefix len) bldr) buf
+    | _               -> Error `Invalid_prefix
+
+and maybe_explode bldr buf =
+  match%sedlex buf with
+    | '*' -> maybe_next_var (Tb.add Explode bldr) buf
+    | ',' -> variable (Tb.add Var_sep bldr) buf
+    | '}' -> token (Tb.add Close_expr bldr) buf
+    | _   -> Error `Error
+
+and maybe_next_var bldr buf =
+  match%sedlex buf with
+    | ',' -> variable (Tb.add Var_sep bldr) buf
+    | '}' -> token (Tb.add Close_expr bldr) buf
+    | _   -> Error `Error
+
+let tokenize s = token (Tb.create ()) (Sedlexing.Utf8.from_string s)
diff --git a/tests/uritmpl/test.ml b/tests/uritmpl/test.ml
new file mode 100644
--- /dev/null
+++ b/tests/uritmpl/test.ml
@@ -0,0 +1,314 @@
+let test_vars =
+  let open Uritmpl.Var in
+  [
+    ("count", A [ "one"; "two"; "three" ]);
+    ("dom", A [ "example"; "com" ]);
+    ("dub", S "me/too");
+    ("hello", S "Hello World!");
+    ("half", S "50%");
+    ("var", S "value");
+    ("who", S "fred");
+    ("base", S "http://example.com/home/");
+    ("path", S "/foo/bar");
+    ("list", A [ "red"; "green"; "blue" ]);
+    ("keys", M [ ("semi", ";"); ("dot", "."); ("comma", ",") ]);
+    ("v", S "6");
+    ("x", S "1024");
+    ("y", S "768");
+    ("empty", S "");
+    ("empty_keys", M []);
+  ]
+
+let expand s =
+  match Uritmpl.of_string s with
+    | Ok tmpl -> Uritmpl.expand tmpl test_vars
+    | Error _ -> assert false
+
+let of_string_to_string_matches s =
+  match Uritmpl.of_string s with
+    | Ok tmpl -> s = Uritmpl.to_string tmpl
+    | Error _ -> failwith s
+
+let test_no_variable_expansion =
+  Oth.test ~name:"No Variables" (fun _ -> assert (expand "foo" = "foo"))
+
+let test_variable_expansion_3_2_1 =
+  Oth.test ~name:"Variable Expansion 3.2.1" (fun _ ->
+      assert (expand "{count}" = "one,two,three");
+      assert (expand "{count*}" = "one,two,three");
+      assert (expand "{/count}" = "/one,two,three");
+      assert (expand "{/count*}" = "/one/two/three");
+      assert (expand "{;count}" = ";count=one,two,three");
+      assert (expand "{;count*}" = ";count=one;count=two;count=three");
+      assert (expand "{?count}" = "?count=one,two,three");
+      assert (expand "{?count*}" = "?count=one&count=two&count=three");
+      assert (expand "{&count*}" = "&count=one&count=two&count=three"))
+
+let test_simple_string_expansion_3_2_2 =
+  Oth.test ~name:"Simple String Expansion 3.2.2" (fun _ ->
+      assert (expand "{var}" = "value");
+      assert (expand "{hello}" = "Hello%20World%21");
+      assert (expand "{half}" = "50%25");
+      assert (expand "O{empty}X" = "OX");
+      assert (expand "O{undef}X" = "OX");
+      assert (expand "{x,y}" = "1024,768");
+      assert (expand "{x,hello,y}" = "1024,Hello%20World%21,768");
+      assert (expand "?{x,empty}" = "?1024,");
+      assert (expand "?{x,undef}" = "?1024");
+      assert (expand "?{undef,y}" = "?768");
+      assert (expand "{var:3}" = "val");
+      assert (expand "{var:30}" = "value");
+      assert (expand "{list}" = "red,green,blue");
+      assert (expand "{list*}" = "red,green,blue");
+      assert (expand "{keys}" = "semi,%3B,dot,.,comma,%2C");
+      assert (expand "{keys*}" = "semi=%3B,dot=.,comma=%2C"))
+
+let test_reserved_expansion_3_2_3 =
+  Oth.test ~name:"Reserved Expansion 3.2.3" (fun _ ->
+      assert (expand "{+var}" = "value");
+      assert (expand "{+hello}" = "Hello%20World!");
+      assert (expand "{+half}" = "50%25");
+      assert (expand "{base}index" = "http%3A%2F%2Fexample.com%2Fhome%2Findex");
+      assert (expand "{+base}index" = "http://example.com/home/index");
+      assert (expand "O{+empty}X" = "OX");
+      assert (expand "O{+undef}X" = "OX");
+      assert (expand "{+path}/here" = "/foo/bar/here");
+      assert (expand "here?ref={+path}" = "here?ref=/foo/bar");
+      assert (expand "up{+path}{var}/here" = "up/foo/barvalue/here");
+      assert (expand "{+x,hello,y}" = "1024,Hello%20World!,768");
+      assert (expand "{+path,x}/here" = "/foo/bar,1024/here");
+      assert (expand "{+path:6}/here" = "/foo/b/here");
+      assert (expand "{+list}" = "red,green,blue");
+      assert (expand "{+list*}" = "red,green,blue");
+      assert (expand "{+keys}" = "semi,;,dot,.,comma,,");
+      assert (expand "{+keys*}" = "semi=;,dot=.,comma=,"))
+
+let test_fragment_expansion_3_2_4 =
+  Oth.test ~name:"Fragment Expansion 3.2.4" (fun _ ->
+      assert (expand "{#var}" = "#value");
+      assert (expand "{#hello}" = "#Hello%20World!");
+      assert (expand "{#half}" = "#50%25");
+      assert (expand "foo{#empty}" = "foo#");
+      assert (expand "foo{#undef}" = "foo");
+      assert (expand "{#x,hello,y}" = "#1024,Hello%20World!,768");
+      assert (expand "{#path,x}/here" = "#/foo/bar,1024/here");
+      assert (expand "{#path:6}/here" = "#/foo/b/here");
+      assert (expand "{#list}" = "#red,green,blue");
+      assert (expand "{#list*}" = "#red,green,blue");
+      assert (expand "{#keys}" = "#semi,;,dot,.,comma,,");
+      assert (expand "{#keys*}" = "#semi=;,dot=.,comma=,"))
+
+let test_label_expansion_with_dot_prefix_3_2_5 =
+  Oth.test ~name:"Label Expansion With Dot Prefix 3.2.5" (fun _ ->
+      assert (expand "{.who}" = ".fred");
+      assert (expand "{.who,who}" = ".fred.fred");
+      assert (expand "{.half,who}" = ".50%25.fred");
+      assert (expand "www{.dom*}" = "www.example.com");
+      assert (expand "X{.var}" = "X.value");
+      assert (expand "X{.empty}" = "X.");
+      assert (expand "X{.undef}" = "X");
+      assert (expand "X{.var:3}" = "X.val");
+      assert (expand "X{.list}" = "X.red,green,blue");
+      assert (expand "X{.list*}" = "X.red.green.blue");
+      assert (expand "X{.keys}" = "X.semi,%3B,dot,.,comma,%2C");
+      assert (expand "X{.keys*}" = "X.semi=%3B.dot=..comma=%2C");
+      assert (expand "X{.empty_keys}" = "X");
+      assert (expand "X{.empty_keys*}" = "X"))
+
+let test_path_segment_expansion_3_2_6 =
+  Oth.test ~name:"Path Segment Expansion 3.2.6" (fun _ ->
+      assert (expand "{/who}" = "/fred");
+      assert (expand "{/who,who}" = "/fred/fred");
+      assert (expand "{/half,who}" = "/50%25/fred");
+      assert (expand "{/who,dub}" = "/fred/me%2Ftoo");
+      assert (expand "{/var}" = "/value");
+      assert (expand "{/var,empty}" = "/value/");
+      assert (expand "{/var,undef}" = "/value");
+      assert (expand "{/var,x}/here" = "/value/1024/here");
+      assert (expand "{/var:1,var}" = "/v/value");
+      assert (expand "{/list}" = "/red,green,blue");
+      assert (expand "{/list*}" = "/red/green/blue");
+      assert (expand "{/list*,path:4}" = "/red/green/blue/%2Ffoo");
+      assert (expand "{/keys}" = "/semi,%3B,dot,.,comma,%2C");
+      assert (expand "{/keys*}" = "/semi=%3B/dot=./comma=%2C"))
+
+let test_path_style_parameter_expansion_3_2_7 =
+  Oth.test ~name:"Path-Style Parameter Expansion 3.2.7" (fun _ ->
+      assert (expand "{;who}" = ";who=fred");
+      assert (expand "{;half}" = ";half=50%25");
+      assert (expand "{;empty}" = ";empty");
+      assert (expand "{;v,empty,who}" = ";v=6;empty;who=fred");
+      assert (expand "{;v,bar,who}" = ";v=6;who=fred");
+      assert (expand "{;x,y}" = ";x=1024;y=768");
+      assert (expand "{;x,y,empty}" = ";x=1024;y=768;empty");
+      assert (expand "{;x,y,undef}" = ";x=1024;y=768");
+      assert (expand "{;hello:5}" = ";hello=Hello");
+      assert (expand "{;list}" = ";list=red,green,blue");
+      assert (expand "{;list*}" = ";list=red;list=green;list=blue");
+      assert (expand "{;keys}" = ";keys=semi,%3B,dot,.,comma,%2C");
+      assert (expand "{;keys*}" = ";semi=%3B;dot=.;comma=%2C"))
+
+let test_form_style_query_expansion_3_2_8 =
+  Oth.test ~name:"Form-Style Query Expansion 3.2.8" (fun _ ->
+      assert (expand "{?who}" = "?who=fred");
+      assert (expand "{?half}" = "?half=50%25");
+      assert (expand "{?x,y}" = "?x=1024&y=768");
+      assert (expand "{?x,y,empty}" = "?x=1024&y=768&empty=");
+      assert (expand "{?x,y,undef}" = "?x=1024&y=768");
+      assert (expand "{?var:3}" = "?var=val");
+      assert (expand "{?list}" = "?list=red,green,blue");
+      assert (expand "{?list*}" = "?list=red&list=green&list=blue");
+      assert (expand "{?keys}" = "?keys=semi,%3B,dot,.,comma,%2C");
+      assert (expand "{?keys*}" = "?semi=%3B&dot=.&comma=%2C"))
+
+let test_form_style_query_continuation_3_2_9 =
+  Oth.test ~name:"Form-Style Query Continuation 3.2.9" (fun _ ->
+      assert (expand "{&who}" = "&who=fred");
+      assert (expand "{&half}" = "&half=50%25");
+      assert (expand "?fixed=yes{&x}" = "?fixed=yes&x=1024");
+      assert (expand "{&x,y,empty}" = "&x=1024&y=768&empty=");
+      assert (expand "{&x,y,undef}" = "&x=1024&y=768");
+      assert (expand "{&var:3}" = "&var=val");
+      assert (expand "{&list}" = "&list=red,green,blue");
+      assert (expand "{&list*}" = "&list=red&list=green&list=blue");
+      assert (expand "{&keys}" = "&keys=semi,%3B,dot,.,comma,%2C");
+      assert (expand "{&keys*}" = "&semi=%3B&dot=.&comma=%2C"))
+
+let test_of_string_to_string =
+  Oth.test ~name:"of_string to_string matches" (fun _ ->
+      assert (of_string_to_string_matches "foo");
+      assert (of_string_to_string_matches "{count}");
+      assert (of_string_to_string_matches "{count*}");
+      assert (of_string_to_string_matches "{/count}");
+      assert (of_string_to_string_matches "{/count*}");
+      assert (of_string_to_string_matches "{;count}");
+      assert (of_string_to_string_matches "{;count*}");
+      assert (of_string_to_string_matches "{?count}");
+      assert (of_string_to_string_matches "{?count*}");
+      assert (of_string_to_string_matches "{&count*}");
+      assert (of_string_to_string_matches "{var}");
+      assert (of_string_to_string_matches "{hello}");
+      assert (of_string_to_string_matches "{half}");
+      assert (of_string_to_string_matches "O{empty}X");
+      assert (of_string_to_string_matches "O{undef}X");
+      assert (of_string_to_string_matches "{x,y}");
+      assert (of_string_to_string_matches "{x,hello,y}");
+      assert (of_string_to_string_matches "?{x,empty}");
+      assert (of_string_to_string_matches "?{x,undef}");
+      assert (of_string_to_string_matches "?{undef,y}");
+      assert (of_string_to_string_matches "{var:3}");
+      assert (of_string_to_string_matches "{var:30}");
+      assert (of_string_to_string_matches "{list}");
+      assert (of_string_to_string_matches "{list*}");
+      assert (of_string_to_string_matches "{keys}");
+      assert (of_string_to_string_matches "{keys*}");
+      assert (of_string_to_string_matches "{+var}");
+      assert (of_string_to_string_matches "{+hello}");
+      assert (of_string_to_string_matches "{+half}");
+      assert (of_string_to_string_matches "{base}index");
+      assert (of_string_to_string_matches "{+base}index");
+      assert (of_string_to_string_matches "O{+empty}X");
+      assert (of_string_to_string_matches "O{+undef}X");
+      assert (of_string_to_string_matches "{+path}/here");
+      assert (of_string_to_string_matches "here?ref={+path}");
+      assert (of_string_to_string_matches "up{+path}{var}/here");
+      assert (of_string_to_string_matches "{+x,hello,y}");
+      assert (of_string_to_string_matches "{+path,x}/here");
+      assert (of_string_to_string_matches "{+path:6}/here");
+      assert (of_string_to_string_matches "{+list}");
+      assert (of_string_to_string_matches "{+list*}");
+      assert (of_string_to_string_matches "{+keys}");
+      assert (of_string_to_string_matches "{+keys*}");
+      assert (of_string_to_string_matches "{#var}");
+      assert (of_string_to_string_matches "{#hello}");
+      assert (of_string_to_string_matches "{#half}");
+      assert (of_string_to_string_matches "foo{#empty}");
+      assert (of_string_to_string_matches "foo{#undef}");
+      assert (of_string_to_string_matches "{#x,hello,y}");
+      assert (of_string_to_string_matches "{#path,x}/here");
+      assert (of_string_to_string_matches "{#path:6}/here");
+      assert (of_string_to_string_matches "{#list}");
+      assert (of_string_to_string_matches "{#list*}");
+      assert (of_string_to_string_matches "{#keys}");
+      assert (of_string_to_string_matches "{#keys*}");
+      assert (of_string_to_string_matches "{.who}");
+      assert (of_string_to_string_matches "{.who,who}");
+      assert (of_string_to_string_matches "{.half,who}");
+      assert (of_string_to_string_matches "www{.dom*}");
+      assert (of_string_to_string_matches "X{.var}");
+      assert (of_string_to_string_matches "X{.empty}");
+      assert (of_string_to_string_matches "X{.undef}");
+      assert (of_string_to_string_matches "X{.var:3}");
+      assert (of_string_to_string_matches "X{.list}");
+      assert (of_string_to_string_matches "X{.list*}");
+      assert (of_string_to_string_matches "X{.keys}");
+      assert (of_string_to_string_matches "X{.keys*}");
+      assert (of_string_to_string_matches "X{.empty_keys}");
+      assert (of_string_to_string_matches "X{.empty_keys*}");
+      assert (of_string_to_string_matches "{/who}");
+      assert (of_string_to_string_matches "{/who,who}");
+      assert (of_string_to_string_matches "{/half,who}");
+      assert (of_string_to_string_matches "{/who,dub}");
+      assert (of_string_to_string_matches "{/var}");
+      assert (of_string_to_string_matches "{/var,empty}");
+      assert (of_string_to_string_matches "{/var,undef}");
+      assert (of_string_to_string_matches "{/var,x}/here");
+      assert (of_string_to_string_matches "{/var:1,var}");
+      assert (of_string_to_string_matches "{/list}");
+      assert (of_string_to_string_matches "{/list*}");
+      assert (of_string_to_string_matches "{/list*,path:4}");
+      assert (of_string_to_string_matches "{/keys}");
+      assert (of_string_to_string_matches "{/keys*}");
+      assert (of_string_to_string_matches "{;who}");
+      assert (of_string_to_string_matches "{;half}");
+      assert (of_string_to_string_matches "{;empty}");
+      assert (of_string_to_string_matches "{;v,empty,who}");
+      assert (of_string_to_string_matches "{;v,bar,who}");
+      assert (of_string_to_string_matches "{;x,y}");
+      assert (of_string_to_string_matches "{;x,y,empty}");
+      assert (of_string_to_string_matches "{;x,y,undef}");
+      assert (of_string_to_string_matches "{;hello:5}");
+      assert (of_string_to_string_matches "{;list}");
+      assert (of_string_to_string_matches "{;list*}");
+      assert (of_string_to_string_matches "{;keys}");
+      assert (of_string_to_string_matches "{;keys*}");
+      assert (of_string_to_string_matches "{?who}");
+      assert (of_string_to_string_matches "{?half}");
+      assert (of_string_to_string_matches "{?x,y}");
+      assert (of_string_to_string_matches "{?x,y,empty}");
+      assert (of_string_to_string_matches "{?x,y,undef}");
+      assert (of_string_to_string_matches "{?var:3}");
+      assert (of_string_to_string_matches "{?list}");
+      assert (of_string_to_string_matches "{?list*}");
+      assert (of_string_to_string_matches "{?keys}");
+      assert (of_string_to_string_matches "{?keys*}");
+      assert (of_string_to_string_matches "{&who}");
+      assert (of_string_to_string_matches "{&half}");
+      assert (of_string_to_string_matches "?fixed=yes{&x}");
+      assert (of_string_to_string_matches "{&x,y,empty}");
+      assert (of_string_to_string_matches "{&x,y,undef}");
+      assert (of_string_to_string_matches "{&var:3}");
+      assert (of_string_to_string_matches "{&list}");
+      assert (of_string_to_string_matches "{&list*}");
+      assert (of_string_to_string_matches "{&keys}");
+      assert (of_string_to_string_matches "{&keys*}"))
+
+let test =
+  Oth.parallel
+    [
+      test_no_variable_expansion;
+      test_variable_expansion_3_2_1;
+      test_simple_string_expansion_3_2_2;
+      test_reserved_expansion_3_2_3;
+      test_fragment_expansion_3_2_4;
+      test_label_expansion_with_dot_prefix_3_2_5;
+      test_path_segment_expansion_3_2_6;
+      test_path_style_parameter_expansion_3_2_7;
+      test_form_style_query_expansion_3_2_8;
+      test_form_style_query_continuation_3_2_9;
+      test_of_string_to_string;
+    ]
+
+let () =
+  Random.self_init ();
+  Oth.run test