- allow $_o_XXX parameter name which is both unused and optional (same for $_b_XXX)

- shift is a ONE_SCALAR_PARA so that $box->pack_start(shift @l, 0, 0, 4) is parsed correctly
- in arrange_global_vars_declared(), don't keep anything in global_vars_declared, better
  create shadow packages to contain them
- much better merging of multiple files defining functions in the same package.
  This fixes the bad behaviour when using the cache (esp. do_pkgs, but it was even worse
  with things in ugtk2.pm)

5 files changed, 55 insertions, 20 deletions

diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml
index e475c8a..bb64bb0 100644
--- a/perl_checker.src/global_checks.ml
+++ b/perl_checker.src/global_checks.ml
@@ -435,17 +435,23 @@ let add_package_to_state state package =
   let package =
     try
       let existing_package = Hashtbl.find state.per_package package.package_name in
-      if existing_package.from_cache then raise Not_found;
-      (* print_endline_flush (existing_package.file_name ^ " vs " ^ package.file_name); *)
-      Hashtbl.iter (fun var pos -> Hashtbl.replace existing_package.vars_declared var pos) package.vars_declared ;
-      { existing_package with
-	body = existing_package.body @ package.body ;
-	uses = existing_package.uses @ package.uses ;
+      print_endline_flush (existing_package.file_name ^ " vs " ^ package.file_name); 
+      let vars_declared = existing_package.vars_declared in
+      Hashtbl.iter (fun var pos -> Hashtbl.replace vars_declared var pos) package.vars_declared ;
+      let p = if existing_package.build_time > package.build_time then existing_package else package in
+      let p = { p with
+	isa = if existing_package.isa = None then package.isa else existing_package.isa ;
+	body = (if existing_package.from_cache then [] else existing_package.body) @ package.body ;
+	uses = (if existing_package.from_cache then [] else existing_package.uses) @ package.uses ;
+	vars_declared = vars_declared ;
+	build_time = max existing_package.build_time package.build_time ;
 	exports = { export_ok   = existing_package.exports.export_ok   @ package.exports.export_ok ;
 		    export_auto = existing_package.exports.export_auto @ package.exports.export_auto ;
 		    export_tags = existing_package.exports.export_tags @ package.exports.export_tags ;
 		    special_export = None }
-      }
+      } in
+      Hashtbl.replace state.per_package package.package_name p ;
+      p
     with Not_found -> package
   in
   Hashtbl.replace state.per_package package.package_name package
@@ -458,15 +464,35 @@ let check_unused_vars package =
 
 let arrange_global_vars_declared state =
   let h = Hashtbl.create 16 in
