Merge pull request #433 from polytypic/enable-by-os_type

Add `os_type` label to enable/disable based on `Sys.os_type`

Author: trefis

CHANGES.md

@@ -2,6 +2,9 @@
 
 #### Added
 
+- Add `os_type` label to enable/disable based on `Sys.os_type` (#433,
+  @polytypic)
+
 - Make MDX compatible with OCaml 5.1 (#435, @polytypic and @kit-ty-kate)
 
 #### Changed

README.md

@@ -390,6 +390,33 @@ The version number can be of the following forms:
 - `X.Y`
 - `X.Y.Z`
 
+#### Matching based on the `os_type` (since mdx 2.4.0)
+
+Block can be processed or ignored depending on the current
+[`os_type`](https://v2.ocaml.org/api/Sys.html#VALos_type).
+
+For example, different blocks could be enabled depending on whether we are on
+Windows or not:
+
+    ```ocaml
+    #require "unix"
+    ```
+
+    <!-- $MDX os_type<>Win32 -->
+    ```ocaml
+    # Unix.nice 0
+    - : int = 0
+    ```
+
+    <!-- $MDX os_type=Win32 -->
+    ```ocaml
+    # Unix.nice 0
+    Exception: Invalid_argument "Unix.nice not implemented".
+    ```
+
+The `os_type` values should be written in ASCII and are compared case
+insensitively.
+
 #### Environment variables declaration
 
 Environment variables can be declared at the beginning of a block:

lib/block.ml

@@ -111,6 +111,7 @@ type t = {
   contents : string list;
   skip : bool;
   version_enabled : bool;
+  os_type_enabled : bool;
   set_variables : (string * string) list;
   unset_variables : string list;
   value : value;
@@ -272,6 +273,16 @@ let version_enabled version =
       Label.Relation.compare op (Ocaml_version.compare curr_version v) 0
   | None -> true
 
+let os_type_enabled os_type =
+  match os_type with
+  | Some (op, v) ->
+      Label.Relation.compare op
+        (String.compare
+           (String.lowercase_ascii Sys.os_type)
+           (String.lowercase_ascii v))
+        0
+  | None -> true
+
 let get_label f (labels : Label.t list) = Util.List.find_map f labels
 
 let label_not_allowed ~loc ~label ~kind =
@@ -296,6 +307,7 @@ type block_config = {
   dir : string option;
   skip : bool;
   version : (Label.Relation.t * Ocaml_version.t) option;
+  os_type : (Label.Relation.t * string) option;
   set_variables : (string * string) list;
   unset_variables : string list;
   file_inc : string option;
@@ -315,6 +327,7 @@ let get_block_config l =
     dir = get_label (function Dir x -> Some x | _ -> None) l;
     skip = List.exists (function Label.Skip -> true | _ -> false) l;
     version = get_label (function Version (x, y) -> Some (x, y) | _ -> None) l;
+    os_type = get_label (function Os_type (x, y) -> Some (x, y) | _ -> None) l;
     set_variables =
       List.filter_map (function Label.Set (v, x) -> Some (v, x) | _ -> None) l;
     unset_variables =
@@ -416,6 +429,7 @@ let mk ~loc ~section ~labels ~legacy_labels ~header ~contents ~errors =
     | None -> infer_block ~loc ~config ~header ~contents ~errors
   in
   let+ version_enabled = version_enabled config.version in
+  let os_type_enabled = os_type_enabled config.os_type in
   {
     loc;
     section;
@@ -425,6 +439,7 @@ let mk ~loc ~section ~labels ~legacy_labels ~header ~contents ~errors =
     contents;
     skip = config.skip;
     version_enabled;
+    os_type_enabled;
     set_variables = config.set_variables;
     unset_variables = config.unset_variables;
     value;
@@ -471,4 +486,4 @@ let is_active ?section:s t =
         | None -> Re.execp (Re.Perl.compile_pat p) "")
     | None -> true
   in
-  active && t.version_enabled && not t.skip
+  active && t.version_enabled && t.os_type_enabled && not t.skip

lib/block.mli

@@ -101,6 +101,8 @@ type t = {
   skip : bool;
   version_enabled : bool;
       (** Whether the current OCaml version complies with the block's version. *)
+  os_type_enabled : bool;
+      (** Whether the current os type complies with the block's version. *)
   set_variables : (string * string) list;
   unset_variables : string list;
   value : value;

lib/label.ml

@@ -89,6 +89,7 @@ type t =
   | Skip
   | Non_det of non_det option
   | Version of Relation.t * Ocaml_version.t
+  | Os_type of Relation.t * string
   | Set of string * string
   | Unset of string
   | Block_kind of block_kind
@@ -115,6 +116,7 @@ let pp ppf = function
   | Non_det (Some Nd_command) -> Fmt.string ppf "non-deterministic=command"
   | Version (op, v) ->
       Fmt.pf ppf "version%a%a" Relation.pp op Ocaml_version.pp v
+  | Os_type (op, v) -> Fmt.pf ppf "os_type%a%s" Relation.pp op v
   | Set (v, x) -> Fmt.pf ppf "set-%s=%s" v x
   | Unset x -> Fmt.pf ppf "unset-%s" x
   | Block_kind bk -> pp_block_kind ppf bk
@@ -170,6 +172,7 @@ let interpret label value =
           | Ok v -> Ok (Version (op, v))
           | Error (`Msg e) ->
               Util.Result.errorf "Invalid `version` label value: %s." e)
+  | "os_type" -> requires_value ~label ~value (fun op v -> Ok (Os_type (op, v)))
   | "non-deterministic" -> (
       match value with
       | None -> Ok (Non_det None)

lib/label.mli

@@ -42,6 +42,7 @@ type t =
   | Skip
   | Non_det of non_det option
   | Version of Relation.t * Ocaml_version.t
+  | Os_type of Relation.t * string
   | Set of string * string
   | Unset of string
   | Block_kind of block_kind

test/bin/mdx-test/expect/dune.inc

@@ -371,6 +371,18 @@
  (alias runtest)
  (action (diff ocaml-errors-ellipsis/test-case.md ocaml-errors-ellipsis.actual)))
 
+(rule
+ (target os_type.actual)
+ (deps (package mdx) (source_tree os_type))
+ (action
+  (with-stdout-to %{target}
+   (chdir os_type
+    (run ocaml-mdx test --output - test-case.md)))))
+
+(rule
+ (alias runtest)
+ (action (diff os_type/test-case.md os_type.actual)))
+
 (rule
  (target padding.actual)
  (deps (package mdx) (source_tree padding))

test/bin/mdx-test/expect/os_type/test-case.md

@@ -0,0 +1,13 @@
+Mdx can skip blocks based on `os_type`:
+
+```ocaml os_type<>Win32
+# #require "unix"
+# Unix.nice 0
+- : int = 0
+```
+
+```ocaml os_type=Win32
+# #require "unix"
+# Unix.nice 0
+Exception: Invalid_argument "Unix.nice not implemented".
+```