diff options
| -rw-r--r-- | perl_checker.src/parser.mly | 10 | ||||
| -rw-r--r-- | perl_checker.src/parser_helper.ml | 20 | ||||
| -rw-r--r-- | perl_checker.src/parser_helper.mli | 2 | ||||
| -rw-r--r-- | perl_checker.src/tree.ml | 14 |
4 files changed, 33 insertions, 13 deletions
diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly index e0c5fe6..29cd4d6 100644 --- a/perl_checker.src/parser.mly +++ b/perl_checker.src/parser.mly @@ -430,11 +430,11 @@ word_paren: arraylen: ARRAYLEN_IDENT {deref_arraylen (to_Ident $1), snd $1} | ARRAYLEN scalar {sp_0($2); deref_arraylen (fst $2), snd $1} | ARRAYLEN bracket_subscript {deref_arraylen (fst $2), sp_pos_range $1 $2} -scalar: SCALAR_IDENT {Deref(I_scalar, to_Ident $1), snd $1} | DOLLAR scalar {sp_0($2); Deref(I_scalar, fst $2), snd $1} | DOLLAR bracket_subscript {Deref(I_scalar, fst $2), sp_pos_range $1 $2} | DOLLAR BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_0($2); sp_0($3); sp_p($5); sp_0($6); Deref(I_scalar, Ref(I_hash, sndfst $4)), sp_pos_range $1 $6} -func: FUNC_IDENT {Deref(I_func , to_Ident $1), snd $1} | AMPERSAND scalar {sp_0($2); Deref(I_func , fst $2), snd $1} | AMPERSAND bracket_subscript {Deref(I_func , fst $2), sp_pos_range $1 $2} -array: ARRAY_IDENT {Deref(I_array , to_Ident $1), snd $1} | AT scalar {sp_0($2); Deref(I_array , fst $2), snd $1} | AT bracket_subscript {Deref(I_array , fst $2), sp_pos_range $1 $2} -hash: HASH_IDENT {Deref(I_hash , to_Ident $1), snd $1} | PERCENT scalar {sp_0($2); Deref(I_hash , fst $2), snd $1} | PERCENT bracket_subscript {Deref(I_hash , fst $2), sp_pos_range $1 $2} -star: STAR_IDENT {Deref(I_star , to_Ident $1), snd $1} | STAR scalar {sp_0($2); Deref(I_star , fst $2), snd $1} | STAR bracket_subscript {Deref(I_star , fst $2), sp_pos_range $1 $2} +scalar: SCALAR_IDENT {Deref(I_scalar, to_Ident $1), snd $1} | DOLLAR scalar {sp_0($2); Deref(I_scalar, fst $2), snd $1} | DOLLAR bracket_subscript {deref_raw I_scalar (fst $2), sp_pos_range $1 $2} | DOLLAR BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_0($2); sp_0($3); sp_p($5); sp_0($6); Deref(I_scalar, Ref(I_hash, sndfst $4)), sp_pos_range $1 $6} +func: FUNC_IDENT {Deref(I_func , to_Ident $1), snd $1} | AMPERSAND scalar {sp_0($2); Deref(I_func , fst $2), snd $1} | AMPERSAND bracket_subscript {deref_raw I_func (fst $2), sp_pos_range $1 $2} +array: ARRAY_IDENT {Deref(I_array , to_Ident $1), snd $1} | AT scalar {sp_0($2); Deref(I_array , fst $2), snd $1} | AT bracket_subscript {deref_raw I_array (fst $2), sp_pos_range $1 $2} +hash: HASH_IDENT {Deref(I_hash , to_Ident $1), snd $1} | PERCENT scalar {sp_0($2); Deref(I_hash , fst $2), snd $1} | PERCENT bracket_subscript {deref_raw I_hash (fst $2), sp_pos_range $1 $2} +star: STAR_IDENT {Deref(I_star , to_Ident $1), snd $1} | STAR scalar {sp_0($2); Deref(I_star , fst $2), snd $1} | STAR bracket_subscript {deref_raw I_star (fst $2), sp_pos_range $1 $2} expr_or_empty: {Block [], (Space_none, bpos)} | expr {sndfst $1, snd $1} diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml index 622f55f..2682bfb 100644 --- a/perl_checker.src/parser_helper.ml +++ b/perl_checker.src/parser_helper.ml @@ -11,6 +11,15 @@ let get_pos (_, (_, pos)) = raw_pos2pos pos let var_dollar_ pos = Deref(I_scalar, Ident(None, "_", pos)) let var_STDOUT = Deref(I_star, Ident(None, "STDOUT", raw_pos2pos bpos)) +let split_name_or_fq_name full_ident = + match split_at2 ':'':' full_ident with + | [] -> internal_error "split_ident" + | [ident] -> None, ident + | l -> + let fql, name = split_last l in + let fq = String.concat "::" fql in + Some fq, name + let is_var_dollar_ = function | Deref(I_scalar, Ident(None, "_", _)) -> true | _ -> false @@ -408,6 +417,14 @@ let to_List = function | l -> List l let deref_arraylen e = Call_op("last_array_index", [Deref(I_array, e)], raw_pos2pos bpos) +let deref_raw context e = + let e = match e with + | Raw_string(s, pos) -> + let fq, ident = split_name_or_fq_name s in + Ident(fq, ident, pos) + | _ -> e + in Deref(context, e) + let to_Ident ((fq, name), (_, pos)) = Ident(fq, name, raw_pos2pos pos) let to_Raw_string (s, (_, pos)) = Raw_string(s, raw_pos2pos pos) let to_Method_call (object_, method_, para) = @@ -478,6 +495,9 @@ let cook_call_op(op, para, pos) = | "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] -> sub_declaration (Ident(None, sf1, pos_f1), "") [ Deref(I_func, f2) ] + | "=", [ Deref(I_star, (Ident _ as f1)); (Anonymous_sub _ as sub) ] -> + sub_declaration (f1, "") [ sub ] + | _ -> call diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli index 7fe749d..a483a2e 100644 --- a/perl_checker.src/parser_helper.mli +++ b/perl_checker.src/parser_helper.mli @@ -7,6 +7,7 @@ val sp_pos_range : val get_pos : 'a * ('b * ('c * 'd)) -> string * 'c * 'd val var_dollar_ : Types.pos -> Types.fromparser val var_STDOUT : Types.fromparser +val split_name_or_fq_name : string -> string option * string val is_var_dollar_ : Types.fromparser -> bool val is_var_number_match : Types.fromparser -> bool val is_parenthesized : Types.fromparser -> bool @@ -97,6 +98,7 @@ val is_not_a_scalar : Types.fromparser -> bool val maybe_to_Raw_string : Types.fromparser -> Types.fromparser val to_List : Types.fromparser list -> Types.fromparser val deref_arraylen : Types.fromparser -> Types.fromparser +val deref_raw : Types.context -> Types.fromparser -> Types.fromparser val to_Ident : (string option * string) * ('a * (int * int)) -> Types.fromparser val to_Raw_string : string * ('a * (int * int)) -> Types.fromparser diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml index 78f365b..ca73f23 100644 --- a/perl_checker.src/tree.ml +++ b/perl_checker.src/tree.ml @@ -200,13 +200,11 @@ let read_xs_extension_from_c global_vars_declared package pos = let offset = strstr s prefix + String.length prefix in let end_ = String.index_from s offset '"' in let ident = String.sub s offset (end_ - offset) in - match split_at2 ':'':' ident with - | [_] -> Hashtbl.replace package.vars_declared (I_func, ident) (pos, ref false) - | l -> - if l <> [] then - let fql, name = split_last l in - let fq = String.concat "::" (package.package_name :: fql) in - Hashtbl.replace global_vars_declared (I_func, fq, name) pos + match split_name_or_fq_name ident with + | None, ident -> Hashtbl.replace package.vars_declared (I_func, ident) (pos, ref false) + | Some fq, ident -> + let fq = package.package_name ^ "::" ^ fq in + Hashtbl.replace global_vars_declared (I_func, fq, ident) pos with Not_found -> ()); in_bootstrap || str_contains s "XS_VERSION_BOOTCHECK" ) false (open_in cfile)); @@ -272,7 +270,7 @@ let get_vars_declaration global_vars_declared package = ) package.body let rec fold_tree f env e = - match f env e with + match f env e with | Some env -> env | None -> match e with |