Merge pull request #443 from ncik-roberts/reserve-sub-namespaces

Give semantics to reserving attribute namespace with dots

CHANGES.md

@@ -11,6 +11,8 @@ unreleased
 
 - Preserve quoted attributes on antiquotes in metaquot (#441, @ncik-roberts)
 
+- Attribute namespaces: Fix semantics of reserving multi-component namespaces (#443, @ncik-roberts)
+
 0.30.0 (20/06/2023)
 -------------------
 

src/name.ml

@@ -44,10 +44,15 @@ module Pattern = struct
   let matches t matched = String.Set.mem matched t.dot_suffixes
 end
 
-let get_outer_namespace name =
+(* On the namespace "a.NAMESPACE", return the pair ("a", NAMESPACE) *)
+let split_outer_namespace name =
   match String.index_opt name '.' with
   | None -> None
-  | Some i -> Some (String.sub name ~pos:0 ~len:i)
+  | Some i ->
+      let n = String.length name in
+      let before_dot = String.sub name ~pos:0 ~len:i in
+      let after_dot = String.sub name ~pos:(i + 1) ~len:(n - i - 1) in
+      Some (before_dot, after_dot)
 
 module Allowlisted = struct
   (* Allow list the following attributes, as well as all their dot suffixes.
@@ -114,8 +119,45 @@ module Allowlisted = struct
 end
 
 module Reserved_namespaces = struct
-  let tbl : (string, unit) Hashtbl.t = Hashtbl.create 16
-  let reserve ns = Hashtbl.add_exn tbl ~key:ns ~data:()
+  type reserved = (string, sub_namespaces) Hashtbl.t
+  and sub_namespaces = All | Sub_namespaces of reserved
+
+  (* If [tbl] contains a mapping from "x" to [All], then "x" and all paths that
+   * start with "x." are reserved with respect to [tbl]
+   *
+   * If [tbl] contains a mapping from "x" to [Sub_namespaces tbl'], and P is
+   * reserved with respect to [tbl'], then all paths "x.P" are reserved with
+   * respect to [tbl].
+   *)
+  let create_reserved () : reserved = Hashtbl.create 16
+
+  let rec reserve ns tbl =
+    match split_outer_namespace ns with
+    | None -> Hashtbl.add_exn tbl ~key:ns ~data:All
+    | Some (outer_ns, rest_ns) -> (
+        match
+          Hashtbl.find_or_add tbl outer_ns ~default:(fun () ->
+              Sub_namespaces (create_reserved ()))
+        with
+        | Sub_namespaces rest_tbl -> reserve rest_ns rest_tbl
+        | All -> ())
+
+  let rec is_in_reserved_namespaces name tbl =
+    match split_outer_namespace name with
+    | Some (ns, rest) -> (
+        match Hashtbl.find_opt tbl ns with
+        | Some (Sub_namespaces rest_tbl) ->
+            is_in_reserved_namespaces rest rest_tbl
+        | Some All -> true
+        | None -> false)
+    | None -> (
+        match Hashtbl.find_opt tbl name with
+        | Some All -> true
+        | Some (Sub_namespaces _) | None -> false)
+
+  let tbl = create_reserved ()
+  let reserve ns = reserve ns tbl
+  let is_in_reserved_namespaces name = is_in_reserved_namespaces name tbl
   let () = reserve "merlin"
   let () = reserve "reason"
   let () = reserve "refmt" (* reason *)
@@ -124,11 +166,6 @@ module Reserved_namespaces = struct
   let () = reserve "metaocaml"
   let () = reserve "ocamlformat"
 
-  let is_in_reserved_namespaces name =
-    match get_outer_namespace name with
-    | Some ns -> Hashtbl.mem tbl ns
-    | None -> Hashtbl.mem tbl name
-
   let check_not_reserved ~kind name =
     let kind, list =
       match kind with

test/driver/attributes/test.ml

@@ -92,3 +92,80 @@ type t2 = <  >
 Line _, characters 17-20:
 Error: Attribute `foo' was not used
 |}]
+
+(* Reserved Namespaces *)
+
+(* ppxlib checks that unreserved attributes aren't dropped *)
+
+let x = (42 [@bar])
+[%%expect{|
+Line _, characters 14-17:
+Error: Attribute `bar' was silently dropped
+|}]
+
+let x = (42 [@bar.baz])
+[%%expect{|
+Line _, characters 14-21:
+Error: Attribute `bar.baz' was silently dropped
+|}]
+
+(* But reserving a namespace disables those checks. *)
+
+let () = Reserved_namespaces.reserve "bar"
+
+let x = (42 [@bar])
+let x = (42 [@bar.baz])
+[%%expect{|
+val x : int = 42
+val x : int = 42
+|}]
+
+let x = (42 [@bar_not_proper_sub_namespace])
+[%%expect{|
+Line _, characters 14-42:
+Error: Attribute `bar_not_proper_sub_namespace' was silently dropped
+|}]
+
+(* The namespace reservation process understands dots as namespace
+   separators. *)
+
+let () = Reserved_namespaces.reserve "baz.qux"
+
+let x = (42 [@baz])
+[%%expect{|
+Line _, characters 14-17:
+Error: Attribute `baz' was silently dropped
+|}]
+
+let x = (42 [@baz.qux])
+[%%expect{|
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux.quux])
+[%%expect{|
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux_not_proper_sub_namespace])
+[%%expect{|
+Line _, characters 14-46:
+Error: Attribute `baz.qux_not_proper_sub_namespace' was silently dropped
+|}]
+
+(* You can reserve multiple subnamespaces under the same namespace *)
+
+let () = Reserved_namespaces.reserve "baz.qux2"
+
+let x = (42 [@baz.qux])
+let x = (42 [@baz.qux2])
+[%%expect{|
+val x : int = 42
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux3])
+[%%expect{|
+Line _, characters 14-22:
+Error: Attribute `baz.qux3' was silently dropped
+|}]

test/driver/attributes/test_510.ml

@@ -103,3 +103,92 @@ type t2 = <  >
 Line _, characters 17-20:
 Error: Attribute `foo' was not used
 |}]
+
+(* Reserved Namespaces *)
+
+(* ppxlib checks that unreserved attributes aren't dropped *)
+
+let x = (42 [@bar])
+[%%expect{|
+
+Line _, characters 14-17:
+Error: Attribute `bar' was silently dropped
+|}]
+
+let x = (42 [@bar.baz])
+[%%expect{|
+
+Line _, characters 14-21:
+Error: Attribute `bar.baz' was silently dropped
+|}]
+
+(* But reserving a namespace disables those checks. *)
+
+let () = Reserved_namespaces.reserve "bar"
+
+let x = (42 [@bar])
+let x = (42 [@bar.baz])
+[%%expect{|
+
+val x : int = 42
+
+val x : int = 42
+|}]
+
+let x = (42 [@bar_not_proper_sub_namespace])
+[%%expect{|
+
+Line _, characters 14-42:
+Error: Attribute `bar_not_proper_sub_namespace' was silently dropped
+|}]
+
+(* The namespace reservation process understands dots as namespace
+   separators. *)
+
+let () = Reserved_namespaces.reserve "baz.qux"
+
+let x = (42 [@baz])
+[%%expect{|
+
+Line _, characters 14-17:
+Error: Attribute `baz' was silently dropped
+|}]
+
+let x = (42 [@baz.qux])
+[%%expect{|
+
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux.quux])
+[%%expect{|
+
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux_not_proper_sub_namespace])
+[%%expect{|
+
+Line _, characters 14-46:
+Error: Attribute `baz.qux_not_proper_sub_namespace' was silently dropped
+|}]
+
+(* You can reserve multiple subnamespaces under the same namespace *)
+
+let () = Reserved_namespaces.reserve "baz.qux2"
+
+let x = (42 [@baz.qux])
+let x = (42 [@baz.qux2])
+[%%expect{|
+
+val x : int = 42
+
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux3])
+[%%expect{|
+
+Line _, characters 14-22:
+Error: Attribute `baz.qux3' was silently dropped
+|}]