4 « installer - doc - The doc.mageia.org Website

about summary refs log tree commit diff stats

path: root/installer/4

Mode

Name

Size

d---------

72

log stats plain

d---------

131

log stats plain

d---------

72

log stats plain

d---------

72

log stats plain

d---------

72

log stats plain

d---------

72

log stats plain

d---------

72

log stats plain

d---------

72

log stats plain

d---------

-rw-r--r--

perl_checker.src/global_checks.ml

52

-rw-r--r--

perl_checker.src/global_checks.mli

1

-rw-r--r--

perl_checker.src/lexer.mll

8

-rw-r--r--

perl_checker.src/parser.mly

34

-rw-r--r--

perl_checker.src/parser_helper.ml

18

-rw-r--r--

perl_checker.src/parser_helper.mli

6

-rw-r--r--

perl_checker.src/tree.ml

34

-rw-r--r--

perl_checker.src/tree.mli

2

-rw-r--r--

perl_checker.src/types.mli

4

9 files changed, 101 insertions, 58 deletions

v>

@@ -245,14 +246,14 @@ 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", _)), (Anonymous_sub(Block f, pos) :: 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, None) ; (I_scalar, "b"), (pos, ref true, None) ] :: 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, func_pos)), Anonymous_sub(Block f, pos) :: l)

+ | Call(Deref(I_func, Ident(None, func, func_pos)), Anonymous_sub(_, Block f, pos) :: l)

when List.mem func [ "grep" ; "map" ; "substInFile" ; "map_index" ; "each_index" ; "partition" ; "find_index" ; "grep_index" ; "find" ; "any" ; "every" ] ->

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, None)] :: vars.our_vars } in

@@ -261,10 +262,16 @@ let check_variables vars t =

check_variable (I_func, Ident(None, func, func_pos)) vars None ;

Some vars

+ | Call(Deref(I_func, (Ident _ as ident)), [ Deref(I_star, (Ident(None, "_", _))) ]) ->

+ (* the &f case: allow access to @_ *)

+ check_variable (I_func, ident) vars None ;

+ let _ = is_my_declared vars (I_array, "_") in

+ Some vars

+

| Call(Deref(I_func, (Ident _ as ident)), [ List [ Deref(I_array, (Ident(None, "_", pos))) ] ]) ->

(* special warning if @_ is unbound *)

check_variable (I_func, ident) vars None ;

- if not (is_our_declared vars (I_array, "_")) then

+ if not (is_my_declared vars (I_array, "_")) then

warn_with_pos pos (sprintf "replace %s(@_) with &%s" (string_of_Ident ident) (string_of_Ident ident)) ;

Some vars

@@ -293,27 +300,32 @@ 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) ->

let vars = declare_Our vars ([ I_func, string_of_Ident ident ], pos) in

- let local_vars, l =

- match has_proto (Block body) with

+ let my_vars, l =

+ match has_proto perl_proto (Block body) with

| Some(mys, mys_pos, body) ->

[], My_our ("my", mys, mys_pos) :: body

- | _ -> [(I_array, "_"), (pos, ref true, None)], body

+ | _ ->

+ let dont_check_use =

+ fq = None && List.mem name ["BEGIN"; "END"; "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

in

let local_vars =

if fq = None && name = "AUTOLOAD"

- then ((I_scalar, "AUTOLOAD"), (pos, ref true, None)) :: local_vars

- else local_vars in

+ then [ (I_scalar, "AUTOLOAD"), (pos, ref true, None) ]

+ else [] in

- let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = local_vars :: vars.our_vars } in

+ let vars' = { vars with my_vars = 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

- | Anonymous_sub(Block l, pos) ->

- let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_array, "_"), (pos, ref true, None)] :: vars.our_vars } in

+ | Anonymous_sub(_, Block l, pos) ->

+ let vars' = { vars with my_vars = [(I_array, "_"), (pos, ref true, None)] :: vars.my_vars } in

let vars' = List.fold_left check_variables_ vars' l in

check_unused_local_variables vars' ;

Some vars

@@ -452,8 +464,8 @@ let arrange_global_vars_declared state =

{ state with global_vars_declared = h }

let get_methods_available state =

- let get_classes state =

- let l = hashtbl_collect (fun _ package ->

+ let classes = uniq (

+ hashtbl_collect (fun _ package ->

match package.isa with

| None ->

if Hashtbl.mem package.vars_declared (I_func, "new") then [package] else []

@@ -463,20 +475,20 @@ let get_methods_available state =

Hashtbl.find state.per_package pkg

with Not_found -> die_with_pos pos ("bad package " ^ pkg)

) l

- ) state.per_package in

- uniq l

- in

+ ) state.per_package

