diff options
| -rw-r--r-- | perl_checker.src/global_checks.ml | 50 | ||||
| -rw-r--r-- | perl_checker.src/lexer.mll | 7 | ||||
| -rw-r--r-- | perl_checker.src/parser.mly | 7 |
3 files changed, 42 insertions, 22 deletions
diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml index 6160590..92a0332 100644 --- a/perl_checker.src/global_checks.ml +++ b/perl_checker.src/global_checks.ml @@ -20,6 +20,7 @@ type vars = { required_vars : (context * string * string) list ; current_package : per_package ; is_toplevel : bool ; + write_only : bool ; state : state ; } @@ -105,36 +106,39 @@ let is_anonymous_variable_name s = String.length s > 1 && s.[0] = '_' let is_my_declared vars t = List.exists (fun l -> - List.mem_assoc t l && (snd3 (List.assoc t l) := true ; true) + List.mem_assoc t l && (if not vars.write_only then snd3 (List.assoc t l) := true ; true) ) vars.my_vars let is_our_declared vars t = List.exists (fun l -> - List.mem_assoc t l && (snd3 (List.assoc t l) := true ; true) + List.mem_assoc t l && (if not vars.write_only then snd3 (List.assoc t l) := true ; true) ) vars.our_vars -let is_var_declared_and_set state package var para = - try - let (_, used, proto) = Hashtbl.find package.vars_declared var in - check_para_comply_with_prototype para proto ; - used := true ; - true - with Not_found -> +let is_var_declared_raw write_only state package var para = + match try - let (_, used, proto) = List.assoc var (get_imports state package) in + let _, used, proto = Hashtbl.find package.vars_declared var in + Some(used, proto) + with Not_found -> try + let _, used, proto = List.assoc var (get_imports state package) in + Some(used, proto) + with Not_found -> + None + with + | Some (used, proto) -> check_para_comply_with_prototype para proto ; - used := true ; + if not write_only then used := true ; true - with Not_found -> + | None -> false let is_var_declared vars var para = List.mem_assoc var vars.locally_imported || - is_var_declared_and_set vars.state vars.current_package var para + is_var_declared_raw vars.write_only vars.state vars.current_package var para let is_global_var_declared vars (context, fq, name) para = try let package = Hashtbl.find vars.state.per_packages fq in - is_var_declared_and_set vars.state package (context, name) para + is_var_declared_raw vars.write_only vars.state package (context, name) para with Not_found -> false @@ -290,6 +294,8 @@ let check_variables vars t = let vars = List.fold_left check_variables_ vars para in Some vars +(* | Call_op("=", -> List.fold_left (fold_tree f) env l*) + | 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 @@ -377,6 +383,20 @@ let check_variables vars t = if op <> "=" then warn_with_pos pos (sprintf "applying %s on a new initialized variable is wrong" op); None + | Call_op("=", [ Deref(context, (Ident _ as var)) ; para], _) -> + check_variable (context, var) { vars with write_only = true } None ; + Some (check_variables_ vars para) + + | Call_op("=", [ List [ List l ] ; para], _) -> + let vars = List.fold_left (fun vars -> function + | Deref(context, (Ident _ as var)) -> + check_variable (context, var) { vars with write_only = true } None ; + vars + | e -> check_variables_ vars e + ) vars l in + let vars = check_variables_ vars para in + Some vars + | Method_call(Raw_string(package_name, pos), Raw_string ("import", _), para) -> let args = match para with @@ -434,7 +454,7 @@ let check_variables vars t = vars let check_tree state package = - let vars = { my_vars = [[]]; our_vars = []; locally_imported = []; required_vars = []; current_package = package; state = state; is_toplevel = true } in + let vars = { my_vars = [[]]; our_vars = []; locally_imported = []; required_vars = []; current_package = package; state = state; is_toplevel = true; write_only = false } in if !Flags.verbose then print_endline_flush_always ("checking package " ^ package.package_name) ; let vars = check_variables vars package.body in check_unused_local_variables vars ; diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll index 27c793a..3cae1cf 100644 --- a/perl_checker.src/lexer.mll +++ b/perl_checker.src/lexer.mll @@ -31,6 +31,7 @@ type raw_token = | COMPACT_HASH_SUBSCRIPT of (string * raw_pos) | RAW_HERE_DOC of ((string * raw_pos) ref * raw_pos) | HERE_DOC of (raw_interpolated_string * raw_pos) ref * raw_pos + | FORMAT of (raw_interpolated_string * raw_pos) ref * raw_pos | SCALAR_IDENT of (string option * string * raw_pos) | ARRAY_IDENT of (string option * string * raw_pos) | HASH_IDENT of (string option * string * raw_pos) @@ -44,7 +45,7 @@ type raw_token = | 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 | LOCAL of raw_pos | FOR of (string * raw_pos) | USE of raw_pos | PACKAGE of raw_pos | BEGIN of raw_pos | END of raw_pos | PRINT of (string * raw_pos) - | NEW of (raw_pos) | FORMAT of (raw_pos) | AT of raw_pos | DOLLAR of raw_pos | PERCENT of raw_pos | AMPERSAND of raw_pos + | NEW of (raw_pos) | AT of raw_pos | DOLLAR of raw_pos | PERCENT of raw_pos | AMPERSAND of raw_pos | STAR of raw_pos | ARRAYLEN of raw_pos | SEMI_COLON of raw_pos | PKG_SCOPE of raw_pos | PAREN of raw_pos | PAREN_END of raw_pos | BRACKET of raw_pos | BRACKET_END of raw_pos | BRACKET_HASHREF of raw_pos | ARRAYREF of raw_pos | ARRAYREF_END of raw_pos | ARROW of raw_pos | INCR of raw_pos | DECR of raw_pos | CONCAT of raw_pos | POWER of raw_pos | TIGHT_NOT of raw_pos | BIT_NEG of raw_pos | REF of raw_pos | ONE_SCALAR_PARA of (string * raw_pos) | PATTERN_MATCH of raw_pos | PATTERN_MATCH_NOT of raw_pos | MULT of (string * raw_pos) | MULT_L_STR of raw_pos @@ -77,6 +78,7 @@ let rec raw_token_to_pos_and_token spaces = function | PATTERN(s, opts, pos) -> pos, Parser.PATTERN(new_any M_special (raw_interpolated_string_to_tokens s, opts) spaces pos) | PATTERN_SUBST(from, to_, opts, pos) -> pos, Parser.PATTERN_SUBST(new_any M_special (raw_interpolated_string_to_tokens from, raw_interpolated_string_to_tokens to_, opts) spaces pos) | HERE_DOC(l, pos) -> pos, Parser.HERE_DOC(new_any M_string (raw_interpolated_string_to_tokens (fst !l), snd !l) spaces pos) + | FORMAT(l, pos) -> pos, Parser.FORMAT(new_any M_string (raw_interpolated_string_to_tokens (fst !l), snd !l) spaces pos) | BAREWORD(s, pos) -> pos, Parser.BAREWORD(new_any M_special s spaces pos) | BAREWORD_PAREN(s, pos) -> pos, Parser.BAREWORD_PAREN(new_any M_special s spaces pos) | REVISION(s, pos) -> pos, Parser.REVISION(new_any M_revision s spaces pos) @@ -101,7 +103,6 @@ let rec raw_token_to_pos_and_token spaces = function | FUNC_DECL_WITH_PROTO(fq, name, proto, pos) -> pos, Parser.FUNC_DECL_WITH_PROTO(new_any M_special (fq, name, proto) spaces pos) | NEW(pos) -> pos, Parser.NEW(new_any M_special () spaces pos) - | FORMAT(pos) -> pos, Parser.FORMAT(new_any M_special () spaces pos) | COMPARE_OP(s, pos) -> pos, Parser.COMPARE_OP(new_any M_special s spaces pos) | COMPARE_OP_STR(s, pos) -> pos, Parser.COMPARE_OP_STR(new_any M_special s spaces pos) | EQ_OP(s, pos) -> pos, Parser.EQ_OP(new_any M_special s spaces pos) @@ -491,7 +492,7 @@ rule token = parse | "print" { PRINT(lexeme lexbuf, pos lexbuf) } | "printf" { PRINT(lexeme lexbuf, pos lexbuf) } | "new" { NEW(pos lexbuf) } -| "format" { let _ = raw_here_doc_next_line "." in FORMAT(pos lexbuf) } +| "format" { let pos = pos lexbuf in FORMAT(here_doc_next_line ".", pos) } | "defined" | "length" | "keys" diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly index f9b5e9d..90e8631 100644 --- a/perl_checker.src/parser.mly +++ b/perl_checker.src/parser.mly @@ -17,7 +17,7 @@ %token <string Types.any_spaces_pos> QUOTEWORDS COMPACT_HASH_SUBSCRIPT %token <(string * Types.raw_pos) Types.any_spaces_pos> RAW_HERE_DOC %token <(string * ((int * int) * token) list) list Types.any_spaces_pos> STRING COMMAND_STRING -%token <((string * ((int * int) * token) list) list * Types.raw_pos) Types.any_spaces_pos> HERE_DOC +%token <((string * ((int * int) * token) list) list * Types.raw_pos) Types.any_spaces_pos> HERE_DOC FORMAT %token <((string * ((int * int) * token) list) list * string) Types.any_spaces_pos> PATTERN QR_PATTERN %token <((string * ((int * int) * token) list) list * (string * ((int * int) * token) list) list * string) Types.any_spaces_pos> PATTERN_SUBST @@ -27,7 +27,7 @@ %token <(string option * string * string) Types.any_spaces_pos> FUNC_DECL_WITH_PROTO %token <string Types.any_spaces_pos> FOR PRINT -%token <unit Types.any_spaces_pos> NEW FORMAT +%token <unit Types.any_spaces_pos> NEW %token <string Types.any_spaces_pos> COMPARE_OP COMPARE_OP_STR EQ_OP EQ_OP_STR %token <string Types.any_spaces_pos> ASSIGN MY_OUR @@ -154,7 +154,7 @@ sideff: /* An expression which may have a side-effect */ | expr FOR expr {sp_p($2); sp_p($3); mcontext_check M_list $3; check_foreach($2); to_Call_op M_none "for infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} decl: -| FORMAT BAREWORD ASSIGN {new_esp M_none Too_complex $1 $3} +| FORMAT BAREWORD ASSIGN {to_Call_op M_none "format" [Raw_string($2.any, get_pos $2) ; to_String false (new_1esp (fst $1.any) $1)] $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) [] Real_sub_declaration) $1 $3} @@ -458,7 +458,6 @@ word_or_scalar: bareword: | NEW { new_1esp (Ident(None, "new", get_pos $1)) $1 } -| FORMAT { new_1esp (Ident(None, "format", get_pos $1)) $1 } | BAREWORD { new_1esp (Ident(None, $1.any, get_pos $1)) $1 } word_paren: |