+4

yaml/ocaml-yamle/lib/error.ml

reviewed

··· 11 11 | Invalid_tag of string 12 12 | Invalid_anchor of string 13 13 | Invalid_alias of string 14 14 + | Invalid_comment 14 15 | Unclosed_single_quote 15 16 | Unclosed_double_quote 16 17 | Unclosed_flow_sequence 17 18 | Unclosed_flow_mapping 18 19 | Invalid_indentation of int * int (** expected, got *) 20 20 + | Invalid_flow_indentation (** Content in flow collection must be indented *) 19 21 | Tab_in_indentation 20 22 | Invalid_block_scalar_header of string 21 23 | Invalid_directive of string ··· 106 108 | Invalid_tag s -> Printf.sprintf "invalid tag: %s" s 107 109 | Invalid_anchor s -> Printf.sprintf "invalid anchor: %s" s 108 110 | Invalid_alias s -> Printf.sprintf "invalid alias: %s" s 111 111 + | Invalid_comment -> "comments must be separated from other tokens by whitespace" 109 112 | Unclosed_single_quote -> "unclosed single quote" 110 113 | Unclosed_double_quote -> "unclosed double quote" 111 114 | Unclosed_flow_sequence -> "unclosed flow sequence '['" 112 115 | Unclosed_flow_mapping -> "unclosed flow mapping '{'" 113 116 | Invalid_indentation (expected, got) -> 114 117 Printf.sprintf "invalid indentation: expected %d, got %d" expected got 118 118 + | Invalid_flow_indentation -> "invalid indentation in flow construct" 115 119 | Tab_in_indentation -> "tab character in indentation" 116 120 | Invalid_block_scalar_header s -> 117 121 Printf.sprintf "invalid block scalar header: %s" s

+5

yaml/ocaml-yamle/lib/input.ml

reviewed

··· 144 144 145 145 (** Mark current position for span creation *) 146 146 let mark t = t.position 147 147 + 148 148 + (** Get the character before the current position *) 149 149 + let peek_back t = 150 150 + if t.pos <= 0 then None 151 151 + else Some t.source.[t.pos - 1]

+6

yaml/ocaml-yamle/lib/parser.ml

reviewed

