summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--perl_checker.src/lexer.mll4
-rw-r--r--perl_checker.src/parser.mly2
-rw-r--r--perl_checker.src/perl_checker.ml7
-rw-r--r--perl_checker.src/tree.ml80
-rw-r--r--perl_checker.src/tree.mli2
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
generated by cgit v1.2.1 (git 2.21.0) at 2024-08-18 18:04:40 +0000