Fix padding by adding hpad & vpad in Cram.t

Author: Leonidas-from-XIV

lib/cram.ml

@@ -20,7 +20,12 @@ module Log = (val Logs.src_log src : Logs.LOG)
 open Astring
 open Misc
 
-type t = { command : string list; output : Output.t list; exit_code : int }
+type t = {
+  command : string list;
+  output : Output.t list;
+  exit_code : int;
+  vpad : int;
+}
 
 let dump_line ppf = function
   | #Output.t as o -> Output.dump ppf o
@@ -37,10 +42,20 @@ let dump ppf (t : t) =
     Fmt.(Dump.list Output.dump)
     t.output t.exit_code
 
+let pp_vpad ppf t =
+  let rec loop = function
+    | 0 -> ()
+    | n ->
+        Fmt.pf ppf "\n";
+        loop (Int.pred n)
+  in
+  loop t.vpad
+
 let pp_command ?(pad = 0) ppf (t : t) =
   match t.command with
   | [] -> ()
   | l ->
+      pp_vpad ppf t;
       let sep ppf () = Fmt.pf ppf "\\\n%a> " pp_pad pad in
       Fmt.pf ppf "%a$ %a\n" pp_pad pad Fmt.(list ~sep string) l
 
@@ -52,7 +67,7 @@ let pp ?pad ppf (t : t) =
   pp_lines (Output.pp ?pad) ppf t.output;
   pp_exit_code ?pad ppf t.exit_code
 
-let pad_of_lines = function
+let hpad_of_lines = function
   | [] -> 0
   | h :: _ ->
       let i = ref 0 in
@@ -61,22 +76,29 @@ let pad_of_lines = function
       done;
       !i
 
-let of_lines t =
-  let pad = pad_of_lines t in
+let of_lines ~syntax ~(loc : Location.t) t =
+  let pos = loc.loc_start in
+  let hpad =
+    match syntax with Syntax.Mli -> pos.pos_cnum + 2 | _ -> hpad_of_lines t
+  in
   let unpad line =
-    if String.is_empty line then line
-    else if String.length line < pad then
-      Fmt.failwith "invalid padding: %S" line
-    else String.with_index_range line ~first:pad
+    match syntax with
+    | Syntax.Mli -> String.trim line
+    | _ ->
+        if String.is_empty line then line
+        else if String.length line < hpad then
+          Fmt.failwith "invalid padding: %S" line
+        else String.with_index_range line ~first:hpad
   in
   let lines = List.map unpad t in
   let lines =
     Lexer_cram.token (Lexing.from_string (String.concat ~sep:"\n" lines))
   in
+  let vpad = match syntax with Syntax.Mli -> 1 | _ -> 0 in
   Log.debug (fun l ->
-      l "Cram.of_lines (pad=%d) %a" pad Fmt.(Dump.list dump_line) lines);
+      l "Cram.of_lines (pad=%d) %a" hpad Fmt.(Dump.list dump_line) lines);
   let mk command output exit_code =
-    { command; output = List.rev output; exit_code }
+    { command; output = List.rev output; exit_code; vpad }
   in
   let rec command_cont acc = function
     | `Command_cont c :: t -> command_cont (c :: acc) t
@@ -101,8 +123,8 @@ let of_lines t =
   match lines with
   | `Command_first cmd :: t ->
       let cmd, t = command_cont [ cmd ] t in
-      (pad, aux cmd [] [] t)
-  | `Command cmd :: t -> (pad, aux [ cmd ] [] [] t)
+      (hpad, aux cmd [] [] t)
+  | `Command cmd :: t -> (hpad, aux [ cmd ] [] [] t)
   | [] -> (0, [])
   | `Output line :: _ ->
       if String.length line > 0 && line.[0] = '$' then

lib/cram.mli

@@ -16,7 +16,12 @@
 
 (** Cram tests *)
 
-type t = { command : string list; output : Output.t list; exit_code : int }
+type t = {
+  command : string list;
+  output : Output.t list;
+  exit_code : int;
+  vpad : int;
+}
 (** The type for cram tests. *)
 
 (** {2 Accessors} *)
@@ -34,7 +39,7 @@ val command_line : t -> string
 
 (** {2 Parser} *)
 
-val of_lines : string list -> int * t list
+val of_lines : syntax:Syntax.t -> loc:Location.t -> string list -> int * t list
 (** [of_lines l] parses the commands [l]. It returns the optional
    whitespace padding. *)
 

lib/test/mdx_test.ml

@@ -118,7 +118,7 @@ let run_cram_tests ?syntax t ?root ppf temp_file pad tests =
         output;
       Cram.pp_exit_code ~pad ppf n)
     tests;
-  Block.pp_footer ?syntax ppf t
+  match syntax with Some Syntax.Mli -> () | _ -> Block.pp_footer ?syntax ppf t
 
 let eval_test ?block ?root c cmd =
   Log.debug (fun l -> l "eval_test %a" Fmt.(Dump.list (Fmt.fmt "%S")) cmd);
@@ -305,7 +305,11 @@ let run_exn ~non_deterministic ~silent_eval ~record_backtrace ~syntax ~silent
           with_non_det non_deterministic non_det ~command:print_block
             ~output:det ~det
       | Cram { language = _; non_det } ->
-          let pad, tests = Cram.of_lines t.contents in
+          let pad, tests =
+            Cram.of_lines
+              ~syntax:(Option.value ~default:Normal syntax)
+              ~loc:t.loc t.contents
+          in
           with_non_det non_deterministic non_det ~command:print_block
             ~output:(fun () ->
               print_block ();