- handle empty prototypes

- check number of parameters in method calls
  (ignoring empty overloaded methods)
- allow non-empty prototypes for methods not using @_

9 files changed, 101 insertions, 58 deletions

diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml
index 53324b9..f10b6ff 100644
--- a/perl_checker.src/global_checks.ml
+++ b/perl_checker.src/global_checks.ml
@@ -10,6 +10,7 @@ type state = {
     methods : (string, (pos * bool ref * prototype option) list) Hashtbl.t ;
     global_vars_declared : (context * string * string, pos * prototype option) Hashtbl.t ;
     global_vars_used : ((context * string * string) * pos) list ref ;
+    packages_being_classes : (string, unit) Hashtbl.t ;
   }
 
 type vars = { 
@@ -232,7 +233,7 @@ let un_parenthesize_one_elt_List = function
 
 let check_unused_local_variables vars =
   List.iter (fun ((_, s as v), (pos, used, _proto)) ->
-    if not !used && s.[0] != '_' && not (List.mem s [ "BEGIN"; "END"; "DESTROY" ]) then warn_with_pos pos (sprintf "unused variable %s" (variable2s v))
+    if not !used && (s.[0] != '_' || s = "_") && not (List.mem s [ "BEGIN"; "END"; "DESTROY" ]) then warn_with_pos pos (sprintf "unused variable %s" (variable2s v))
   ) (List.hd vars.my_vars)
   
 
@@ -245,14 +246,14 @@ let check_variables vars t =
 	let vars' = List.fold_left check_variables_ vars' l in
 	check_unused_local_variables vars' ;
 	Some vars
-    | Call(Deref(I_func, Ident(None, "sort", _)), (Anonymous_sub(Block f, pos) :: l)) ->
+    | Call(Deref(I_func, Ident(None, "sort", _)), (Anonymous_sub(_, Block f, pos) :: l)) ->
 	let vars = List.fold_left check_variables_ vars l in
 	let vars' = { vars with my_vars = [ (I_scalar, "a"), (pos, ref true, None) ; (I_scalar, "b"), (pos, ref true, None) ] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in
 	let vars' = List.fold_left check_variables_ vars' f in
 	check_unused_local_variables vars' ;
 	Some vars
 
-    | Call(Deref(I_func, Ident(None, func, func_pos)), Anonymous_sub(Block f, pos) :: l) 
+    | Call(Deref(I_func, Ident(None, func, func_pos)), Anonymous_sub(_, Block f, pos) :: l) 
       when List.mem func [ "grep" ; "map" ; "substInFile" ; "map_index" ; "each_index" ; "partition" ; "find_index" ; "grep_index" ; "find" ; "any" ; "every" ] ->
 	let vars = List.fold_left check_variables_ vars l in
 	let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref true, None)] :: vars.our_vars } in
@@ -261,10 +262,16 @@ let check_variables vars t =
 	check_variable (I_func, Ident(None, func, func_pos)) vars None ;
 	Some vars
 
+    | Call(Deref(I_func, (Ident _ as ident)), [ Deref(I_star, (Ident(None, "_", _))) ]) ->
+	(* the &f case: allow access to @_ *)
+	check_variable (I_func, ident) vars None ;
+	let _ = is_my_declared vars (I_array, "_") in
+	Some vars
+
     | Call(Deref(I_func, (Ident _ as ident)), [ List [ Deref(I_array, (Ident(None, "_", pos))) ] ]) ->
 	(* special warning if @_ is unbound *)
 	check_variable (I_func, ident) vars None ;
-	if not (is_our_declared vars (I_array, "_")) then
+	if not (is_my_declared vars (I_array, "_")) then
 	  warn_with_pos pos (sprintf "replace %s(@_) with &%s" (string_of_Ident ident) (string_of_Ident ident)) ;
 	Some vars
 
@@ -293,27 +300,32 @@ let check_variables vars t =
 	check_unused_local_variables vars' ;
 	Some vars
 
-    | Sub_declaration(Ident(fq, name, pos) as ident, _perl_proto, Block body) ->
+    | Sub_declaration(Ident(fq, name, pos) as ident, perl_proto, Block body) ->
 	let vars = declare_Our vars ([ I_func, string_of_Ident ident ], pos) in
 
