summaryrefslogtreecommitdiffstats
path: root/perl_checker.src
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2004-04-28 12:23:18 +0000
committerPascal Rigaux <pixel@mandriva.com>2004-04-28 12:23:18 +0000
commit70dcfcd34535185dcac19d115f16a295711b267a (patch)
treeb6db2a98f49fdc3399c580192dca726f3fba92fe /perl_checker.src
parent7c9690bacb9ae134d735355d4276841abb77a099 (diff)
downloadperl-MDK-Common-70dcfcd34535185dcac19d115f16a295711b267a.tar
perl-MDK-Common-70dcfcd34535185dcac19d115f16a295711b267a.tar.gz
perl-MDK-Common-70dcfcd34535185dcac19d115f16a295711b267a.tar.bz2
perl-MDK-Common-70dcfcd34535185dcac19d115f16a295711b267a.tar.xz
perl-MDK-Common-70dcfcd34535185dcac19d115f16a295711b267a.zip
handle bad PO-: comments at the lexical level instead of doing it in the grammar
to have a better error message
Diffstat (limited to 'perl_checker.src')
-rw-r--r--perl_checker.src/common.ml2
-rw-r--r--perl_checker.src/common.mli1
-rw-r--r--perl_checker.src/lexer.mll32
-rw-r--r--perl_checker.src/parser.mly1
4 files changed, 26 insertions, 10 deletions
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}