+ ) in

List.iter (fun pkg ->

+ Hashtbl.replace state.packages_being_classes pkg.package_name () ;

Hashtbl.iter (fun (context, v) (pos, is_used, proto) ->

if context = I_func then

let l = try Hashtbl.find state.methods v with Not_found -> [] in

Hashtbl.replace state.methods v ((pos, is_used, proto) :: l)

) pkg.vars_declared

- ) (get_classes state) ;

+ ) classes ;

state

-let default_state() = { per_package = Hashtbl.create 16; methods = Hashtbl.create 256 ; global_vars_declared = Hashtbl.create 256; global_vars_used = ref [] }

+let default_state() = { per_package = Hashtbl.create 16; methods = Hashtbl.create 256 ; global_vars_declared = Hashtbl.create 256; global_vars_used = ref []; packages_being_classes = Hashtbl.create 16 }

let cache_cache = Hashtbl.create 16

diff --git a/perl_checker.src/global_checks.mli b/perl_checker.src/global_checks.mli
index e081e48..6b25f73 100644
--- a/perl_checker.src/global_checks.mli
+++ b/perl_checker.src/global_checks.mli

@@ -6,6 +6,7 @@ type state = {

methods : (string, (pos * bool ref * prototype option) list) Hashtbl.t ;

global_vars_declared : (context * string * string, pos * prototype option) Hashtbl.t;

global_vars_used : ((context * string * string) * pos) list ref;

+ packages_being_classes : (string, unit) Hashtbl.t ;

}

val default_state : unit -> state

diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll
index 59e348e..044c562 100644
--- a/perl_checker.src/lexer.mll
+++ b/perl_checker.src/lexer.mll

@@ -39,6 +39,7 @@ type raw_token =

| RAW_IDENT of (string option * string * raw_pos)

| RAW_IDENT_PAREN of (string option * string * raw_pos)

| ARRAYLEN_IDENT of (string option * string * raw_pos)

+ | SUB_WITH_PROTO of (string * raw_pos)

| FUNC_DECL_WITH_PROTO of (string * string * raw_pos)

| IF of raw_pos | ELSIF of raw_pos | ELSE of raw_pos | UNLESS of raw_pos | DO of raw_pos | WHILE of raw_pos | UNTIL of raw_pos | MY_OUR of (string * raw_pos) | CONTINUE of raw_pos | SUB of raw_pos

@@ -96,6 +97,7 @@ let rec raw_token_to_pos_and_token spaces = function

| RAW_IDENT(kind, name, pos) -> pos, Parser.RAW_IDENT(new_any M_special (kind, name) spaces pos)

| RAW_IDENT_PAREN(kind, name, pos) -> pos, Parser.RAW_IDENT_PAREN(new_any M_special (kind, name) spaces pos)

| ARRAYLEN_IDENT(kind, name, pos) -> pos, Parser.ARRAYLEN_IDENT(new_any M_special (kind, name) spaces pos)

+ | SUB_WITH_PROTO(proto, pos) -> pos, Parser.SUB_WITH_PROTO(new_any M_special proto spaces pos)

| FUNC_DECL_WITH_PROTO(name, proto, pos) -> pos, Parser.FUNC_DECL_WITH_PROTO(new_any M_special (name, proto) spaces pos)

| NEW(pos) -> pos, Parser.NEW(new_any M_special () spaces pos)

@@ -584,12 +586,16 @@ rule token = parse

| "\\" ' '* '('

{ putback lexbuf 1; REF(pos lexbuf) }

+| "sub(" [ '$' '@' '\\' '&' ';' '%' ]* ')' {

+ SUB_WITH_PROTO(skip_n_char_ 4 1 (lexeme lexbuf), pos lexbuf)

+ }

+