-	let local_vars, l =
-	  match has_proto (Block body) with
+	let my_vars, l =
+	  match has_proto perl_proto (Block body) with
 	  | Some(mys, mys_pos, body) ->
 	      [], My_our ("my", mys, mys_pos) :: body
-	  | _ -> [(I_array, "_"), (pos, ref true, None)], body
+	  | _ -> 
+	      let dont_check_use = 
+		fq = None && List.mem name ["BEGIN"; "END"; "DESTROY"] ||
+		Hashtbl.mem vars.state.packages_being_classes (some_or fq vars.current_package.package_name)
+	      in
+	      [(I_array, "_"), (pos, ref dont_check_use, None)], body
 	in
 	let local_vars = 
 	  if fq = None && name = "AUTOLOAD" 
-	  then ((I_scalar, "AUTOLOAD"), (pos, ref true, None)) :: local_vars 
-	  else local_vars in
+	  then [ (I_scalar, "AUTOLOAD"), (pos, ref true, None) ]
+	  else [] in
 
-	let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = local_vars :: vars.our_vars } in
+	let vars' = { vars with my_vars = my_vars :: vars.my_vars ; our_vars = local_vars :: vars.our_vars } in
 	let vars' = List.fold_left check_variables_ vars' l in
 	check_unused_local_variables vars' ;
 	Some vars
 
-    | Anonymous_sub(Block l, pos) ->
-	let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_array, "_"), (pos, ref true, None)] :: vars.our_vars } in
+    | Anonymous_sub(_, Block l, pos) ->
+	let vars' = { vars with my_vars = [(I_array, "_"), (pos, ref true, None)] :: vars.my_vars } in
 	let vars' = List.fold_left check_variables_ vars' l in
 	check_unused_local_variables vars' ;
 	Some vars
@@ -452,8 +464,8 @@ let arrange_global_vars_declared state =
   { state with global_vars_declared = h }
 
 let get_methods_available state =
-  let get_classes state =
-    let l = hashtbl_collect (fun _ package ->
+  let classes = uniq (
+    hashtbl_collect (fun _ package ->
       match package.isa with
       | None ->
 	  if Hashtbl.mem package.vars_declared (I_func, "new") then [package] else []
@@ -463,20 +475,20 @@ let get_methods_available state =
 	      Hashtbl.find state.per_package pkg
 	    with Not_found -> die_with_pos pos ("bad package " ^ pkg)
 	  ) l
-    ) state.per_package in
-    uniq l
-  in
+    ) state.per_package
+  ) in
   List.iter (fun pkg ->
+    Hashtbl.replace state.packages_being_classes pkg.package_name () ;
     Hashtbl.iter (fun (context, v) (pos, is_used, proto) ->
       if context = I_func then
 	let l = try Hashtbl.find state.methods v with Not_found -> [] in
 	Hashtbl.replace state.methods v ((pos, is_used, proto) :: l)
     ) pkg.vars_declared
-  ) (get_classes state) ;
+  ) classes ;
   state
 
 
-let default_state() = { per_package = Hashtbl.create 16; methods = Hashtbl.create 256 ; global_vars_declared = Hashtbl.create 256; global_vars_used = ref [] }
+let default_state() = { per_package = Hashtbl.create 16; methods = Hashtbl.create 256 ; global_vars_declared = Hashtbl.create 256; global_vars_used = ref []; packages_being_classes = Hashtbl.create 16 }
 
 let cache_cache = Hashtbl.create 16
 
diff --git a/perl_checker.src/global_checks.mli b/perl_checker.src/global_checks.mli
index e081e48..6b25f73 100644
--- a/perl_checker.src/global_checks.mli
+++ b/perl_checker.src/global_checks.mli
@@ -6,6 +6,7 @@ type state = {
     methods : (string, (pos * bool ref * prototype option) list) Hashtbl.t ;
     global_vars_declared : (context * string * string, pos * prototype option) Hashtbl.t;
     global_vars_used : ((context * string * string) * pos) list ref;
+    packages_being_classes : (string, unit) Hashtbl.t ;
   } 
 
 val default_state : unit -> state
diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll
index 59e348e..044c562 100644
--- a/perl_checker.src/lexer.mll
+++ b/perl_checker.src/lexer.mll
@@ -39,6 +39,7 @@ type raw_token =
   | RAW_IDENT of (string option * string * raw_pos)
   | RAW_IDENT_PAREN of (string option * string * raw_pos)
   | ARRAYLEN_IDENT of (string option * string * raw_pos)
