diff --git a/doc/changes/added/13758.md b/doc/changes/added/13758.md
new file mode 100644
index 00000000000..a9149c08068
--- /dev/null
+++ b/doc/changes/added/13758.md
@@ -0,0 +1,2 @@
+- Preserve multiline block strings when formatting Dune files with language
+  version 3.25 or later (#13758, @Alizter)
diff --git a/src/dune_lang/format.ml b/src/dune_lang/format.ml
index 895b40ce7ea..636ec8c8b5a 100644
--- a/src/dune_lang/format.ml
+++ b/src/dune_lang/format.ml
@@ -12,55 +12,131 @@ let parse lb =
   else Sexps (Parser.parse lb ~mode:Cst)
 ;;
 
-let can_be_displayed_wrapped =
-  List.for_all ~f:(fun (c : Cst.t) ->
-    match c with
-    | Atom _ | Quoted_string _ | Template _ | List (_, []) | List (_, [ _ ]) -> true
+let block_string_min_version = 3, 25
+
+let can_be_displayed_wrapped ~version =
+  List.for_all ~f:(fun (sexp : Cst.t) ->
+    match sexp with
+    | Atom _ | List (_, []) | List (_, [ _ ]) | Template _ | Quoted_string _ -> true
+    | Block_string _ -> version < block_string_min_version
     | List _ | Comment _ -> false)
 ;;
 
 let pp_simple t = Cst.abstract t |> Option.value_exn |> Ast.remove_locs |> Dune_sexp.pp
 
-let print_wrapped_list ~version x =
-  let inner = Pp.concat_map ~sep:Pp.space ~f:pp_simple x in
-  if version < (2, 8)
-  then Pp.char '(' ++ Pp.hovbox ~indent:1 inner ++ Pp.char ')'
-  else Pp.hvbox ~indent:1 (Pp.char '(' ++ inner ++ Pp.char ')')
+let escaped_block_line parts =
+  String.concat
+    ~sep:""
+    (List.map parts ~f:(function
+       | Template.Part.Text text -> Escape.escaped text
+       | Pform pform -> Template.Pform.to_string pform))
+;;
+
+let pp_block_line (kind, parts) =
+  let kind, contents =
+    match kind with
+    | Block_string.Kind.Escaped -> kind, escaped_block_line parts
+    | Raw ->
+      if
+        List.for_all parts ~f:(function
+          | Template.Part.Text text ->
+            not (String.exists text ~f:(fun char -> char = '\r' || char = '\n'))
+          | Pform _ -> false)
+      then kind, Template.Part.list_to_string parts
+      else Escaped, escaped_block_line parts
+  in
+  let prefix = "\"" ^ Block_string.Kind.delimiter kind in
+  Pp.verbatim
+    (if String.is_empty contents then prefix else Printf.sprintf "%s %s" prefix contents)
+;;
+
+let preserved_block_lines ~version lines =
+  if version < block_string_min_version
+  then None
+  else (
+    match List.rev lines with
+    | (_, [] | _, [ Template.Part.Text "" ]) :: (_ :: _ as lines) -> Some (List.rev lines)
+    | _ -> None)
+;;
+
+let sexp_ends_with_cut ~version : Cst.t -> bool = function
+  | Block_string (_, block_string) ->
+    Option.is_some (preserved_block_lines ~version block_string)
+  | Atom _ | Quoted_string _ | Template _ | List _ | Comment _ -> false
+;;
+
+let rec sexp_contains_preserved_block ~version : Cst.t -> bool = function
+  | Block_string (_, block_string) ->
+    Option.is_some (preserved_block_lines ~version block_string)
+  | List (_, sexps) -> List.exists sexps ~f:(sexp_contains_preserved_block ~version)
+  | Atom _ | Quoted_string _ | Template _ | Comment _ -> false
 ;;
 
 let pp_comment_line l = Pp.char ';' ++ Pp.verbatim l
 let pp_comment lines = Pp.vbox (Pp.concat_map ~sep:Pp.cut ~f:pp_comment_line lines)
 let pp_break attached = if attached then Pp.char ' ' else Pp.cut
 
-let pp_list_with_comments pp_sexp sexps =
-  let rec go (l : Cst.t list) =
-    match l with
-    | x :: Comment (loc, c) :: xs ->
-      let attached = Loc.on_same_line (Cst.loc x) loc in
-      pp_sexp x ++ pp_break attached ++ pp_comment c ++ Pp.cut ++ go xs
-    | Comment (_, c) :: xs -> pp_comment c ++ Pp.cut ++ go xs
-    | [ x ] -> pp_sexp x
-    | x :: xs -> pp_sexp x ++ Pp.cut ++ go xs
-    | [] -> Pp.nop
-  in
-  go sexps
-;;
-
 let rec pp_sexp ~version : Cst.t -> _ = function
-  | (Atom _ | Quoted_string _ | Template _) as sexp -> pp_simple sexp
+  | Quoted_string (_, string) -> Pp.verbatim (Escape.quoted string)
+  | Block_string (_, block_string) as sexp ->
+    (match preserved_block_lines ~version block_string with
+     | Some lines -> Pp.vbox (Pp.concat_map lines ~sep:Pp.cut ~f:pp_block_line ++ Pp.cut)
+     | None -> pp_simple sexp)
+  | (Atom _ | Template _) as sexp -> pp_simple sexp
   | List (_, sexps) ->
     Pp.vbox
       ~indent:1
-      (if can_be_displayed_wrapped sexps
+      (if can_be_displayed_wrapped ~version sexps
        then print_wrapped_list ~version sexps
        else pp_sexp_list ~version sexps)
   | Comment (_, c) -> pp_comment c
 
 and pp_sexp_list ~version sexps =
-  Pp.char '(' ++ pp_list_with_comments (pp_sexp ~version) sexps ++ Pp.char ')'
+  Pp.char '(' ++ pp_list_with_comments ~version sexps ++ Pp.char ')'
+
+and pp_list_with_comments ~version = function
+  | sexp :: Comment (loc, comment) :: sexps ->
+    let break =
+      if sexp_ends_with_cut ~version sexp
+      then Pp.nop
+      else pp_break (Loc.on_same_line (Cst.loc sexp) loc)
+    in
+    pp_sexp ~version sexp
+    ++ break
+    ++ pp_comment comment
+    ++ Pp.cut
+    ++ pp_list_with_comments ~version sexps
+  | Comment (_, comment) :: sexps ->
+    pp_comment comment ++ Pp.cut ++ pp_list_with_comments ~version sexps
+  | [ sexp ] -> pp_sexp ~version sexp
+  | sexp :: (next :: _ as sexps) ->
+    let break =
+      if sexp_ends_with_cut ~version sexp
+      then if sexp_ends_with_cut ~version next then Pp.newline else Pp.nop
+      else Pp.cut
+    in
+    pp_sexp ~version sexp ++ break ++ pp_list_with_comments ~version sexps
+  | [] -> Pp.nop
+
+and print_wrapped_list ~version sexps =
+  let inner =
+    Pp.concat_map sexps ~sep:Pp.space ~f:(fun sexp ->
+      match sexp with
+      | Quoted_string _ | Block_string _ -> pp_sexp ~version sexp
+      | List _ when sexp_contains_preserved_block ~version sexp -> pp_sexp ~version sexp
+      | Atom _ | Template _ | List _ -> pp_simple sexp
+      | Comment _ -> Code_error.raise "unexpected comment in a wrapped list" [])
+  in
+  if version < (2, 8)
+  then Pp.char '(' ++ Pp.hovbox ~indent:1 inner ++ Pp.char ')'
+  else Pp.hvbox ~indent:1 (Pp.char '(' ++ inner ++ Pp.char ')')
+;;
+
+let pp_top_sexp ~version sexp =
+  pp_sexp ~version sexp
+  ++ if sexp_ends_with_cut ~version sexp then Pp.nop else Pp.char '\n'
 ;;
 
-let pp_top_sexp ~version sexp = pp_sexp ~version sexp ++ Pp.char '\n'
 let pp_top_sexps ~version = Pp.concat_map ~sep:Pp.newline ~f:(pp_top_sexp ~version)
 
 let format_string ~version input =
diff --git a/src/dune_lang/import.ml b/src/dune_lang/import.ml
index 0392b1531be..3f1d8093294 100644
--- a/src/dune_lang/import.ml
+++ b/src/dune_lang/import.ml
@@ -10,6 +10,8 @@ include struct
   module Parser = Parser
   module Ast = Ast
   module Template = Template
+  module Block_string = Block_string
+  module Escape = Escape
 end
 
 include struct
diff --git a/src/dune_lang/string_with_vars.ml b/src/dune_lang/string_with_vars.ml
index 0646e8d087f..55a682ac20c 100644
--- a/src/dune_lang/string_with_vars.ml
+++ b/src/dune_lang/string_with_vars.ml
@@ -93,7 +93,7 @@ let decode_manually f =
   | Atom (loc, A s) -> literal ~quoted:false ~loc s
   | Quoted_string (loc, s) -> literal ~quoted:true ~loc s
   | List (loc, _) -> User_error.raise ~loc [ Pp.text "Unexpected list" ]
-  | Template { quoted; loc; parts } ->
+  | Template { quoted; loc; parts; _ } ->
     { quoted
     ; loc
     ; parts =
diff --git a/src/dune_sexp/block_string.ml b/src/dune_sexp/block_string.ml
new file mode 100644
index 00000000000..216f1dd9dbe
--- /dev/null
+++ b/src/dune_sexp/block_string.ml
@@ -0,0 +1,58 @@
+open Import
+
+module Kind = struct
+  type t =
+    | Escaped
+    | Raw
+
+  let delimiter = function
+    | Escaped -> "\\|"
+    | Raw -> "\\>"
+  ;;
+
+  let repr =
+    Repr.variant
+      "dune-sexp-block-string-kind"
+      [ Repr.case0 "Escaped" ~test:(function
+          | Escaped -> true
+          | Raw -> false)
+      ; Repr.case0 "Raw" ~test:(function
+          | Raw -> true
+          | Escaped -> false)
+      ]
+  ;;
+end
+
+type t = (Kind.t * Template.Part.t list) list
+
+let repr = Repr.list (Repr.pair Kind.repr (Repr.list Template.Part.repr))
+
+let to_ast ~loc lines =
+  let text = Buffer.create 16 in
+  let parts = ref [] in
+  let flush_text () =
+    if Buffer.length text > 0
+    then (
+      parts := Template.Part.Text (Buffer.contents text) :: !parts;
+      Buffer.clear text)
+  in
+  let add_part = function
+    | Template.Part.Text string -> Buffer.add_string text string
+    | Pform _ as pform ->
+      flush_text ();
+      parts := pform :: !parts
+  in
+  let rec collect first = function
+    | [] -> ()
+    | (_, line) :: lines ->
+      if not first then Buffer.add_char text '\n';
+      List.iter line ~f:add_part;
+      collect false lines
+  in
+  collect true lines;
+  match !parts with
+  | [] -> Ast.Quoted_string (loc, Buffer.contents text)
+  | _ ->
+    flush_text ();
+    Ast.Template { Template.quoted = true; parts = List.rev !parts; loc }
+;;
diff --git a/src/dune_sexp/block_string.mli b/src/dune_sexp/block_string.mli
new file mode 100644
index 00000000000..bae7ca7a302
--- /dev/null
+++ b/src/dune_sexp/block_string.mli
@@ -0,0 +1,19 @@
+open Import
+
+(** Block strings as represented in the concrete syntax tree. *)
+
+module Kind : sig
+  type t =
+    | Escaped
+    | Raw
+
+  val delimiter : t -> string
+end
+
+(** The kind and template parts of each logical line. *)
+type t = (Kind.t * Template.Part.t list) list
+
+val repr : t Repr.t
+
+(** Convert a block string to its abstract representation. *)
+val to_ast : loc:Loc.t -> t -> Ast.t
diff --git a/src/dune_sexp/cst.ml b/src/dune_sexp/cst.ml
index a8b5a6d6b32..b234440223a 100644
--- a/src/dune_sexp/cst.ml
+++ b/src/dune_sexp/cst.ml
@@ -3,6 +3,7 @@ open Stdune
 type t =
   | Atom of Loc.t * Atom.t
   | Quoted_string of Loc.t * string
+  | Block_string of Loc.t * Block_string.t
   | Template of Template.t
   | List of Loc.t * t list
   | Comment of Loc.t * string list
@@ -11,7 +12,9 @@ let rec to_dyn =
   let open Dyn in
   function
   | Atom (_, a) -> variant "Atom" [ Atom.to_dyn a ]
-  | Quoted_string (_, s) -> variant "Quoted_string" [ string s ]
+  | Quoted_string (_, contents) -> variant "Quoted_string" [ string contents ]
+  | Block_string (_, block_string) ->
+    variant "Block_string" [ Repr.to_dyn Block_string.repr block_string ]
   | Template t -> variant "Template" [ Template.to_dyn t ]
   | List (_, l) -> variant "List" [ list to_dyn l ]
   | Comment (_, c) -> variant "Comment" [ Dyn.(list string) c ]
@@ -20,6 +23,7 @@ let rec to_dyn =
 let loc
       ( Atom (loc, _)
       | Quoted_string (loc, _)
+      | Block_string (loc, _)
       | List (loc, _)
       | Template { loc; _ }
       | Comment (loc, _) )
@@ -29,7 +33,8 @@ let loc
 
 let rec abstract : t -> Ast.t option = function
   | Atom (loc, atom) -> Some (Atom (loc, atom))
-  | Quoted_string (loc, s) -> Some (Quoted_string (loc, s))
+  | Quoted_string (loc, string) -> Some (Quoted_string (loc, string))
+  | Block_string (loc, block_string) -> Some (Block_string.to_ast ~loc block_string)
   | Template t -> Some (Template t)
   | List (loc, l) -> Some (List (loc, List.filter_map ~f:abstract l))
   | Comment _ -> None
@@ -37,7 +42,7 @@ let rec abstract : t -> Ast.t option = function
 
 let rec concrete : Ast.t -> t = function
   | Atom (loc, atom) -> Atom (loc, atom)
-  | Quoted_string (loc, s) -> Quoted_string (loc, s)
+  | Quoted_string (loc, string) -> Quoted_string (loc, string)
   | Template t -> Template t
   | List (loc, l) -> List (loc, List.map ~f:concrete l)
 ;;
@@ -46,7 +51,7 @@ let to_sexp c = abstract c |> Option.map ~f:Ast.remove_locs
 
 let extract_comments =
   let rec loop acc = function
-    | Atom _ | Quoted_string _ | Template _ -> acc
+    | Atom _ | Quoted_string _ | Block_string _ | Template _ -> acc
     | List (_, l) -> List.fold_left l ~init:acc ~f:loop
     | Comment (loc, comment) -> (loc, comment) :: acc
   in
@@ -58,7 +63,8 @@ let tokenize ts =
   let emit loc (token : Lexer.Token.t) = tokens := (loc, token) :: !tokens in
   let rec iter = function
     | Atom (loc, s) -> emit loc (Atom s)
-    | Quoted_string (loc, s) -> emit loc (Quoted_string s)
+    | Quoted_string (loc, string) -> emit loc (Quoted_string string)
+    | Block_string (loc, block_string) -> emit loc (Block_string block_string)
     | Template ({ loc; _ } as template) -> emit loc (Template template)
     | Comment (loc, comment) -> emit loc (Comment comment)
     | List (loc, l) ->
diff --git a/src/dune_sexp/cst.mli b/src/dune_sexp/cst.mli
index c74c77f86a0..8b6e46c0a61 100644
--- a/src/dune_sexp/cst.mli
+++ b/src/dune_sexp/cst.mli
@@ -5,6 +5,7 @@ open Stdune
 type t =
   | Atom of Loc.t * Atom.t
   | Quoted_string of Loc.t * string
+  | Block_string of Loc.t * Block_string.t
   | Template of Template.t
   | List of Loc.t * t list
   | Comment of Loc.t * string list
diff --git a/src/dune_sexp/dune_sexp.ml b/src/dune_sexp/dune_sexp.ml
index 6cfb840e3f2..2c38892a15f 100644
--- a/src/dune_sexp/dune_sexp.ml
+++ b/src/dune_sexp/dune_sexp.ml
@@ -3,6 +3,7 @@ module Atom = Atom
 module Combinators = Combinators
 module Decoder = Decoder
 module Encoder = Encoder
+module Escape = Escape
 module Syntax = Syntax
 module Versioned_file = Versioned_file
 module Versioned_file_first_line = Versioned_file_first_line
@@ -10,4 +11,5 @@ module Cst = Cst
 module Parser = Parser
 module Conv = Conv
 module Template = Template
+module Block_string = Block_string
 include T
diff --git a/src/dune_sexp/lexer.mli b/src/dune_sexp/lexer.mli
index e0691f31ff3..fed912b9108 100644
--- a/src/dune_sexp/lexer.mli
+++ b/src/dune_sexp/lexer.mli
@@ -2,6 +2,7 @@ module Token : sig
   type t =
     | Atom of Atom.t
     | Quoted_string of string
+    | Block_string of Block_string.t
     | Lparen
     | Rparen
     | Eof
diff --git a/src/dune_sexp/lexer.mll b/src/dune_sexp/lexer.mll
index 0c2b245d01d..b111203a77d 100644
--- a/src/dune_sexp/lexer.mll
+++ b/src/dune_sexp/lexer.mll
@@ -5,6 +5,7 @@ module Token = struct
   type t =
     | Atom of Atom.t
     | Quoted_string of string
+    | Block_string of Block_string.t
     | Lparen
     | Rparen
     | Eof
@@ -47,10 +48,6 @@ let eval_hex_char c =
 
 let eval_hex_escape c1 c2 = (eval_hex_char c1 * 16) + eval_hex_char c2
 
-type block_string_line_kind =
-  | With_escape_sequences
-  | Raw
-
 module Template = struct
   include Template
 
@@ -81,53 +78,131 @@ module Template = struct
     val add_var : Part.t -> unit
     val add_text : string -> unit
     val add_text_c : char -> unit
+    val add_char : char -> unit
+    val add_newline : string -> unit
+    val begin_block : preserve:bool -> Block_string.Kind.t -> unit
+    val start_block_line : Block_string.Kind.t -> unit
   end = struct
     type state =
       | String
       | Template of Part.t list
+      | Block_string of
+          { current_kind : Block_string.Kind.t
+          ; current_line_started : bool
+          ; current_line_parts : Part.t list
+          ; lines : Block_string.t
+          }
 
     let text_buf = Buffer.create 256
+    let state = ref String
 
-    let new_token () = Buffer.clear text_buf
+    let new_token () =
+      Buffer.clear text_buf;
+      state := String
+    ;;
 
     let take_buf () =
       let contents = Buffer.contents text_buf in
       Buffer.clear text_buf;
       contents
-
-    let state = ref String
+    ;;
 
     let add_buf_to_parts parts =
       match take_buf () with
       | "" -> parts
-      | t -> add_text parts t
+      | text -> add_text parts text
+    ;;
+
+    let begin_block ~preserve kind =
+      if preserve
+      then
+        state
+        := Block_string
+             { current_kind = kind
+             ; current_line_started = true
+             ; current_line_parts = []
+             ; lines = []
+             }
+    ;;
+
+    let start_block_line kind =
+      match !state with
+      | Block_string ({ current_line_started = false; _ } as block) ->
+        state
+        := Block_string { block with current_kind = kind; current_line_started = true }
+      | String | Template _ | Block_string _ -> ()
+    ;;
+
+    let finish_block_line () =
+      match !state with
+      | Block_string { current_kind; current_line_parts; lines; _ } ->
+        let parts = add_buf_to_parts current_line_parts in
+        let line = current_kind, List.rev parts in
+        state
+        := Block_string
+             { current_kind
+             ; current_line_started = false
+             ; current_line_parts = []
+             ; lines = line :: lines
+             }
+      | String | Template _ -> Buffer.add_char text_buf '\n'
+    ;;
+
+    let add_text text = Buffer.add_string text_buf text
+    let add_text_c char = Buffer.add_char text_buf char
+
+    let add_char char =
+      match !state, char with
+      | Block_string _, '\n' -> finish_block_line ()
+      | Block_string block, _ ->
+        Buffer.add_char text_buf char;
+        if not block.current_line_started
+        then state := Block_string { block with current_line_started = true }
+      | (String | Template _), _ -> Buffer.add_char text_buf char
+    ;;
+
+    let add_newline newline =
+      match !state with
+      | Block_string _ -> String.iter newline ~f:add_char
+      | String | Template _ -> add_text newline
+    ;;
 
     let get () =
       match !state with
       | String -> Token.Quoted_string (take_buf ())
+      | Block_string { current_kind; current_line_parts; lines; _ } ->
+        let final_parts = add_buf_to_parts current_line_parts in
+        let final_line = current_kind, List.rev final_parts in
+        state := String;
+        Token.Block_string (List.rev (final_line :: lines))
       | Template parts ->
         state := String;
-        begin match add_buf_to_parts parts with
-        | [] -> assert false
-        | [Text s] -> Quoted_string s
-        | parts ->
-          Token.Template
-            { quoted = true
-            ; loc = dummy_loc
-            ; parts = List.rev parts
-            }
-        end
-
-    let add_var v =
+        (match add_buf_to_parts parts with
+         | [] -> assert false
+         | [ Text s ] -> Quoted_string s
+         | parts ->
+           Token.Template
+             { quoted = true
+             ; loc = dummy_loc
+             ; parts = List.rev parts
+             })
+    ;;
+
+    let add_var var =
       match !state with
-      | String ->
-        state := Template (v :: add_buf_to_parts []);
+      | String -> state := Template (var :: add_buf_to_parts [])
+      | Block_string block ->
+        let current_line_parts = add_buf_to_parts block.current_line_parts in
+        state
+        := Block_string
+             { block with
+               current_line_started = true
+             ; current_line_parts = var :: current_line_parts
+             }
       | Template parts ->
         let parts = add_buf_to_parts parts in
-        state := Template (v::parts)
-
-    let add_text s = Buffer.add_string text_buf s
-    let add_text_c c = Buffer.add_char text_buf c
+        state := Template (var :: parts)
+    ;;
   end
 end
 }
@@ -160,7 +235,7 @@ rule token with_comments = parse
   | '"'
     { let start = Lexing.lexeme_start_p lexbuf in
       Template.Buffer.new_token ();
-      let token = start_quoted_string lexbuf in
+      let token = start_quoted_string with_comments lexbuf in
       lexbuf.lex_start_p <- start;
       token
     }
@@ -187,23 +262,31 @@ and atom acc start = parse
   | ""
     { Template.token acc ~quoted:false ~start lexbuf }
 
-and start_quoted_string = parse
+and start_quoted_string preserve_block_syntax = parse
   | "\\|"
-    { block_string_start With_escape_sequences lexbuf }
+    { Template.Buffer.begin_block
+        ~preserve:preserve_block_syntax
+        Block_string.Kind.Escaped;
+      block_string_start Block_string.Kind.Escaped lexbuf
+    }
   | "\\>"
-    { block_string_start Raw lexbuf }
+    { Template.Buffer.begin_block
+        ~preserve:preserve_block_syntax
+        Block_string.Kind.Raw;
+      block_string_start Block_string.Kind.Raw lexbuf
+    }
   | ""
     { quoted_string lexbuf }
 
 and block_string_start kind = parse
-  | newline as s
+  | newline as newline
     { Lexing.new_line lexbuf;
-      Template.Buffer.add_text s;
+      Template.Buffer.add_newline newline;
       block_string_after_newline lexbuf
     }
   | ' '
     { match kind with
-      | With_escape_sequences -> block_string lexbuf
+      | Block_string.Kind.Escaped -> block_string lexbuf
       | Raw -> raw_block_string lexbuf
     }
   | eof
@@ -213,23 +296,22 @@ and block_string_start kind = parse
     }
 
 and block_string = parse
-  | newline as s
+  | newline as newline
     { Lexing.new_line lexbuf;
-      Template.Buffer.add_text s;
+      Template.Buffer.add_newline newline;
       block_string_after_newline lexbuf
     }
   | '\\'
     { match escape_sequence lexbuf with
       | Newline -> block_string_after_newline lexbuf
-      | Other   -> block_string               lexbuf
+      | Other -> block_string lexbuf
     }
-  | "%{" {
-      let var = template_variable lexbuf in
-      Template.Buffer.add_var var;
+  | "%{"
+    { Template.Buffer.add_var (template_variable lexbuf);
       block_string lexbuf
     }
-  | _ as c
-    { Template.Buffer.add_text_c c;
+  | _ as char
+    { Template.Buffer.add_char char;
       block_string lexbuf
     }
   | eof
@@ -238,21 +320,25 @@ and block_string = parse
 
 and block_string_after_newline = parse
   | blank* "\"\\|"
-    { block_string_start With_escape_sequences lexbuf }
+    { Template.Buffer.start_block_line Block_string.Kind.Escaped;
+      block_string_start Block_string.Kind.Escaped lexbuf
+    }
   | blank* "\"\\>"
-    { block_string_start Raw lexbuf }
+    { Template.Buffer.start_block_line Block_string.Kind.Raw;
+      block_string_start Block_string.Kind.Raw lexbuf
+    }
   | ""
     { Template.Buffer.get ()
     }
 
 and raw_block_string = parse
-  | newline as s
+  | newline as newline
     { Lexing.new_line lexbuf;
-      Template.Buffer.add_text s;
+      Template.Buffer.add_newline newline;
       block_string_after_newline lexbuf
     }
-  | _ as c
-    { Template.Buffer.add_text_c c;
+  | _ as char
+    { Template.Buffer.add_char char;
       raw_block_string lexbuf
     }
   | eof
@@ -289,7 +375,7 @@ and escape_sequence = parse
     { Lexing.new_line lexbuf;
       Newline }
   | '%'
-    { Template.Buffer.add_text_c '%';
+    { Template.Buffer.add_char '%';
       Other
     }
   | ['\\' '\'' '"' 'n' 't' 'b' 'r'] as c
@@ -301,7 +387,7 @@ and escape_sequence = parse
         | 't' -> '\t'
         | _   -> c
       in
-      Template.Buffer.add_text_c c;
+      Template.Buffer.add_char c;
       Other
     }
   | (digit as c1) (digit as c2) (digit as c3)
@@ -309,7 +395,7 @@ and escape_sequence = parse
       if v > 255 then
         error lexbuf "escape sequence in quoted string out of range"
           ~delta:(-1);
-      Template.Buffer.add_text_c (Char.chr v);
+      Template.Buffer.add_char (Char.chr v);
       Other
     }
   | digit digit digit
@@ -320,7 +406,7 @@ and escape_sequence = parse
     }
   | 'x' (hexdigit as c1) (hexdigit as c2)
     { let v = eval_hex_escape c1 c2 in
-      Template.Buffer.add_text_c (Char.chr v);
+      Template.Buffer.add_char (Char.chr v);
       Other
     }
   | 'x' hexdigit?
diff --git a/src/dune_sexp/parser.ml b/src/dune_sexp/parser.ml
index 0cb0fd16a0f..cbdaf20b354 100644
--- a/src/dune_sexp/parser.ml
+++ b/src/dune_sexp/parser.ml
@@ -2,131 +2,63 @@ open Stdune
 
 let error (loc : Loc.t) message = User_error.raise ~loc [ Pp.text message ]
 
-(* To avoid writing two parsers, one for the Cst and one for the Ast, we write
-   only one that work for both.
-
-   The natural thing to do would be to have parser that produce [Cst.t] value
-   and drop comment for the [Ast.t] one. However the most used parser is the one
-   producing Ast one, so it is the one we want to go fast. As a result, we
-   encode comment as special [Ast.t] values and decode them for the [Cst.t]
-   parser.
-
-   We could also do clever things with GADTs, but it will add type variables
-   everywhere which is annoying. *)
-module Encoded : sig
-  type t
-
-  val template : Template.t -> t
-  val atom : Loc.t -> Atom.t -> t
-  val quoted_string : Loc.t -> string -> t
-  val comment : Loc.t -> string list -> t
-  val list : Loc.t -> t list -> t
-  val to_csts : t list -> Cst.t list
-  val to_asts : t list -> Ast.t list
-end = struct
-  open Ast
-
-  type t = Ast.t
-
-  let comment_marker : Template.t =
-    (* In this value, both the location and template values are non-sensical:
-
-       - the location ends before it starts
-
-       - the template is empty and un-quoted *)
-    let loc : Loc.t =
-      Loc.create
-        ~start:{ pos_fname = ""; pos_cnum = -1; pos_lnum = -1; pos_bol = -1 }
-        ~stop:{ pos_fname = ""; pos_cnum = -2; pos_lnum = -2; pos_bol = -2 }
-    in
-    { loc; parts = []; quoted = false }
-  ;;
-
-  let template t =
-    assert (t <> comment_marker);
-    Template t
-  ;;
-
-  let atom loc a = Atom (loc, a)
-  let quoted_string loc s = Quoted_string (loc, s)
-
-  let comment loc lines =
-    List
-      ( loc
-      , Template comment_marker
-        :: List.map lines ~f:(fun line -> Quoted_string (Loc.none, line)) )
-  ;;
-
-  let list loc l = List (loc, l)
-  let to_asts l = l
-
-  let rec to_cst (x : Ast.t) : Cst.t =
-    match x with
-    | Template t -> Template t
-    | Quoted_string (loc, s) -> Quoted_string (loc, s)
-    | Atom (loc, a) -> Atom (loc, a)
-    | List (loc, Template x :: l) when x = comment_marker ->
-      Comment
-        ( loc
-        , List.map l ~f:(function
-            | Quoted_string (_, s) -> s
-            | _ -> assert false) )
-    | List (loc, l) -> List (loc, to_csts l)
-
-  and to_csts l = List.map l ~f:to_cst
-end
-
 module Mode = struct
   type 'a t =
     | Single : Ast.t t
     | Many : Ast.t list t
     | Many_as_one : Ast.t t
     | Cst : Cst.t list t
-
-  let with_comments : type a. a t -> bool = function
-    | Single -> false
-    | Many -> false
-    | Many_as_one -> false
-    | Cst -> true
-  ;;
-
-  let make_result : type a. a t -> Lexing.lexbuf -> Encoded.t list -> a =
-    fun t lexbuf sexps ->
-    match t with
-    | Single ->
-      (match Encoded.to_asts sexps with
-       | [ sexp ] -> sexp
-       | [] -> error (Loc.of_lexbuf lexbuf) "no s-expression found in input"
-       | _ :: sexp :: _ -> error (Ast.loc sexp) "too many s-expressions found in input")
-    | Many -> Encoded.to_asts sexps
-    | Many_as_one ->
-      (match Encoded.to_asts sexps with
-       | [] -> List (Loc.in_file (Path.of_string lexbuf.lex_curr_p.pos_fname), [])
-       | x :: l ->
-         let last = List.fold_left l ~init:x ~f:(fun _ x -> x) in
-         let loc = Loc.set_stop (Ast.loc x) (Ast.loc last |> Loc.stop) in
-         List (loc, x :: l))
-    | Cst -> Encoded.to_csts sexps
-  ;;
 end
 
-let rec loop with_comments depth lexer lexbuf acc =
-  match (lexer ~with_comments lexbuf : Lexer.Token.t) with
-  | Atom a ->
-    let loc = Loc.of_lexbuf lexbuf in
-    loop with_comments depth lexer lexbuf (Encoded.atom loc a :: acc)
-  | Quoted_string s ->
-    let loc = Loc.of_lexbuf lexbuf in
-    loop with_comments depth lexer lexbuf (Encoded.quoted_string loc s :: acc)
-  | Template t ->
-    let loc = Loc.of_lexbuf lexbuf in
-    loop with_comments depth lexer lexbuf (Encoded.template { t with loc } :: acc)
+let rec loop_ast depth lexer lexbuf acc =
+  match (lexer ~with_comments:false lexbuf : Lexer.Token.t) with
+  | Atom atom ->
+    let sexp = Ast.Atom (Loc.of_lexbuf lexbuf, atom) in
+    loop_ast depth lexer lexbuf (sexp :: acc)
+  | Quoted_string string ->
+    let sexp = Ast.Quoted_string (Loc.of_lexbuf lexbuf, string) in
+    loop_ast depth lexer lexbuf (sexp :: acc)
+  | Block_string block_string ->
+    let sexp = Block_string.to_ast ~loc:(Loc.of_lexbuf lexbuf) block_string in
+    loop_ast depth lexer lexbuf (sexp :: acc)
+  | Template template ->
+    let sexp = Ast.Template { template with loc = Loc.of_lexbuf lexbuf } in
+    loop_ast depth lexer lexbuf (sexp :: acc)
+  | Lparen ->
+    let start = Lexing.lexeme_start_p lexbuf in
+    let sexps = loop_ast (depth + 1) lexer lexbuf [] in
+    let loc = Loc.create ~start ~stop:(Lexing.lexeme_end_p lexbuf) in
+    loop_ast depth lexer lexbuf (Ast.List (loc, sexps) :: acc)
+  | Rparen ->
+    if depth = 0
+    then
+      error (Loc.of_lexbuf lexbuf) "right parenthesis without matching left parenthesis";
+    List.rev acc
+  | Eof ->
+    if depth > 0 then error (Loc.of_lexbuf lexbuf) "unclosed parenthesis at end of input";
+    List.rev acc
+  | Comment _ -> loop_ast depth lexer lexbuf acc
+;;
+
+let rec loop_cst depth lexer lexbuf acc =
+  match (lexer ~with_comments:true lexbuf : Lexer.Token.t) with
+  | Atom atom ->
+    let sexp = Cst.Atom (Loc.of_lexbuf lexbuf, atom) in
+    loop_cst depth lexer lexbuf (sexp :: acc)
+  | Quoted_string string ->
+    let sexp = Cst.Quoted_string (Loc.of_lexbuf lexbuf, string) in
+    loop_cst depth lexer lexbuf (sexp :: acc)
+  | Block_string block_string ->
+    let sexp = Cst.Block_string (Loc.of_lexbuf lexbuf, block_string) in
+    loop_cst depth lexer lexbuf (sexp :: acc)
+  | Template template ->
+    let sexp = Cst.Template { template with loc = Loc.of_lexbuf lexbuf } in
+    loop_cst depth lexer lexbuf (sexp :: acc)
   | Lparen ->
     let start = Lexing.lexeme_start_p lexbuf in
-    let sexps = loop with_comments (depth + 1) lexer lexbuf [] in
-    let stop = Lexing.lexeme_end_p lexbuf in
-    let loc = Loc.create ~start ~stop in
-    loop with_comments depth lexer lexbuf (Encoded.list loc sexps :: acc)
+    let sexps = loop_cst (depth + 1) lexer lexbuf [] in
+    let loc = Loc.create ~start ~stop:(Lexing.lexeme_end_p lexbuf) in
+    loop_cst depth lexer lexbuf (Cst.List (loc, sexps) :: acc)
   | Rparen ->
     if depth = 0
     then
@@ -136,16 +68,27 @@ let rec loop with_comments depth lexer lexbuf acc =
     if depth > 0 then error (Loc.of_lexbuf lexbuf) "unclosed parenthesis at end of input";
     List.rev acc
   | Comment lines ->
-    if not with_comments
-    then loop false depth lexer lexbuf acc
-    else (
-      let loc = Loc.of_lexbuf lexbuf in
-      loop with_comments depth lexer lexbuf (Encoded.comment loc lines :: acc))
+    let sexp = Cst.Comment (Loc.of_lexbuf lexbuf, lines) in
+    loop_cst depth lexer lexbuf (sexp :: acc)
 ;;
 
-let parse ~mode ?(lexer = Lexer.token) lexbuf =
-  let with_comments = Mode.with_comments mode in
-  loop with_comments 0 lexer lexbuf [] |> Mode.make_result mode lexbuf
+let parse : type result. mode:result Mode.t -> ?lexer:Lexer.t -> Lexing.lexbuf -> result =
+  fun ~mode ?(lexer = Lexer.token) lexbuf ->
+  match mode with
+  | Cst -> loop_cst 0 lexer lexbuf []
+  | Single ->
+    (match loop_ast 0 lexer lexbuf [] with
+     | [ sexp ] -> sexp
+     | [] -> error (Loc.of_lexbuf lexbuf) "no s-expression found in input"
+     | _ :: sexp :: _ -> error (Ast.loc sexp) "too many s-expressions found in input")
+  | Many -> loop_ast 0 lexer lexbuf []
+  | Many_as_one ->
+    (match loop_ast 0 lexer lexbuf [] with
+     | [] -> Ast.List (Loc.in_file (Path.of_string lexbuf.lex_curr_p.pos_fname), [])
+     | sexp :: sexps ->
+       let last = List.fold_left sexps ~init:sexp ~f:(fun _ sexp -> sexp) in
+       let loc = Loc.set_stop (Ast.loc sexp) (Loc.stop (Ast.loc last)) in
+       Ast.List (loc, sexp :: sexps))
 ;;
 
 let parse_string ~fname ~mode ?lexer str =
diff --git a/src/dune_sexp/t.ml b/src/dune_sexp/t.ml
index db1bfc8278f..d706054d33d 100644
--- a/src/dune_sexp/t.ml
+++ b/src/dune_sexp/t.ml
@@ -65,6 +65,6 @@ let rec to_sexp = function
   | Atom (A s) -> Sexp.Atom s
   | List s -> List (List.map ~f:to_sexp s)
   | Quoted_string s -> List [ Atom "quoted"; Atom s ]
-  | Template ({ quoted; parts = _; loc = _ } as t) ->
+  | Template ({ quoted; _ } as t) ->
     List [ Atom "template"; Atom (Bool.to_string quoted); Atom (Template.to_string t) ]
 ;;
diff --git a/src/dune_sexp/template.ml b/src/dune_sexp/template.ml
index 96e07334635..d8c73a42f19 100644
--- a/src/dune_sexp/template.ml
+++ b/src/dune_sexp/template.ml
@@ -134,6 +134,14 @@ module Part = struct
     | Text s -> Text s
     | Pform v -> Pform { v with loc = Loc.none }
   ;;
+
+  let list_to_string parts =
+    String.concat
+      ~sep:""
+      (List.map parts ~f:(function
+         | Text s -> s
+         | Pform pf -> Pform.to_string pf))
+  ;;
 end
 
 type t =
diff --git a/src/dune_sexp/template.mli b/src/dune_sexp/template.mli
index 794db3de081..013c45992b7 100644
--- a/src/dune_sexp/template.mli
+++ b/src/dune_sexp/template.mli
@@ -56,6 +56,7 @@ module Part : sig
     | Pform of Pform.t
 
   val repr : t Repr.t
+  val list_to_string : t list -> string
 end
 
 type t =
diff --git a/test/blackbox-tests/test-cases/formatting/format-dune-file.t/run.t b/test/blackbox-tests/test-cases/formatting/format-dune-file.t/run.t
index f12202536a5..9e5924f97f2 100644
--- a/test/blackbox-tests/test-cases/formatting/format-dune-file.t/run.t
+++ b/test/blackbox-tests/test-cases/formatting/format-dune-file.t/run.t
@@ -89,23 +89,42 @@ The same file, but in the current version:
     (action
      (run %{project_root}/src/let-syntax/pp.exe %{input-file}))))
 
-In multi-line strings, newlines are escaped, but their syntax is not preserved.
+For dune-lang >= 3.25, multi-line block strings are preserved:
 
-  $ dune format-dune-file <<EOF
+  $ dune format-dune-file --dune-version 3.25 <<EOF
+  > (echo "\> multi
+  >       "\> line
+  >       "\> string
+  >       "\| string
+  > )
+  > EOF
+  (echo
+   "\> multi
+   "\> line
+   "\> string
+   "\| string
+   )
+
+For older versions, multi-line strings are escaped:
+
+  $ dune format-dune-file --dune-version 3.24 <<EOF
   > (echo "\> multi
   >       "\> line
   >       "\> string
   >       "\| string
   > )
-  > 
+  > EOF
+  (echo "multi\nline\nstring\nstring\n")
+
+Regular quoted strings with embedded newlines are always escaped:
+
+  $ dune format-dune-file <<EOF
   > (echo "\
   > multi
   > line
   > string
   > ")
   > EOF
-  (echo "multi\nline\nstring\nstring\n")
-  
   (echo "multi\nline\nstring\n")
 
 Comments are preserved.
@@ -309,3 +328,31 @@ within Dune is always the directory directly containing the file.
    bbbbbbbbbbbbb
    ccccccccccccccccc
    dddddddddddddddddd)
+
+Using block strings for long bash commands (>= 3.25) preserves line breaks:
+
+  $ dune format-dune-file --dune-version 3.25 <<EOF
+  > (rule
+  >  (targets jumptbl.h)
+  >  (mode fallback)
+  >  (deps
+  >   (:h instruct.h))
+  >  (action
+  >   (with-stdout-to
+  >    %{targets}
+  >    (bash "\> cat "%{h}" | tr -d '\r' |
+  >          "\>   sed -n -e '/^  /s/ \([A-Z]\)/ \&\&lbl_\1/gp' -e '/^}/q'
+  > ))))
+  > EOF
+  (rule
+   (targets jumptbl.h)
+   (mode fallback)
+   (deps
+    (:h instruct.h))
+   (action
+    (with-stdout-to
+     %{targets}
+     (bash
+      "\> cat "%{h}" | tr -d '\r' |
+      "\>   sed -n -e '/^  /s/ \([A-Z]\)/ \&\&lbl_\1/gp' -e '/^}/q'
+      ))))
diff --git a/test/expect-tests/dune_sexp/dune b/test/expect-tests/dune_sexp/dune
index ec3019c27a4..60124484f6a 100644
--- a/test/expect-tests/dune_sexp/dune
+++ b/test/expect-tests/dune_sexp/dune
@@ -5,6 +5,7 @@
   dune_tests_common
   stdune
   dune_sexp
+  dune_lang
   ;; This is because of the (implicit_transitive_deps false)
   ;; in dune-project
   ppx_expect.config
diff --git a/test/expect-tests/dune_sexp/multiline_string_tests.ml b/test/expect-tests/dune_sexp/multiline_string_tests.ml
new file mode 100644
index 00000000000..0fa9e212746
--- /dev/null
+++ b/test/expect-tests/dune_sexp/multiline_string_tests.ml
@@ -0,0 +1,385 @@
+open Stdune
+
+let feature_ver = 3, 25
+let before_feature_ver = 3, 24
+let parse_csts input = Dune_sexp.Parser.parse_string ~fname:"test" ~mode:Cst input
+
+let print_csts input =
+  List.iter (parse_csts input) ~f:(fun cst ->
+    print_endline (Dune_sexp.Cst.to_dyn cst |> Dyn.to_string))
+;;
+
+let print_abstract_csts input =
+  List.iter (parse_csts input) ~f:(fun cst ->
+    match Dune_sexp.Cst.abstract cst with
+    | None -> print_endline "None"
+    | Some ast ->
+      let sexp = Dune_sexp.Ast.remove_locs ast in
+      print_endline (Dune_sexp.to_dyn sexp |> Dyn.to_string))
+;;
+
+let ast_without_locs input =
+  Dune_sexp.Parser.parse_string ~fname:"test" ~mode:Single input
+  |> Dune_sexp.Ast.remove_locs
+;;
+
+let format_round_trip ~version input =
+  let formatted = Dune_lang.Format.format_string ~version input in
+  let reformatted = Dune_lang.Format.format_string ~version formatted in
+  let before = Dune_sexp.to_dyn (ast_without_locs input) |> Dyn.to_string in
+  let after = Dune_sexp.to_dyn (ast_without_locs formatted) |> Dyn.to_string in
+  if not (String.equal before after)
+  then
+    Code_error.raise
+      "formatting changed block string semantics"
+      [ "before", Dyn.string before; "after", Dyn.string after ];
+  if not (String.equal formatted reformatted)
+  then
+    Code_error.raise
+      "block string formatting is not idempotent"
+      [ "formatted", Dyn.string formatted; "reformatted", Dyn.string reformatted ];
+  formatted
+;;
+
+let format_feature input = format_round_trip ~version:feature_ver input
+
+let print_format_round_trip input =
+  format_feature input |> Printf.printf "formatted: %S\n"
+;;
+
+(* ==================== Parsing Tests ====================
+   These tests verify the data structure produced by parsing block strings. *)
+
+let%expect_test "parse: basic block string" =
+  let input =
+    {|"\| hello
+"\| world
+|}
+  in
+  print_csts input;
+  [%expect
+    {|
+    Block_string
+      [ (Escaped, [ Text "hello" ]); (Escaped, [ Text "world" ]); (Escaped, []) ]
+    |}]
+;;
+
+let%expect_test "parse: block string in list" =
+  let input =
+    {|(echo "\| hello
+      "\| world
+)|}
+  in
+  print_csts input;
+  [%expect
+    {|
+    List
+      [ Atom (A "echo")
+      ; Block_string
+          [ (Escaped, [ Text "hello" ])
+          ; (Escaped, [ Text "world" ])
+          ; (Escaped, [])
+          ]
+      ]
+    |}]
+;;
+
+let%expect_test "parse: mixed block kinds (escaped and raw)" =
+  let input =
+    {|"\| first
+"\> second
+"\| third
+|}
+  in
+  print_csts input;
+  [%expect
+    {|
+    Block_string
+      [ (Escaped, [ Text "first" ])
+      ; (Raw, [ Text "second" ])
+      ; (Escaped, [ Text "third" ])
+      ; (Escaped, [])
+      ]
+    |}]
+;;
+
+let%expect_test "parse: empty block string" =
+  let input =
+    {|"\|
+|}
+  in
+  print_csts input;
+  [%expect {| Block_string [ (Escaped, []); (Escaped, []) ] |}]
+;;
+
+let%expect_test "parse: block string with pform" =
+  let input =
+    {|"\| hello %{name}
+"\| world
+|}
+  in
+  print_csts input;
+  [%expect
+    {|
+    Block_string
+      [ (Escaped, [ Text "hello "; Pform { name = "name"; payload = None } ])
+      ; (Escaped, [ Text "world" ])
+      ; (Escaped, [])
+      ]
+    |}]
+;;
+
+let%expect_test "parse: \\n escape in block string creates line break" =
+  let input =
+    {|"\| line one\nline two
+|}
+  in
+  print_csts input;
+  [%expect
+    {|
+    Block_string
+      [ (Escaped, [ Text "line one" ])
+      ; (Escaped, [ Text "line two" ])
+      ; (Escaped, [])
+      ]
+    |}]
+;;
+
+let%expect_test "parse: raw block string preserves backslash-n literal" =
+  let input =
+    {|"\> echo \n something
+|}
+  in
+  print_csts input;
+  [%expect {| Block_string [ (Raw, [ Text "echo \\n something" ]); (Raw, []) ] |}]
+;;
+
+(* ==================== Round-trip / Formatting Tests ====================
+   These tests verify that formatting produces correct output and is idempotent. *)
+
+let%expect_test "format: block string with feature version" =
+  let input =
+    {|"\| hello
+"\| world
+|}
+  in
+  let output = format_feature input in
+  print_endline output;
+  [%expect
+    {|
+    "\| hello
+    "\| world
+  |}]
+;;
+
+let%expect_test "format: block string with older version (fallback)" =
+  let input =
+    {|"\| hello
+"\| world
+|}
+  in
+  let output = format_round_trip ~version:before_feature_ver input in
+  print_endline output;
+  [%expect {| "hello\nworld\n" |}]
+;;
+
+let%expect_test "format: escaped pforms with older version" =
+  let input =
+    {|"\| %{name}
+|}
+  in
+  format_round_trip ~version:before_feature_ver input |> print_string;
+  [%expect {| "%{name}\n" |}]
+;;
+
+let%expect_test "format: raw pform-like text with older version" =
+  let input =
+    {|"\> %{name}
+|}
+  in
+  format_round_trip ~version:before_feature_ver input |> print_string;
+  [%expect {| "\%{name}\n" |}]
+;;
+
+let%expect_test "format: mixed block kinds preserves each line's kind" =
+  let input =
+    {|"\> first
+"\| second
+|}
+  in
+  let output = format_feature input in
+  print_endline output;
+  [%expect
+    {|
+    "\> first
+    "\| second
+    |}]
+;;
+
+let%expect_test "format: empty block string" =
+  let input =
+    {|"\|
+|}
+  in
+  let output = format_feature input in
+  print_endline output;
+  [%expect
+    {|
+    "\|
+  |}]
+;;
+
+let%expect_test "format: block string with pform" =
+  let input =
+    {|"\| hello %{name}
+"\| world
+|}
+  in
+  let output = format_feature input in
+  print_endline output;
+  [%expect
+    {|
+    "\| hello %{name}
+    "\| world
+    |}]
+;;
+
+let%expect_test "format: \\n escape formats as multi-line" =
+  let input =
+    {|"\| line one\nline two
+|}
+  in
+  let output = format_feature input in
+  print_endline output;
+  [%expect
+    {|
+    "\| line one
+    "\| line two
+    |}]
+;;
+
+let%expect_test "format: raw block string preserves backslash-n" =
+  let input =
+    {|"\> echo \n something
+|}
+  in
+  let output = format_feature input in
+  print_endline output;
+  [%expect
+    {|
+    "\> echo \n something
+    |}]
+;;
+
+(* ==================== CST to AST Conversion Tests ====================
+   These tests verify that block strings with pforms are correctly converted
+   to Templates when abstracting CST to AST. *)
+
+let%expect_test "abstract: block string without pforms becomes Quoted_string" =
+  let input =
+    {|"\| hello world
+|}
+  in
+  print_abstract_csts input;
+  [%expect
+    {|
+    "hello world\n\
+     "
+    |}]
+;;
+
+let%expect_test "abstract: block string with pform becomes Template" =
+  let input =
+    {|"\| hello %{name}
+|}
+  in
+  print_abstract_csts input;
+  (* Block strings with pforms become Templates so the pforms get expanded *)
+  [%expect {| template "\"hello %{name}\\n\"" |}]
+;;
+
+let%expect_test "round-trip: escaped block string contents" =
+  print_format_round_trip
+    {|"\| \%{literal} \\n
+|};
+  [%expect {| formatted: "\"\\| \\%{literal} \\\\n\n" |}]
+;;
+
+let%expect_test "round-trip: escaped continuation before a raw line" =
+  print_format_round_trip
+    {|"\| %{x}\
+"\> literal
+|};
+  [%expect {| formatted: "\"\\| %{x}literal\n" |}]
+;;
+
+let%expect_test "round-trip: CRLF block string" =
+  print_format_round_trip "\"\\| value\r\n";
+  [%expect {| formatted: "\"\\| value\\r\n" |}]
+;;
+
+let%expect_test "round-trip: block string without a final newline" =
+  print_format_round_trip {|"\| value|};
+  [%expect {| formatted: "\"value\"\n" |}]
+;;
+
+let%expect_test "format: empty block string without a final newline" =
+  format_feature {|"\| |} |> Printf.printf "%S\n";
+  [%expect {| "\"\"\n" |}]
+;;
+
+let%expect_test "format: block string nested in singleton lists" =
+  format_feature
+    {|(("\| value
+"\> next
+))|}
+  |> print_string;
+  [%expect
+    {|
+    (("\| value
+      "\> next
+      ))
+    |}]
+;;
+
+let%expect_test "format: numeric newline escape in a block string" =
+  format_feature
+    {|"\| before\010after
+|}
+  |> Printf.printf "%S\n";
+  [%expect {| "\"\\| before\n\"\\| after\n" |}]
+;;
+
+let%expect_test "round-trip: raw CRLF block string" =
+  print_format_round_trip "\"\\> %{literal}\r\n";
+  [%expect {| formatted: "\"\\| \\%{literal}\\r\n" |}]
+;;
+
+let%expect_test "round-trip: raw block string without a final newline" =
+  print_format_round_trip {|"\> value|};
+  [%expect {| formatted: "\"value\"\n" |}]
+;;
+
+let%expect_test "round-trip: consecutive block strings" =
+  print_format_round_trip
+    {|(items "\| first
+
+"\> second
+)|};
+  [%expect {| formatted: "(items\n \"\\| first\n \n \"\\> second\n )\n" |}]
+;;
+
+let%expect_test "format: block string followed by another list element" =
+  format_feature
+    {|(items "\| first
+"\| second
+tail)|}
+  |> print_string;
+  [%expect
+    {|
+    (items
+     "\| first
+     "\| second
+     tail)
+    |}]
+;;