summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--perl_checker.src/parser.mly20
-rw-r--r--perl_checker.src/parser_helper.ml42
-rw-r--r--perl_checker.src/parser_helper.mli19
-rw-r--r--perl_checker.src/types.mli1
4 files changed, 54 insertions, 28 deletions
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 <STDIN> 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 <STDIN> 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
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-13 22:21:14 +0000