From 87bc1a8e7cb91e78fcaec2a6f8a554500a4dc6c6 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Wed, 17 Nov 2004 16:53:50 +0000 Subject: create string_of_fromparser(), needs tuning --- perl_checker.src/global_checks.ml | 8 +-- perl_checker.src/parser.mly | 2 +- perl_checker.src/parser_helper.ml | 106 +++++++++++++++++++++++++++---------- perl_checker.src/parser_helper.mli | 6 +-- perl_checker.src/tree.ml | 28 +++++----- 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 \"") | "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" -> -- cgit v1.2.1