| "sub" ' '+ ident ' '* '(' [ '$' '@' '\\' '&' ';' '%' ]* ')' {

(* bloody prototypes, must be caught especially otherwise "($)" is badly tokenized *)

(* and alas "($@)" is both valid as an expression and a prototype *)

let s = lexeme lexbuf in

let ident_start = non_index_from s 3 ' ' in

-

+

let proto_start = String.index_from s ident_start '(' in

let ident_end = non_rindex_from s (proto_start-1) ' ' in

let ident = String.sub s ident_start (ident_end - ident_start + 1) in

diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly
index 0b27e80..d2a8cc9 100644
--- a/perl_checker.src/parser.mly
+++ b/perl_checker.src/parser.mly

@@ -23,6 +23,7 @@

%token <((string * ((int * int) * token) list) list * (string * ((int * int) * token) list) list * string) Types.any_spaces_pos> PATTERN_SUBST

%token <(string option * string) Types.any_spaces_pos> SCALAR_IDENT ARRAY_IDENT HASH_IDENT FUNC_IDENT STAR_IDENT RAW_IDENT RAW_IDENT_PAREN ARRAYLEN_IDENT

+%token <string Types.any_spaces_pos> SUB_WITH_PROTO

%token <(string * string) Types.any_spaces_pos> FUNC_DECL_WITH_PROTO

%token <string Types.any_spaces_pos> FOR PRINT

@@ -154,14 +155,14 @@ sideff: /* An expression which may have a side-effect */

decl:

| FORMAT BAREWORD ASSIGN {new_esp M_special Too_complex $1 $3}

| FORMAT ASSIGN {new_esp M_special Too_complex $1 $2}

-| func_decl semi_colon {if snd $1.any = "" 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 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}

| 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), "", 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), "", 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)) $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}

| use {$1}

use:

@@ -179,8 +180,8 @@ use_revision:

| USE {$1}

func_decl:

-| SUB word { new_esp M_none ($2.any, "") $1 $2}

-| FUNC_DECL_WITH_PROTO {new_1esp (Ident(None, fst $1.any, get_pos $1), snd $1.any) $1 }

+| SUB word { new_esp M_none ($2.any, None) $1 $2}

+| FUNC_DECL_WITH_PROTO {new_1esp (Ident(None, fst $1.any, get_pos $1), Some (snd $1.any)) $1 }

listexpr: /* Basic list expressions */

| %prec PREC_LOW { default_pesp P_tok []}

@@ -276,18 +277,27 @@ term:

| BRACKET BRACKET_END {new_pesp (M_ref M_hash) P_expr (Ref(I_hash, List [])) $1 $2} /* empty hash */

| BRACKET_HASHREF expr BRACKET_END %prec PREC_HIGH {sp_p($3); new_pesp (M_ref M_hash) P_expr (Ref(I_hash, $2.any.expr)) $1 $3} /* { foo => "Bar" } */

-| SUB BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); new_pesp (M_ref M_sub) P_expr (anonymous_sub (new_esp (M_ref M_array) [] $2 $2)) $1 $3}

-| SUB BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; new_pesp (M_ref M_sub) P_expr (anonymous_sub $3) $1 $4}

+| SUB BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); new_pesp (M_ref M_sub) P_expr (anonymous_sub None (new_esp (M_ref M_array) [] $2 $2)) $1 $3}

+| SUB_WITH_PROTO BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); new_pesp (M_ref M_sub) P_expr (anonymous_sub (Some $1.any) (new_esp (M_ref M_array) [] $2 $2)) $1 $3}

+| SUB BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; new_pesp (M_ref M_sub) P_expr (anonymous_sub None $3) $1 $4}

+| SUB_WITH_PROTO BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_block_sub $3 $4; new_pesp (M_ref M_sub) P_expr (anonymous_sub (Some $1.any) $3) $1 $4}

| termdo {new_1pesp P_tok $1.any $1}

-| REF term {new_pesp (M_ref $2.mcontext) P_expr (Ref(I_scalar, $2.any.expr)) $1 $2} /* \$x, \@y, \%z */

+| REF term {new_pesp (M_ref $2.mcontext) P_expr (Ref(I_scalar, remove_call_with_same_para_special $2.any.expr)) $1 $2} /* \$x, \@y, \%z */

| my_our %prec UNIOP {new_1pesp P_expr $1.any $1}

| LOCAL term %prec UNIOP {sp_n($2); new_pesp $2.mcontext P_expr (to_Local $2) $1 $2}

| parenthesized {new_1pesp $1.any.priority (List $1.any.expr) $1} /* (1, 2) */

| parenthesized arrayref {sp_0($2); let is_slice = not (is_only_one_in_List $2.any) in new_pesp (if is_slice then M_list else M_scalar) P_tok (to_Deref_with(I_array, (if is_slice then I_array else I_scalar), List $1.any.expr, List $2.any)) $1 $2} /* list indexing or slicing */

-| variable {new_1pesp P_tok $1.any $1}

+| variable {

+ let e =

+ match $1.any with

+ | Deref(I_func, Ident _) ->

+ call_with_same_para_special $1.any (* not the same as f(@_) *)

+ | e -> e in

+ new_1pesp P_tok e $1

+ }

| subscripted {new_1pesp P_tok $1.any $1}

@@ -308,9 +318,9 @@ term:

| func parenthesized {sp_0($2); new_pesp M_unknown P_tok (call_func true ($1.any, $2.any.expr)) $1 $2} /* &foo(@args) */

| word argexpr {check_parenthesized_first_argexpr_with_Ident $1.any $2; new_pesp M_unknown P_call_no_paren (call(Deref(I_func, $1.any), $2.any.expr)) $1 $2} /* foo $a, $b */

| word_paren parenthesized {sp_0($2); new_pesp M_unknown P_tok (call(Deref(I_func, $1.any), $2.any.expr)) $1 $2} /* foo(@args) */

-| word BRACKET lines BRACKET_END listexpr %prec LSTOP {sp_n($2); check_block_sub $3 $4; new_pesp M_unknown (if $5.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub $3 :: $5.any.expr)) $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); new_pesp M_unknown (if $7.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub(new_esp (M_ref M_hash) [ Ref(I_hash, $4.any.expr) ] $4 $4) :: $7.any.expr)) $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); new_pesp M_unknown (if $8.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub(new_esp (M_ref M_hash) [ Ref(I_hash, $4.any.expr); Semi_colon ] $4 $4) :: $8.any.expr)) $1 $8} /* map { { foo }; } @bar */

+| word BRACKET lines BRACKET_END listexpr %prec LSTOP {sp_n($2); check_block_sub $3 $4; new_pesp M_unknown (if $5.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub None $3 :: $5.any.expr)) $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); new_pesp M_unknown (if $7.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub None (new_esp (M_ref M_hash) [ Ref(I_hash, $4.any.expr) ] $4 $4) :: $7.any.expr)) $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); new_pesp M_unknown (if $8.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub None (new_esp (M_ref M_hash) [ Ref(I_hash, $4.any.expr); Semi_colon ] $4 $4) :: $8.any.expr)) $1 $8} /* map { { foo }; } @bar */

| term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); new_pesp M_unknown P_tok (to_Method_call($1.any.expr, $3.any, $4.any.expr)) $1 $4} /* $foo->bar(list) */

| term ARROW word_or_scalar {sp_0($2); sp_0($3); new_pesp M_unknown P_tok (to_Method_call($1.any.expr, $3.any, [])) $1 $3} /* $foo->bar */

diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml
index db6182c..fb8ba16 100644
--- a/perl_checker.src/parser_helper.ml
+++ b/perl_checker.src/parser_helper.ml

@@ -566,7 +566,11 @@ let to_Local esp =

else die_with_rawpos esp.pos "bad argument to \"local\""

let sub_declaration (name, proto) body = Sub_declaration(name, proto, Block body)

-let anonymous_sub body = Anonymous_sub (Block body.any, raw_pos2pos body.pos)

+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

+ | Call(f, [Deref(I_star, (Ident(None, "_", _)))]) -> f

+ | e -> e

let cook_call_op op para pos =

(match op with

@@ -604,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, "") [ Deref(I_func, f2) ]

+ sub_declaration (f1, None) [ call_with_same_para_special(Deref(I_func, f2)) ]

| "=", [ 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), "") [ Deref(I_func, f2) ]

+ sub_declaration (Ident(None, sf1, pos_f1), None) [ call_with_same_para_special(Deref(I_func, f2)) ]

| "=", [ Deref(I_star, (Ident _ as f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] ->

- sub_declaration (f1, "") [ Deref(I_func, f2) ]

+ sub_declaration (f1, None) [ call_with_same_para_special(Deref(I_func, f2)) ]

| "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] ->

- sub_declaration (Ident(None, sf1, pos_f1), "") [ Deref(I_func, f2) ]

+ sub_declaration (Ident(None, sf1, pos_f1), None) [ call_with_same_para_special(Deref(I_func, f2)) ]

- | "=", [ Deref(I_star, (Ident _ as f1)); (Anonymous_sub _ as sub) ] ->

- sub_declaration (f1, "") [ sub ]

+ | "=", [ Deref(I_star, (Ident _ as f1)); (Anonymous_sub(proto, sub, _)) ] ->

+ sub_declaration (f1, proto) [ sub ]

| "||", 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 03d9af9..77fef90 100644
--- a/perl_checker.src/parser_helper.mli
+++ b/perl_checker.src/parser_helper.mli

@@ -149,9 +149,13 @@ val to_Local :

Types.fromparser Types.prio_anyexpr Types.any_spaces_pos ->

Types.fromparser

val sub_declaration :

- Types.fromparser * string -> Types.fromparser list -> Types.fromparser

+ Types.fromparser * string option ->

+ Types.fromparser list -> Types.fromparser

val anonymous_sub :

+ string option ->

Types.fromparser list Types.any_spaces_pos -> Types.fromparser

+val call_with_same_para_special : Types.fromparser -> Types.fromparser

+val remove_call_with_same_para_special : Types.fromparser -> Types.fromparser

val cook_call_op :

string -> Types.fromparser list -> int * int -> Types.fromparser

val to_Call_op :

diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml
index e69bd0b..8154eb6 100644
--- a/perl_checker.src/tree.ml
+++ b/perl_checker.src/tree.ml

@@ -116,7 +116,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 })

