handle bad PO-: comments at the lexical level instead of doing it in the grammar

to have a better error message

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}