From ebe50ae19d23458ac9ae2af2189a62796aecbf48 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Tue, 16 Dec 2003 19:24:37 +0000 Subject: - add the tuple(...) context - check that the value xxx in "... or xxx" is dropped - handle "... or ..., ..." --- perl_checker.src/parser.mly | 20 +++++++++--------- perl_checker.src/parser_helper.ml | 42 +++++++++++++++++++++++++++++--------- perl_checker.src/parser_helper.mli | 19 +++++++++-------- perl_checker.src/types.mli | 1 + 4 files changed, 54 insertions(+), 28 deletions(-) (limited to 'perl_checker.src') diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly index d8855e0..7760424 100644 --- a/perl_checker.src/parser.mly +++ b/perl_checker.src/parser.mly @@ -62,8 +62,8 @@ %nonassoc PREC_LOW %nonassoc LOOPEX -%left OR XOR -%left AND +%right OR XOR +%right AND %right NOT %nonassoc LSTOP %left COMMA RIGHT_ARROW @@ -104,7 +104,7 @@ prog: lines EOF {$1.any} lines: /* A collection of "lines" in the program */ | { default_esp [] } | sideff { new_1esp [$1.any] $1 } -| line lines { if $2.any <> [] then mcontext_check_none $1; new_esp $2.mcontext ($1.any @ $2.any) $1 $2 } +| line lines { if $2.any <> [] then mcontext_check_none "value is dropped" $1.any $1; new_esp $2.mcontext ($1.any @ $2.any) $1 $2 } line: | decl { new_1esp [$1.any] $1 } @@ -189,16 +189,16 @@ listexpr: /* Basic list expressions */ | argexpr %prec PREC_LOW {$1} expr: /* Ordinary expressions; logical combinations */ -| expr AND expr {sp_p($2); sp_p($3); if $1.any.priority <> P_and then mcontext_check M_scalar $1; to_Call_op_ M_none P_and "and" [ prio_lo P_and $1; prio_lo_after P_and $3 ] $1 $3} -| expr OR expr {sp_p($2); sp_p($3); if $1.any.priority <> P_or then mcontext_check M_scalar $1; to_Call_op_ M_none P_or "or" [ prio_lo P_or $1; prio_lo_after P_or $3 ] $1 $3} +| expr AND expr {sp_p($2); sp_p($3); mcontext_check M_scalar $1; mcontext_check_none "value should be dropped" [$3.any.expr] $3; to_Call_op_ M_none P_and "and" [ prio_lo P_and $1; prio_lo_after P_and $3 ] $1 $3} +| expr OR expr {sp_p($2); sp_p($3); mcontext_check M_scalar $1; mcontext_check_none "value should be dropped" [$3.any.expr] $3; to_Call_op_ M_none P_or "or" [ prio_lo P_or $1; prio_lo_after P_or $3 ] $1 $3} | argexpr %prec PREC_LOW { new_1pesp $1.any.priority (List $1.any.expr) $1 } argexpr: /* Expressions are a list of terms joined by commas */ -| argexpr comma { new_pesp M_list P_comma $1.any.expr $1 $2} -| bareword RIGHT_ARROW term {if not_simple ($3.any.expr) then sp_p($3); new_pesp M_list P_comma (followed_by_comma [$1.any] false @ [$3.any.expr]) $1 $3} -| bareword RIGHT_ARROW BRACKET expr BRACKET_END {sp_p($3); sp_p($5); new_pesp M_list P_comma (followed_by_comma [$1.any] false @ [ Ref(I_hash, $4.any.expr) ]) $1 $5} -| argexpr comma term {if not_simple ($3.any.expr) then sp_p($3); new_pesp M_list P_comma (followed_by_comma $1.any.expr $2.any @ [$3.any.expr]) $1 $3} -| argexpr comma BRACKET expr BRACKET_END {sp_p($3); sp_p($5); new_pesp M_list P_comma (followed_by_comma $1.any.expr $2.any @ [ Ref(I_hash, $4.any.expr) ]) $1 $5} +| argexpr comma { new_pesp $1.mcontext P_comma $1.any.expr $1 $2} +| bareword RIGHT_ARROW term {if not_simple ($3.any.expr) then sp_p($3); new_pesp (mtuple_context_concat M_string $3.mcontext) P_comma (followed_by_comma [$1.any] false @ [$3.any.expr]) $1 $3} +| bareword RIGHT_ARROW BRACKET expr BRACKET_END {sp_p($3); sp_p($5); new_pesp (mtuple_context_concat M_string (M_ref M_hash)) P_comma (followed_by_comma [$1.any] false @ [ Ref(I_hash, $4.any.expr) ]) $1 $5} +| argexpr comma term {if not_simple ($3.any.expr) then sp_p($3); new_pesp (mtuple_context_concat $1.mcontext $3.mcontext) P_comma (followed_by_comma $1.any.expr $2.any @ [$3.any.expr]) $1 $3} +| argexpr comma BRACKET expr BRACKET_END {sp_p($3); sp_p($5); new_pesp (mtuple_context_concat $1.mcontext (M_ref M_hash)) P_comma (followed_by_comma $1.any.expr $2.any @ [ Ref(I_hash, $4.any.expr) ]) $1 $5} | term %prec PREC_LOW { new_1pesp $1.any.priority [$1.any.expr] $1 } /********************************************************************************/ diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml index 13191a5..a1af279 100644 --- a/perl_checker.src/parser_helper.ml +++ b/perl_checker.src/parser_helper.ml @@ -965,6 +965,7 @@ let rec mcontext2s = function | M_sub -> "sub" | M_scalar -> "scalar" + | M_tuple l -> "tuple(" ^ String.concat ", " (List.map mcontext2s l) ^ ")" | M_list -> "list" | M_array -> "array" | M_hash -> "hash" @@ -993,6 +994,10 @@ let rec mcontext_lower c1 c2 = | M_string, M_string | M_string, M_scalar | M_string, M_list | M_revision, M_revision | M_revision, M_scalar | M_revision, M_list | M_scalar, M_scalar | M_scalar, M_list + -> true + + | M_tuple t1, M_tuple t2 -> List.for_all2 mcontext_lower t1 t2 + | M_tuple _, M_list | M_list, M_list | M_none, M_none @@ -1088,16 +1093,28 @@ let mcontext_unop_l wanted_mcontext esp = mcontext_unop wanted_mcontext { esp wi let mcontext_check_non_none esp = if esp.mcontext = M_none then warn_rule "() context not accepted here" -let mcontext_check_none esp = - match esp.mcontext with - | M_none | M_unknown -> () - | M_mixed l when List.exists (fun c -> c = M_none) l -> () - | _ -> - match esp.any with - | [List [Num("1", _)]; Semi_colon] -> () (* allow "1;" for package return value. It would be much better to check we are at toplevel, but hell i don't want to wire this information up to here *) - | [List [Call_op ("<>", [Ident (None, "STDIN", _)], _)]; Semi_colon] -> () (* allow to ask "press return" *) - | [List [Call(Deref(I_func, Ident(None, "map", _)), _)]; Semi_colon] -> warn_rule "if you don't use the return value, use \"foreach\" instead of \"map\"" - | _ -> warn esp.pos "value is dropped" +let mcontext_check_none msg expr esp = + let rec mcontext_check_none_rec msg expr = function + | M_none | M_unknown -> () + | M_mixed l when List.exists (fun c -> c = M_none) l -> () + | M_tuple l -> + (match expr with + | [List l_expr] -> + let rec iter = function + | e::l_expr, mcontext::l -> + mcontext_check_none_rec (if l = [] then msg else "value is dropped") [e] mcontext + | [], [] -> () + | _ -> internal_error "mcontext_check_none" + in iter (l_expr, l) + | _ -> internal_error "mcontext_check_none") + | _ -> + match expr with + | [List [Num("1", _)]; Semi_colon] -> () (* allow "1;" for package return value. It would be much better to check we are at toplevel, but hell i don't want to wire this information up to here *) + | [List [Call_op ("<>", [Ident (None, "STDIN", _)], _)]; Semi_colon] -> () (* allow to ask "press return" *) + | [List [Call(Deref(I_func, Ident(None, "map", _)), _)]; Semi_colon] -> warn_rule "if you don't use the return value, use \"foreach\" instead of \"map\"" + | _ -> warn esp.pos msg + in + mcontext_check_none_rec msg expr esp.mcontext let mcontext_op_assign left right = mcontext_check_non_none right; @@ -1105,3 +1122,8 @@ let mcontext_op_assign left right = match left.any.expr with | Deref(I_array, _) | My_our("my", [(I_array, _)], _) -> M_mixed [ M_array; M_none ] | _ -> mcontext_merge right.mcontext M_none + +let mtuple_context_concat c1 c2 = + match c1 with + | M_tuple l -> M_tuple (l @ [c2]) + | _ -> M_tuple [c1 ; c2] diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli index a97b4ed..678c6f8 100644 --- a/perl_checker.src/parser_helper.mli +++ b/perl_checker.src/parser_helper.mli @@ -190,6 +190,13 @@ val call : Types.fromparser * Types.fromparser list -> Types.fromparser val check_return : Types.fromparser Types.any_spaces_pos -> Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> unit +val call_and_context : + Types.fromparser * Types.fromparser list -> + bool -> + Types.priority -> + 'a Types.any_spaces_pos -> + 'b Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos val call_no_paren : Types.fromparser Types.any_spaces_pos -> Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> @@ -198,13 +205,6 @@ val call_with_paren : Types.fromparser Types.any_spaces_pos -> Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -val call_and_context : - Types.fromparser * Types.fromparser list -> - bool -> - Types.priority -> - 'a Types.any_spaces_pos -> - 'b Types.any_spaces_pos -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos val call_func : Types.fromparser Types.any_spaces_pos -> Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> @@ -282,7 +282,10 @@ val mcontext_unop_l : Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> Types.maybe_context val mcontext_check_non_none : 'a Types.any_spaces_pos -> unit -val mcontext_check_none : Types.fromparser list Types.any_spaces_pos -> unit +val mcontext_check_none : + string -> Types.fromparser list -> 'a Types.any_spaces_pos -> unit val mcontext_op_assign : Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> 'a Types.any_spaces_pos -> Types.maybe_context +val mtuple_context_concat : + Types.maybe_context -> Types.maybe_context -> Types.maybe_context diff --git a/perl_checker.src/types.mli b/perl_checker.src/types.mli index 812392d..e10e8f5 100644 --- a/perl_checker.src/types.mli +++ b/perl_checker.src/types.mli @@ -20,6 +20,7 @@ type maybe_context = | M_int | M_float | M_string | M_ref of maybe_context | M_revision | M_sub | M_scalar + | M_tuple of maybe_context list | M_list | M_array | M_hash -- cgit v1.2.1