@@ -151,7 +151,7 @@ let get_exported t =

Ref(I_array,

List[List[

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", _))])])

]])

], _)] ->

@@ -246,25 +246,31 @@ let read_xs_extension_from_so global_vars_declared package pos =

true

with Not_found -> false

-let has_proto = function

- | Block (List [Call_op ("=", [My_our ("my", mys, mys_pos); Deref(I_array, Ident(None, "_", _))], _pos)] :: body) ->

- Some(mys, mys_pos, body)

- | _ -> None

-

-let get_proto body =

+let has_proto perl_proto body =

+ match perl_proto with

+ | Some "" -> Some([], raw_pos2pos bpos, [body])

+ | _ ->

+ match body with

+ | Block [] ->

+ Some([ I_array, "_empty" ], raw_pos2pos bpos, [])

+ | Block (List [Call_op ("=", [My_our ("my", mys, mys_pos); Deref(I_array, Ident(None, "_", _))], _pos)] :: body) ->

+ Some(mys, mys_pos, body)

+ | _ -> None

+

+let get_proto perl_proto body =

map_option (fun (mys, _pos, _) ->

let scalars, others = break_at (fun (context, _) -> context <> I_scalar) mys in

let must_have, optional = break_at (fun (_, s) -> String.length s > 2 && (s.[0] = 'o' || s.[0] = 'b') && s.[1] = '_') scalars in

let min = List.length must_have in

{ proto_nb_min = min; proto_nb_max = if others = [] then Some(min + List.length optional) else None }

- ) (has_proto body)

+ ) (has_proto perl_proto body)

let get_vars_declaration global_vars_declared package =

List.iter (function

- | Sub_declaration(Ident(None, name, pos), _perl_proto, body) ->

- Hashtbl.replace package.vars_declared (I_func, name) (pos, ref false, get_proto body)

- | Sub_declaration(Ident(Some fq, name, pos), _perl_proto, body) ->

- Hashtbl.replace global_vars_declared (I_func, fq, name) (pos, get_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) ->

+ Hashtbl.replace global_vars_declared (I_func, fq, name) (pos, get_proto perl_proto body)

| List [ Call_op("=", [My_our("our", ours, pos); _], _) ]

| List [ Call_op("=", [My_our("local", ([ I_scalar, "_" ] as ours), pos); _], _) ]

@@ -293,7 +299,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'

diff --git a/perl_checker.src/tree.mli b/perl_checker.src/tree.mli
index 48b2657..c3b89b2 100644
--- a/perl_checker.src/tree.mli
+++ b/perl_checker.src/tree.mli

@@ -40,7 +40,7 @@ val findfile : string list -> string -> string

val get_global_info_from_package : bool -> int -> fromparser list -> per_package list

-val has_proto : fromparser -> ((context * string) list * pos * fromparser list) option

+val has_proto : string option -> fromparser -> ((context * string) list * pos * fromparser list) option

val get_vars_declaration : (context * string * string, pos * prototype option) Hashtbl.t -> per_package -> unit

val die_with_pos : string * int * int -> string -> 'a

diff --git a/perl_checker.src/types.mli b/perl_checker.src/types.mli
index c8fbeaa..1a33d20 100644
--- a/perl_checker.src/types.mli
+++ b/perl_checker.src/types.mli

@@ -47,10 +47,10 @@ type fromparser =

| Call of fromparser * fromparser list

| Method_call of fromparser * fromparser * fromparser list

- | Anonymous_sub of fromparser * pos

+ | 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 * fromparser (* name, prototype, body *)

+ | Sub_declaration of fromparser * string option * fromparser (* name, prototype, body *)

| Package of fromparser

| Label of string

| Perl_checker_comment of string * pos