summaryrefslogtreecommitdiffstats
path: root/perl_checker.src
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2004-01-22 17:46:22 +0000
committerPascal Rigaux <pixel@mandriva.com>2004-01-22 17:46:22 +0000
commitc3b7eb925c11f62803d8cf7e3c8aa1da1ef8ae5b (patch)
tree1429d2b655369688f243cca8ae1b1b86a4dfd39a /perl_checker.src
parent241d710f992744224bae702e39e11ae9eaf23c12 (diff)
downloadperl_checker-c3b7eb925c11f62803d8cf7e3c8aa1da1ef8ae5b.tar
perl_checker-c3b7eb925c11f62803d8cf7e3c8aa1da1ef8ae5b.tar.gz
perl_checker-c3b7eb925c11f62803d8cf7e3c8aa1da1ef8ae5b.tar.bz2
perl_checker-c3b7eb925c11f62803d8cf7e3c8aa1da1ef8ae5b.tar.xz
perl_checker-c3b7eb925c11f62803d8cf7e3c8aa1da1ef8ae5b.zip
handle "format" perl instruction
Diffstat (limited to 'perl_checker.src')
-rw-r--r--perl_checker.src/global_checks.ml50
-rw-r--r--perl_checker.src/lexer.mll7
-rw-r--r--perl_checker.src/parser.mly7
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: