diff options
| -rw-r--r-- | perl_checker.src/lexer.mll | 4 | ||||
| -rw-r--r-- | perl_checker.src/parser.mly | 23 | ||||
| -rw-r--r-- | perl_checker.src/parser_helper.ml | 28 | ||||
| -rw-r--r-- | perl_checker.src/parser_helper.mli | 5 | ||||
| -rw-r--r-- | perl_checker.src/perl_checker.ml | 2 | ||||
| -rw-r--r-- | perl_checker.src/tree.ml | 49 | ||||
| -rw-r--r-- | perl_checker.src/types.mli | 2 |
7 files changed, 78 insertions, 35 deletions
diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll index b295400..448d0c9 100644 --- a/perl_checker.src/lexer.mll +++ b/perl_checker.src/lexer.mll @@ -14,6 +14,7 @@ type raw_token = | RAW_STRING of (string * raw_pos) | STRING of (raw_interpolated_string * raw_pos) | PATTERN of (raw_interpolated_string * string * raw_pos) + | QR_PATTERN of (raw_interpolated_string * string * raw_pos) | PATTERN_SUBST of (raw_interpolated_string * raw_interpolated_string * string * raw_pos) | BAREWORD of (string * raw_pos) | BAREWORD_PAREN of (string * raw_pos) @@ -66,6 +67,7 @@ let rec raw_token_to_pos_and_token spaces = function | RAW_HERE_DOC(r, pos) -> pos, Parser.RAW_HERE_DOC(!r, (spaces, pos)) | STRING(l, pos) -> pos, Parser.STRING(raw_interpolated_string_to_tokens l, (spaces, pos)) | COMMAND_STRING(l, pos) -> pos, Parser.COMMAND_STRING(raw_interpolated_string_to_tokens l, (spaces, pos)) + | QR_PATTERN(s, opts, pos) -> pos, Parser.QR_PATTERN((raw_interpolated_string_to_tokens s, opts), (spaces, pos)) | PATTERN(s, opts, pos) -> pos, Parser.PATTERN((raw_interpolated_string_to_tokens s, opts), (spaces, pos)) | PATTERN_SUBST(from, to_, opts, pos) -> pos, Parser.PATTERN_SUBST((raw_interpolated_string_to_tokens from, raw_interpolated_string_to_tokens to_, opts), (spaces, pos)) | HERE_DOC(l, pos) -> pos, Parser.HERE_DOC((raw_interpolated_string_to_tokens (fst !l), snd !l), (spaces, pos)) @@ -504,7 +506,7 @@ rule token = parse let s, pos = ins delimited_string lexbuf in let opts, _ = raw_ins pattern_options lexbuf in check_multi_line_delimited_string (Some opts) pos ; - PATTERN(s, opts, pos) + QR_PATTERN(s, opts, pos) } | "s" pattern_separator { diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly index 12e6f93..a2e61dc 100644 --- a/perl_checker.src/parser.mly +++ b/perl_checker.src/parser.mly @@ -19,7 +19,7 @@ %token <(string * ((int * int) * token) list) list * (Types.spaces * Types.raw_pos)> STRING COMMAND_STRING %token <((string * ((int * int) * token) list) list * Types.raw_pos) * (Types.spaces * Types.raw_pos)> HERE_DOC -%token <((string * ((int * int) * token) list) list * string) * (Types.spaces * Types.raw_pos)> PATTERN +%token <((string * ((int * int) * token) list) list * string) * (Types.spaces * Types.raw_pos)> PATTERN QR_PATTERN %token <((string * ((int * int) * token) list) list * (string * ((int * int) * token) list) list * string) * (Types.spaces * Types.raw_pos)> PATTERN_SUBST %token <(string option * string) * (Types.spaces * Types.raw_pos)> SCALAR_IDENT ARRAY_IDENT HASH_IDENT FUNC_IDENT STAR_IDENT RAW_IDENT RAW_IDENT_PAREN ARRAYLEN_IDENT @@ -224,6 +224,8 @@ term: | term PATTERN_MATCH PATTERN_SUBST {sp_n($2); sp_p($3); check_unneeded_var_dollar_s ($1); to_Call_op_(P_expr, "s///", sndfst $1 :: from_PATTERN_SUBST $3) (sp_pos_range $1 $3)} | term PATTERN_MATCH_NOT PATTERN_SUBST {die_with_rawpos (sndsnd $2) "use =~ instead of !~ and negate the return value"} +| term PATTERN_MATCH QR_PATTERN {sp_n($2); sp_p($3); to_Call_op_(P_expr, "m//", sndfst $1 :: from_PATTERN $3) (sp_pos_range $1 $3)} +| term PATTERN_MATCH_NOT QR_PATTERN {sp_n($2); sp_p($3); to_Call_op_(P_expr, "!m//", sndfst $1 :: from_PATTERN $3) (sp_pos_range $1 $3)} | term PATTERN_MATCH scalar { (P_expr, Call(Too_complex, [sndfst $1 ; fst $3 ])), sp_pos_range $1 $3} | term PATTERN_MATCH_NOT scalar { (P_expr, Call(Too_complex, [sndfst $1 ; fst $3 ])), sp_pos_range $1 $3} @@ -265,8 +267,8 @@ term: | BRACKET BRACKET_END {(P_expr, Ref(I_hash, List [])), sp_pos_range $1 $2} /* empty hash */ | BRACKET_HASHREF expr BRACKET_END %prec PREC_HIGH {sp_p($3); (P_expr, Ref(I_hash, sndfst $2)), sp_pos_range $1 $3} /* { foo => "Bar" } */ -| SUB BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); (P_expr, anonymous_sub []), sp_pos_range $1 $3} -| SUB BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; (P_expr, anonymous_sub(fst $3)), sp_pos_range $1 $4} +| SUB BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); (P_expr, anonymous_sub ([], snd $2)), sp_pos_range $1 $3} +| SUB BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; (P_expr, anonymous_sub $3), sp_pos_range $1 $4} | termdo {(P_tok, fst $1), snd $1} | REF term {(P_expr, Ref(I_scalar, sndfst $2)), sp_pos_range $1 $2} /* \$x, \@y, \%z */ @@ -288,9 +290,9 @@ term: | func parenthesized {sp_0($2); (P_tok, call_func true (fst $1, sndfst $2)), sp_pos_range $1 $2} /* &foo(@args) */ | word argexpr {check_parenthesized_first_argexpr (string_of_Ident (fst $1)) $2; (P_call_no_paren, call(Deref(I_func, fst $1), sndfst $2)), sp_pos_range $1 $2} /* foo $a, $b */ | word_paren parenthesized {sp_0($2); (P_tok, call(Deref(I_func, fst $1), sndfst $2)), sp_pos_range $1 $2} /* foo(@args) */ -| word BRACKET lines BRACKET_END listexpr %prec LSTOP {sp_n($2); check_block_sub $3 $4; ((if sndfst $5 = [] then P_tok else P_call_no_paren), call(Deref(I_func, fst $1), anonymous_sub(fst $3) :: sndfst $5)), sp_pos_range $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); ((if sndfst $7 = [] then P_tok else P_call_no_paren), call(Deref(I_func, fst $1), anonymous_sub [ Ref(I_hash, sndfst $4) ] :: sndfst $7)), sp_pos_range $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); ((if sndfst $8 = [] then P_tok else P_call_no_paren), call(Deref(I_func, fst $1), anonymous_sub [ Ref(I_hash, sndfst $4); Semi_colon ] :: sndfst $8)), sp_pos_range $1 $8} /* map { { foo }; } @bar */ +| word BRACKET lines BRACKET_END listexpr %prec LSTOP {sp_n($2); check_block_sub $3 $4; ((if sndfst $5 = [] then P_tok else P_call_no_paren), call(Deref(I_func, fst $1), anonymous_sub $3 :: sndfst $5)), sp_pos_range $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); ((if sndfst $7 = [] then P_tok else P_call_no_paren), call(Deref(I_func, fst $1), anonymous_sub([ Ref(I_hash, sndfst $4) ], snd $4) :: sndfst $7)), sp_pos_range $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); ((if sndfst $8 = [] then P_tok else P_call_no_paren), call(Deref(I_func, fst $1), anonymous_sub([ Ref(I_hash, sndfst $4); Semi_colon ], snd $4) :: sndfst $8)), sp_pos_range $1 $8} /* map { { foo }; } @bar */ | term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); (P_tok, to_Method_call(sndfst $1, fst $3, sndfst $4)), sp_pos_range $1 $4} /* $foo->bar(list) */ | term ARROW word_or_scalar {sp_0($2); sp_0($3); (P_tok, to_Method_call(sndfst $1, fst $3, [])), sp_pos_range $1 $3} /* $foo->bar */ @@ -304,11 +306,11 @@ term: | 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 ...\"" } -| PRINT { to_Call_op_(P_call_no_paren, fst $1, var_STDOUT :: [ var_dollar_ ]) (snd $1)} +| PRINT { to_Call_op_(P_call_no_paren, fst $1, var_STDOUT :: [ var_dollar_ (get_pos $1) ]) (snd $1)} | PRINT argexpr {check_parenthesized_first_argexpr (fst $1) $2; to_Call_op_(P_call_no_paren, fst $1, var_STDOUT :: sndfst $2) (sp_pos_range $1 $2)} | PRINT_TO_SCALAR { to_Call_op_(P_call_no_paren, fstfst $1, var_STDOUT :: [ Deref(I_scalar, Ident(None, sndfst $1, get_pos $1)) ]) (snd $1)} | PRINT_TO_SCALAR argexpr { to_Call_op_(P_call_no_paren, fstfst $1, Deref(I_scalar, Ident(None, sndfst $1, get_pos $1)) :: sndfst $2) (sp_pos_range $1 $2)} -| PRINT_TO_STAR { to_Call_op_(P_call_no_paren, fstfst $1, Deref(I_star, Ident(None, sndfst $1, get_pos $1)) :: [ var_dollar_ ]) (snd $1)} +| PRINT_TO_STAR { to_Call_op_(P_call_no_paren, fstfst $1, Deref(I_star, Ident(None, sndfst $1, get_pos $1)) :: [ var_dollar_ (get_pos $1) ]) (snd $1)} | PRINT_TO_STAR argexpr { to_Call_op_(P_call_no_paren, fstfst $1, Deref(I_star, Ident(None, sndfst $1, get_pos $1)) :: sndfst $2) (sp_pos_range $1 $2)} | hash PKG_SCOPE {sp_0($2); (P_tok, Call(Too_complex, [fst $1])), sp_pos_range $1 $2} /* %main:: */ @@ -325,8 +327,9 @@ terminal: | QUOTEWORDS {to_Call_op_(P_tok, "qw", [to_Raw_string $1]) (snd $1)} | HERE_DOC {(P_tok, to_String false (fstfst $1, snd $1)), snd $1} | RAW_HERE_DOC {(P_tok, Raw_string(fstfst $1, raw_pos2pos (sndfst $1))), snd $1} -| PATTERN {to_Call_op_(P_expr, "m//", var_dollar_ :: from_PATTERN $1) (snd $1)} -| PATTERN_SUBST {to_Call_op_(P_expr, "s///", var_dollar_ :: from_PATTERN_SUBST $1) (snd $1)} +| QR_PATTERN {to_Call_op_(P_tok, "qr//", from_PATTERN $1) (snd $1)} +| PATTERN {to_Call_op_(P_expr, "m//", var_dollar_ (get_pos $1) :: from_PATTERN $1) (snd $1)} +| PATTERN_SUBST {to_Call_op_(P_expr, "s///", var_dollar_ (get_pos $1) :: from_PATTERN_SUBST $1) (snd $1)} | diamond {(P_expr, fst $1), snd $1} diamond: diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml index a965dba..0cea7e2 100644 --- a/perl_checker.src/parser_helper.ml +++ b/perl_checker.src/parser_helper.ml @@ -8,7 +8,7 @@ let raw_pos2pos(a, b) = !Info.current_file, a, b let pos_range (_, (_, (a1, b1))) (_, (_, (a2, b2))) = raw_pos2pos((if a1 = -1 then a2 else a1), (if b2 = -1 then b1 else b2)) let sp_pos_range (_, (space, (a1, b1))) (_, (_, (a2, b2))) = space, ((if a1 = -1 then a2 else a1), (if b2 = -1 then b1 else b2)) let get_pos (_, (_, pos)) = raw_pos2pos pos -let var_dollar_ = Deref(I_scalar, Ident(None, "_", raw_pos2pos bpos)) +let var_dollar_ pos = Deref(I_scalar, Ident(None, "_", pos)) let var_STDOUT = Deref(I_star, Ident(None, "STDOUT", raw_pos2pos bpos)) let is_var_dollar_ = function @@ -227,19 +227,21 @@ let sp_same (_, (spaces1, _) as ter1) (_, (spaces2, _) as ter2) = let check_word_alone (word, _) = match word with - | Ident(None, f, _) -> + | Ident(None, f, pos) -> (match f with | "length" | "stat" | "lstat" | "chop" | "chomp" | "quotemeta" | "lc" | "lcfirst" | "uc" | "ucfirst" -> - Deref(I_func, word) + Call(Deref(I_func, word), [var_dollar_ pos]) - | "split" | "shift" - | "return" | "eof" | "die" | "caller" + | "split" -> Call(Deref(I_func, word), [ Raw_string(" ", pos) ; var_dollar_ pos ]) + | "shift" -> Call(Deref(I_func, word), [ Deref(I_array, Ident(None, "_", raw_pos2pos bpos)) ]) + | "die" -> Call(Deref(I_func, word), [ Deref(I_scalar, Ident(None, "@", raw_pos2pos bpos)) ]) + | "return" | "eof" | "caller" | "redo" | "next" | "last" -> Deref(I_func, word) | "hex" | "ref" -> warn_rule (sprintf "please use \"%s $_\" instead of \"%s\"" f f) ; - Deref(I_func, word) + Call(Deref(I_func, word), [ Raw_string(" ", pos) ; var_dollar_ pos ]) | "time" | "wantarray" | "fork" | "getppid" | "arch" -> warn_rule (sprintf "please use %s() instead of %s" f f) ; Deref(I_func, word) @@ -399,8 +401,9 @@ let to_Local ((_, e), (_, pos)) = | _ -> [e] in let local_vars, local_exprs = fpartition (function - | Deref(I_star, Ident(None, ident, _)) -> - Some(I_star, ident) + | Deref(I_star as context, Ident(None, ident, _)) + | Deref(I_scalar as context, Ident(None, ("_" as ident), _)) -> + Some(context, ident) | Deref(I_scalar, Ident _) | Deref(I_array, Ident _) | Deref(I_star, Ident _) @@ -419,7 +422,7 @@ let op prio s (_, both) = prio, (((), both), s) let op_p prio s e = sp_p e ; op prio s e let sub_declaration (name, proto) body = Sub_declaration(name, proto, Block body) -let anonymous_sub body = Anonymous_sub (Block body) +let anonymous_sub (body, (_, pos)) = Anonymous_sub (Block body, raw_pos2pos pos) let cook_call_op(op, para, pos) = let call = Call_op(op, para, raw_pos2pos pos) in @@ -499,6 +502,13 @@ let call_func is_a_func (e, para) = if para = [] then warn_rule "length() with no parameter !?" else if is_not_a_scalar (List.hd para) then warn_rule "never use \"length @l\", it returns the length of the string int(@l)" ; None + + | "split" -> + (match para with + | [ List(Call_op("m//", Deref(I_scalar, Ident(None, "_", _)) :: pattern, pos) :: l) ] + | Call_op("m//", Deref(I_scalar, Ident(None, "_", _)) :: pattern, pos) :: l -> + Some(Call_op("qr//", pattern, pos) :: l) + | _ -> None) | _ -> None in Call(e, some_or para' para) diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli index a5b0837..d3a1028 100644 --- a/perl_checker.src/parser_helper.mli +++ b/perl_checker.src/parser_helper.mli @@ -5,7 +5,7 @@ val pos_range : val sp_pos_range : 'a * ('b * (int * int)) -> 'c * ('d * (int * int)) -> 'b * (int * int) val get_pos : 'a * ('b * ('c * 'd)) -> string * 'c * 'd -val var_dollar_ : Types.fromparser +val var_dollar_ : Types.pos -> Types.fromparser val var_STDOUT : Types.fromparser val is_var_dollar_ : Types.fromparser -> bool val is_var_number_match : Types.fromparser -> bool @@ -110,7 +110,8 @@ val op_p : 'a * ((unit * (Types.spaces * (int * 'd))) * 'b) val sub_declaration : Types.fromparser * string -> Types.fromparser list -> Types.fromparser -val anonymous_sub : Types.fromparser list -> Types.fromparser +val anonymous_sub : + Types.fromparser list * ('a * (int * int)) -> Types.fromparser val cook_call_op : string * Types.fromparser list * (int * int) -> Types.fromparser val call_op_ : diff --git a/perl_checker.src/perl_checker.ml b/perl_checker.src/perl_checker.ml index bf4853d..489042a 100644 --- a/perl_checker.src/perl_checker.ml +++ b/perl_checker.src/perl_checker.ml @@ -78,7 +78,7 @@ let parse_options = let usage = "Usage: perl_checker [-v] [-q] <files>\nOptions are:" in Arg.parse options (lpush args_r) usage; - let args = if !args_r = [] then (Unix.chdir "/home/pixel/cooker/gi/perl-install" ; ["/home/pixel/cooker/gi/perl-install/t.pl"]) else !args_r in + let args = if !args_r = [] then ["../t.pl"] else !args_r in let required_packages, state = collect_withenv parse_file default_state args in let state = parse_required_packages state required_packages in diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml index bc72db8..94efd3d 100644 --- a/perl_checker.src/tree.ml +++ b/perl_checker.src/tree.ml @@ -112,7 +112,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 }) @@ -252,7 +252,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' @@ -357,12 +357,12 @@ let is_global_var context ident = match context with | I_scalar -> (match ident with - | "_" | "@" | "!" | ">" | "\\" | "$" | "^A" | "'" | "/" | "?" | "<" | "^W" | "|" | "^I" | "&" + | "@" | "!" | ">" | "\\" | "$" | "^A" | "'" | "/" | "?" | "<" | "^W" | "|" | "^I" | "&" | "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" -> true | _ -> false) | I_array -> (match ident with - | "_" | "ARGV" | "INC" -> true + | "ARGV" | "INC" -> true | _ -> false) | I_hash -> (match ident with @@ -429,7 +429,7 @@ let declare_Our vars (ours, pos) = | [] -> vars (* we're at the toplevel, already declared in vars_declared *) | l_pre :: other -> List.iter (fun v -> - if List.mem_assoc v l_pre then warn_with_pos pos (sprintf "redeclared variable %s" (variable2s v)) + if List.mem_assoc v l_pre && v <> (I_scalar, "_") then warn_with_pos pos (sprintf "redeclared variable %s" (variable2s v)) ) ours ; { vars with our_vars = (List.map (fun v -> v, (pos, ref false)) ours @ l_pre) :: other } @@ -455,13 +455,28 @@ 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", pos)), (Anonymous_sub(Block f) :: 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) ; (I_scalar, "b"), (pos, ref true) ] :: 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, _)), Anonymous_sub(Block f, pos) :: l) when func = "grep" || func = "map" || func = "substInFile" || func = "map_index" || func = "each_index" || func = "partition" || func = "find_index" || func = "grep_index" -> + 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)] :: vars.our_vars } in + let vars' = List.fold_left check_variables_ vars' f in + check_unused_local_variables vars' ; + Some vars + + | Call_op("while infix", [ expr ; (List [ Call_op("<>", _, _) ] as l) ], pos) + | Call_op("for infix", [ expr ; l ], pos) -> + let vars = check_variables_ vars l in + let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref true)] :: vars.our_vars } in + let vars' = check_variables_ vars' expr in + if List.hd(vars'.my_vars) <> [] then warn_with_pos pos "you can't declare variables in foreach infix"; + Some vars + | Call_op("foreach my", [my; expr; Block block], _) -> let vars = check_variables_ vars expr in let vars = check_variables_ vars (Block (my :: block)) in @@ -474,18 +489,30 @@ let check_variables vars t = let vars = List.fold_left check_variables_ vars other in Some vars - | Sub_declaration(Ident(None, "AUTOLOAD", pos) as ident, _proto, Block l) -> + | Sub_declaration(Ident(fq, name, pos) as ident, _proto, Block l) -> let vars = declare_Our vars ([ I_func, string_of_Ident ident ], pos) in - let vars' = { vars with my_vars = [ (I_scalar, "AUTOLOAD"), (pos, ref true) ] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in + let local_vars = ((I_array, "_"), (pos, ref true)) :: (if fq = None && name = "AUTOLOAD" then [ (I_scalar, "AUTOLOAD"), (pos, ref true) ] else []) in + let vars' = { vars with 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 - | Sub_declaration(Ident(_, _, pos) as ident, _proto, body) -> - let vars = declare_Our vars ([ I_func, string_of_Ident ident ], pos) in - let vars = check_variables_ vars body in + | Anonymous_sub(Block l, pos) -> + let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_array, "_"), (pos, ref true)] :: vars.our_vars } in + let vars' = List.fold_left check_variables_ vars' l in + check_unused_local_variables vars' ; + Some vars + + | Call_op("foreach", [ expr ; Block l ], pos) -> + let vars = check_variables_ vars expr in + let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref true)] :: vars.our_vars } in + let vars' = List.fold_left check_variables_ vars' l in + check_unused_local_variables vars' ; Some vars + | Anonymous_sub _ + | Sub_declaration _ -> internal_error "check_variables" + | Ident _ as var -> check_variable (I_star, var) vars ; Some vars diff --git a/perl_checker.src/types.mli b/perl_checker.src/types.mli index f69dc3d..2aeb4b7 100644 --- a/perl_checker.src/types.mli +++ b/perl_checker.src/types.mli @@ -33,7 +33,7 @@ type fromparser = | Call of fromparser * fromparser list | Method_call of fromparser * fromparser * fromparser list - | Anonymous_sub of fromparser + | Anonymous_sub of fromparser * pos | My_our of string * (context * string) list * pos | Use of fromparser * fromparser list | Sub_declaration of fromparser * string * fromparser (* name, prototype, body *) |