summaryrefslogtreecommitdiffstats
path: root/perl_checker.src
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2004-11-17 16:53:50 +0000
committerPascal Rigaux <pixel@mandriva.com>2004-11-17 16:53:50 +0000
commitcab1e04c6458ab10cdb5ef03f125aee5668695ac (patch)
treef75e759b610f2cc47c0a90355edbb11d95aa2c56 /perl_checker.src
parentc01730aac021a10c13cdbaf99813b0869e045889 (diff)
downloadperl-MDK-Common-cab1e04c6458ab10cdb5ef03f125aee5668695ac.tar
perl-MDK-Common-cab1e04c6458ab10cdb5ef03f125aee5668695ac.tar.gz
perl-MDK-Common-cab1e04c6458ab10cdb5ef03f125aee5668695ac.tar.bz2
perl-MDK-Common-cab1e04c6458ab10cdb5ef03f125aee5668695ac.tar.xz
perl-MDK-Common-cab1e04c6458ab10cdb5ef03f125aee5668695ac.zip
create string_of_fromparser(), needs tuning
Diffstat (limited to 'perl_checker.src')
-rw-r--r--perl_checker.src/global_checks.ml8
-rw-r--r--perl_checker.src/parser.mly2
-rw-r--r--perl_checker.src/parser_helper.ml106
-rw-r--r--perl_checker.src/parser_helper.mli6
-rw-r--r--perl_checker.src/tree.ml28
5 files changed, 101 insertions, 49 deletions
diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml
index 7b24d50..b0b8d7a 100644
--- a/perl_checker.src/global_checks.ml
+++ b/perl_checker.src/global_checks.ml
@@ -192,7 +192,7 @@ let is_global_var context ident =
let check_variable (context, var) vars para =
match var with
| Ident(_, s, pos) when context <> I_func && is_anonymous_variable_name s && s <> "__FILE__" && s <> "__LINE__" ->
- warn_with_pos [Warn_normalized_expressions] pos (sprintf "variable %s must not be used\n (variable with name _XXX are reserved for unused variables)" (variable2s(context, string_of_Ident var)))
+ warn_with_pos [Warn_normalized_expressions] pos (sprintf "variable %s must not be used\n (variable with name _XXX are reserved for unused variables)" (variable2s(context, string_of_fromparser var)))
| Ident(Some pkg, _, _) when uses_external_package pkg || List.mem pkg !ignored_packages -> ()
| Ident(None, ident, pos) ->
if is_my_declared vars (context, ident) || is_our_declared vars (context, ident) || is_var_declared vars (context, ident) para || is_global_var context ident
@@ -203,7 +203,7 @@ let check_variable (context, var) vars para =
then ()
else
if context = I_func then
- warn_with_pos [Warn_names] pos ("unknown function " ^ string_of_Ident var)
+ warn_with_pos [Warn_names] pos ("unknown function " ^ string_of_fromparser var)
else
lpush vars.state.global_vars_used ((context, fq, name), pos)
| _ -> ()
@@ -287,7 +287,7 @@ let check_variables vars t =
(* special warning if @_ is unbound *)
check_variable (I_func, ident) vars None ;
if not (is_my_declared vars (I_array, "_")) then
- warn_with_pos [Warn_suggest_simpler] pos (sprintf "replace %s(@_) with &%s" (string_of_Ident ident) (string_of_Ident ident)) ;
+ warn_with_pos [Warn_suggest_simpler] pos (sprintf "replace %s(@_) with &%s" (string_of_fromparser ident) (string_of_fromparser ident)) ;
Some vars
| Call(Deref(I_func, Ident(None, "require", _)), [Ident _]) -> Some vars
@@ -322,7 +322,7 @@ let check_variables vars t =
Some vars
| 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 vars = declare_Our vars ([ I_func, string_of_fromparser ident ], pos) in
let my_vars, l =
match has_proto perl_proto (Block body) with
diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly
index adecfac..e3ae85b 100644
--- a/perl_checker.src/parser.mly
+++ b/perl_checker.src/parser.mly
@@ -268,7 +268,7 @@ term:
| "-" ->
(match $2.any.expr with
| Ident(_, _, pos) when $2.spaces = Space_0 ->
- let s = "-" ^ string_of_Ident $2.any.expr in
+ let s = "-" ^ string_of_fromparser $2.any.expr in
warn_rule [Warn_complex_expressions] (Printf.sprintf "don't use %s, use '%s' instead" s s);
new_pesp M_string P_tok (Raw_string(s, pos)) $1 $2
| _ -> to_Call_op_ (mcontext_float_or_int [$2.mcontext]) P_tight "- unary" [$2.any.expr] $1 $2)
diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml
index 85e1d2e..d80de58 100644
--- a/perl_checker.src/parser_helper.ml
+++ b/perl_checker.src/parser_helper.ml
@@ -128,10 +128,6 @@ let not_simple = function
| Num _ | Ident _ | Deref(_, Ident _) -> false
| _ -> true
-let string_of_Ident = function
- | Ident(None, s, _) -> s
- | Ident(Some fq, s, _) -> fq ^ "::" ^ s
- | _ -> internal_error "string_of_Ident"
let context2s = function
| I_scalar -> "$"
| I_hash -> "%"
@@ -141,6 +137,61 @@ let context2s = function
| I_star -> "*"
let variable2s(context, ident) = context2s context ^ ident
+let rec string_of_fromparser = function
+ | Semi_colon -> ";"
+ | Undef -> "undef"
+ | Num(num, _) -> num
+
+ | Raw_string(s, _) -> "\"" ^ s ^ "\""
+ | String(l, _) ->
+ let l' = List.map (fun (s, e) ->
+ s ^ if e = List[] then "" else string_of_fromparser e
+ ) l in
+ "\"" ^ String.concat "" l' ^ "\""
+
+ | Ident(None, s, _) -> s
+ | Ident(Some fq, s, _) -> fq ^ "::" ^ s
+ | My_our(myour, l, _) -> myour ^ "(" ^ String.concat "," (List.map (fun (context, s) -> context2s context ^ s) l) ^ ")"
+
+ | Anonymous_sub(_, e, _) -> "sub { " ^ string_of_fromparser e ^ " }"
+ | Ref(_, e) -> "\\" ^ string_of_fromparser e
+ | Deref(context, e) -> context2s context ^ string_of_fromparser e
+
+ | Diamond(None) -> "<>"
+ | Diamond(Some e) -> "<" ^ string_of_fromparser e ^ ">"
+
+ | Sub_declaration(name, _prototype, body, Real_sub_declaration) ->
+ "sub " ^ string_of_fromparser name ^ " { " ^ string_of_fromparser body ^ " }"
+
+ | Sub_declaration(name, _prototype, body, Glob_assign) ->
+ "*" ^ string_of_fromparser name ^ " = sub { " ^ string_of_fromparser body ^ " };"
+
+ | Deref_with(_, _, _e1, _e2) ->
+ internal_error "todo"
+
+ | Package(p) -> "package " ^ string_of_fromparser p
+
+ | Use(e, []) -> "use " ^ string_of_fromparser e
+ | Use(e, l) -> "use " ^ string_of_fromparser e ^ "(" ^ lstring_of_fromparser l
+
+ | List l -> lstring_of_fromparser_parentheses l
+ | Block l -> "{ " ^ lstring_of_fromparser l ^ " }"
+ | Call_op(op, l, _) -> op ^ lstring_of_fromparser_parentheses l
+
+ | Call(e, l) -> string_of_fromparser e ^ lstring_of_fromparser l
+
+ | Method_call(obj, meth, l) ->
+ let para = if l = [] then "" else lstring_of_fromparser_parentheses l in
+ string_of_fromparser obj ^ "->" ^ string_of_fromparser meth ^ para
+
+ | Label(e) -> e ^ ": "
+
+ | Perl_checker_comment _ -> ""
+ | Too_complex -> "XXX"
+
+and lstring_of_fromparser l = String.concat ", " (List.map string_of_fromparser l)
+and lstring_of_fromparser_parentheses l = "(" ^ lstring_of_fromparser l ^ ")"
+
let rec is_same_fromparser a b =
match a, b with
| Undef, Undef -> true
@@ -288,8 +339,8 @@ let prio_lo_check pri_out pri_in pos expr =
| _ -> ())
else
(match expr with
- | Call_op ("print", [Deref (I_star, Ident (None, "STDOUT", _)); Deref(I_scalar, ident)], _) ->
- warn [Warn_traps] pos (sprintf "use parentheses: replace \"print $%s ...\" with \"print($%s ...)\"" (string_of_Ident ident) (string_of_Ident ident))
+ | Call_op ("print", [Deref (I_star, Ident (None, "STDOUT", _)); (Deref(I_scalar, _) as ident)], _) ->
+ warn [Warn_traps] pos (sprintf "use parentheses: replace \"print %s ...\" with \"print(%s ...)\"" (string_of_fromparser ident) (string_of_fromparser ident))
| _ -> warn [Warn_traps] pos "missing parentheses (needed for clarity)")
let prio_lo pri_out in_ = prio_lo_check pri_out in_.any.priority in_.pos in_.any.expr ; in_.any.expr
@@ -432,7 +483,7 @@ let check_parenthesized_first_argexpr_with_Ident ident esp =
| Ident(None, word, _) when List.mem word ["ref" ; "readlink"] ->
if esp.any.priority <> P_tok then warn_rule [Warn_complex_expressions] "use parentheses around argument"
| _ -> ());
- check_parenthesized_first_argexpr (string_of_Ident ident) esp
+ check_parenthesized_first_argexpr (string_of_fromparser ident) esp
let check_hash_subscript esp =
let can_be_raw_string = function
@@ -581,7 +632,7 @@ let only_one_array_ref esp =
let e = only_one esp in
(match e with
| Call_op("last_array_index", [Deref(I_array, e)], _) ->
- warn [Warn_suggest_simpler] esp.pos (sprintf "you can replace $#%s with -1" (string_of_Ident e))
+ warn [Warn_suggest_simpler] esp.pos (sprintf "you can replace $#%s with -1" (string_of_fromparser e))
| _ -> ());
e
@@ -611,7 +662,7 @@ let deref_raw context e =
let fq, ident = split_name_or_fq_name s in
Ident(fq, ident, pos)
| Deref(I_scalar, (Ident _ as ident)) ->
- warn_rule [Warn_suggest_simpler] (sprintf "%s{$%s} can be written %s$%s" (context2s context) (string_of_Ident ident) (context2s context) (string_of_Ident ident));
+ warn_rule [Warn_suggest_simpler] (sprintf "%s{$%s} can be written %s$%s" (context2s context) (string_of_fromparser ident) (context2s context) (string_of_fromparser ident));
e
| _ -> e
in Deref(context, e)
@@ -686,15 +737,15 @@ let cook_call_op op para pos =
| "foreach", [ _; Block [ expr ; Semi_colon ] ]
| "foreach", [ _; Block [ expr ] ] ->
(match expr with
- | Call_op("if infix", [ List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, (Ident _ as l)) ; Deref(I_scalar, Ident(None, "_", _)) ]) ] ; _ ], _) ->
- let l = string_of_Ident l in
- warn_rule [Warn_suggest_functional] (sprintf "use \"push @%s, grep { ... } ...\" instead of \"foreach (...) { push @%s, $_ if ... }\"\n or sometimes \"@%s = grep { ... } ...\"" l l l)
- | Call_op("if infix", [ List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, (Ident _ as l)); _ ]) ] ; _ ], _) ->
- let l = string_of_Ident l in
- warn_rule [Warn_suggest_functional] (sprintf "use \"push @%s, map { ... ? ... : () } ...\" instead of \"foreach (...) { push @%s, ... if ... }\"\n or sometimes \"@%s = map { ... ? ... : () } ...\"\n or sometimes \"@%s = map { if_(..., ...) } ...\"" l l l l)
- | List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, (Ident _ as l)); _ ]) ] ->
- let l = string_of_Ident l in
- warn_rule [Warn_suggest_functional] (sprintf "use \"push @%s, map { ... } ...\" instead of \"foreach (...) { push @%s, ... }\"\n or sometimes \"@%s = map { ... } ...\"" l l l)
+ | Call_op("if infix", [ List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, Ident _) as l ; Deref(I_scalar, Ident(None, "_", _)) ]) ] ; _ ], _) ->
+ let l = string_of_fromparser l in
+ warn_rule [Warn_suggest_functional] (sprintf "use \"push %s, grep { ... } ...\" instead of \"foreach (...) { push %s, $_ if ... }\"\n or sometimes \"%s = grep { ... } ...\"" l l l)
+ | Call_op("if infix", [ List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, Ident _) as l; _ ]) ] ; _ ], _) ->
+ let l = string_of_fromparser l in
+ warn_rule [Warn_suggest_functional] (sprintf "use \"push %s, map { ... ? ... : () } ...\" instead of \"foreach (...) { push %s, ... if ... }\"\n or sometimes \"%s = map { ... ? ... : () } ...\"\n or sometimes \"%s = map { if_(..., ...) } ...\"" l l l l)
+ | List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, Ident _) as l; _ ]) ] ->
+ let l = string_of_fromparser l in
+ warn_rule [Warn_suggest_functional] (sprintf "use \"push %s, map { ... } ...\" instead of \"foreach (...) { push %s, ... }\"\n or sometimes \"%s = map { ... } ...\"" l l l)
| _ -> ())
| "=", [My_our _; Ident(None, "undef", _)] ->
@@ -739,11 +790,11 @@ let cook_call_op op para pos =
match op, para with
| "=", [ Deref(I_star, (Ident _ as f1)); Deref(I_star, (Ident _ as f2)) ] ->
- let s1, s2 = string_of_Ident f1, string_of_Ident f2 in
+ let s1, s2 = string_of_fromparser f1, string_of_fromparser f2 in
warn [Warn_complex_expressions] 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)) ] Glob_assign
| "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Deref(I_star, (Ident _ as f2)) ] ->
- let s2 = string_of_Ident f2 in
+ let s2 = string_of_fromparser f2 in
warn [Warn_help_perl_checker] 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)) ] Glob_assign
@@ -844,12 +895,6 @@ msgstr \"\"
) sorted_pot_strings ;
close_out fd
-let fake_string_from_String_l l = String.concat "$foo" (List.map fst l)
-let fake_string_option_from_expr = function
- | String(l, _) -> Some(fake_string_from_String_l l)
- | Raw_string(s, _) -> Some s
- | _ -> None
-
let check_system_call = function
| "mkdir" :: l ->
let has_p = List.exists (str_begins_with "-p") l in
@@ -965,6 +1010,11 @@ let call_raw force_non_builtin_func (e, para) =
| _ -> warn_rule [Warn_traps] (f ^ " is expecting an array"))
| "system" ->
+ let fake_string_option_from_expr = function
+ | String(l, _) -> Some(String.concat "" (List.map fst l))
+ | Raw_string(s, _) -> Some s
+ | _ -> None
+ in
(match un_parenthesize_full_l para with
| [ e ] ->
(match fake_string_option_from_expr e with
@@ -983,8 +1033,8 @@ let call_raw force_non_builtin_func (e, para) =
let para' = match f with
| "no" ->
(match para with
- | [ Ident(_, _, pos) as s ] -> Some [ Raw_string(string_of_Ident s, pos) ]
- | [ Call(Deref(I_func, (Ident(_, _, pos) as s)), l) ] -> Some(Raw_string(string_of_Ident s, pos) :: l)
+ | [ Ident(_, _, pos) as s ] -> Some [ Raw_string(string_of_fromparser s, pos) ]
+ | [ Call(Deref(I_func, (Ident(_, _, pos) as s)), l) ] -> Some(Raw_string(string_of_fromparser s, pos) :: l)
| _ -> die_rule "use \"no PACKAGE <para>\"")
| "undef" ->
(match para with
diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli
index e0ff110..82a57ef 100644
--- a/perl_checker.src/parser_helper.mli
+++ b/perl_checker.src/parser_helper.mli
@@ -48,9 +48,11 @@ val is_always_false : Types.fromparser -> bool
val is_lvalue : Types.fromparser -> bool
val not_complex : Types.fromparser -> bool
val not_simple : Types.fromparser -> bool
-val string_of_Ident : Types.fromparser -> string
val context2s : Types.context -> string
val variable2s : Types.context * string -> string
+val string_of_fromparser : Types.fromparser -> string
+val lstring_of_fromparser : Types.fromparser list -> string
+val lstring_of_fromparser_parentheses : Types.fromparser list -> string
val is_same_fromparser : Types.fromparser -> Types.fromparser -> bool
val from_scalar : Types.fromparser Types.any_spaces_pos -> Types.fromparser
val from_array : Types.fromparser Types.any_spaces_pos -> Types.fromparser
@@ -203,8 +205,6 @@ val po_comments : string list ref
val po_comment : string Types.any_spaces_pos -> unit
val check_format_a_la_printf : string -> int -> Types.maybe_context list
val generate_pot : string -> unit
-val fake_string_from_String_l : (string * 'a) list -> string
-val fake_string_option_from_expr : Types.fromparser -> string option
val check_system_call : string list -> unit
val call_raw :
bool -> Types.fromparser * Types.fromparser list -> Types.fromparser
diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml
index dd62174..a4b5dfb 100644
--- a/perl_checker.src/tree.ml
+++ b/perl_checker.src/tree.ml
@@ -70,11 +70,11 @@ let get_current_package t =
| [] -> List.rev ((Some current_package, List.rev found_body) :: packages)
| Package(Ident _ as ident) :: body ->
let packages = (Some current_package, List.rev found_body) :: packages in
- bundled_packages packages (string_of_Ident ident) [] body
+ bundled_packages packages (string_of_fromparser ident) [] body
| instr :: body ->
bundled_packages packages current_package (instr :: found_body) body
in
- bundled_packages [] (string_of_Ident ident) [] body
+ bundled_packages [] (string_of_fromparser ident) [] body
| _ ->
if str_ends_with !Info.current_file ".pm" then warn_with_pos [Warn_normalized_expressions] (!Info.current_file, 0, 0) (sprintf "module %s does not have \"package xxxx;\" on its first line" (Info.absolute_file_to_file !Info.current_file)) ;
[ None, t ]
@@ -91,7 +91,7 @@ let from_qw_raw = function
some_or (l_option2option_l (List.map (function
| String([s, List []], pos)
| Raw_string(s, pos) -> Some(s, pos)
- | Ident(_, _, pos) as ident -> Some(string_of_Ident ident, pos)
+ | Ident(_, _, pos) as ident -> Some(string_of_fromparser ident, pos)
| e -> warn_with_pos [] (get_pos_from_expr e) "not recognised yet"; None
) l)) []
| e -> warn_with_pos [] (get_pos_from_expr e) "not recognised yet"; []
@@ -186,15 +186,17 @@ let get_uses t =
| Use(Ident(None, "lib", _), [libs]) ->
use_lib := List.map Info.file_to_absolute_file (List.map snd (from_qw libs)) @ !use_lib ;
uses
- | Use(Ident _ as pkg, _) when uses_external_package (string_of_Ident pkg) -> uses
- | Use(Ident(_, _, pos) as ident, l) ->
- let package = string_of_Ident ident in
- let para = match l with
- | [] -> None
- | [ Num(_, _) ] -> None (* don't care about the version number *)
- | _ -> Some(collect from_qw l)
- in
- (package, (para, pos)) :: uses
+ | Use(Ident(_, _, pos) as pkg, l) ->
+ let package = string_of_fromparser pkg in
+ if uses_external_package package then
+ uses
+ else
+ let para = match l with
+ | [] -> None
+ | [ Num(_, _) ] -> None (* don't care about the version number *)
+ | _ -> Some(collect from_qw l)
+ in
+ (package, (para, pos)) :: uses
| _ -> uses
) [] t
@@ -398,7 +400,7 @@ let get_global_info_from_package from_basedir require_name build_time t =
| Perl_checker_comment(s, pos) when str_begins_with "require " s ->
Some((skip_n_char 8 s, pos) :: l)
| Call(Deref(I_func, Ident (None, "require", pos)), [Ident _ as pkg]) ->
- let package = string_of_Ident pkg in
+ let package = string_of_fromparser pkg in
if uses_external_package package then None else Some((package, pos) :: l)
| Call(Deref(I_func, Ident (None, "require", pos)), [Raw_string(pkg, _)])
when not (String.contains pkg '/') && Filename.check_suffix pkg ".pm" ->