disallow

- $a = (1, 2)
- my $a = (1, 2)
- my ($a, $b) = (1, 2, 3)

5 files changed, 51 insertions, 25 deletions

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