From dcdef6368ea8db7584b5ce80835fb262e987fd4c Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Tue, 16 Dec 2003 23:19:47 +0000 Subject: disallow - $a = (1, 2) - my $a = (1, 2) - my ($a, $b) = (1, 2, 3) --- perl_checker.src/common.ml | 5 +++++ perl_checker.src/common.mli | 2 +- perl_checker.src/parser.mly | 22 +++++++++---------- perl_checker.src/parser_helper.ml | 44 +++++++++++++++++++++++++++----------- perl_checker.src/parser_helper.mli | 3 ++- 5 files changed, 51 insertions(+), 25 deletions(-) (limited to 'perl_checker.src') diff --git a/perl_checker.src/common.ml b/perl_checker.src/common.ml index 554a65c..ddd6b08 100644 --- a/perl_checker.src/common.ml +++ b/perl_checker.src/common.ml @@ -185,6 +185,11 @@ let rec for_all2_ p l1 l2 = | (a1::l1, a2::l2) -> p a1 a2 && for_all2_ p l1 l2 | (_, _) -> false +let rec for_all2_true p l1 l2 = + match (l1, l2) with + | (a1::l1, a2::l2) -> p a1 a2 && for_all2_true p l1 l2 + | (_, _) -> true + let maxl l = fold_right1 max l let rec stack2list s = diff --git a/perl_checker.src/common.mli b/perl_checker.src/common.mli index 0545d9f..276faca 100644 --- a/perl_checker.src/common.mli +++ b/perl_checker.src/common.mli @@ -19,7 +19,6 @@ val sndter3 : 'a * 'b * 'c -> 'b * 'c val o : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b val curry : ('a * 'b -> 'c) -> 'a -> 'b -> 'c val uncurry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c -val is_int : float -> bool val uncons : 'a list -> 'a * 'a list val has_env : string -> bool val some : 'a option -> 'a @@ -44,6 +43,7 @@ val keep_best : ('a * 'a -> 'a option) -> 'a list -> 'a list val keep_bests : ('a * 'a -> 'a option) -> 'a list -> 'a list val fold_right1 : ('a -> 'a -> 'a) -> 'a list -> 'a val for_all2_ : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool +val for_all2_true : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool val maxl : 'a list -> 'a val stack2list : 'a Stack.t -> 'a list val stack_exists : ('a -> bool) -> 'a Stack.t -> bool diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly index ebdf59d..23d39a1 100644 --- a/perl_checker.src/parser.mly +++ b/perl_checker.src/parser.mly @@ -288,7 +288,7 @@ term: | termdo {new_1pesp P_tok $1.any $1} | REF term {new_pesp (M_ref $2.mcontext) P_expr (Ref(I_scalar, remove_call_with_same_para_special $2.any.expr)) $1 $2} /* \$x, \@y, \%z */ | my_our %prec UNIOP {new_1pesp P_expr $1.any $1} -| LOCAL term %prec UNIOP {sp_n($2); new_pesp M_none P_expr (to_Local $2) $1 $2} +| LOCAL term %prec UNIOP {sp_n($2); new_pesp (M_mixed [ $2.mcontext ; M_none ]) P_expr (to_Local $2) $1 $2} | parenthesized {new_1pesp $1.any.priority (List $1.any.expr) $1} /* (1, 2) */ | parenthesized arrayref {sp_0($2); let is_slice = not (is_only_one_in_List $2.any) in new_pesp (if is_slice then M_list else M_scalar) P_tok (to_Deref_with(I_array, (if is_slice then I_array else I_scalar), List $1.any.expr, List $2.any)) $1 $2} /* list indexing or slicing */ @@ -409,21 +409,21 @@ parenthesized_start: | parenthesized_start BRACKET expr BRACKET_END comma {(if $1.any = [] then sp_0_or_cr else sp_p)($2); sp_p($3); sp_p($4); new_esp (M_ref M_hash) ($1.any @ [Ref(I_hash, $3.any.expr)]) $1 $5} my_our: /* Things that can be "my"'d */ -| my_our_paren PAREN_END {sp_0($2); if snd $1.any <> [] && fstfst $1.any then die_rule "syntax error"; new_esp M_none (My_our(sndfst $1.any, snd $1.any, get_pos $1)) $1 $2} -| my_our_paren SCALAR_IDENT PAREN_END {check_my_our_paren $1 $2; new_esp M_none (My_our(sndfst $1.any, snd $1.any @ [I_scalar, snd $2.any], pos_range $1 $3)) $1 $3} -| my_our_paren HASH_IDENT PAREN_END {check_my_our_paren $1 $2; new_esp M_none (My_our(sndfst $1.any, snd $1.any @ [I_hash, snd $2.any], pos_range $1 $3)) $1 $3} -| my_our_paren ARRAY_IDENT PAREN_END {check_my_our_paren $1 $2; new_esp M_none (My_our(sndfst $1.any, snd $1.any @ [I_array, snd $2.any], pos_range $1 $3)) $1 $3} +| my_our_paren PAREN_END {sp_0($2); if snd $1.any <> [] && fstfst $1.any then die_rule "syntax error"; new_esp (M_mixed [ $1.mcontext ; M_none ]) (My_our(sndfst $1.any, snd $1.any, get_pos $1)) $1 $2} +| my_our_paren SCALAR_IDENT PAREN_END {check_my_our_paren $1 $2; new_esp (M_mixed [ mtuple_context_concat $1.mcontext M_scalar; M_none ]) (My_our(sndfst $1.any, snd $1.any @ [I_scalar, snd $2.any], pos_range $1 $3)) $1 $3} +| my_our_paren HASH_IDENT PAREN_END {check_my_our_paren $1 $2; new_esp (M_mixed [ M_list ; M_none ]) (My_our(sndfst $1.any, snd $1.any @ [I_hash, snd $2.any], pos_range $1 $3)) $1 $3} +| my_our_paren ARRAY_IDENT PAREN_END {check_my_our_paren $1 $2; new_esp (M_mixed [ M_list ; M_none ]) (My_our(sndfst $1.any, snd $1.any @ [I_array, snd $2.any], pos_range $1 $3)) $1 $3} | MY_OUR SCALAR_IDENT {new_esp (M_mixed [M_scalar; M_none]) (My_our($1.any, [I_scalar, snd $2.any], get_pos $2)) $1 $2} | MY_OUR HASH_IDENT {new_esp (M_mixed [M_hash ; M_none]) (My_our($1.any, [I_hash, snd $2.any], get_pos $2)) $1 $2} | MY_OUR ARRAY_IDENT {new_esp (M_mixed [M_array ; M_none]) (My_our($1.any, [I_array, snd $2.any], get_pos $2)) $1 $2} my_our_paren: -| MY_OUR PAREN {sp_1($2); new_esp M_special ((true, $1.any), []) $1 $2} -| my_our_paren comma {if fstfst $1.any then die_rule "syntax error"; new_esp M_none ((true, sndfst $1.any), snd $1.any) $1 $2} -| my_our_paren BAREWORD {check_my_our_paren $1 $2; if $2.any <> "undef" then die_rule "scalar expected"; new_esp M_none ((false, sndfst $1.any), snd $1.any @ [I_raw, $2.any]) $1 $2} -| my_our_paren SCALAR_IDENT {check_my_our_paren $1 $2; new_esp M_none ((false, sndfst $1.any), snd $1.any @ [I_scalar, snd $2.any]) $1 $2} -| my_our_paren HASH_IDENT {check_my_our_paren $1 $2; new_esp M_none ((false, sndfst $1.any), snd $1.any @ [I_hash, snd $2.any]) $1 $2} -| my_our_paren ARRAY_IDENT {check_my_our_paren $1 $2; new_esp M_none ((false, sndfst $1.any), snd $1.any @ [I_array, snd $2.any]) $1 $2} +| MY_OUR PAREN {sp_1($2); new_esp (M_tuple []) ((true, $1.any), []) $1 $2} +| my_our_paren comma {if fstfst $1.any then die_rule "syntax error"; new_esp $1.mcontext ((true, sndfst $1.any), snd $1.any) $1 $2} +| my_our_paren BAREWORD {check_my_our_paren $1 $2; if $2.any <> "undef" then die_rule "scalar expected"; new_esp (mtuple_context_concat $1.mcontext M_none) ((false, sndfst $1.any), snd $1.any @ [I_raw, $2.any]) $1 $2} +| my_our_paren SCALAR_IDENT {check_my_our_paren $1 $2; new_esp (mtuple_context_concat $1.mcontext M_scalar) ((false, sndfst $1.any), snd $1.any @ [I_scalar, snd $2.any]) $1 $2} +| my_our_paren HASH_IDENT {check_my_our_paren $1 $2; new_esp M_list ((false, sndfst $1.any), snd $1.any @ [I_hash, snd $2.any]) $1 $2} +| my_our_paren ARRAY_IDENT {check_my_our_paren $1 $2; new_esp M_list ((false, sndfst $1.any), snd $1.any @ [I_array, snd $2.any]) $1 $2} termdo: /* Things called with "do" */ | DO term %prec UNIOP { die_rule "\"do EXPR\" not allowed" } /* do $filename */ diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml index 117dfee..76bd171 100644 --- a/perl_checker.src/parser_helper.ml +++ b/perl_checker.src/parser_helper.ml @@ -134,7 +134,7 @@ let rec is_same_fromparser a b = | Raw_string(s1, _), Raw_string(s2, _) -> s1 = s2 | String(l1, _), String(l2, _) -> - List.for_all2 (fun (s1, e1) (s2, e2) -> s1 = s2 && is_same_fromparser e1 e2) l1 l2 + for_all2_ (fun (s1, e1) (s2, e2) -> s1 = s2 && is_same_fromparser e1 e2) l1 l2 | Ref(c1, e1), Ref(c2, e2) | Deref(c1, e1), Deref(c2, e2) -> c1 = c2 && is_same_fromparser e1 e2 @@ -144,13 +144,13 @@ let rec is_same_fromparser a b = | Diamond(None), Diamond(None) -> true | Diamond(Some e1), Diamond(Some e2) -> is_same_fromparser e1 e2 - | List(l1), List(l2) -> List.for_all2 is_same_fromparser l1 l2 + | List(l1), List(l2) -> for_all2_ is_same_fromparser l1 l2 - | Call_op(op1, l1, _), Call_op(op2, l2, _) -> op1 = op2 && List.for_all2 is_same_fromparser l1 l2 - | Call(e1, l1), Call(e2, l2) -> is_same_fromparser e1 e2 && List.for_all2 is_same_fromparser l1 l2 + | Call_op(op1, l1, _), Call_op(op2, l2, _) -> op1 = op2 && for_all2_ is_same_fromparser l1 l2 + | Call(e1, l1), Call(e2, l2) -> is_same_fromparser e1 e2 && for_all2_ is_same_fromparser l1 l2 | Method_call(e1, m1, l1), Method_call(e2, m2, l2) -> - is_same_fromparser e1 e2 && is_same_fromparser m1 m2 && List.for_all2 is_same_fromparser l1 l2 + is_same_fromparser e1 e2 && is_same_fromparser m1 m2 && for_all2_ is_same_fromparser l1 l2 | _ -> false @@ -998,8 +998,8 @@ let rec mcontext_lower c1 c2 = match c1, c2 with | M_special, _ | _, M_special -> internal_error "M_special in mcontext_compare" - | M_array, M_array | M_array, M_int | M_array, M_float | M_array, M_scalar | M_array, M_list - | M_hash, M_hash | M_hash, M_scalar | M_hash, M_list + | M_array, M_array | M_array, M_int | M_array, M_float | M_array, M_scalar | M_array, M_tuple _ | M_array, M_list + | M_hash, M_hash | M_hash, M_scalar | M_hash, M_tuple _ | M_hash, M_list | M_bool, M_bool | M_bool, M_scalar | M_bool, M_list @@ -1011,7 +1011,11 @@ let rec mcontext_lower c1 c2 = | M_scalar, M_scalar | M_scalar, M_list -> true - | M_tuple t1, M_tuple t2 -> List.for_all2 mcontext_lower t1 t2 + | M_bool, M_tuple (c :: _) | M_int, M_tuple (c :: _) | M_float, M_tuple (c :: _) | M_ref _, M_tuple (c :: _) | M_string, M_tuple (c :: _) | M_revision, M_tuple (c :: _) | M_scalar, M_tuple (c :: _) + -> mcontext_lower c1 c + + | M_tuple t1, M_tuple t2 -> + List.length t1 <= List.length t2 && for_all2_true mcontext_lower t1 t2 | M_tuple _, M_list | M_list, M_list @@ -1074,8 +1078,10 @@ let mcontext_check_raw wanted_mcontext esp f_lower f_greater f_err = f_err()) let mcontext_check wanted_mcontext esp = - if wanted_mcontext <> M_list && wanted_mcontext <> M_array then - (match un_parenthesize_full esp.any.expr with + (match wanted_mcontext with + | M_list | M_array | M_mixed [M_array; M_none] | M_tuple _ -> () + | _ -> + match un_parenthesize_full esp.any.expr with | Call(Deref(I_func, Ident(None, "grep", _)), _) -> warn_rule "in scalar context, use \"any\" instead of \"grep\"" | _ -> ()); mcontext_check_raw wanted_mcontext esp (fun () -> ()) (fun () -> ()) (fun () -> ()) @@ -1134,12 +1140,26 @@ let mcontext_check_none msg expr esp = let mcontext_op_assign left right = mcontext_check_non_none right; + let left_context = + match left.mcontext with + | M_mixed [ c ; M_none ] -> c + | c -> c + in + let left_context = + match left_context with + | M_array | M_hash -> M_list + | M_tuple l -> M_tuple (List.map (fun _ -> M_unknown) l) + | c -> c + in + mcontext_check left_context 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]) + match c1, c2 with + | M_array, _ | _, M_array + | M_hash, _ | _, M_hash -> M_list + | 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 ec86b55..dc4369d 100644 --- a/perl_checker.src/parser_helper.mli +++ b/perl_checker.src/parser_helper.mli @@ -286,6 +286,7 @@ 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 + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> + Types.maybe_context val mtuple_context_concat : Types.maybe_context -> Types.maybe_context -> Types.maybe_context -- cgit v1.2.1