+  | SUB_WITH_PROTO of (string * raw_pos)
   | FUNC_DECL_WITH_PROTO of (string * string * raw_pos)
 
   | IF of raw_pos | ELSIF of raw_pos | ELSE of raw_pos | UNLESS of raw_pos | DO of raw_pos | WHILE of raw_pos | UNTIL of raw_pos | MY_OUR of (string * raw_pos) | CONTINUE of raw_pos | SUB of raw_pos
@@ -96,6 +97,7 @@ let rec raw_token_to_pos_and_token spaces = function
   | RAW_IDENT(kind, name, pos) -> pos, Parser.RAW_IDENT(new_any M_special (kind, name) spaces pos)
   | RAW_IDENT_PAREN(kind, name, pos) -> pos, Parser.RAW_IDENT_PAREN(new_any M_special (kind, name) spaces pos)
   | ARRAYLEN_IDENT(kind, name, pos) -> pos, Parser.ARRAYLEN_IDENT(new_any M_special (kind, name) spaces pos)
+  | SUB_WITH_PROTO(proto, pos) -> pos, Parser.SUB_WITH_PROTO(new_any M_special proto spaces pos)
   | FUNC_DECL_WITH_PROTO(name, proto, pos) -> pos, Parser.FUNC_DECL_WITH_PROTO(new_any M_special (name, proto) spaces pos)
 
   | NEW(pos) -> pos, Parser.NEW(new_any M_special () spaces pos)
@@ -584,12 +586,16 @@ rule token = parse
 | "\\" ' '* '('
     { putback lexbuf 1; REF(pos lexbuf) }
 
+| "sub(" [ '$' '@' '\\' '&' ';' '%' ]* ')' {
+    SUB_WITH_PROTO(skip_n_char_ 4 1 (lexeme lexbuf), pos lexbuf)
+  }
+
 | "sub" ' '+ ident ' '* '(' [ '$' '@' '\\' '&' ';' '%' ]* ')' {
     (* bloody prototypes, must be caught especially otherwise "($)" is badly tokenized *)
     (* and alas "($@)" is both valid as an expression and a prototype *)
     let s = lexeme lexbuf in
     let ident_start = non_index_from s 3 ' ' in
-      
+
     let proto_start = String.index_from s ident_start '(' in
     let ident_end = non_rindex_from s (proto_start-1) ' ' in
     let ident = String.sub s ident_start (ident_end - ident_start + 1) in
diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly
index 0b27e80..d2a8cc9 100644
--- a/perl_checker.src/parser.mly
+++ b/perl_checker.src/parser.mly
@@ -23,6 +23,7 @@
 %token <((string * ((int * int) * token) list) list * (string * ((int * int) * token) list) list * string) Types.any_spaces_pos> PATTERN_SUBST
 
 %token <(string option * string) Types.any_spaces_pos> SCALAR_IDENT ARRAY_IDENT HASH_IDENT FUNC_IDENT STAR_IDENT RAW_IDENT RAW_IDENT_PAREN ARRAYLEN_IDENT
+%token <string Types.any_spaces_pos> SUB_WITH_PROTO
 %token <(string * string) Types.any_spaces_pos> FUNC_DECL_WITH_PROTO
 
 %token <string Types.any_spaces_pos> FOR PRINT
@@ -154,14 +155,14 @@ sideff: /* An expression which may have a side-effect */
 decl:
 | FORMAT BAREWORD ASSIGN {new_esp M_special Too_complex $1 $3}
 | FORMAT ASSIGN {new_esp M_special Too_complex $1 $2}
-| func_decl semi_colon {if snd $1.any = "" then die_rule "there is no need to pre-declare in Perl!" else (warn_rule "please don't use prototype pre-declaration" ; new_esp M_special Too_complex $1 $2) }
+| func_decl semi_colon {if snd $1.any = None then die_rule "there is no need to pre-declare in Perl!" else (warn_rule "please don't use prototype pre-declaration" ; new_esp M_special Too_complex $1 $2) }
 | func_decl BRACKET BRACKET_END {sp_n($2); sp_0_or_cr($3); let name, proto = $1.any in new_esp M_none (sub_declaration (name, proto) []) $1 $3}
 | func_decl BRACKET lines BRACKET_END {sp_n($2); check_block_sub $3 $4; new_esp M_none (sub_declaration $1.any $3.any) $1 $4}
 | func_decl BRACKET BRACKET expr BRACKET_END            BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); new_esp M_none (sub_declaration $1.any [Ref(I_hash, prio_lo P_loose $4)]) $1 $6}
 | func_decl BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); new_esp M_none (sub_declaration $1.any [Ref(I_hash, prio_lo P_loose $4); Semi_colon]) $1 $7}
 | PACKAGE word semi_colon {sp_0_or_cr($1); sp_1($2); new_esp M_none (Package $2.any) $1 $3}
