diff options
| -rw-r--r-- | perl_checker.src/lexer.mll | 4 | ||||
| -rw-r--r-- | perl_checker.src/parser.mly | 2 | ||||
| -rw-r--r-- | perl_checker.src/perl_checker.ml | 7 | ||||
| -rw-r--r-- | perl_checker.src/tree.ml | 80 | ||||
| -rw-r--r-- | perl_checker.src/tree.mli | 2 |
5 files changed, 49 insertions, 46 deletions
diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll index bf344a4..cfd7af9 100644 --- a/perl_checker.src/lexer.mll +++ b/perl_checker.src/lexer.mll @@ -418,11 +418,11 @@ rule token = parse | "split" | "grep" { (* ok_for_match! *) BAREWORD(lexeme lexbuf, pos lexbuf) } -| "print " ['A'-'Z'] ['A'-'Z' '0'-'9']* ' ' { +| "print " ['A'-'Z'] ['A'-'Z' '0'-'9']* ['\n' ' '] { putback lexbuf 1; PRINT_TO_STAR(skip_n_char 6 (lexeme lexbuf), pos lexbuf) } -| "print $" ident ' ' { +| "print $" ident ['\n' ' '] { putback lexbuf 1; PRINT_TO_SCALAR(skip_n_char 7 (lexeme lexbuf), pos lexbuf); } diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly index 2279ac1..62e10ea 100644 --- a/perl_checker.src/parser.mly +++ b/perl_checker.src/parser.mly @@ -296,7 +296,7 @@ term: | term ARROW MULT {check_MULT_is_x $3; sp_0($2); sp_0($3); (P_tok, to_Method_callP(sndfst $1, Ident(None, "x", get_pos $3), [])), sp_pos_range $1 $3} /* $foo->bar */ | NEW word { sp_n($2); (P_call_no_paren, to_Method_call(fst $2, Ident(None, "new", get_pos $1), [])), sp_pos_range $1 $2} /* new Class */ -| NEW word parenthesized { sp_n($2); sp_0($3); (P_call_no_paren, to_Method_call(fst $2, Ident(None, "new", get_pos $1), sndfst $3)), sp_pos_range $1 $3} /* new Class(...) */ +| NEW word_paren parenthesized { sp_n($2); sp_0($3); (P_call_no_paren, to_Method_call(fst $2, Ident(None, "new", get_pos $1), sndfst $3)), sp_pos_range $1 $3} /* new Class(...) */ | NEW word terminal { die_rule "you must parenthesize parameters: \"new Class(...)\" instead of \"new Class ...\"" } | NEW word variable { die_rule "you must parenthesize parameters: \"new Class(...)\" instead of \"new Class ...\"" } diff --git a/perl_checker.src/perl_checker.ml b/perl_checker.src/perl_checker.ml index d5d4945..9da3726 100644 --- a/perl_checker.src/perl_checker.ml +++ b/perl_checker.src/perl_checker.ml @@ -4,7 +4,6 @@ open Tree let inc = let inc_ref = ref [] in - let ignored_packages = ref [] in let rec updir dir nb = if nb = 0 then dir else match dir with @@ -21,7 +20,7 @@ let inc = ignored_packages := readlines (open_in (reldir ^ "/.perl_checker")) with Sys_error _ -> () ); - !inc_ref, !ignored_packages + !inc_ref let findfile dirs f = List.find Sys.file_exists (List.map (fun dir -> dir ^ "/" ^ f) dirs) @@ -48,8 +47,8 @@ and parse_package_if_needed state (package_name, (_, pos)) = if List.mem_assoc package_name state.per_package then state else try let package = snd (List.hd state.per_package) in - let inc, ignored_packages = inc package.file_name package.package_name package.has_package_name in - if List.mem package_name ignored_packages then state + let inc = inc package.file_name package.package_name package.has_package_name in + if List.mem package_name !ignored_packages then state else let file = String.concat "/" (split_at2 ':'':' package_name) ^ ".pm" in parse_file state (findfile inc file) diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml index 69a72fb..3f8a949 100644 --- a/perl_checker.src/tree.ml +++ b/perl_checker.src/tree.ml @@ -35,7 +35,7 @@ type vars = { let anonymous_package_count = ref 0 let default_state = { per_package = []; global_vars_declared = Hashtbl.create 256; global_vars_used = ref [] } let empty_exports = { export_ok = []; export_auto = []; export_tags = []; re_export_all = false } - +let ignored_packages = ref [] let die_with_pos pos msg = failwith (Info.pos2sfull pos ^ msg) let warn_with_pos pos msg = prerr_endline (Info.pos2sfull pos ^ msg) @@ -190,15 +190,13 @@ let get_imports state package = try let package_used = List.assoc package_name state.per_package in let exports = package_used.exports in - let imports_vars = - match imports with - | None -> - let re = - if exports.re_export_all - then collect (fun (package_name, _) -> (List.assoc package_name state.per_package).exports.export_ok) package_used.uses - else [] in - exports.export_auto @ re - | Some l -> + match imports with + | None -> + let re = if exports.re_export_all then collect get_one package_used.uses else [] in + let l = List.map (fun (context, name) -> (context, name), package_name) exports.export_auto in + re @ l + | Some l -> + let imports_vars = collect (function | I_raw, tag -> (try @@ -210,8 +208,8 @@ let get_imports state package = else die_with_pos pos (sprintf "package %s doesn't export %s" package_name (variable2s variable)) ) l - in - List.map (fun (context, name) -> (context, name), package_name) imports_vars + in + List.map (fun (context, name) -> (context, name), package_name) imports_vars with Not_found -> [] in collect get_one package.uses @@ -275,8 +273,11 @@ and fold_tree_option f env = function let is_my_declared vars t = List.exists (List.exists ((=) t)) vars.my_vars let is_our_declared vars t = List.exists (List.exists ((=) t)) vars.our_vars let is_global_var_declared vars (context, fq, name) = - let fq = some_or fq vars.current_package in - Hashtbl.mem vars.state.global_vars_declared (context, fq, name) + fq = None && List.mem_assoc (context, name) vars.imported || + (let fq = some_or fq vars.current_package in + Hashtbl.mem vars.state.global_vars_declared (context, fq, name)) + + let is_global_var context ident = match context with @@ -300,18 +301,21 @@ let is_global_var context ident = | _ -> false) | I_func -> (match ident with + | "-b" | "-d" | "-e" | "-f" | "-l" | "-r" | "-s" | "-w" | "-x" | "abs" | "alarm" | "basename" | "bless" - | "caller" | "chdir" | "chmod" | "chomp" | "chop" | "chown" | "chr" | "chroot" | "close" | "closedir" | "crypt" | "delete" | "die" - | "each" | "eval" | "exec" | "exists" | "exit" | "fcntl" | "fileno" | "fork" - | "gethostbyaddr" | "gethostbyname" | "getgrnam" | "getgrgid" | "getpwent" | "getpwnam" | "getpwuid" | "gmtime" | "goto" | "grep" | "hex" + | "caller" | "chdir" | "chmod" | "chomp" | "chop" | "chown" | "chr" | "chroot" | "close" | "closedir" | "crypt" + | "defined" | "delete" | "die" + | "each" | "endpwent" | "eof" | "eval" | "exec" | "exists" | "exit" + | "fcntl" | "fileno" | "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" - | "map" | "mkdir" | "next" | "oct" | "open" | "opendir" | "ord" + | "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" | "select" | "setpwent" | "shift" | "sleep" | "sort" | "splice" | "split" | "sprintf" | "stat" | "substr" - | "symlink" | "sysopen" | "sysread" | "sysseek" | "system" | "syswrite" | "time" | "uc" | "umask" | "unpack" | "unshift" - | "unlink" | "utime" | "values" | "vec" | "waitpid" | "wantarray" | "warn" | "write" + | "symlink" | "syscall" | "sysopen" | "sysread" | "sysseek" | "system" | "syswrite" | "time" + | "uc" | "umask" | "undef" | "unlink" | "unpack" | "unshift" | "utime" | "values" | "vec" | "waitpid" | "wantarray" | "warn" | "write" -> true | _ -> false) @@ -319,16 +323,23 @@ let is_global_var context ident = let check_variable (context, var) vars = match var with - | Ident(None, ident, pos) when context <> I_func -> - if is_my_declared vars (context, ident) || is_our_declared vars (context, ident) || - List.mem_assoc (context, ident) vars.imported || is_global_var context ident || is_global_var_declared vars (context, None, ident) + | Ident(Some pkg, _, _) when uses_external_package pkg || List.mem pkg !ignored_packages -> () + | Ident(None, ident, pos) -> + if is_my_declared vars (context, ident) || is_our_declared vars (context, ident) || is_global_var context ident || is_global_var_declared vars (context, None, ident) then () - else warn_with_pos pos (sprintf "undeclared variable %s" (variable2s(context, ident))) - | Ident(fq, name, pos) -> - if context = I_func && fq = None && is_global_var context name || - is_global_var_declared vars (context, fq, name) + else warn_with_pos pos (if context = I_func then "unknown function " ^ ident else "undeclared variable " ^ variable2s(context, ident)) + | Ident(Some fq, name, pos) when context = I_func -> + if (fq = "CORE") && is_global_var context name || is_global_var_declared vars (context, Some fq, name) then () - else lpush vars.state.global_vars_used ((context, some_or fq vars.current_package, name), pos) + else ( + warn_with_pos pos ("unknown function " ^ Parser_helper.string_of_Ident var) + ) + | Ident(Some fq, name, pos) -> + if is_global_var_declared vars (context, Some fq, name) + then () + else ( + lpush vars.state.global_vars_used ((context, fq, name), pos) + ) | _ -> () let declare_My vars (mys, pos) = @@ -387,8 +398,8 @@ let check_variables vars t = let vars = List.fold_left check_variables_ vars other in Some vars - | Sub_declaration(Ident(fq, name, pos), _proto, body) -> - let vars = declare_Our vars ([ I_func, (some_or fq vars.current_package) ^ "::" ^ name ], pos) in + | Sub_declaration(Ident(_, _, pos) as ident, _proto, body) -> + let vars = declare_Our vars ([ I_func, Parser_helper.string_of_Ident ident ], pos) in let vars = check_variables_ vars body in Some vars @@ -418,15 +429,6 @@ let check_variables vars t = let vars = List.fold_left check_variables_ { vars with my_vars = [[]] } t in vars -(* -let check_vars vars = - List.iter (function - | I_func, (f, pos) -> - if not (is_our_declared vars (I_func, f)) then warn_with_pos pos ("unknown function " ^ f) - | _ -> () - ) vars.global_vars_used -*) - let check_tree state package = let imports = get_imports state package in let vars = { my_vars = [[]]; our_vars = []; imported = imports; current_package = package.package_name; state = state } in diff --git a/perl_checker.src/tree.mli b/perl_checker.src/tree.mli index 736c68e..c655994 100644 --- a/perl_checker.src/tree.mli +++ b/perl_checker.src/tree.mli @@ -23,6 +23,8 @@ type state = { global_vars_used : ((context * string * string) * pos) list ref; } +val ignored_packages : string list ref + val default_state : state val get_global_info_from_package : fromparser list -> per_package val get_global_vars_declaration : state -> per_package -> unit |