-  Hashtbl.iter (fun (context, fq, name) (pos, proto) ->
-    try
-      let package = Hashtbl.find state.per_package fq in
-      if not (Hashtbl.mem package.vars_declared (context, name)) then
-	Hashtbl.add package.vars_declared (context, name) (pos, ref false, proto)
-      (* otherwise dropping this second declaration *)
-    with Not_found ->
-      (* keeping it in global_vars_declared *)
-      Hashtbl.add h (context, fq, name) (pos, proto)
+  Hashtbl.iter (fun (context, fq, name) (file, _, _ as pos, proto) ->
+    let package =
+      try
+	Hashtbl.find state.per_package fq
+      with Not_found ->
+   (* creating a new shadow package *)
+	let package = 
+	  { 
+	    file_name = file ; 
+	    package_name = fq;
+	    has_package_name = true ;
+	    exports = empty_exports ;
+	    imported = ref None ;
+	    vars_declared = Hashtbl.create 16 ;
+	    uses = [] ;
+	    required_packages = [] ;
+	    body = [] ;
+	    isa = None ;
+	    lines_starts = [] ;
+	    build_time = 0 ;
+	    from_cache = false ;
+	    from_basedir = false ;
+	  } in
+	Hashtbl.add state.per_package fq package ;
+	package
+    in
+    if not (Hashtbl.mem package.vars_declared (context, name)) then
+      Hashtbl.add package.vars_declared (context, name) (pos, ref false, proto)
+	(* otherwise dropping this second declaration *)
   ) state.global_vars_declared ;
   { state with global_vars_declared = h }
 
@@ -516,7 +542,7 @@ let read_packages_from_cache state dir =
 
     List.iter (fun pkg -> 
       Info.add_a_file pkg.file_name pkg.lines_starts ;
-      Hashtbl.add state.per_package pkg.package_name { pkg with from_cache = true }
+      add_package_to_state state { pkg with from_cache = true }
     ) l
   with Sys_error _ -> ()
 
@@ -526,6 +552,7 @@ let write_packages_cache state dir =
     let fh = open_out file in
     output_string fh ("perl_checker cache " ^ string_of_int Build.date ^ "\n") ;
     let l = List.filter (fun pkg -> pkg.has_package_name) (List.map (fun pkg -> { pkg with imported = ref None }) (hashtbl_values state.per_package)) in
+    (*List.iter (fun pkg -> prerr_endline ("XXXX " ^ pkg.package_name ^ ": " ^ String.concat " " (List.map snd (hashtbl_keys pkg.vars_declared)))) l ;*)
     Marshal.to_channel fh l [] ;
     close_out fh ;
     if !Flags.verbose then print_endline_flush ("saving cached packages in " ^ file)
diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll
index 0153374..d0a2152 100644
--- a/perl_checker.src/lexer.mll
+++ b/perl_checker.src/lexer.mll
@@ -455,6 +455,7 @@ rule token = parse
 | "length" 
 | "keys" 
 | "exists" 
+| "shift"
 | "eval"
 | "ref"      { ONE_SCALAR_PARA(lexeme lexbuf, pos lexbuf) }
 
diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml
index bdf3d49..69627e6 100644
--- a/perl_checker.src/parser_helper.ml
+++ b/perl_checker.src/parser_helper.ml
@@ -835,8 +835,11 @@ let call_one_scalar_para { any = e ; pos = pos } para esp_start esp_end =
   let para =
     match para with
     | [] ->
-	  if not (List.mem e [ "length" ]) then warn_rule (sprintf "please use \"%s $_\" instead of \"%s\"" e e) ;
-	  [var_dollar_ (raw_pos2pos pos)]
+	  if e = "shift" then 
+	    [ Deref(I_array, Ident(None, "_", raw_pos2pos pos)) ]
+	  else
+	    (if not (List.mem e [ "length" ]) then warn_rule (sprintf "please use \"%s $_\" instead of \"%s\"" e e) ;
+	     [var_dollar_ (raw_pos2pos pos)])
     | _ -> para
   in
   new_pesp M_unknown P_mul (call(Deref(I_func, Ident(None, e, raw_pos2pos pos)), para)) esp_start esp_end
diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml
index 929a5a3..eabf553 100644
--- a/perl_checker.src/tree.ml
+++ b/perl_checker.src/tree.ml
@@ -274,7 +274,10 @@ let get_proto perl_proto body =
     | (I_array, _) :: _ :: _ -> warn_with_pos pos "an array must be the last variable in a prototype"
     | (I_hash, _) :: _ :: _ -> warn_with_pos pos "an hash must be the last variable in a prototype"
     | _ -> ());
-    let is_optional (_, s) = String.length s > 2 && (s.[0] = 'o' || s.[0] = 'b') && s.[1] = '_' in
+    let is_optional (_, s) = 
+      String.length s > 2 &&                (s.[0] = 'o' || s.[0] = 'b') && s.[1] = '_' ||
+      String.length s > 3 && s.[0] = '_' && (s.[1] = 'o' || s.[1] = 'b') && s.[2] = '_'
+    in
     let must_have, optional = break_at is_optional scalars in
     if not (List.for_all is_optional optional) then
       warn_with_pos pos "an non-optional argument must not follow an optional argument";
diff --git a/perl_checker.src/tree.mli b/perl_checker.src/tree.mli
index c3b89b2..473ab39 100644
--- a/perl_checker.src/tree.mli
+++ b/perl_checker.src/tree.mli
@@ -33,6 +33,7 @@ type per_package = {
     from_basedir : bool ;
   }
 
+val empty_exports : exports
 val ignore_package : string -> unit
 val use_lib : string list ref
 val uses_external_package : string -> bool