-| BEGIN BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; new_esp M_none (Sub_declaration(Ident(None, "BEGIN", get_pos $1), "", Block $3.any)) $1 $4}
-| END   BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; new_esp M_none (Sub_declaration(Ident(None, "END",   get_pos $1), "", Block $3.any)) $1 $4}
+| BEGIN BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; new_esp M_none (Sub_declaration(Ident(None, "BEGIN", get_pos $1), None, Block $3.any)) $1 $4}
+| END   BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; new_esp M_none (Sub_declaration(Ident(None, "END",   get_pos $1), None, Block $3.any)) $1 $4}
 | use {$1}
 
 use:
@@ -179,8 +180,8 @@ use_revision:
 | USE {$1}
 
 func_decl:
-| SUB word { new_esp M_none ($2.any, "") $1 $2}
-| FUNC_DECL_WITH_PROTO {new_1esp (Ident(None, fst $1.any, get_pos $1), snd $1.any) $1 }
+| SUB word { new_esp M_none ($2.any, None) $1 $2}
+| FUNC_DECL_WITH_PROTO {new_1esp (Ident(None, fst $1.any, get_pos $1), Some (snd $1.any)) $1 }
 
 listexpr: /* Basic list expressions */
 | %prec PREC_LOW { default_pesp P_tok []}
@@ -276,18 +277,27 @@ term:
 
 | BRACKET BRACKET_END {new_pesp (M_ref M_hash) P_expr (Ref(I_hash, List [])) $1 $2} /* empty hash */
 | BRACKET_HASHREF expr BRACKET_END %prec PREC_HIGH {sp_p($3); new_pesp (M_ref M_hash) P_expr (Ref(I_hash, $2.any.expr)) $1 $3} /* { foo => "Bar" } */
-| SUB BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); new_pesp (M_ref M_sub) P_expr (anonymous_sub (new_esp (M_ref M_array) [] $2 $2)) $1 $3}
-| SUB BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; new_pesp (M_ref M_sub) P_expr (anonymous_sub $3) $1 $4}
+| SUB            BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); new_pesp (M_ref M_sub) P_expr (anonymous_sub None          (new_esp (M_ref M_array) [] $2 $2)) $1 $3}
+| SUB_WITH_PROTO BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); new_pesp (M_ref M_sub) P_expr (anonymous_sub (Some $1.any) (new_esp (M_ref M_array) [] $2 $2)) $1 $3}
+| SUB            BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; new_pesp (M_ref M_sub) P_expr (anonymous_sub None          $3) $1 $4}
+| SUB_WITH_PROTO BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; new_pesp (M_ref M_sub) P_expr (anonymous_sub (Some $1.any) $3) $1 $4}
 
 | termdo {new_1pesp P_tok $1.any $1}
-| REF term {new_pesp (M_ref $2.mcontext) P_expr (Ref(I_scalar, $2.any.expr)) $1 $2} /* \$x, \@y, \%z */
+| REF term {new_pesp (M_ref $2.mcontext) P_expr (Ref(I_scalar, remove_call_with_same_para_special $2.any.expr)) $1 $2} /* \$x, \@y, \%z */
 | my_our %prec UNIOP {new_1pesp P_expr $1.any $1}
 | LOCAL term    %prec UNIOP {sp_n($2); new_pesp $2.mcontext P_expr (to_Local $2) $1 $2}
 
 | parenthesized {new_1pesp $1.any.priority (List $1.any.expr) $1} /* (1, 2) */
 | parenthesized arrayref {sp_0($2); let is_slice = not (is_only_one_in_List $2.any) in new_pesp (if is_slice then M_list else M_scalar) P_tok (to_Deref_with(I_array, (if is_slice then I_array else I_scalar), List $1.any.expr, List $2.any)) $1 $2} /* list indexing or slicing */
 
