+3

yaml/ocaml-yamle/lib/error.ml

reviewed

··· 20 20 | Invalid_flow_indentation (** Content in flow collection must be indented *) 21 21 | Tab_in_indentation 22 22 | Invalid_block_scalar_header of string 23 23 + | Invalid_quoted_scalar_indentation of string 23 24 | Invalid_directive of string 24 25 | Invalid_yaml_version of string 25 26 | Invalid_tag_directive of string ··· 121 122 | Tab_in_indentation -> "tab character in indentation" 122 123 | Invalid_block_scalar_header s -> 123 124 Printf.sprintf "invalid block scalar header: %s" s 125 125 + | Invalid_quoted_scalar_indentation s -> 126 126 + Printf.sprintf "%s" s 124 127 | Invalid_directive s -> Printf.sprintf "invalid directive: %s" s 125 128 | Invalid_yaml_version s -> Printf.sprintf "invalid YAML version: %s" s 126 129 | Invalid_tag_directive s -> Printf.sprintf "invalid TAG directive: %s" s

+39 -3

yaml/ocaml-yamle/lib/parser.ml

reviewed

··· 6 6 | Implicit_document_start 7 7 | Document_start 8 8 | Document_content 9 9 + | Document_content_done (* After parsing a node, check for unexpected content *) 9 10 | Document_end 10 11 | Block_node 11 12 | Block_node_or_indentless_sequence ··· 36 37 mutable tag_directives : (string * string) list; 37 38 mutable current_token : Token.spanned option; 38 39 mutable finished : bool; 40 40 + mutable explicit_doc_end : bool; (** True if last doc ended with explicit ... *) 41 41 + mutable stream_start : bool; (** True if we haven't emitted any documents yet *) 39 42 } 40 43 41 44 let create scanner = { ··· 50 53 ]; 51 54 current_token = None; 52 55 finished = false; 56 56 + explicit_doc_end = false; 57 57 + stream_start = true; 53 58 } 54 59 55 60 let of_string s = create (Scanner.of_string s) ··· 208 213 | None -> Span.point Position.initial 209 214 in 210 215 216 216 + (* After first document, stream_start is false *) 217 217 + t.stream_start <- false; 211 218 push_state t Document_end; 212 219 t.state <- Document_content; 213 220 Event.Document_start { version = t.version; implicit }, span ··· 222 229 223 230 if not implicit then skip_token t; 224 231 232 232 + (* Track if this document ended explicitly with ... *) 233 233 + t.explicit_doc_end <- not implicit; 225 234 t.state <- Implicit_document_start; 226 235 Event.Document_end { implicit }, span 227 236 ··· 599 608 empty_scalar_event ~anchor:None ~tag:None tok.span 600 609 601 610 (** Main state machine dispatcher *) 602 602 - let parse t = 611 611 + let rec parse t = 603 612 match t.state with 604 613 | Stream_start -> 605 614 parse_stream_start t ··· 607 616 | Implicit_document_start -> 608 617 (* Skip any document end markers before checking what's next *) 609 618 while check t (function Token.Document_end -> true | _ -> false) do 619 619 + t.explicit_doc_end <- true; (* Seeing ... counts as explicit end *) 610 620 skip_token t 611 621 done; 612 622 ··· 617 627 t.state <- End; 618 628 t.finished <- true; 619 629 Event.Stream_end, tok.span 620 620 - | Token.Version_directive _ | Token.Tag_directive _ | Token.Document_start -> 630 630 + | Token.Version_directive _ | Token.Tag_directive _ -> 631 631 + (* Directives are only allowed at stream start or after explicit ... (MUS6/01) *) 632 632 + if not t.stream_start && not t.explicit_doc_end then 633 633 + Error.raise_span tok.span (Invalid_directive "directives require explicit document end '...' before them"); 634 634 + parse_document_start t ~implicit:false 635 635 + | Token.Document_start -> 621 636 parse_document_start t ~implicit:false 622 637 (* These tokens are invalid at document start - they indicate leftover junk *) 623 638 | Token.Flow_sequence_end | Token.Flow_mapping_end | Token.Flow_entry ··· 638 653 let tok = current_token t in 639 654 t.state <- pop_state t; 640 655 empty_scalar_event ~anchor:None ~tag:None tok.span 641 641 - end else 656 656 + end else begin 657 657 + (* Push Document_content_done so we return there after parsing the node. 658 658 + This allows us to check for unexpected content after the node. *) 659 659 + push_state t Document_content_done; 642 660 parse_node t ~block:true ~indentless:false 661 661 + end 662 662 + 663 663 + | Document_content_done -> 664 664 + (* After parsing a node in document content, check for unexpected content *) 665 665 + if check t (function 666 666 + | Token.Version_directive _ | Token.Tag_directive _ 667 667 + | Token.Document_start | Token.Document_end | Token.Stream_end -> true 668 668 + | _ -> false) 669 669 + then begin 670 670 + (* Valid document boundary - continue to Document_end *) 671 671 + t.state <- pop_state t; 672 672 + parse t (* Continue to emit the next event *) 673 673 + end else begin 674 674 + (* Unexpected content after document value - this is an error (KS4U, BS4K) *) 675 675 + let tok = current_token t in 676 676 + Error.raise_span tok.span 677 677 + (Unexpected_token "content not allowed after document value") 678 678 + end 643 679 644 680 | Document_end -> 645 681 parse_document_end t

+75 -12

yaml/ocaml-yamle/lib/scanner.ml

reviewed

··· 99 99 done 100 100 end 101 101 102 102 - (** Skip blanks (spaces/tabs) and return whether tabs were found *) 102 102 + (** Skip blanks (spaces/tabs) and return (found_tabs, found_spaces) *) 103 103 let skip_blanks_check_tabs t = 104 104 let found_tab = ref false in 105 105 + let found_space = ref false in 105 106 while Input.next_is_blank t.input do 106 106 - if Input.peek t.input = Some '\t' then found_tab := true; 107 107 + (match Input.peek t.input with 108 108 + | Some '\t' -> found_tab := true 109 109 + | Some ' ' -> found_space := true 110 110 + | _ -> ()); 107 111 ignore (Input.next t.input) 108 112 done; 109 109 - !found_tab 113 113 + (!found_tab, !found_space) 110 114 111 115 (** Skip whitespace and comments, return true if at newline *) 112 116 let rec skip_to_next_token t = ··· 140 144 Input.consume_break t.input; 141 145 (* Allow simple keys after line breaks in flow context *) 142 146 t.allow_simple_key <- true; 147 147 + (* After line break in flow, check for tabs at start of line (Y79Y/03) 148 148 + Tabs are not allowed as indentation - if tab is first char and results 149 149 + in a column less than flow_indent, it's an error *) 150 150 + if Input.next_is (( = ) '\t') t.input then begin 151 151 + (* Tab at start of line in flow context - skip tabs and check position *) 152 152 + let start_mark = Input.mark t.input in 153 153 + while Input.next_is (( = ) '\t') t.input do 154 154 + ignore (Input.next t.input) 155 155 + done; 156 156 + (* If only tabs were used (no spaces) and column < flow_indent, error *) 157 157 + if not (Input.next_is_break t.input) && not (Input.is_eof t.input) && 158 158 + column t < t.flow_indent then 159 159 + Error.raise_at start_mark Invalid_flow_indentation 160 160 + end; 143 161 skip_to_next_token t 144 162 end else begin 145 163 ignore (Input.next t.input); ··· 414 432 (* Check for document boundary *) 415 433 if Input.at_document_boundary t.input then 416 434 Error.raise_at start Unclosed_single_quote; 435 435 + (* Check indentation: continuation must be > block indent (QB6E, DK95) *) 436 436 + let col = column t in 437 437 + let indent = current_indent t in 438 438 + if not (Input.is_eof t.input) && not (Input.next_is_break t.input) && col <= indent && indent >= 0 then 439 439 + Error.raise_at (Input.mark t.input) (Invalid_quoted_scalar_indentation "invalid indentation in quoted scalar"); 417 440 (* Count empty lines (consecutive line breaks) *) 418 441 let empty_lines = ref 0 in 419 442 while Input.next_is_break t.input do ··· 423 446 ignore (Input.next t.input) 424 447 done; 425 448 if Input.at_document_boundary t.input then 426 426 - Error.raise_at start Unclosed_single_quote 449 449 + Error.raise_at start Unclosed_single_quote; 450 450 + (* Check indentation after each empty line too *) 451 451 + let col = column t in 452 452 + let indent = current_indent t in 453 453 + if not (Input.is_eof t.input) && not (Input.next_is_break t.input) && col <= indent && indent >= 0 then 454 454 + Error.raise_at (Input.mark t.input) (Invalid_quoted_scalar_indentation "invalid indentation in quoted scalar") 427 455 done; 428 456 (* Apply folding rules *) 429 457 if !empty_lines > 0 then begin ··· 552 580 (* Count consecutive line breaks (empty lines) *) 553 581 let empty_lines = ref 0 in 554 582 let continue = ref true in 583 583 + let started_with_tab = ref false in 555 584 while !continue do 585 585 + (* Track if we start with a tab (for DK95/01 check) *) 586 586 + if Input.next_is (( = ) '\t') t.input then started_with_tab := true; 556 587 (* Skip blanks (spaces/tabs) on the line *) 557 588 while Input.next_is_blank t.input do 558 589 ignore (Input.next t.input) ··· 560 591 (* Check if we hit another line break (empty line) *) 561 592 if Input.next_is_break t.input then begin 562 593 Input.consume_break t.input; 563 563 - incr empty_lines 594 594 + incr empty_lines; 595 595 + started_with_tab := false (* Reset for next line *) 564 596 end else 565 597 continue := false 566 598 done; 567 599 (* Check for document boundary - this terminates the quoted string *) 568 600 if Input.at_document_boundary t.input then 569 601 Error.raise_at start Unclosed_double_quote; 602 602 + (* Check indentation: continuation must be > block indent (QB6E, DK95) 603 603 + Note: must be strictly greater than block indent, not just equal *) 604 604 + let col = column t in 605 605 + let indent = current_indent t in 606 606 + let start_col = start.column in 607 607 + (* DK95/01: if continuation started with tabs and column < start column, error *) 608 608 + if not (Input.is_eof t.input) && !started_with_tab && col < start_col then 609 609 + Error.raise_at (Input.mark t.input) (Invalid_quoted_scalar_indentation "invalid indentation in quoted scalar"); 610 610 + if not (Input.is_eof t.input) && col <= indent && indent >= 0 then 611 611 + Error.raise_at (Input.mark t.input) (Invalid_quoted_scalar_indentation "invalid indentation in quoted scalar"); 570 612 (* Per YAML spec: single break = space, break + empty lines = newlines *) 571 613 if !empty_lines > 0 then begin 572 614 (* Empty lines: output N newlines where N = number of empty lines *) ··· 775 817 let buf = Buffer.create 256 in 776 818 let trailing_breaks = Buffer.create 16 in 777 819 let leading_blank = ref false in (* Was the previous line "more indented"? *) 820 820 + let max_empty_line_indent = ref 0 in (* Track max indent of empty lines before first content *) 778 821 779 822 (* Skip to content indentation, skipping empty lines. 780 823 Returns the number of spaces actually skipped (important for detecting dedentation). *) ··· 843 886 match Input.peek_nth t.input (!idx) with 844 887 | None | Some '\n' | Some '\r' -> 845 888 (* Line has only spaces - empty line *) 889 889 + (* Track max indent of empty lines for later validation *) 890 890 + if !idx > !max_empty_line_indent then 891 891 + max_empty_line_indent := !idx; 846 892 while Input.next_is (( = ) ' ') t.input do 847 893 ignore (Input.next t.input) 848 894 done; ··· 852 898 | _ -> 853 899 (* Has content (including tabs which are content, not indentation) *) 854 900 0 901 901 + end else if Input.next_is (( = ) '\t') t.input then begin 902 902 + (* Tab at start of line in implicit indent mode - this is an error (Y79Y) 903 903 + because tabs cannot be used as indentation in YAML *) 904 904 + Error.raise_at (Input.mark t.input) Tab_in_indentation 855 905 end else 856 856 - (* Not at break or space - could be tab (content) or other *) 906 906 + (* Not at break or space - other content character *) 857 907 0 858 908 end 859 909 in ··· 887 937 if line_indent <= base_level then 888 938 false (* No content - first line not indented enough *) 889 939 else begin 940 940 + (* Validate: first content line must be indented at least as much as 941 941 + the maximum indent seen on empty lines before it (5LLU, S98Z, W9L4) *) 942 942 + if line_indent < !max_empty_line_indent && line_indent > base_level then 943 943 + Error.raise_at (Input.mark t.input) 944 944 + (Invalid_block_scalar_header "wrongly indented line in block scalar"); 890 945 content_indent := line_indent; 891 946 true 892 947 end ··· 1011 1066 while Input.next_is_digit t.input do 1012 1067 minor := !minor * 10 + (Char.code (Input.next_exn t.input) - Char.code '0') 1013 1068 done; 1069 1069 + (* Validate: only whitespace and comments allowed before line break (MUS6) *) 1070 1070 + skip_whitespace_and_comment t; 1071 1071 + if not (Input.next_is_break t.input) && not (Input.is_eof t.input) then 1072 1072 + Error.raise_at (Input.mark t.input) (Invalid_directive "expected comment or line break after version"); 1014 1073 let span = Span.make ~start ~stop:(Input.mark t.input) in 1015 1074 Token.Version_directive { major = !major; minor = !minor }, span 1016 1075 ··· 1207 1266 ignore (Input.next t.input); 1208 1267 1209 1268 (* Check for tabs after - : pattern like -\t- is invalid *) 1210 1210 - let found_tabs = skip_blanks_check_tabs t in 1269 1269 + let (found_tabs, _found_spaces) = skip_blanks_check_tabs t in 1211 1270 if found_tabs then begin 1212 1271 (* If we found tabs and next char is - followed by whitespace, error *) 1213 1272 match Input.peek t.input with ··· 1248 1307 ignore (Input.next t.input); 1249 1308 1250 1309 (* Check for tabs after ? : pattern like ?\t- or ?\tkey is invalid *) 1251 1251 - let found_tabs = skip_blanks_check_tabs t in 1310 1310 + let (found_tabs, _found_spaces) = skip_blanks_check_tabs t in 1252 1311 if found_tabs && t.flow_level = 0 then begin 1253 1312 (* In block context, tabs after ? are not allowed *) 1254 1313 Error.raise_at start Tab_in_indentation ··· 1344 1403 let start = Input.mark t.input in 1345 1404 ignore (Input.next t.input); 1346 1405 1347 1347 - (* Check for tabs after : : pattern like :\t- is invalid in block context *) 1348 1348 - let found_tabs = skip_blanks_check_tabs t in 1349 1349 - if found_tabs && t.flow_level = 0 then begin 1350 1350 - (* In block context, tabs after : followed by indicator are not allowed *) 1406 1406 + (* Check for tabs after : : patterns like :\t- or :\tkey: are invalid in block context (Y79Y/09) 1407 1407 + However, :\t bar (tab followed by space then content) is valid (6BCT) *) 1408 1408 + let (found_tabs, found_spaces) = skip_blanks_check_tabs t in 1409 1409 + if found_tabs && not found_spaces && t.flow_level = 0 then begin 1410 1410 + (* In block context, tabs-only after : followed by indicator or alphanumeric are not allowed *) 1351 1411 match Input.peek t.input with 1352 1412 | Some ('-' | '?') -> 1413 1413 + Error.raise_at start Tab_in_indentation 1414 1414 + | Some c when (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') -> 1415 1415 + (* Tab-only followed by alphanumeric - likely a key, which is invalid *) 1353 1416 Error.raise_at start Tab_in_indentation 1354 1417 | _ -> () 1355 1418 end;

+8

yaml/ocaml-yamle/tests/dune

reviewed

··· 185 185 (executable (name count_tests) (modules count_tests) (libraries test_suite_lib)) 186 186 (executable (name test_bs4k) (modules test_bs4k) (libraries yamle)) 187 187 (executable (name test_ks4u) (modules test_ks4u) (libraries yamle)) 188 188 + (executable (name test_5llu_quick) (modules test_5llu_quick) (libraries yamle)) 189 189 + (executable (name test_mus6_debug) (modules test_mus6_debug) (libraries yamle)) 190 190 + (executable (name debug_mus6_load) (modules debug_mus6_load) (libraries yamle test_suite_lib)) 191 191 + (executable (name debug_mus6_01) (modules debug_mus6_01) (libraries yamle)) 192 192 + (executable (name debug_dk95_01) (modules debug_dk95_01) (libraries yamle)) 193 193 + (executable (name debug_y79y_first) (modules debug_y79y_first) (libraries yamle)) 194 194 + (executable (name debug_y79y_03) (modules debug_y79y_03) (libraries yamle)) 195 195 + (executable (name debug_y79y_09) (modules debug_y79y_09) (libraries yamle))