- perl_checker: many new features including

  - checking methods being available
  - checking unused functions
  - saving parsed file in .perl_checker.cache
  - new instruction "Basedir .." in .perl_checker (useful for gi/perl-install/standalone/.perl_checker)

10 files changed, 37 insertions, 19 deletions

diff --git a/Makefile b/Makefile
index 9cca86d..ccb9190 100644
--- a/Makefile
+++ b/Makefile
@@ -34,6 +34,7 @@ install: clean all
 	install perl_checker.src/perl_checker $(BINDIR)
 	install -m 644 MDK/Common.pm $(INSTALLVENDORLIB)/MDK
 	install -m 644 MDK/Common/*.pm $(INSTALLVENDORLIB)/MDK/Common
+	cp -r perl_checker_fake_packages $(INSTALLVENDORLIB)
 
 rpm: update tar build commit
 
diff --git a/perl_checker.src/Makefile b/perl_checker.src/Makefile
index 727b38d..37a562b 100644
--- a/perl_checker.src/Makefile
+++ b/perl_checker.src/Makefile
@@ -6,7 +6,7 @@ RESULT  = perl_checker
 BCSUFFIX = _debug
 SOURCES = build.ml common.ml flags.ml config_file.ml types.mli info.ml parser_helper.ml parser.mly lexer.mll tree.ml global_checks.ml perl_checker.ml
 LIBS = unix
-VENDORLIB = $(shell dirname `pwd`)/perl_checker_fake_packages
+VENDORLIB = $(shell dirname `pwd`)
 
 NAME = shyant
 
@@ -18,7 +18,7 @@ build_ml:
 
 build.ml:
 	date '+let date = %s' > $@
-	echo 'let fake_packages_dir = "'$(VENDORLIB)'"' >> $@
+	echo 'let fake_packages_dir = "'$(VENDORLIB)'/perl_checker_fake_packages"' >> $@
 
 tags: 
 	ocamltags *.ml
diff --git a/perl_checker.src/common.ml b/perl_checker.src/common.ml
index 44e63fd..c9991b7 100644
--- a/perl_checker.src/common.ml
+++ b/perl_checker.src/common.ml
@@ -748,6 +748,16 @@ let rec fold_lines f init chan =
   with End_of_file -> init
 let readlines chan = List.rev (fold_lines (fun l e -> e::l) [] chan)
 
+let rec updir dir nb =
+  if nb = 0 then dir else
+  match dir with
+  | "." -> String.concat "/" (times ".." nb)
+  | _ -> 
+      if Filename.basename dir = ".." then
+	dir ^ "/" ^ String.concat "/" (times ".." nb)
+      else
+	updir (Filename.dirname dir) (nb-1)
+
 let split_at c s =
   let rec split_at_ accu i =
     try
diff --git a/perl_checker.src/common.mli b/perl_checker.src/common.mli
index 7f2c341..33b2736 100644
--- a/perl_checker.src/common.mli
+++ b/perl_checker.src/common.mli
@@ -201,6 +201,7 @@ 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
 val readlines : in_channel -> string list
+val updir : string -> int -> string
 val split_at : char -> string -> string list
 val split_at2 : char -> char -> string -> string list
 val words : string -> string list
diff --git a/perl_checker.src/config_file.ml b/perl_checker.src/config_file.ml
index f4453f5..a5ee94f 100644
--- a/perl_checker.src/config_file.ml
+++ b/perl_checker.src/config_file.ml
@@ -29,10 +29,12 @@ let read dir =
       ) default fh
     in
     Hashtbl.add config_cache dir config ;
+    if !Flags.verbose then print_endline_flush ("reading config file " ^ file_name);
     config
   with Sys_error _ -> default
 
+
 let rec read_any dir depth =
   if depth = 0 then () else
   let _ = read dir in
-  read_any (dir ^ "/..") (depth - 1)
+  read_any (updir dir 1) (depth - 1)
diff --git a/perl_checker.src/flags.ml b/perl_checker.src/flags.ml
index 85f405c..fdedc95 100644
--- a/perl_checker.src/flags.ml
+++ b/perl_checker.src/flags.ml
@@ -5,4 +5,4 @@ let quiet = ref false
 let generate_pot = ref false
 let expand_tabs = ref (Some 8)
 let check_unused_global_vars = ref false
-
+let no_cache = ref false
diff --git a/perl_checker.src/flags.mli b/perl_checker.src/flags.mli
index 16d929a..b3d8ffa 100644
--- a/perl_checker.src/flags.mli
+++ b/perl_checker.src/flags.mli
@@ -3,3 +3,4 @@ val quiet : bool ref
 val generate_pot : bool ref
 val expand_tabs : int option ref
 val check_unused_global_vars : bool ref
+val no_cache : bool ref
diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml
index 0ce4d7e..727d3ed 100644
--- a/perl_checker.src/global_checks.ml
+++ b/perl_checker.src/global_checks.ml
@@ -140,13 +140,13 @@ let is_global_var context ident =
       | "fcntl" | "fileno" | "flock" | "formline" | "fork"
       | "gethostbyaddr" | "gethostbyname" | "getgrnam" | "getgrgid" | "getppid" | "getpwent" | "getpwnam" | "getpwuid" | "gmtime" | "goto" | "grep" | "hex"
       | "index" | "int" | "ioctl" | "join" | "keys" | "kill"
-      | "last" | "lc" | "length" | "link" | "localtime" | "log" | "lstat"
+      | "last" | "lc" | "lcfirst" | "length" | "link" | "localtime" | "log" | "lstat"
       | "map" | "mkdir" | "next" | "no" | "oct" | "open" | "opendir" | "ord"
       | "pack" | "pipe" | "pop" | "print" | "printf" | "push" | "quotemeta" 
       | "rand" | "read" | "readdir" | "readlink" | "redo" | "ref" | "rename" | "require" | "return" | "reverse" | "rmdir"
       | "scalar" | "seek" | "select" | "setpwent" | "shift" | "sleep" | "sort" | "splice" | "split" | "sprintf" | "stat" | "substr"
       | "symlink" | "syscall" | "sysopen" | "sysread" | "sysseek" | "system" | "syswrite" | "tie" | "time"
-      | "uc" | "umask" | "undef" | "unlink" | "unpack" | "unshift" | "utime" | "values" | "vec" | "waitpid" | "wantarray" | "warn" | "write"
+      | "uc" | "ucfirst" | "umask" | "undef" | "unlink" | "unpack" | "unshift" | "utime" | "values" | "vec" | "waitpid" | "wantarray" | "warn" | "write"
 	  -> true
 
       | _ -> false)
@@ -415,7 +415,7 @@ let default_state() = { per_package = Hashtbl.create 16; methods = Hashtbl.creat
 let cache_cache = Hashtbl.create 16
 
 let read_packages_from_cache state dir =
-  if Hashtbl.mem cache_cache dir then () else
+  if !Flags.no_cache || Hashtbl.mem cache_cache dir then () else
   try
     Hashtbl.add cache_cache dir ();
     let file = dir ^ "/.perl_checker.cache" in
diff --git a/perl_checker.src/perl_checker.ml b/perl_checker.src/perl_checker.ml
index 0d1bb28..52eaaf5 100644
--- a/perl_checker.src/perl_checker.ml
+++ b/perl_checker.src/perl_checker.ml
@@ -3,12 +3,6 @@ open Common
 open Tree
 open Global_checks
 
-let rec updir dir nb =
-  if nb = 0 then dir else
-  match dir with
-  | "." -> String.concat "/" (times ".." nb)
-  | _ -> updir (Filename.dirname dir) (nb-1)
-
 let search_basedir file_name nb =
   let dir = Filename.dirname file_name in
   let config = Config_file.read dir in
@@ -17,11 +11,14 @@ let search_basedir file_name nb =
 
 let basedir = ref ""
 let set_basedir state package =
-  let nb = List.length (split_at2 ':'':' package.package_name) - 1 in
-  let dir = search_basedir package.file_name nb in
-  lpush Tree.use_lib dir ;
-  read_packages_from_cache state dir ;
-  basedir := dir
+  if !basedir = "" then
+    let nb = List.length (split_at2 ':'':' package.package_name) - 1 in
+    let dir = search_basedir package.file_name nb in
+    lpush Tree.use_lib dir ;
+    Config_file.read_any dir 1 ;
+    read_packages_from_cache state dir ;
+    if !Flags.verbose then print_endline_flush ("basedir is " ^ dir);
+    basedir := dir
 
 let mtime f = int_of_float ((Unix.stat f).Unix.st_mtime)
 
@@ -65,7 +62,7 @@ and parse_package_if_needed state (package_name, pos) =
   try
     let dir = findfile (Build.fake_packages_dir :: !use_lib) rel_file in
     let file = dir ^ "/" ^ rel_file in
-    Config_file.read_any dir (List.length splitted) ;
+    Config_file.read_any (Filename.dirname file) (List.length splitted) ;
     let already_done =
       try
 	let pkg = Hashtbl.find state.per_package package_name in
@@ -114,6 +111,7 @@ let parse_options =
     "-t", Arg.Int (fun i -> Flags.expand_tabs := Some i), "  set the tabulation width (default is 8)" ;
     "--check-unused", Arg.Set Flags.check_unused_global_vars, "  check unused global functions & variables" ;
     "--restrict-to-files", Arg.Set restrict_to_files, "  only display warnings concerning the file(s) given on command line" ;
+    "--no-cache", Arg.Set Flags.no_cache, "  do not use cache" ;
     "--generate-pot", Arg.String generate_pot_chosen, "" ;
   ] in
   let usage = "Usage: perl_checker [-v] [-q] <files>\nOptions are:" in
diff --git a/perl_checker_fake_packages/Gtk2.pm b/perl_checker_fake_packages/Gtk2.pm
index 11e99b1..4d5ebb4 100644
--- a/perl_checker_fake_packages/Gtk2.pm
+++ b/perl_checker_fake_packages/Gtk2.pm
@@ -21,14 +21,17 @@ sub can_default {}
 sub can_focus {}
 sub cancel_button {}
 sub child {}
+sub children {}
 sub clear {}
 sub collapse_all {}
 sub create_items {}
 sub create_pango_layout {}
 sub create_tag {}
 sub dir_list {}
+sub disable_activate {}
 sub draw_layout {}
 sub draw_rectangle {}
+sub entry {}
 sub expand {}
 sub expand_all {}
 sub fg_gc {}
@@ -121,6 +124,7 @@ sub set_tip {}
 sub set_title {}
 sub set_transient_for {}
 sub set_uposition {}
+sub set_use_arrows_always {}
 sub set_visibility {}
 sub set_wrap_mode {}
 sub shape_combine_mask {}
@@ -136,6 +140,7 @@ sub values {}
 sub vbox {}
 sub white_gc {}
 sub width {}
+sub widget {}
 sub window {}
 sub window_position {}
 sub Gtk2::x {}