-| variable {new_1pesp P_tok $1.any $1}
+| variable { 
+    let e = 
+      match $1.any with
+      | Deref(I_func, Ident _) ->
+	  call_with_same_para_special $1.any (* not the same as f(@_) *)
+      | e -> e in
+    new_1pesp P_tok e $1 
+  }
 
 | subscripted {new_1pesp P_tok $1.any $1}
 
@@ -308,9 +318,9 @@ term:
 | func parenthesized {sp_0($2); new_pesp M_unknown P_tok (call_func true ($1.any, $2.any.expr)) $1 $2} /* &foo(@args) */
 | word argexpr {check_parenthesized_first_argexpr_with_Ident  $1.any $2; new_pesp M_unknown P_call_no_paren (call(Deref(I_func, $1.any), $2.any.expr)) $1 $2} /* foo $a, $b */
 | word_paren parenthesized {sp_0($2); new_pesp M_unknown P_tok (call(Deref(I_func, $1.any), $2.any.expr)) $1 $2} /* foo(@args) */
-| word BRACKET lines BRACKET_END listexpr %prec LSTOP {sp_n($2); check_block_sub $3 $4; new_pesp M_unknown (if $5.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub $3 :: $5.any.expr)) $1 $5} /* map { foo } @bar */
-| word BRACKET BRACKET expr BRACKET_END            BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); new_pesp M_unknown (if $7.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub(new_esp (M_ref M_hash) [ Ref(I_hash, $4.any.expr) ] $4 $4) :: $7.any.expr)) $1 $7} /* map { { foo } } @bar */
-| word BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); new_pesp M_unknown (if $8.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub(new_esp (M_ref M_hash) [ Ref(I_hash, $4.any.expr); Semi_colon ] $4 $4) :: $8.any.expr)) $1 $8} /* map { { foo }; } @bar */
+| word BRACKET lines BRACKET_END listexpr %prec LSTOP {sp_n($2); check_block_sub $3 $4; new_pesp M_unknown (if $5.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub None $3 :: $5.any.expr)) $1 $5} /* map { foo } @bar */
+| word BRACKET BRACKET expr BRACKET_END            BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); new_pesp M_unknown (if $7.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub None (new_esp (M_ref M_hash) [ Ref(I_hash, $4.any.expr) ] $4 $4) :: $7.any.expr)) $1 $7} /* map { { foo } } @bar */
+| word BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); new_pesp M_unknown (if $8.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub None (new_esp (M_ref M_hash) [ Ref(I_hash, $4.any.expr); Semi_colon ] $4 $4) :: $8.any.expr)) $1 $8} /* map { { foo }; } @bar */
 
 | term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); new_pesp M_unknown P_tok (to_Method_call($1.any.expr, $3.any, $4.any.expr)) $1 $4} /* $foo->bar(list) */
 | term ARROW word_or_scalar {sp_0($2); sp_0($3); new_pesp M_unknown P_tok (to_Method_call($1.any.expr, $3.any, [])) $1 $3} /* $foo->bar */
diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml
index db6182c..fb8ba16 100644
--- a/perl_checker.src/parser_helper.ml
+++ b/perl_checker.src/parser_helper.ml
@@ -566,7 +566,11 @@ let to_Local esp =
   else die_with_rawpos esp.pos "bad argument to \"local\""
 
 let sub_declaration (name, proto) body = Sub_declaration(name, proto, Block body)
