summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2003-04-30 09:30:59 +0000
committerPascal Rigaux <pixel@mandriva.com>2003-04-30 09:30:59 +0000
commit3d726d18053a2ea9cf435d661fc6fd0a36daab99 (patch)
tree64406beefbf9d941a955d72f33dcb1f5d8ef15cf
parent16d1e7e21e4169abd573a3b6e53afb4a203a81f2 (diff)
downloadperl_checker-3d726d18053a2ea9cf435d661fc6fd0a36daab99.tar
perl_checker-3d726d18053a2ea9cf435d661fc6fd0a36daab99.tar.gz
perl_checker-3d726d18053a2ea9cf435d661fc6fd0a36daab99.tar.bz2
perl_checker-3d726d18053a2ea9cf435d661fc6fd0a36daab99.tar.xz
perl_checker-3d726d18053a2ea9cf435d661fc6fd0a36daab99.zip
allow "*foo = sub {}" with no prototype
-rw-r--r--perl_checker.src/global_checks.ml5
-rw-r--r--perl_checker.src/parser.mly12
-rw-r--r--perl_checker.src/parser_helper.ml12
-rw-r--r--perl_checker.src/parser_helper.mli2
-rw-r--r--perl_checker.src/tree.ml6
-rw-r--r--perl_checker.src/types.mli4
6 files changed, 22 insertions, 19 deletions
diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml
index f51811a..9bb83b5 100644
--- a/perl_checker.src/global_checks.ml
+++ b/perl_checker.src/global_checks.ml
@@ -306,7 +306,7 @@ let check_variables vars t =
check_unused_local_variables vars' ;
Some vars
- | Sub_declaration(Ident(fq, name, pos) as ident, perl_proto, Block body) ->
+ | Sub_declaration(Ident(fq, name, pos) as ident, perl_proto, Block body, kind) ->
let vars = declare_Our vars ([ I_func, string_of_Ident ident ], pos) in
let my_vars, l =
@@ -315,7 +315,8 @@ let check_variables vars t =
[], My_our ("my", mys, mys_pos) :: body
| _ ->
let dont_check_use =
- fq = None && List.mem name ["BEGIN"; "END"; "DESTROY"] ||
+ kind = Glob_assign ||
+ fq = None && List.mem name ["DESTROY"] ||
Hashtbl.mem vars.state.packages_being_classes (some_or fq vars.current_package.package_name)
in
[(I_array, "_"), (pos, ref dont_check_use, None)], body
diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly
index 2a45414..2f12f75 100644
--- a/perl_checker.src/parser.mly
+++ b/perl_checker.src/parser.mly
@@ -157,13 +157,13 @@ decl:
| FORMAT BAREWORD ASSIGN {new_esp M_none Too_complex $1 $3}
| FORMAT ASSIGN {new_esp M_none Too_complex $1 $2}
| func_decl semi_colon {if snd $1.any = None then die_rule "there is no need to pre-declare in Perl!" else (warn_rule "please don't use prototype pre-declaration" ; new_esp M_special Too_complex $1 $2) }
-| func_decl BRACKET BRACKET_END {sp_n($2); sp_0_or_cr($3); let name, proto = $1.any in new_esp M_none (sub_declaration (name, proto) []) $1 $3}
-| func_decl BRACKET lines BRACKET_END {sp_n($2); check_block_sub $3 $4; new_esp M_none (sub_declaration $1.any $3.any) $1 $4}
-| func_decl BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); new_esp M_none (sub_declaration $1.any [Ref(I_hash, prio_lo P_loose $4)]) $1 $6}
-| func_decl BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); new_esp M_none (sub_declaration $1.any [Ref(I_hash, prio_lo P_loose $4); Semi_colon]) $1 $7}
+| func_decl BRACKET BRACKET_END {sp_n($2); sp_0_or_cr($3); let name, proto = $1.any in new_esp M_none (sub_declaration (name, proto) [] Real_sub_declaration) $1 $3}
+| func_decl BRACKET lines BRACKET_END {sp_n($2); check_block_sub $3 $4; new_esp M_none (sub_declaration $1.any $3.any Real_sub_declaration) $1 $4}
+| func_decl BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); new_esp M_none (sub_declaration $1.any [Ref(I_hash, prio_lo P_loose $4)] Real_sub_declaration) $1 $6}
+| func_decl BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); new_esp M_none (sub_declaration $1.any [Ref(I_hash, prio_lo P_loose $4); Semi_colon] Real_sub_declaration) $1 $7}
| PACKAGE word semi_colon {sp_0_or_cr($1); sp_1($2); new_esp M_none (Package $2.any) $1 $3}
-| BEGIN BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; new_esp M_none (Sub_declaration(Ident(None, "BEGIN", get_pos $1), None, Block $3.any)) $1 $4}
-| END BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; new_esp M_none (Sub_declaration(Ident(None, "END", get_pos $1), None, Block $3.any)) $1 $4}
+| BEGIN BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; new_esp M_none (Sub_declaration(Ident(None, "BEGIN", get_pos $1), None, Block $3.any, Glob_assign)) $1 $4}
+| END BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); check_block_sub $3 $4; new_esp M_none (Sub_declaration(Ident(None, "END", get_pos $1), None, Block $3.any, Glob_assign)) $1 $4}
| use {$1}
use:
diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml
index c7290f5..e9a0398 100644
--- a/perl_checker.src/parser_helper.ml
+++ b/perl_checker.src/parser_helper.ml
@@ -565,7 +565,7 @@ let to_Local esp =
else if local_exprs = [] then My_our("local", local_vars, raw_pos2pos esp.pos)
else die_with_rawpos esp.pos "bad argument to \"local\""
-let sub_declaration (name, proto) body = Sub_declaration(name, proto, Block body)
+let sub_declaration (name, proto) body sub_kind = Sub_declaration(name, proto, Block body, sub_kind)
let anonymous_sub proto body = Anonymous_sub (proto, Block body.any, raw_pos2pos body.pos)
let call_with_same_para_special f = Call(f, [Deref(I_star, (Ident(None, "_", raw_pos2pos bpos)))])
let remove_call_with_same_para_special = function
@@ -608,19 +608,19 @@ let cook_call_op op para pos =
| "=", [ Deref(I_star, (Ident _ as f1)); Deref(I_star, (Ident _ as f2)) ] ->
let s1, s2 = string_of_Ident f1, string_of_Ident f2 in
warn pos (sprintf "\"*%s = *%s\" is better written \"*%s = \\&%s\"" s1 s2 s1 s2) ;
- sub_declaration (f1, None) [ call_with_same_para_special(Deref(I_func, f2)) ]
+ sub_declaration (f1, None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign
| "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Deref(I_star, (Ident _ as f2)) ] ->
let s2 = string_of_Ident f2 in
warn pos (sprintf "\"*{'%s'} = *%s\" is better written \"*{'%s'} = \\&%s\"" sf1 s2 sf1 s2) ;
- sub_declaration (Ident(None, sf1, pos_f1), None) [ call_with_same_para_special(Deref(I_func, f2)) ]
+ sub_declaration (Ident(None, sf1, pos_f1), None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign
| "=", [ Deref(I_star, (Ident _ as f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] ->
- sub_declaration (f1, None) [ call_with_same_para_special(Deref(I_func, f2)) ]
+ sub_declaration (f1, None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign
| "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] ->
- sub_declaration (Ident(None, sf1, pos_f1), None) [ call_with_same_para_special(Deref(I_func, f2)) ]
+ sub_declaration (Ident(None, sf1, pos_f1), None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign
| "=", [ Deref(I_star, (Ident _ as f1)); (Anonymous_sub(proto, sub, _)) ] ->
- sub_declaration (f1, proto) [ sub ]
+ sub_declaration (f1, proto) [ sub ] Glob_assign
| "||", e :: _ when is_always_true e -> warn_rule "<constant> || ... is the same as <constant>"; call
| "&&", e :: _ when is_always_false e -> warn_rule "<constant> && ... is the same as <constant>"; call
diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli
index 09a6a0e..86cd2b2 100644
--- a/perl_checker.src/parser_helper.mli
+++ b/perl_checker.src/parser_helper.mli
@@ -150,7 +150,7 @@ val to_Local :
Types.fromparser
val sub_declaration :
Types.fromparser * string option ->
- Types.fromparser list -> Types.fromparser
+ Types.fromparser list -> Types.sub_declaration_kind -> Types.fromparser
val anonymous_sub :
string option ->
Types.fromparser list Types.any_spaces_pos -> Types.fromparser
diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml
index 8154eb6..9b62bb9 100644
--- a/perl_checker.src/tree.ml
+++ b/perl_checker.src/tree.ml
@@ -267,9 +267,9 @@ let get_proto perl_proto body =
let get_vars_declaration global_vars_declared package =
List.iter (function
- | Sub_declaration(Ident(None, name, pos), perl_proto, body) ->
+ | Sub_declaration(Ident(None, name, pos), perl_proto, body, _) ->
Hashtbl.replace package.vars_declared (I_func, name) (pos, ref false, get_proto perl_proto body)
- | Sub_declaration(Ident(Some fq, name, pos), perl_proto, body) ->
+ | Sub_declaration(Ident(Some fq, name, pos), perl_proto, body, _) ->
Hashtbl.replace global_vars_declared (I_func, fq, name) (pos, get_proto perl_proto body)
| List [ Call_op("=", [My_our("our", ours, pos); _], _) ]
@@ -310,7 +310,7 @@ let rec fold_tree f env e =
| String(l, _)
-> List.fold_left (fun env (_, e) -> fold_tree f env e) env l
- | Sub_declaration(e1, _, e2)
+ | Sub_declaration(e1, _, e2, _)
| Deref_with(_, _, e1, e2)
->
let env = fold_tree f env e1 in
diff --git a/perl_checker.src/types.mli b/perl_checker.src/types.mli
index d9bda2c..98b49e5 100644
--- a/perl_checker.src/types.mli
+++ b/perl_checker.src/types.mli
@@ -27,6 +27,8 @@ type maybe_context =
| M_unknown
| M_mixed of maybe_context list
+type sub_declaration_kind = Real_sub_declaration | Glob_assign
+
type fromparser =
| Undef
| Ident of string option * string * pos
@@ -50,7 +52,7 @@ type fromparser =
| Anonymous_sub of string option * fromparser * pos (* prototype, expr, pos *)
| My_our of string * (context * string) list * pos
| Use of fromparser * fromparser list
- | Sub_declaration of fromparser * string option * fromparser (* name, prototype, body *)
+ | Sub_declaration of fromparser * string option * fromparser * sub_declaration_kind (* name, prototype, body, kind *)
| Package of fromparser
| Label of string
| Perl_checker_comment of string * pos