From 5086a51d09b7d5333b8b39927dba18f04c249237 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Wed, 28 Apr 2004 12:23:18 +0000 Subject: handle bad PO-: comments at the lexical level instead of doing it in the grammar to have a better error message --- perl_checker.src/common.ml | 2 ++ perl_checker.src/common.mli | 1 + perl_checker.src/lexer.mll | 32 +++++++++++++++++++++++--------- perl_checker.src/parser.mly | 1 - 4 files changed, 26 insertions(+), 10 deletions(-) (limited to 'perl_checker.src') diff --git a/perl_checker.src/common.ml b/perl_checker.src/common.ml index 6a3be82..7d03ffb 100644 --- a/perl_checker.src/common.ml +++ b/perl_checker.src/common.ml @@ -475,6 +475,8 @@ let break_at f l = in b [] l let break v l = break_at ((=) v) l +let drop_while f l = snd (break_at (fun e -> not (f e)) l) + (* break_at_indice 0 [1;2] gives [], [1;2] break_at_indice 1 [1;2] gives [1], [2] *) diff --git a/perl_checker.src/common.mli b/perl_checker.src/common.mli index df09b47..f0cd8f8 100644 --- a/perl_checker.src/common.mli +++ b/perl_checker.src/common.mli @@ -142,6 +142,7 @@ val map3 : ('a -> 'b -> 'c -> 'd) -> 'a list -> 'b list -> 'c list -> 'd list val filter2 : ('a * 'b -> bool) -> 'a list -> 'b list -> 'a list * 'b list val break_at : ('a -> bool) -> 'a list -> 'a list * 'a list val break : 'a -> 'a list -> 'a list * 'a list +val drop_while : ('a -> bool) -> 'a list -> 'a list val break_at_indice : int -> 'a list -> 'a list * 'a list val rev_nth : 'a -> 'a list -> int val getset_nth : 'a list -> int -> ('a -> 'a) -> 'a list diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll index 3cae1cf..069b4ec 100644 --- a/perl_checker.src/lexer.mll +++ b/perl_checker.src/lexer.mll @@ -58,14 +58,34 @@ and raw_interpolated_string = (string * raw_token list) list let new_any mcontext any spaces pos = { mcontext = mcontext ; any = any ; spaces = spaces ; pos = pos } +let pos lexbuf = lexeme_start lexbuf, lexeme_end lexbuf +let pos2sfull_with start end_ = Info.pos2sfull (!current_file, start, end_) +let pos2sfull lexbuf = pos2sfull_with (lexeme_start lexbuf) (lexeme_end lexbuf) + +let warn_with_pos (start, end_) err = print_endline_flush (pos2sfull_with start end_ ^ err) +let warn lexbuf err = warn_with_pos (pos lexbuf) err +let die lexbuf err = failwith (pos2sfull_with (lexeme_start lexbuf) (lexeme_end lexbuf) ^ err) + let rec concat_bareword_paren accu = function | PRINT(s, pos1) :: PAREN(pos2) :: l | BAREWORD(s, pos1) :: PAREN(pos2) :: l -> concat_bareword_paren (PAREN(pos2) :: BAREWORD_PAREN(s, pos1) :: accu) l | RAW_IDENT(kind, ident, pos1) :: PAREN(pos2) :: l -> - concat_bareword_paren (PAREN(pos2) :: RAW_IDENT_PAREN(kind, ident, pos1) :: accu) l + concat_bareword_paren (PAREN(pos2) :: RAW_IDENT_PAREN(kind, ident, pos1) :: accu) l + | PO_COMMENT(_, pos) as e :: l -> + let l = drop_while (function CR | SPACE _ -> true | _ -> false) l in + (match l with + | PO_COMMENT _ :: _ + (* the check will be done on this PO_COMMENT *) + | BAREWORD("N", _) :: PAREN(_) :: _ + | BAREWORD("N_", _) :: PAREN(_) :: _ -> + concat_bareword_paren (e :: accu) l + | _ -> + warn_with_pos pos "N(...) must follow the #-PO: comment, with nothing in between" ; + concat_bareword_paren accu l) | [] -> List.rev accu - | e :: l -> concat_bareword_paren (e :: accu) l + | e :: l -> + concat_bareword_paren (e :: accu) l let rec raw_token_to_pos_and_token spaces = function | INT(s, pos) -> pos, Parser.NUM(new_any M_int s spaces pos) @@ -210,9 +230,6 @@ let get_token token lexbuf = let next_rule = Stack.create() -let pos lexbuf = lexeme_start lexbuf, lexeme_end lexbuf -let pos2sfull_with start end_ = Info.pos2sfull (!current_file, start, end_) -let pos2sfull lexbuf = pos2sfull_with (lexeme_start lexbuf) (lexeme_end lexbuf) let putback lexbuf nb = lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - nb let add_a_new_line raw_pos = @@ -245,11 +262,8 @@ let building_current_interpolated_string = Stack.create() let building_current_string = Stack.create() let current_string_start_pos = ref 0 let current_string_start_line = ref 0 -let warn_with_pos (start, end_) err = print_endline_flush (pos2sfull_with start end_ ^ err) -let warn lexbuf err = warn_with_pos (pos lexbuf) err -let die lexbuf err = failwith (pos2sfull_with (lexeme_start lexbuf) (lexeme_end lexbuf) ^ err) -let die_in_string lexbuf err = failwith (pos2sfull_with !current_string_start_pos (lexeme_end lexbuf) ^ err) +let die_in_string lexbuf err = failwith (pos2sfull_with !current_string_start_pos (lexeme_end lexbuf) ^ err) let warn_escape_unneeded lexbuf c = warn lexbuf ("you can replace \\" ^ c ^ " with " ^ c) let next_interpolated toks = let r = Stack.top building_current_string in diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly index 234982b..460fbf3 100644 --- a/perl_checker.src/parser.mly +++ b/perl_checker.src/parser.mly @@ -465,7 +465,6 @@ word_paren: | BAREWORD_PAREN { new_1esp (Ident(None, $1.any, get_pos $1)) $1 } | RAW_IDENT_PAREN { new_1esp (to_Ident $1) $1 } | PO_COMMENT word_paren { po_comment($1); new_esp M_special $2.any $1 $2 } -| PO_COMMENT { die_rule "N(...) must follow the #-PO: comment, with nothing in between" } arraylen: ARRAYLEN_IDENT {new_esp M_int (deref_arraylen (to_Ident $1)) $1 $1} | ARRAYLEN scalar {sp_0($2); new_esp M_int (deref_arraylen $2.any ) $1 $1 } | ARRAYLEN bracket_subscript {new_esp M_int (deref_arraylen $2.any) $1 $2} -- cgit v1.2.1