··· 460 460 | Token.Flow_sequence_end -> 461 461 t.state <- Flow_sequence_entry; 462 462 empty_scalar_event ~anchor:None ~tag:None tok.span 463 463 + | Token.Flow_entry -> 464 464 + (* Double comma or comma after comma - invalid *) 465 465 + Error.raise_span tok.span (Unexpected_token "unexpected ',' in flow sequence") 463 466 | Token.Key -> 464 467 skip_token t; 465 468 push_state t Flow_sequence_entry_mapping_end; ··· 535 538 skip_token t; 536 539 t.state <- pop_state t; 537 540 Event.Mapping_end, tok.span 541 541 + | Token.Flow_entry -> 542 542 + (* Double comma or comma after comma - invalid *) 543 543 + Error.raise_span tok.span (Unexpected_token "unexpected ',' in flow mapping") 538 544 | Token.Key -> 539 545 skip_token t; 540 546 if check t (function

+141 -23

yaml/ocaml-yamle/lib/scanner.ml

reviewed

··· 24 24 mutable stream_ended : bool; 25 25 mutable indent_stack : indent list; (** Stack of indentation levels *) 26 26 mutable flow_level : int; (** Nesting depth in [] or {} *) 27 27 + mutable flow_indent : int; (** Column where outermost flow collection started *) 27 28 mutable simple_keys : simple_key option list; (** Per flow-level simple key tracking *) 28 29 mutable allow_simple_key : bool; 30 30 + mutable leading_whitespace : bool; (** True when at start of line (only whitespace seen) *) 31 31 + mutable document_has_content : bool; (** True if we've emitted content tokens in current document *) 29 32 } 30 33 31 34 let create input = ··· 38 41 stream_ended = false; 39 42 indent_stack = []; 40 43 flow_level = 0; 44 44 + flow_indent = 0; 41 45 simple_keys = [None]; (* One entry for the base level *) 42 46 allow_simple_key = true; 47 47 + leading_whitespace = true; (* Start at beginning of stream *) 48 48 + document_has_content = false; 43 49 } 44 50 45 51 let of_string s = create (Input.of_string s) ··· 60 66 | [] -> 0 61 67 | { indent; _ } :: _ -> indent 62 68 63 63 - (** Skip whitespace and comments, return true if at newline *) 64 64 - let rec skip_to_next_token t = 65 65 - (* Skip blanks *) 69 69 + (** Skip whitespace to end of line, checking for valid comments. 70 70 + Returns true if any whitespace (including tabs) was found before a comment. *) 71 71 + let skip_whitespace_and_comment t = 72 72 + let has_whitespace = ref false in 73 73 + (* Skip blanks (spaces and tabs) *) 66 74 while Input.next_is_blank t.input do 75 75 + has_whitespace := true; 67 76 ignore (Input.next t.input) 68 77 done; 69 69 - (* Skip comment *) 78 78 + (* Check for comment *) 70 79 if Input.next_is (( = ) '#') t.input then begin 80 80 + (* Validate: comment must be preceded by whitespace or be at start of line *) 81 81 + if not !has_whitespace then begin 82 82 + (* Check if we're at the start of input or after a line break *) 83 83 + match Input.peek_back t.input with 84 84 + | None -> () (* Start of input - OK *) 85 85 + | Some c when Input.is_break c -> () (* After line break - OK *) 86 86 + | _ -> 87 87 + (* Comment not preceded by whitespace - ERROR *) 88 88 + Error.raise_at (Input.mark t.input) Invalid_comment 89 89 + end; 90 90 + (* Skip to end of line *) 71 91 while not (Input.is_eof t.input) && not (Input.next_is_break t.input) do 72 92 ignore (Input.next t.input) 73 93 done 74 74 - end; 94 94 + end 95 95 + 96 96 + (** Skip blanks (spaces/tabs) and return whether tabs were found *) 97 97 + let skip_blanks_check_tabs t = 98 98 + let found_tab = ref false in 99 99 + while Input.next_is_blank t.input do 100 100 + if Input.peek t.input = Some '\t' then found_tab := true; 101 101 + ignore (Input.next t.input) 102 102 + done; 103 103 + !found_tab 104 104 + 105 105 + (** Skip whitespace and comments, return true if at newline *) 106 106 + let rec skip_to_next_token t = 107 107 + (* Check for tabs used as indentation in block context *) 108 108 + (match Input.peek t.input with 109 109 + | Some '\t' when t.flow_level = 0 && t.leading_whitespace && 110 110 + (column t - 1) <= current_indent t -> 111 111 + (* Tab found in indentation zone - this is invalid *) 112 112 + (* Skip to end of line to check if line has content *) 113 113 + let start_pos = Input.mark t.input in 114 114 + while Input.next_is_blank t.input do 115 115 + ignore (Input.next t.input) 116 116 + done; 117 117 + (* If we have content on this line with a tab, raise error *) 118 118 + if not (Input.next_is_break t.input) && not (Input.is_eof t.input) then 119 119 + Error.raise_at start_pos Tab_in_indentation 120 120 + | _ -> ()); 121 121 + 122 122 + (* Skip blanks and validate comments *) 123 123 + skip_whitespace_and_comment t; 75 124 (* Skip line break in block context *) 76 125 if t.flow_level = 0 && Input.next_is_break t.input then begin 77 126 Input.consume_break t.input; 78 127 t.allow_simple_key <- true; 128 128 + t.leading_whitespace <- true; 79 129 skip_to_next_token t 80 130 end 81 131 else if t.flow_level > 0 && Input.next_is_whitespace t.input then begin ··· 297 347 while Input.next_is_blank t.input do 298 348 ignore (Input.next t.input) 299 349 done; 350 350 + (* Check for document boundary - this terminates the quoted string *) 351 351 + if Input.at_document_boundary t.input then 352 352 + Error.raise_at start Unclosed_single_quote; 300 353 loop () 301 354 | Some c -> 302 355 Buffer.add_char buf c; ··· 414 467 end else 415 468 continue := false 416 469 done; 470 470 + (* Check for document boundary - this terminates the quoted string *) 471 471 + if Input.at_document_boundary t.input then 472 472 + Error.raise_at start Unclosed_double_quote; 417 473 (* Per YAML spec: single break = space, break + empty lines = newlines *) 418 474 if !empty_lines > 0 then begin 419 475 (* Empty lines: output N newlines where N = number of empty lines *) ··· 444 500 | Some c2 when in_flow && Input.is_flow_indicator c2 -> false 445 501 | _ -> true) 446 502 | '#' -> 447 447 - (* # is OK if not preceded by whitespace (checked at call site) *) 448 448 - false 503 503 + (* # is a comment indicator only if preceded by whitespace *) 504 504 + (* Check the previous character to determine if this is a comment *) 505 505 + (match Input.peek_back t.input with 506 506 + | None -> true (* At start - can't be comment indicator, allow it *) 507 507 + | Some c when Input.is_whitespace c -> false (* Preceded by whitespace - comment *) 508 508 + | Some c when Input.is_break c -> false (* At start of line - comment *) 509 509 + | _ -> true) (* Not preceded by whitespace - part of scalar *) 449 510 | c when in_flow && Input.is_flow_indicator c -> false 450 511 | _ when Input.is_break c -> false 451 512 | _ -> true ··· 455 516 let start = Input.mark t.input in 456 517 let in_flow = t.flow_level > 0 in 457 518 let indent = current_indent t in 519 519 + (* Validate flow collection indentation *) 520 520 + if in_flow && (column t) < t.flow_indent then 521 521 + Error.raise_at start Invalid_flow_indentation; 458 522 let buf = Buffer.create 64 in 459 523 let spaces = Buffer.create 16 in 460 524 let leading_blanks = ref false in ··· 463 527 match Input.peek t.input with 464 528 | None -> () 465 529 | Some c when can_continue_plain t c ~in_flow -> 466 466 - (* Check for # preceded by space *) 467 467 - if c = '#' && Buffer.length buf > 0 then 468 468 - () (* Stop - # after content *) 469 469 - else begin 530 530 + (* can_continue_plain already handles # correctly - it returns false 531 531 + when # is preceded by whitespace (making it a comment indicator) *) 532 532 + begin 470 533 if Buffer.length spaces > 0 then begin 471 534 if !leading_blanks then begin 472 535 (* Fold line break *) ··· 567 630 chomping := Chomping.Keep; ignore (Input.next t.input) 568 631 | _ -> ()); 569 632 570 570 - (* Skip to end of line *) 571 571 - while Input.next_is_blank t.input do 572 572 - ignore (Input.next t.input) 573 573 - done; 574 574 - 575 575 - (* Optional comment *) 576 576 - if Input.next_is (( = ) '#') t.input then begin 577 577 - while not (Input.is_eof t.input) && not (Input.next_is_break t.input) do 578 578 - ignore (Input.next t.input) 579 579 - done 580 580 - end; 633 633 + (* Skip whitespace and optional comment *) 634 634 + skip_whitespace_and_comment t; 581 635 582 636 (* Consume line break *) 583 637 if Input.next_is_break t.input then ··· 843 897 Note: we use col, not col-1, to allow entries at the same level. *) 844 898 unroll_indent t col; 845 899 900 900 + (* We're about to process actual content, not leading whitespace *) 901 901 + t.leading_whitespace <- false; 902 902 + 846 903 if Input.is_eof t.input then 847 904 fetch_stream_end t 848 905 else if Input.at_document_boundary t.input then ··· 901 958 Input.skip t.input 3; 902 959 let span = Span.make ~start ~stop:(Input.mark t.input) in 903 960 let token = if indicator = "---" then Token.Document_start else Token.Document_end in 961 961 + (* Reset document content flag after document end marker *) 962 962 + if indicator = "..." then 963 963 + t.document_has_content <- false; 904 964 emit t span token 905 965 906 966 and fetch_directive t = 967 967 + (* Directives can only appear: 968 968 + 1. At stream start (before any document content) 969 969 + 2. After a document end marker (...) 970 970 + If we've emitted content in the current document, we need a document end marker first *) 971 971 + if t.document_has_content then 972 972 + Error.raise_at (Input.mark t.input) 973 973 + (Unexpected_token "directives must be separated from document content by document end marker (...)"); 907 974 unroll_indent t (-1); 908 975 remove_simple_key t; 909 976 t.allow_simple_key <- false; ··· 912 979 913 980 and fetch_flow_collection_start t token_type = 914 981 save_simple_key t; 982 982 + (* Record indent of outermost flow collection *) 983 983 + if t.flow_level = 0 then 984 984 + t.flow_indent <- column t; 915 985 t.flow_level <- t.flow_level + 1; 916 986 t.allow_simple_key <- true; 917 987 t.simple_keys <- None :: t.simple_keys; 988 988 + t.document_has_content <- true; 918 989 let start = Input.mark t.input in 919 990 ignore (Input.next t.input); 920 991 let span = Span.make ~start ~stop:(Input.mark t.input) in ··· 956 1027 end; 957 1028 remove_simple_key t; 958 1029 t.allow_simple_key <- true; 1030 1030 + t.document_has_content <- true; 959 1031 let start = Input.mark t.input in 960 1032 ignore (Input.next t.input); 1033 1033 + 1034 1034 + (* Check for tabs after - : pattern like -\t- is invalid *) 1035 1035 + let found_tabs = skip_blanks_check_tabs t in 1036 1036 + if found_tabs then begin 1037 1037 + (* If we found tabs and next char is - followed by whitespace, error *) 1038 1038 + match Input.peek t.input with 1039 1039 + | Some '-' -> 1040 1040 + (match Input.peek_nth t.input 1 with 1041 1041 + | None -> Error.raise_at start Tab_in_indentation 1042 1042 + | Some c when Input.is_whitespace c -> 1043 1043 + Error.raise_at start Tab_in_indentation 1044 1044 + | Some _ -> ()) 1045 1045 + | _ -> () 1046 1046 + end; 1047 1047 + 961 1048 let span = Span.make ~start ~stop:(Input.mark t.input) in 962 1049 emit t span Token.Block_entry 963 1050 ··· 980 1067 end; 981 1068 remove_simple_key t; 982 1069 t.allow_simple_key <- t.flow_level = 0; 1070 1070 + t.document_has_content <- true; 983 1071 let start = Input.mark t.input in 984 1072 ignore (Input.next t.input); 1073 1073 + 1074 1074 + (* Check for tabs after ? : pattern like ?\t- or ?\tkey is invalid *) 1075 1075 + let found_tabs = skip_blanks_check_tabs t in 1076 1076 + if found_tabs && t.flow_level = 0 then begin 1077 1077 + (* In block context, tabs after ? are not allowed *) 1078 1078 + Error.raise_at start Tab_in_indentation 1079 1079 + end; 1080 1080 + 985 1081 let span = Span.make ~start ~stop:(Input.mark t.input) in 986 1082 emit t span Token.Key 987 1083 ··· 1041 1137 end 1042 1138 end); 1043 1139 remove_simple_key t; 1044 1044 - t.allow_simple_key <- t.flow_level = 0; 1140 1140 + (* In block context, allow_simple_key becomes true only after a line break, 1141 1141 + not immediately after ':'. This prevents constructs like "key: - a". 1142 1142 + The line break handling in skip_to_next_token will set it to true. *) 1143 1143 + t.allow_simple_key <- false; 1144 1144 + t.document_has_content <- true; 1045 1145 let start = Input.mark t.input in 1046 1146 ignore (Input.next t.input); 1147 1147 + 1148 1148 + (* Check for tabs after : : pattern like :\t- is invalid in block context *) 1149 1149 + let found_tabs = skip_blanks_check_tabs t in 1150 1150 + if found_tabs && t.flow_level = 0 then begin 1151 1151 + (* In block context, tabs after : followed by indicator are not allowed *) 1152 1152 + match Input.peek t.input with 1153 1153 + | Some ('-' | '?') -> 1154 1154 + Error.raise_at start Tab_in_indentation 1155 1155 + | _ -> () 1156 1156 + end; 1157 1157 + 1047 1158 let span = Span.make ~start ~stop:(Input.mark t.input) in 1048 1159 emit t span Token.Value 1049 1160 1050 1161 and fetch_alias t = 1051 1162 save_simple_key t; 1052 1163 t.allow_simple_key <- false; 1164 1164 + t.document_has_content <- true; 1053 1165 let start = Input.mark t.input in 1054 1166 ignore (Input.next t.input); (* consume * *) 1055 1167 let name, span = scan_anchor_alias t in ··· 1059 1171 and fetch_anchor t = 1060 1172 save_simple_key t; 1061 1173 t.allow_simple_key <- false; 1174 1174 + t.document_has_content <- true; 1062 1175 let start = Input.mark t.input in 1063 1176 ignore (Input.next t.input); (* consume & *) 1064 1177 let name, span = scan_anchor_alias t in ··· 1068 1181 and fetch_tag t = 1069 1182 save_simple_key t; 1070 1183 t.allow_simple_key <- false; 1184 1184 + t.document_has_content <- true; 1071 1185 let handle, suffix, span = scan_tag t in 1072 1186 emit t span (Token.Tag { handle; suffix }) 1073 1187 1074 1188 and fetch_block_scalar t literal = 1075 1189 remove_simple_key t; 1076 1190 t.allow_simple_key <- true; 1191 1191 + t.document_has_content <- true; 1077 1192 let value, style, span = scan_block_scalar t literal in 1078 1193 emit t span (Token.Scalar { style; value }) 1079 1194 1080 1195 and fetch_single_quoted t = 1081 1196 save_simple_key t; 1082 1197 t.allow_simple_key <- false; 1198 1198 + t.document_has_content <- true; 1083 1199 let value, span = scan_single_quoted t in 1084 1200 emit t span (Token.Scalar { style = Scalar_style.Single_quoted; value }) 1085 1201 1086 1202 and fetch_double_quoted t = 1087 1203 save_simple_key t; 1088 1204 t.allow_simple_key <- false; 1205 1205 + t.document_has_content <- true; 1089 1206 let value, span = scan_double_quoted t in 1090 1207 emit t span (Token.Scalar { style = Scalar_style.Double_quoted; value }) 1091 1208 ··· 1106 1223 and fetch_plain_scalar t = 1107 1224 save_simple_key t; 1108 1225 t.allow_simple_key <- false; 1226 1226 + t.document_has_content <- true; 1109 1227 let value, span = scan_plain_scalar t in 1110 1228 emit t span (Token.Scalar { style = Scalar_style.Plain; value }) 1111 1229

+54

yaml/ocaml-yamle/tests/dune

reviewed

··· 22 22 (modules test_analyze) 23 23 (libraries yamle test_suite_lib)) 24 24 25 25 + (executable 26 26 + (name run_all_tests) 27 27 + (modules run_all_tests) 28 28 + (libraries yamle test_suite_lib)) 29 29 + 30 30 + (executable 31 31 + (name analyze_failures) 32 32 + (modules analyze_failures) 33 33 + (libraries yamle test_suite_lib)) 34 34 + 35 35 + (executable 36 36 + (name test_tabs) 37 37 + (modules test_tabs) 38 38 + (libraries yamle)) 39 39 + 40 40 + (executable 41 41 + (name test_tabs_extended) 42 42 + (modules test_tabs_extended) 43 43 + (libraries yamle)) 44 44 + 45 45 + (executable 46 46 + (name test_tabs_y79y) 47 47 + (modules test_tabs_y79y) 48 48 + (libraries yamle)) 49 49 + 50 50 + (executable 51 51 + (name test_quick) 52 52 + (modules test_quick) 53 53 + (libraries yamle)) 54 54 + 55 55 + (executable 56 56 + (name list_y79y) 57 57 + (modules list_y79y) 58 58 + (libraries test_suite_lib)) 59 59 + 60 60 + (executable 61 61 + (name debug_y79y) 62 62 + (modules debug_y79y) 63 63 + (libraries yamle)) 64 64 + 65 65 + (executable 66 66 + (name debug_y79y_events) 67 67 + (modules debug_y79y_events) 68 68 + (libraries yamle)) 69 69 + 70 70 + (executable 71 71 + (name debug_y79y_array) 72 72 + (modules debug_y79y_array) 73 73 + (libraries yamle)) 74 74 + 75 75 + (executable 76 76 + (name debug_seq) 77 77 + (modules debug_seq) 78 78 + (libraries yamle))