disallow s/foo/die "bar \"zzz\"/e

3 files changed, 17 insertions, 1 deletions

diff --git a/perl_checker.src/common.ml b/perl_checker.src/common.ml
index ee989dc..e30dc20 100644
--- a/perl_checker.src/common.ml
+++ b/perl_checker.src/common.ml
@@ -561,6 +561,8 @@ let rec transpose = function
 let rec range min max =
   if min >= max then [] else min :: range (min + 1) max
 
+let sum l = List.fold_left (+) 0 l
+
 let rec filter_some_with f = function
   | [] -> []
   | e :: l -> 
@@ -745,6 +747,15 @@ let char_is_number c =
   let i = Char.code c in
   Char.code '0' <= i && i <= Char.code '9'
 
+let count_chars_in_string s c =
+  let rec rec_count_chars_in_string from =
+    try
+      let from' = String.index_from s from c in
+      1 + rec_count_chars_in_string (from' + 1)
+    with
+      Not_found -> 0
+  in rec_count_chars_in_string 0
+
 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 5702b1d..48ff55a 100644
--- a/perl_checker.src/common.mli
+++ b/perl_checker.src/common.mli
@@ -155,7 +155,7 @@ val hashtbl_keys : ('a, 'b) Hashtbl.t -> 'a list
 val hashtbl_to_list : ('a, 'b) Hashtbl.t -> ('a * 'b) list
 val hashtbl_collect : ('a -> 'b -> 'c list) -> ('a, 'b) Hashtbl.t -> 'c list
 val hashtbl_exists : ('a -> 'b -> bool) -> ('a, 'b) Hashtbl.t -> bool
-val memoize : ('a -> 'a) -> 'a -> 'a
+val memoize : ('a -> 'b) -> 'a -> 'b
 val array_shift : 'a array -> 'a array
 val array_last_n : int -> 'a array -> 'a array
 val array_collect : ('a -> 'b list) -> 'a array -> 'b list
@@ -163,6 +163,7 @@ val lvector_product : 'a list list -> 'a list list
 val vector_product2 : 'a list -> 'a list -> ('a * 'a) list
 val transpose : 'a list list -> 'a list list
 val range : int -> int -> int list
+val sum : int list -> int
 val filter_some_with : ('a -> 'b option) -> 'a list -> 'b list
 val filter_some : 'a option list -> 'a list
 val difference : 'a list -> 'a list -> 'a list
@@ -202,6 +203,7 @@ val char_is_alphanumerical : char -> bool
 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_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 71d6399..672ff5c 100644
--- a/perl_checker.src/lexer.mll
+++ b/perl_checker.src/lexer.mll
@@ -562,6 +562,9 @@ rule token = parse
   let s2, (_, end_)  = ins delimited_string lexbuf in 
   let opts, _ = raw_ins pattern_options lexbuf in
   let pos = start, end_ in
+  if String.contains opts 'e' && sum (List.map (fun (s, _) -> count_chars_in_string s '"') s2) > 2 then
+    die lexbuf ("do not write so complicated things in the eval part of s///,\n" ^
+		"i generate wrong warnings for things like s/xxx/die \"yyy \\\"zzz\\\" \"/")
   check_multi_line_delimited_string (Some opts) pos ;
   PATTERN_SUBST(s1, s2, opts, pos)
 }