-let anonymous_sub body = Anonymous_sub (Block body.any, raw_pos2pos body.pos)
+let anonymous_sub proto body = Anonymous_sub (proto, Block body.any, raw_pos2pos body.pos)
+let call_with_same_para_special f = Call(f, [Deref(I_star, (Ident(None, "_", raw_pos2pos bpos)))])
+let remove_call_with_same_para_special = function
+  | Call(f, [Deref(I_star, (Ident(None, "_", _)))]) -> f
+  | e -> e
 
 let cook_call_op op para pos =
   (match op with
@@ -604,19 +608,19 @@ let cook_call_op op para pos =
   | "=", [ Deref(I_star, (Ident _ as f1)); Deref(I_star, (Ident _ as f2)) ] ->
       let s1, s2 = string_of_Ident f1, string_of_Ident f2 in
       warn pos (sprintf "\"*%s = *%s\" is better written \"*%s = \\&%s\"" s1 s2 s1 s2) ;
-      sub_declaration (f1, "") [ Deref(I_func, f2) ]
+      sub_declaration (f1, None) [ call_with_same_para_special(Deref(I_func, f2)) ]
   | "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Deref(I_star, (Ident _ as f2)) ] ->
       let s2 = string_of_Ident f2 in
       warn pos (sprintf "\"*{'%s'} = *%s\" is better written \"*{'%s'} = \\&%s\"" sf1 s2 sf1 s2) ;
-      sub_declaration (Ident(None, sf1, pos_f1), "") [ Deref(I_func, f2) ]
+      sub_declaration (Ident(None, sf1, pos_f1), None) [ call_with_same_para_special(Deref(I_func, f2)) ]
 
   | "=", [ Deref(I_star, (Ident _ as f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] ->
-      sub_declaration (f1, "") [ Deref(I_func, f2) ]
+      sub_declaration (f1, None) [ call_with_same_para_special(Deref(I_func, f2)) ]
   | "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] ->
-      sub_declaration (Ident(None, sf1, pos_f1), "") [ Deref(I_func, f2) ]
+      sub_declaration (Ident(None, sf1, pos_f1), None) [ call_with_same_para_special(Deref(I_func, f2)) ]
 
-  | "=", [ Deref(I_star, (Ident _ as f1)); (Anonymous_sub _ as sub) ] ->
-      sub_declaration (f1, "") [ sub ]
+  | "=", [ Deref(I_star, (Ident _ as f1)); (Anonymous_sub(proto, sub, _)) ] ->
+      sub_declaration (f1, proto) [ sub ]
 
   | "||", e :: _ when is_always_true  e -> warn_rule "<constant> || ... is the same as <constant>"; call
   | "&&", e :: _ when is_always_false e -> warn_rule "<constant> && ... is the same as <constant>"; call
diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli
index 03d9af9..77fef90 100644
--- a/perl_checker.src/parser_helper.mli
+++ b/perl_checker.src/parser_helper.mli
@@ -149,9 +149,13 @@ val to_Local :
   Types.fromparser Types.prio_anyexpr Types.any_spaces_pos ->
   Types.fromparser
 val sub_declaration :
-  Types.fromparser * string -> Types.fromparser list -> Types.fromparser
+  Types.fromparser * string option ->
+  Types.fromparser list -> Types.fromparser
 val anonymous_sub :
+  string option ->
   Types.fromparser list Types.any_spaces_pos -> Types.fromparser
+val call_with_same_para_special : Types.fromparser -> Types.fromparser
+val remove_call_with_same_para_special : Types.fromparser -> Types.fromparser
 val cook_call_op :
   string -> Types.fromparser list -> int * int -> Types.fromparser
 val to_Call_op :
diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml
index e69bd0b..8154eb6 100644
--- a/perl_checker.src/tree.ml
+++ b/perl_checker.src/tree.ml
@@ -116,7 +116,7 @@ let get_exported t =
 	if exports.export_ok <> [] then warn_with_pos pos "weird, @EXPORT_OK set twice" ;
 	(match v with
 	| Call(Deref(I_func, Ident(None, "map", _)), 
-	       [ Anonymous_sub(Block [List [Deref(I_array, Deref(I_scalar, Ident (None, "_", _)))]], _);
+	       [ Anonymous_sub(_, Block [List [Deref(I_array, Deref(I_scalar, Ident (None, "_", _)))]], _);
 		 Call(Deref(I_func, Ident(None, "values", _)), [ Deref(I_hash, Ident(None, "EXPORT_TAGS", _))])]) ->
 		   { exports with export_ok = collect snd exports.export_tags }
 	| _ -> { exports with export_ok = from_qw v })
@@ -151,7 +151,7 @@ let get_exported t =
 		    Ref(I_array,
 			List[List[
 			     Call(Deref(I_func, Ident(None, "map", _)),
-				  [Anonymous_sub(Block [List [Deref(I_array, Deref(I_scalar, Ident(None, "_", _)))]], _);
+				  [Anonymous_sub(_, Block [List [Deref(I_array, Deref(I_scalar, Ident(None, "_", _)))]], _);
 				   Call(Deref(I_func, Ident(None, "values", _)), [Deref(I_hash, Ident(None, "EXPORT_TAGS", _))])])
 			   ]])
 		  ], _)] ->
@@ -246,25 +246,31 @@ let read_xs_extension_from_so global_vars_declared package pos =
     true
   with Not_found -> false
 
-let has_proto = function
-  | Block (List [Call_op ("=", [My_our ("my", mys, mys_pos); Deref(I_array, Ident(None, "_", _))], _pos)] :: body) ->
-      Some(mys, mys_pos, body)
-  | _ -> None
-
-let get_proto body =
+let has_proto perl_proto body = 
+  match perl_proto with
+  | Some "" -> Some([], raw_pos2pos bpos, [body])
+  | _ -> 
+      match body with
+      | Block [] ->
+	  Some([ I_array, "_empty" ], raw_pos2pos bpos, [])
+      | Block (List [Call_op ("=", [My_our ("my", mys, mys_pos); Deref(I_array, Ident(None, "_", _))], _pos)] :: body) ->
+	  Some(mys, mys_pos, body)
+      | _ -> None
+
+let get_proto perl_proto body =
   map_option (fun (mys, _pos, _) ->
     let scalars, others = break_at (fun (context, _) -> context <> I_scalar) mys in
     let must_have, optional = break_at (fun (_, s) -> String.length s > 2 && (s.[0] = 'o' || s.[0] = 'b') && s.[1] = '_') scalars in
     let min = List.length must_have in    
     { proto_nb_min = min; proto_nb_max = if others = [] then Some(min + List.length optional) else None }
-  ) (has_proto body)
+  ) (has_proto perl_proto body)
 
 let get_vars_declaration global_vars_declared package = 
   List.iter (function
-    | Sub_declaration(Ident(None, name, pos), _perl_proto, body) ->
-	Hashtbl.replace package.vars_declared (I_func, name) (pos, ref false, get_proto body)
-    | Sub_declaration(Ident(Some fq, name, pos), _perl_proto, body) ->
-	Hashtbl.replace global_vars_declared (I_func, fq, name) (pos, get_proto body)
+    | Sub_declaration(Ident(None, name, pos), perl_proto, body) ->
+	Hashtbl.replace package.vars_declared (I_func, name) (pos, ref false, get_proto perl_proto body)
+    | Sub_declaration(Ident(Some fq, name, pos), perl_proto, body) ->
+	Hashtbl.replace global_vars_declared (I_func, fq, name) (pos, get_proto perl_proto body)
 
     | List [ Call_op("=", [My_our("our", ours, pos); _], _) ]
     | List [ Call_op("=", [My_our("local", ([ I_scalar, "_" ] as ours), pos); _], _) ]
@@ -293,7 +299,7 @@ let rec fold_tree f env e =
   | Some env -> env
   | None ->
   match e with
-  | Anonymous_sub(e', _)
+  | Anonymous_sub(_, e', _)
   | Ref(_, e')
   | Deref(_, e')
     -> fold_tree f env e'
diff --git a/perl_checker.src/tree.mli b/perl_checker.src/tree.mli
index 48b2657..c3b89b2 100644
--- a/perl_checker.src/tree.mli
+++ b/perl_checker.src/tree.mli
@@ -40,7 +40,7 @@ val findfile : string list -> string -> string
 
 val get_global_info_from_package : bool -> int -> fromparser list -> per_package list
 
-val has_proto : fromparser -> ((context * string) list * pos * fromparser list) option
+val has_proto : string option -> fromparser -> ((context * string) list * pos * fromparser list) option
 val get_vars_declaration : (context * string * string, pos * prototype option) Hashtbl.t -> per_package -> unit
 
 val die_with_pos : string * int * int -> string -> 'a
diff --git a/perl_checker.src/types.mli b/perl_checker.src/types.mli
index c8fbeaa..1a33d20 100644
--- a/perl_checker.src/types.mli
+++ b/perl_checker.src/types.mli
@@ -47,10 +47,10 @@ type fromparser =
    | Call of fromparser * fromparser list
    | Method_call of fromparser * fromparser * fromparser list
 
-   | Anonymous_sub of fromparser * pos
+   | Anonymous_sub of string option * fromparser * pos (* prototype, expr, pos *)
    | My_our of string * (context * string) list * pos
    | Use of fromparser * fromparser list
-   | Sub_declaration of fromparser * string * fromparser (* name, prototype, body *)
+   | Sub_declaration of fromparser * string option * fromparser (* name, prototype, body *)
    | Package of fromparser
    | Label of string
    | Perl_checker_comment of string * pos