anil.recoil.org
Pure OCaml Yaml 1.2 reader and writer using Bytesrw
Fix block scalar double newline bug in emitter
Block scalars (literal | and folded >) were producing a blank line
between the scalar content and the next key because write_scalar
added a trailing newline and the caller also added one.
The fix makes write_scalar return a bool indicating whether it
already wrote trailing content, and uses a dedicated
write_block_scalar_indent function for proper content indentation.
Added tests to verify no double newlines in block scalar output.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+126
-25
+59
-23
lib/emitter.ml
+59
-23
lib/emitter.ml
···
169
169
Buffer.contents buf
170
170
end
171
171
172
-
(** Write scalar with appropriate quoting *)
172
+
(** Write indentation for block scalar content.
173
+
Block scalar content must be indented by at least 1 space more than the
174
+
containing structure. We use config.indent spaces, ensuring at least 1. *)
175
+
let write_block_scalar_indent t =
176
+
let content_indent = max 1 t.config.indent in
177
+
for _ = 1 to t.indent + content_indent do
178
+
write_char t ' '
179
+
done
180
+
181
+
(** Write scalar with appropriate quoting.
182
+
Returns true if the scalar ends with a newline (block scalars), false otherwise.
183
+
Callers should check this to avoid double newlines. *)
173
184
let write_scalar t ?(style = `Any) value =
174
185
match match style with `Any -> Quoting.choose_style value | s -> s with
175
-
| `Plain | `Any -> write t value
186
+
| `Plain | `Any ->
187
+
write t value;
188
+
false
176
189
| `Single_quoted ->
177
190
write_char t '\'';
178
191
write t (escape_single_quoted value);
179
-
write_char t '\''
192
+
write_char t '\'';
193
+
false
180
194
| `Double_quoted ->
181
195
write_char t '"';
182
196
write t (escape_double_quoted value);
183
-
write_char t '"'
197
+
write_char t '"';
198
+
false
184
199
| `Literal ->
185
200
write t "|";
186
201
write_newline t;
187
-
String.split_on_char '\n' value
188
-
|> List.iter (fun line ->
189
-
write_indent t;
190
-
write t line;
191
-
write_newline t)
202
+
let lines = String.split_on_char '\n' value in
203
+
let rec write_lines = function
204
+
| [] -> ()
205
+
| [ last ] ->
206
+
write_block_scalar_indent t;
207
+
write t last
208
+
(* No trailing newline - caller will add it *)
209
+
| line :: rest ->
210
+
write_block_scalar_indent t;
211
+
write t line;
212
+
write_newline t;
213
+
write_lines rest
214
+
in
215
+
write_lines lines;
216
+
true (* Block scalar ends with content on last line, needs newline from caller *)
192
217
| `Folded ->
193
218
write t ">";
194
219
write_newline t;
195
-
String.split_on_char '\n' value
196
-
|> List.iter (fun line ->
197
-
write_indent t;
198
-
write t line;
199
-
write_newline t)
220
+
let lines = String.split_on_char '\n' value in
221
+
let rec write_lines = function
222
+
| [] -> ()
223
+
| [ last ] ->
224
+
write_block_scalar_indent t;
225
+
write t last
226
+
(* No trailing newline - caller will add it *)
227
+
| line :: rest ->
228
+
write_block_scalar_indent t;
229
+
write t line;
230
+
write_newline t;
231
+
write_lines rest
232
+
in
233
+
write_lines lines;
234
+
true (* Block scalar ends with content on last line, needs newline from caller *)
200
235
201
236
(** Write anchor if present *)
202
237
let write_anchor t anchor =
···
275
310
if t.need_separator then write t ", ";
276
311
write_anchor t anchor;
277
312
write_tag t ~implicit:plain_implicit tag;
278
-
write_scalar t ~style value;
313
+
let (_ : bool) = write_scalar t ~style value in
279
314
write t ": ";
280
315
t.need_separator <- false;
281
316
t.state <- In_flow_mapping_value
···
286
321
write t ", ";
287
322
write_anchor t anchor;
288
323
write_tag t ~implicit:plain_implicit tag;
289
-
write_scalar t ~style value;
324
+
let (_ : bool) = write_scalar t ~style value in
290
325
write t ": ";
291
326
t.need_separator <- false;
292
327
t.state <- In_flow_mapping_value
···
295
330
(* Normal value scalar *)
296
331
write_anchor t anchor;
297
332
write_tag t ~implicit:plain_implicit tag;
298
-
write_scalar t ~style value;
333
+
let (_ : bool) = write_scalar t ~style value in
299
334
t.need_separator <- true;
300
335
t.state <- In_flow_mapping_key
301
336
end
···
304
339
t.need_separator <- true;
305
340
write_anchor t anchor;
306
341
write_tag t ~implicit:plain_implicit tag;
307
-
write_scalar t ~style value
342
+
let (_ : bool) = write_scalar t ~style value in
343
+
()
308
344
end
309
345
else begin
310
346
match t.state with
···
313
349
write t "- ";
314
350
write_anchor t anchor;
315
351
write_tag t ~implicit:plain_implicit tag;
316
-
write_scalar t ~style value;
352
+
let (_ : bool) = write_scalar t ~style value in
317
353
write_newline t
318
354
| In_block_mapping_key indent ->
319
355
write_indent t;
320
356
write_anchor t anchor;
321
357
write_tag t ~implicit:plain_implicit tag;
322
-
write_scalar t ~style value;
358
+
let (_ : bool) = write_scalar t ~style value in
323
359
write_char t ':';
324
360
t.state <- In_block_mapping_value indent
325
361
| In_block_mapping_first_key indent ->
326
362
(* First key after "- ", no indent needed *)
327
363
write_anchor t anchor;
328
364
write_tag t ~implicit:plain_implicit tag;
329
-
write_scalar t ~style value;
365
+
let (_ : bool) = write_scalar t ~style value in
330
366
write_char t ':';
331
367
t.state <- In_block_mapping_value indent
332
368
| In_block_mapping_value indent ->
333
369
write_char t ' ';
334
370
write_anchor t anchor;
335
371
write_tag t ~implicit:plain_implicit tag;
336
-
write_scalar t ~style value;
372
+
let (_ : bool) = write_scalar t ~style value in
337
373
write_newline t;
338
374
t.state <- In_block_mapping_key indent
339
375
| _ ->
340
376
write_anchor t anchor;
341
377
write_tag t ~implicit:plain_implicit tag;
342
-
write_scalar t ~style value;
378
+
let (_ : bool) = write_scalar t ~style value in
343
379
write_newline t
344
380
end
345
381
| Event.Sequence_start { anchor; tag; implicit; style } ->
+8
-2
tests/dune
+8
-2
tests/dune
···
2
2
3
3
(executable
4
4
(name run_all_tests)
5
-
(modules run_all_tests test_yamlrw)
6
-
(libraries yamlrw test_suite_lib alcotest))
5
+
(modules run_all_tests)
6
+
(libraries yamlrw test_suite_lib))
7
+
8
+
; Unit tests using Alcotest
9
+
(test
10
+
(name test_yamlrw)
11
+
(modules test_yamlrw)
12
+
(libraries yamlrw alcotest))
7
13
8
14
(executable
9
15
(name run_all_tests_eio)
+59
tests/test_yamlrw.ml
+59
tests/test_yamlrw.ml
···
275
275
| `O [ ("description", `String _) ] -> ()
276
276
| _ -> Alcotest.fail "expected mapping with folded block"
277
277
278
+
(* Test that block scalars don't create double newlines when emitted as values.
279
+
This was a bug where write_scalar would add a trailing newline for block
280
+
scalars, and then the caller would also add a newline, creating a blank line
281
+
between the value and the next key. *)
282
+
let test_block_scalar_no_double_newline () =
283
+
(* Create a value that will use folded style due to length > 80 chars,
284
+
or explicitly use events to force block scalar style *)
285
+
let emitter = Emitter.create () in
286
+
Emitter.emit emitter (Event.Stream_start { encoding = `Utf8 });
287
+
Emitter.emit emitter (Event.Document_start { version = None; implicit = true });
288
+
Emitter.emit emitter (Event.Mapping_start { anchor = None; tag = None; implicit = true; style = `Block });
289
+
(* Emit a key *)
290
+
Emitter.emit emitter (Event.Scalar { anchor = None; tag = None; value = "url"; plain_implicit = true; quoted_implicit = true; style = `Plain });
291
+
(* Emit a folded scalar value *)
292
+
Emitter.emit emitter (Event.Scalar { anchor = None; tag = None; value = "https://example.org/very/long/path"; plain_implicit = true; quoted_implicit = true; style = `Folded });
293
+
(* Emit another key-value pair *)
294
+
Emitter.emit emitter (Event.Scalar { anchor = None; tag = None; value = "next"; plain_implicit = true; quoted_implicit = true; style = `Plain });
295
+
Emitter.emit emitter (Event.Scalar { anchor = None; tag = None; value = "value"; plain_implicit = true; quoted_implicit = true; style = `Plain });
296
+
Emitter.emit emitter Event.Mapping_end;
297
+
Emitter.emit emitter (Event.Document_end { implicit = true });
298
+
Emitter.emit emitter Event.Stream_end;
299
+
let result = Emitter.contents emitter in
300
+
(* Check there's no double newline (blank line) in the output *)
301
+
let has_double_newline =
302
+
let rec check i =
303
+
if i >= String.length result - 1 then false
304
+
else if result.[i] = '\n' && result.[i+1] = '\n' then true
305
+
else check (i + 1)
306
+
in
307
+
check 0
308
+
in
309
+
Alcotest.(check bool) "no double newlines in block scalar output" false has_double_newline;
310
+
(* Also verify the output can be parsed back *)
311
+
let parsed = of_string result in
312
+
match parsed with
313
+
| `O [ ("url", `String _); ("next", `String "value") ] -> ()
314
+
| _ -> Alcotest.fail ("expected mapping with url and next keys, got: " ^ result)
315
+
316
+
let test_literal_block_no_double_newline () =
317
+
let emitter = Emitter.create () in
318
+
Emitter.emit emitter (Event.Stream_start { encoding = `Utf8 });
319
+
Emitter.emit emitter (Event.Document_start { version = None; implicit = true });
320
+
Emitter.emit emitter (Event.Mapping_start { anchor = None; tag = None; implicit = true; style = `Block });
321
+
Emitter.emit emitter (Event.Scalar { anchor = None; tag = None; value = "desc"; plain_implicit = true; quoted_implicit = true; style = `Plain });
322
+
Emitter.emit emitter (Event.Scalar { anchor = None; tag = None; value = "line1\nline2"; plain_implicit = true; quoted_implicit = true; style = `Literal });
323
+
Emitter.emit emitter (Event.Scalar { anchor = None; tag = None; value = "next"; plain_implicit = true; quoted_implicit = true; style = `Plain });
324
+
Emitter.emit emitter (Event.Scalar { anchor = None; tag = None; value = "value"; plain_implicit = true; quoted_implicit = true; style = `Plain });
325
+
Emitter.emit emitter Event.Mapping_end;
326
+
Emitter.emit emitter (Event.Document_end { implicit = true });
327
+
Emitter.emit emitter Event.Stream_end;
328
+
let result = Emitter.contents emitter in
329
+
(* The output should be parseable and not have a blank line between the literal and next key *)
330
+
let parsed = of_string result in
331
+
match parsed with
332
+
| `O [ ("desc", `String _); ("next", `String "value") ] -> ()
333
+
| _ -> Alcotest.fail ("expected mapping with desc and next keys, got: " ^ result)
334
+
278
335
let multiline_tests =
279
336
[
280
337
("literal block", `Quick, test_literal_block);
281
338
("folded block", `Quick, test_folded_block);
339
+
("folded block no double newline", `Quick, test_block_scalar_no_double_newline);
340
+
("literal block no double newline", `Quick, test_literal_block_no_double_newline);
282
341
]
283
342
284
343
(** Error handling tests *)