From de78701d02ead12353fdb70af275ff67a502b1f0 Mon Sep 17 00:00:00 2001
From: Pascal Rigaux <pixel@mandriva.com>
Date: Wed, 28 Apr 2004 12:55:44 +0000
Subject: various detection of join() misuse

---
 perl_checker.src/parser_helper.ml      | 9 +++++++++
 perl_checker.src/test/various_errors.t | 4 ++++
 perl_checker.src/tree.ml               | 2 +-
 3 files changed, 14 insertions(+), 1 deletion(-)

(limited to 'perl_checker.src')

diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml
index fc578a1..113d57b 100644
--- a/perl_checker.src/parser_helper.ml
+++ b/perl_checker.src/parser_helper.ml
@@ -832,6 +832,15 @@ let call_raw force_non_builtin_func (e, para) =
 	  | [ Ident(None, s, pos) ] -> Some [ Raw_string(s, pos) ]
 	  | _ -> None)
 
+
+      | "join" ->
+	  (match un_parenthesize_full_l para with
+	  | e :: _ when not (is_a_scalar e) -> warn_rule "first argument of join() must be a scalar";
+	  | [_] -> warn_rule "not enough parameters"
+	  | [_; e] when is_a_scalar e -> warn_rule "join('...', $foo) is the same as $foo"
+	  | _ -> ());
+	  None
+
       | "last" | "next" | "redo" when not force_non_builtin_func ->
 	  (match para with
 	  | [ Ident(None, s, pos) ] -> Some [ Raw_string(s, pos) ]
diff --git a/perl_checker.src/test/various_errors.t b/perl_checker.src/test/various_errors.t
index 4ad9976..0ad2154 100644
--- a/perl_checker.src/test/various_errors.t
+++ b/perl_checker.src/test/various_errors.t
@@ -18,6 +18,10 @@ $xxx ? $yyy = 1 : $zzz = 2;              missing parentheses (needed for clarity
 
 N_("xxx") . 'yyy'                        N_("xxx") . "yyy" is dumb since the string "xxx" will never get translated
 
+join(@l)                                 first argument of join() must be a scalar
+
+join(',', 'foo')                         join('...', $foo) is the same as $foo
+
 my (@l2, $xxx) = @l;                     @l2 takes all the arguments, $xxx is undef in any case
 
 $bad                                     undeclared variable $bad
diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml
index 5c762ac..3b0d4ea 100644
--- a/perl_checker.src/tree.ml
+++ b/perl_checker.src/tree.ml
@@ -95,7 +95,7 @@ let from_qw_raw = function
 	| Ident(_, _, pos) as ident -> Some(string_of_Ident ident, pos)
 	| e -> warn_with_pos (get_pos_from_expr e) "not recognised yet"; None
       ) l)) []
-  | e -> warn_with_pos (get_pos_in_tree e) "not recognised yet"; []
+  | e -> warn_with_pos (get_pos_from_expr e) "not recognised yet"; []
 
 let from_qw e =
   List.map (fun (s, pos) -> 
-- 
cgit v1.2.1