summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--perl_checker.src/lexer.mll4
-rw-r--r--perl_checker.src/parser.mly23
-rw-r--r--perl_checker.src/parser_helper.ml28
-rw-r--r--perl_checker.src/parser_helper.mli5
-rw-r--r--perl_checker.src/perl_checker.ml2
-rw-r--r--perl_checker.src/tree.ml49
-rw-r--r--perl_checker.src/types.mli2
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 *)
generated by cgit v1.2.1 (git 2.21.0) at 2024-08-18 05:02:05 +0000