From 19ec25715ed9df4a57e553b255c736bcc9cd40ac Mon Sep 17 00:00:00 2001
From: Pascal Rigaux <pixel@mandriva.com>
Date: Wed, 1 Oct 2003 12:01:00 +0000
Subject: perfect warning for suggesting qq(...) instead of "..."

---
 perl_checker.src/common.ml  |  7 +++++++
 perl_checker.src/common.mli |  1 +
 perl_checker.src/lexer.mll  | 30 +++++++++++++++++++-----------
 3 files changed, 27 insertions(+), 11 deletions(-)

diff --git a/perl_checker.src/common.ml b/perl_checker.src/common.ml
index e30dc20..554a65c 100644
--- a/perl_checker.src/common.ml
+++ b/perl_checker.src/common.ml
@@ -756,6 +756,13 @@ let count_chars_in_string s c =
       Not_found -> 0
   in rec_count_chars_in_string 0
 
+let rec string_fold_left f val_ s =
+  let val_ = ref val_ in
+  for i = 0 to String.length s - 1 do
+    val_ := f !val_ s.[i]
+  done ;
+  !val_
+
 let rec string_forall_with f i s =
   try
     f s.[i] && string_forall_with f (i+1) s
diff --git a/perl_checker.src/common.mli b/perl_checker.src/common.mli
index 48ff55a..0545d9f 100644
--- a/perl_checker.src/common.mli
+++ b/perl_checker.src/common.mli
@@ -204,6 +204,7 @@ val char_is_alphanumerical_ : char -> bool
 val char_is_alpha : char -> bool
 val char_is_number : char -> bool
 val count_chars_in_string : string -> char -> int
+val string_fold_left : ('a -> char -> 'a) -> 'a -> string -> 'a
 val string_forall_with : (char -> bool) -> int -> string -> bool
 val starts_with_non_lowercase : string -> bool
 val fold_lines : ('a -> string -> 'a) -> 'a -> in_channel -> 'a
diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll
index 15f9038..83edc4d 100644
--- a/perl_checker.src/lexer.mll
+++ b/perl_checker.src/lexer.mll
@@ -234,6 +234,7 @@ let raw_here_doc_next_line mark =
 let delimit_char = ref '/'
 type string_escape_kinds = Double_quote | Qq | Delimited | Here_doc
 let string_escape_kind = ref Double_quote
+let string_quote_escape = ref false
 let string_escape_useful = ref (Left false)
 let not_ok_for_match = ref (-1)
 let string_nestness = ref 0
@@ -275,18 +276,24 @@ let raw_ins_to_string t lexbuf =
   RAW_STRING(s, pos)
 let ins_to_string t lexbuf =
   string_escape_useful := Left false ;
+  string_quote_escape := false ;
   let s, pos = ins t lexbuf in
 
   if not !string_is_i18n then
     (match !string_escape_useful, s with
     | Right c, [ _, [] ] ->
-	let msg = 
-	  if c = "\"" then
-	    "or you can replace \"xxx\\" ^ c ^ "xxx\" with 'xxx" ^ c ^ "xxx'"
-	  else
-	    "you can replace \"xxx\\" ^ c ^ "xxx\" with 'xxx" ^ c ^ "xxx'" in
-	warn_with_pos pos msg
-    | _ -> ());
+	warn_with_pos pos ("you can replace \"xxx\\" ^ c ^ "xxx\" with 'xxx" ^ c ^ "xxx', that way you don't need to escape <" ^ c ^ ">")
+    | _ -> 
+	if !string_quote_escape then
+	  let full_s = String.concat "" (List.map fst s) in
+	  let nb = string_fold_left (fun nb c ->
+	    if nb < 0 then nb else
+	    if c = '(' then nb + 1 else
+	    if c = ')' then nb - 1 else nb
+	  ) 0 full_s in
+	  if nb = 0 then
+	    warn_with_pos pos "you can replace \"xxx\\\"xxx\" with qq(xxx\"xxx), that way you don't need to escape <\">"
+    );
 
   not_ok_for_match := lexeme_end lexbuf; 
   string_is_i18n := false ;
@@ -832,7 +839,8 @@ and string_escape = parse
 | 'x' [^ '{'] _     { string_escape_useful := Left true; hex_in_string lexbuf next_rule (skip_n_char 1 (lexeme lexbuf)) }
 | '\n' { die lexbuf "do not use \"\\\" before end-of-line, it's useless and generally bad" }
 | '\\'{ next_s "\\" (Stack.pop next_rule) lexbuf }
-| ['b' 'f' '$' '@' '%' 'a' 'r' '{' '['] { 
+| ['b' 'f' 'a' 'r'] { string_escape_useful := Left true; next_s ("\\" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf }
+| ['$' '@' '%' '{' '['] { 
 	if !string_escape_useful = Left false then string_escape_useful := Right (lexeme lexbuf) ;
 	next_s ("\\" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf 
   }
@@ -842,10 +850,10 @@ and string_escape = parse
     | Double_quote -> 
 	if c <> "\"" then
 	  warn_escape_unneeded lexbuf c
-	else if not !string_is_i18n then (
+	else (
 	  if !string_escape_useful = Left false then string_escape_useful := Right c ;
-	  warn lexbuf "you can replace \"xxx\\\"xxx\" with qq(xxx\"xxx), that way you don't need to escape <\">"
-	)
+	  string_quote_escape := true
+        )
     | Qq -> if c <> "(" && c <> ")" then warn_escape_unneeded lexbuf c
     | Here_doc -> warn_escape_unneeded lexbuf c
     | Delimited -> if c = String.make 1 !delimit_char then 
-- 
cgit v1.2.1