diff options
author | Pascal Rigaux <pixel@mandriva.com> | 2003-08-11 02:11:29 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 2003-08-11 02:11:29 +0000 |
commit | 5a52635cb5b6830442ab350b8855b4e8115bca9e (patch) | |
tree | 904b49aafe73d8aca041eade5a7dce0ebe45cbb4 /perl_checker.src | |
parent | b9c762fe0077a6de3e0fc10aa86a8eea9f1a2af5 (diff) | |
download | perl-MDK-Common-5a52635cb5b6830442ab350b8855b4e8115bca9e.tar perl-MDK-Common-5a52635cb5b6830442ab350b8855b4e8115bca9e.tar.gz perl-MDK-Common-5a52635cb5b6830442ab350b8855b4e8115bca9e.tar.bz2 perl-MDK-Common-5a52635cb5b6830442ab350b8855b4e8115bca9e.tar.xz perl-MDK-Common-5a52635cb5b6830442ab350b8855b4e8115bca9e.zip |
- allow $_o_XXX parameter name which is both unused and optional (same for $_b_XXX)
- shift is a ONE_SCALAR_PARA so that $box->pack_start(shift @l, 0, 0, 4) is parsed correctly
- in arrange_global_vars_declared(), don't keep anything in global_vars_declared, better
create shadow packages to contain them
- much better merging of multiple files defining functions in the same package.
This fixes the bad behaviour when using the cache (esp. do_pkgs, but it was even worse
with things in ugtk2.pm)
Diffstat (limited to 'perl_checker.src')
-rw-r--r-- | perl_checker.src/global_checks.ml | 61 | ||||
-rw-r--r-- | perl_checker.src/lexer.mll | 1 | ||||
-rw-r--r-- | perl_checker.src/parser_helper.ml | 7 | ||||
-rw-r--r-- | perl_checker.src/tree.ml | 5 | ||||
-rw-r--r-- | perl_checker.src/tree.mli | 1 |
5 files changed, 55 insertions, 20 deletions
diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml index e475c8a..bb64bb0 100644 --- a/perl_checker.src/global_checks.ml +++ b/perl_checker.src/global_checks.ml @@ -435,17 +435,23 @@ let add_package_to_state state package = let package = try let existing_package = Hashtbl.find state.per_package package.package_name in - if existing_package.from_cache then raise Not_found; - (* print_endline_flush (existing_package.file_name ^ " vs " ^ package.file_name); *) - Hashtbl.iter (fun var pos -> Hashtbl.replace existing_package.vars_declared var pos) package.vars_declared ; - { existing_package with - body = existing_package.body @ package.body ; - uses = existing_package.uses @ package.uses ; + print_endline_flush (existing_package.file_name ^ " vs " ^ package.file_name); + let vars_declared = existing_package.vars_declared in + Hashtbl.iter (fun var pos -> Hashtbl.replace vars_declared var pos) package.vars_declared ; + let p = if existing_package.build_time > package.build_time then existing_package else package in + let p = { p with + isa = if existing_package.isa = None then package.isa else existing_package.isa ; + body = (if existing_package.from_cache then [] else existing_package.body) @ package.body ; + uses = (if existing_package.from_cache then [] else existing_package.uses) @ package.uses ; + vars_declared = vars_declared ; + build_time = max existing_package.build_time package.build_time ; exports = { export_ok = existing_package.exports.export_ok @ package.exports.export_ok ; export_auto = existing_package.exports.export_auto @ package.exports.export_auto ; export_tags = existing_package.exports.export_tags @ package.exports.export_tags ; special_export = None } - } + } in + Hashtbl.replace state.per_package package.package_name p ; + p with Not_found -> package in Hashtbl.replace state.per_package package.package_name package @@ -458,15 +464,35 @@ let check_unused_vars package = let arrange_global_vars_declared state = let h = Hashtbl.create 16 in - Hashtbl.iter (fun (context, fq, name) (pos, proto) -> - try - let package = Hashtbl.find state.per_package fq in - if not (Hashtbl.mem package.vars_declared (context, name)) then - Hashtbl.add package.vars_declared (context, name) (pos, ref false, proto) - (* otherwise dropping this second declaration *) - with Not_found -> - (* keeping it in global_vars_declared *) - Hashtbl.add h (context, fq, name) (pos, proto) + Hashtbl.iter (fun (context, fq, name) (file, _, _ as pos, proto) -> + let package = + try + Hashtbl.find state.per_package fq + with Not_found -> + (* creating a new shadow package *) + let package = + { + file_name = file ; + package_name = fq; + has_package_name = true ; + exports = empty_exports ; + imported = ref None ; + vars_declared = Hashtbl.create 16 ; + uses = [] ; + required_packages = [] ; + body = [] ; + isa = None ; + lines_starts = [] ; + build_time = 0 ; + from_cache = false ; + from_basedir = false ; + } in + Hashtbl.add state.per_package fq package ; + package + in + if not (Hashtbl.mem package.vars_declared (context, name)) then + Hashtbl.add package.vars_declared (context, name) (pos, ref false, proto) + (* otherwise dropping this second declaration *) ) state.global_vars_declared ; { state with global_vars_declared = h } @@ -516,7 +542,7 @@ let read_packages_from_cache state dir = List.iter (fun pkg -> Info.add_a_file pkg.file_name pkg.lines_starts ; - Hashtbl.add state.per_package pkg.package_name { pkg with from_cache = true } + add_package_to_state state { pkg with from_cache = true } ) l with Sys_error _ -> () @@ -526,6 +552,7 @@ let write_packages_cache state dir = let fh = open_out file in output_string fh ("perl_checker cache " ^ string_of_int Build.date ^ "\n") ; let l = List.filter (fun pkg -> pkg.has_package_name) (List.map (fun pkg -> { pkg with imported = ref None }) (hashtbl_values state.per_package)) in + (*List.iter (fun pkg -> prerr_endline ("XXXX " ^ pkg.package_name ^ ": " ^ String.concat " " (List.map snd (hashtbl_keys pkg.vars_declared)))) l ;*) Marshal.to_channel fh l [] ; close_out fh ; if !Flags.verbose then print_endline_flush ("saving cached packages in " ^ file) diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll index 0153374..d0a2152 100644 --- a/perl_checker.src/lexer.mll +++ b/perl_checker.src/lexer.mll @@ -455,6 +455,7 @@ rule token = parse | "length" | "keys" | "exists" +| "shift" | "eval" | "ref" { ONE_SCALAR_PARA(lexeme lexbuf, pos lexbuf) } diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml index bdf3d49..69627e6 100644 --- a/perl_checker.src/parser_helper.ml +++ b/perl_checker.src/parser_helper.ml @@ -835,8 +835,11 @@ let call_one_scalar_para { any = e ; pos = pos } para esp_start esp_end = let para = match para with | [] -> - if not (List.mem e [ "length" ]) then warn_rule (sprintf "please use \"%s $_\" instead of \"%s\"" e e) ; - [var_dollar_ (raw_pos2pos pos)] + if e = "shift" then + [ Deref(I_array, Ident(None, "_", raw_pos2pos pos)) ] + else + (if not (List.mem e [ "length" ]) then warn_rule (sprintf "please use \"%s $_\" instead of \"%s\"" e e) ; + [var_dollar_ (raw_pos2pos pos)]) | _ -> para in new_pesp M_unknown P_mul (call(Deref(I_func, Ident(None, e, raw_pos2pos pos)), para)) esp_start esp_end diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml index 929a5a3..eabf553 100644 --- a/perl_checker.src/tree.ml +++ b/perl_checker.src/tree.ml @@ -274,7 +274,10 @@ let get_proto perl_proto body = | (I_array, _) :: _ :: _ -> warn_with_pos pos "an array must be the last variable in a prototype" | (I_hash, _) :: _ :: _ -> warn_with_pos pos "an hash must be the last variable in a prototype" | _ -> ()); - let is_optional (_, s) = String.length s > 2 && (s.[0] = 'o' || s.[0] = 'b') && s.[1] = '_' in + let is_optional (_, s) = + String.length s > 2 && (s.[0] = 'o' || s.[0] = 'b') && s.[1] = '_' || + String.length s > 3 && s.[0] = '_' && (s.[1] = 'o' || s.[1] = 'b') && s.[2] = '_' + in let must_have, optional = break_at is_optional scalars in if not (List.for_all is_optional optional) then warn_with_pos pos "an non-optional argument must not follow an optional argument"; diff --git a/perl_checker.src/tree.mli b/perl_checker.src/tree.mli index c3b89b2..473ab39 100644 --- a/perl_checker.src/tree.mli +++ b/perl_checker.src/tree.mli @@ -33,6 +33,7 @@ type per_package = { from_basedir : bool ; } +val empty_exports : exports val ignore_package : string -> unit val use_lib : string list ref val uses_external_package : string -> bool |