check lvalue validity

4 files changed, 36 insertions, 2 deletions

diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly
index 10ad566..6a091ac 100644
--- a/perl_checker.src/parser.mly
+++ b/perl_checker.src/parser.mly
@@ -230,9 +230,9 @@ term:
 | term MULT_L_STR term {sp_same $2 $3; mcontext_check M_int $3; let pri = P_mul in to_Call_op_ (if mcontext_lower $1.mcontext M_string then M_string else M_list) pri "x" 
     										                                                 [prio_lo_concat $1; prio_lo_after pri $3] $1 $3}
 
-| term ASSIGN     term {sp_same $2 $3; let pri = P_assign    in to_Call_op_ (mcontext_op_assign $1 $3)       pri $2.any [$1.any.expr   ; prio_lo_after pri $3] $1 $3}
+| term ASSIGN     term {sp_same $2 $3; let pri = P_assign    in to_Call_assign_op_ (mcontext_op_assign $1 $3)       pri $2.any ($1.any.expr) (prio_lo_after pri $3) $1 $3}
 
-| term ASSIGN     BRACKET expr_bracket_end {sp_p($2); sp_p($3); sp_p($4); to_Call_op_ (M_mixed [M_ref M_hash; M_none]) P_assign $2.any [prio_lo P_assign $1; $4.any] $1 $4}
+| term ASSIGN     BRACKET expr_bracket_end {sp_p($2); sp_p($3); sp_p($4); to_Call_assign_op_ (M_mixed [M_ref M_hash; M_none]) P_assign $2.any (prio_lo P_assign $1) $4.any $1 $4}
 | term AND_TIGHT  BRACKET expr_bracket_end {sp_p($2); sp_p($3); sp_p($4); to_Call_op_ M_bool P_tight_and "&&"   [prio_lo P_assign $1; $4.any] $1 $4}
 | term OR_TIGHT   BRACKET expr_bracket_end {sp_p($2); sp_p($3); sp_p($4); to_Call_op_ M_bool P_tight_or  "||"   [prio_lo P_assign $1; $4.any] $1 $4}
 
diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml
index a673f6d..a32e3fd 100644
--- a/perl_checker.src/parser_helper.ml
+++ b/perl_checker.src/parser_helper.ml
@@ -98,6 +98,23 @@ let is_always_false = function
   | Ident(None, "undef", _) -> true
   | _ -> false
 
+let rec is_lvalue = function
+  | Call(Deref(I_func, Ident(None, f, _)), _) -> List.mem f [ "substr" ]
+
+  | Call_op("?:", [ _ ; a ; b ], _) -> is_lvalue a && is_lvalue b
+
+  | Call_op("local", l, _)
+  | List [ List l ] 
+    -> List.for_all is_lvalue l
+
+  | My_our _
+  | Deref(_, _)
+  | Deref_with(_, _, _, _)
+  | Ident(None, "undef", _)
+    -> true
+
+  | _ -> false
+
 let not_complex e =
   if is_parenthesized e then true else
   let rec not_complex_ op = function
@@ -728,6 +745,9 @@ let to_Call_op mcontext op para esp_start esp_end =
 let to_Call_op_ mcontext prio op para esp_start esp_end = 
   let pos = raw_pos_range esp_start esp_end in
   new_any mcontext { priority = prio ; expr = cook_call_op op para pos } esp_start.spaces pos
+let to_Call_assign_op_ mcontext prio op left right esp_left esp_end = 
+  if not (is_lvalue left) then warn esp_left.pos "invalid lvalue";
+  to_Call_op_ mcontext prio op [ left ; right ] esp_left esp_end
 
 let followed_by_comma expr true_comma =
   if true_comma then expr else
diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli
index 7ff7c96..ecd5095 100644
--- a/perl_checker.src/parser_helper.mli
+++ b/perl_checker.src/parser_helper.mli
@@ -45,6 +45,7 @@ val un_parenthesize_full : Types.fromparser -> Types.fromparser
 val un_parenthesize_full_l : Types.fromparser list -> Types.fromparser list
 val is_always_true : Types.fromparser -> bool
 val is_always_false : Types.fromparser -> bool
+val is_lvalue : Types.fromparser -> bool
 val not_complex : Types.fromparser -> bool
 val not_simple : Types.fromparser -> bool
 val string_of_Ident : Types.fromparser -> string
@@ -105,6 +106,7 @@ val check_arrow_needed :
   Types.fromparser Types.prio_anyexpr Types.any_spaces_pos ->
   'a Types.any_spaces_pos -> unit
 val check_scalar_subscripted : Types.fromparser Types.any_spaces_pos -> unit
+val negatable_ops : (string * string) list
 val check_negatable_expr :
   Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit
 val check_ternary_paras :
@@ -181,6 +183,15 @@ val to_Call_op_ :
   'a Types.any_spaces_pos ->
   'b Types.any_spaces_pos ->
   Types.fromparser Types.prio_anyexpr Types.any_spaces_pos
+val to_Call_assign_op_ :
+  Types.maybe_context ->
+  Types.priority ->
+  string ->
+  Types.fromparser ->
+  Types.fromparser ->
+  'a Types.any_spaces_pos ->
+  'b Types.any_spaces_pos ->
+  Types.fromparser Types.prio_anyexpr Types.any_spaces_pos
 val followed_by_comma :
   Types.fromparser list -> bool -> Types.fromparser list
 val pot_strings : (string, (string * int * int) * string list) Hashtbl.t
diff --git a/perl_checker.src/test/various_errors.t b/perl_checker.src/test/various_errors.t
index 535034b..af21eb4 100644
--- a/perl_checker.src/test/various_errors.t
+++ b/perl_checker.src/test/various_errors.t
@@ -12,9 +12,12 @@ if ($xxx = '') {}                        are you sure you did not mean "==" inst
 
 N("xxx$yyy")                             don't use interpolated translated string, use %s or %d instead
 
+if ($xxx && $yyy = xxx()) {}             invalid lvalue
+
 1 + 2 >> 3                               missing parentheses (needed for clarity)
 
 $xxx ? $yyy = 1 : $zzz = 2;              missing parentheses (needed for clarity)
+                                         invalid lvalue
 
 N_("xxx") . 'yyy'                        N_("xxx") . "yyy" is dumb since the string "xxx" will never get translated