diff options
author | Pascal Rigaux <pixel@mandriva.com> | 2004-05-08 22:23:50 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 2004-05-08 22:23:50 +0000 |
commit | f585176ac98de3d36207c0cbbfbbc601b430a6fe (patch) | |
tree | 58e9bdc05034785e68b4f3b11c21d05bf11b5fc8 /perl_checker.src | |
parent | e0820e4f4e101bd8502f1f2bb0c1c0c7fd8b21e7 (diff) | |
download | perl-MDK-Common-f585176ac98de3d36207c0cbbfbbc601b430a6fe.tar perl-MDK-Common-f585176ac98de3d36207c0cbbfbbc601b430a6fe.tar.gz perl-MDK-Common-f585176ac98de3d36207c0cbbfbbc601b430a6fe.tar.bz2 perl-MDK-Common-f585176ac98de3d36207c0cbbfbbc601b430a6fe.tar.xz perl-MDK-Common-f585176ac98de3d36207c0cbbfbbc601b430a6fe.zip |
better contexts
Diffstat (limited to 'perl_checker.src')
-rw-r--r-- | perl_checker.src/parser.mly | 124 | ||||
-rw-r--r-- | perl_checker.src/parser_helper.ml | 177 | ||||
-rw-r--r-- | perl_checker.src/parser_helper.mli | 34 | ||||
-rw-r--r-- | perl_checker.src/test/context.t | 8 | ||||
-rw-r--r-- | perl_checker.src/test/return_value.t | 5 | ||||
-rw-r--r-- | perl_checker.src/types.mli | 11 |
6 files changed, 183 insertions, 176 deletions
diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly index 460fbf3..aa2c1d2 100644 --- a/perl_checker.src/parser.mly +++ b/perl_checker.src/parser.mly @@ -118,20 +118,20 @@ line: | BRACKET lines BRACKET_END semi_colon {check_block_sub $2 $3; new_esp $2.mcontext [Block $2.any] $1 $4} if_then_else: /* Real conditional expressions */ -| IF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_scalar $3; check_block_sub $6 $7; to_Call_op (if $9.any = [] then M_none else mcontext_lmerge ($6.mcontext :: mcontext_lmaybe $8 @ [$9.mcontext])) "if" (prio_lo P_loose $3 :: Block $6.any :: $8.any @ $9.any) $1 $9} -| UNLESS PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_scalar $3; check_block_sub $6 $7; check_unless_else $8 $9; to_Call_op M_none "unless" (prio_lo P_loose $3 :: Block $6.any :: $8.any @ $9.any) $1 $9} +| IF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; check_block_sub $6 $7; to_Call_op (if $9.any = [] then M_none else mcontext_lmerge ($6.mcontext :: mcontext_lmaybe $8 @ [$9.mcontext])) "if" (prio_lo P_loose $3 :: Block $6.any :: $8.any @ $9.any) $1 $9} +| UNLESS PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; check_block_sub $6 $7; check_unless_else $8 $9; to_Call_op M_none "unless" (prio_lo P_loose $3 :: Block $6.any :: $8.any @ $9.any) $1 $9} elsif: | {default_esp []} -| ELSIF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_scalar $3; check_block_sub $6 $7; new_esp (mcontext_lmerge ($6.mcontext :: mcontext_lmaybe $8)) (prio_lo P_loose $3 :: Block $6.any :: $8.any) $1 $8} +| ELSIF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; check_block_sub $6 $7; new_esp (mcontext_lmerge ($6.mcontext :: mcontext_lmaybe $8)) (prio_lo P_loose $3 :: Block $6.any :: $8.any) $1 $8} else_: | { default_esp [] } | ELSE BRACKET lines BRACKET_END {sp_p($1); sp_n($2); check_block_sub $3 $4; new_esp $3.mcontext [Block $3.any] $1 $4} loop: -| WHILE PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_scalar $3; check_block_sub $6 $7; to_Call_op M_none "while" [ prio_lo P_loose $3; Block $6.any ] $1 $8} -| UNTIL PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_scalar $3; check_block_sub $6 $7; to_Call_op M_none "until" [ prio_lo P_loose $3; Block $6.any ] $1 $8} +| WHILE PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; check_block_sub $6 $7; to_Call_op M_none "while" [ prio_lo P_loose $3; Block $6.any ] $1 $8} +| UNTIL PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_bool $3; check_block_sub $6 $7; to_Call_op M_none "until" [ prio_lo P_loose $3; Block $6.any ] $1 $8} | FOR PAREN expr_or_empty semi_colon expr_or_empty semi_colon expr_or_empty PAREN_END BRACKET lines BRACKET_END {sp_p($1); check_for($1); sp_n($2); sp_0($3); sp_p($5); sp_p($7); sp_0($8); sp_n($9); check_block_sub $10 $11; to_Call_op M_none "for" [ $3.any; $5.any; $7.any; Block $10.any ] $1 $11} | FOR SCALAR_IDENT PAREN expr PAREN_END BRACKET lines BRACKET_END cont { die_rule "don't use for without \"my\"ing the iteration variable" } | FOR PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); mcontext_check M_list $3; check_block_sub $6 $7; check_for_foreach $1 $3; to_Call_op M_none "foreach" [ prio_lo P_loose $3; Block $6.any ] $1 $8} @@ -147,10 +147,10 @@ cont: /* Continue blocks */ sideff: /* An expression which may have a side-effect */ | expr { new_1esp $1.any.expr $1 } -| expr IF expr {sp_p($2); sp_p($3); mcontext_check M_scalar $3; call_op_if_infix (prio_lo P_loose $1) (prio_lo P_loose $3) $1 $3} -| expr UNLESS expr {sp_p($2); sp_p($3); mcontext_check M_scalar $3; call_op_unless_infix (prio_lo P_loose $1) (prio_lo P_loose $3) $1 $3} -| expr WHILE expr {sp_p($2); sp_p($3); mcontext_check M_scalar $3; to_Call_op M_none "while infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} -| expr UNTIL expr {sp_p($2); sp_p($3); mcontext_check M_scalar $3; to_Call_op M_none "until infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} +| expr IF expr {sp_p($2); sp_p($3); mcontext_check M_bool $3; call_op_if_infix (prio_lo P_loose $1) (prio_lo P_loose $3) $1 $3} +| expr UNLESS expr {sp_p($2); sp_p($3); mcontext_check M_bool $3; call_op_unless_infix (prio_lo P_loose $1) (prio_lo P_loose $3) $1 $3} +| expr WHILE expr {sp_p($2); sp_p($3); mcontext_check M_bool $3; to_Call_op M_none "while infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} +| expr UNTIL expr {sp_p($2); sp_p($3); mcontext_check M_bool $3; to_Call_op M_none "until infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} | expr FOR expr {sp_p($2); sp_p($3); mcontext_check M_list $3; check_foreach($2); to_Call_op M_none "for infix" [ prio_lo P_loose $1 ; prio_lo P_loose $3 ] $1 $3} decl: @@ -189,8 +189,8 @@ listexpr: /* Basic list expressions */ | argexpr %prec PREC_LOW {$1} expr: /* Ordinary expressions; logical combinations */ -| 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} +| expr AND expr {sp_p($2); sp_p($3); mcontext_check M_bool $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_bool $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 */ @@ -204,30 +204,36 @@ argexpr: /* Expressions are a list of terms joined by commas */ /********************************************************************************/ term: | term - COMPARE_OP_STR term {sp_same $2 $3; sp_p $2; let pri = P_cmp in to_Call_op_ (mcontext_symops M_string $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term COMPARE_OP term {sp_same $2 $3; sp_p $2; let pri = P_cmp in to_Call_op_ (mcontext_symops M_float $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term LT term {sp_same $2 $3; sp_p $2; let pri = P_cmp in to_Call_op_ (mcontext_symops M_float $1 $3) pri "<" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term GT term {sp_same $2 $3; sp_p $2; let pri = P_cmp in to_Call_op_ (mcontext_symops M_float $1 $3) pri ">" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term EQ_OP term {sp_same $2 $3; sp_p $2; let pri = P_eq in to_Call_op_ (mcontext_symops M_float $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term EQ_OP_STR term {sp_same $2 $3; sp_p $2; let pri = P_eq in to_Call_op_ (mcontext_symops M_string $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term POWER term {sp_same $2 $3; let pri = P_tight in to_Call_op_ (mcontext_symops M_float $1 $3) pri "**" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term BIT_AND term {sp_same $2 $3; sp_p $2; let pri = P_bit in to_Call_op_ (mcontext_symops M_int $1 $3) pri "&" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term BIT_OR term {sp_same $2 $3; let pri = P_bit in to_Call_op_ (mcontext_symops M_int $1 $3) pri "|" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term BIT_XOR term {sp_same $2 $3; sp_p $2; let pri = P_bit in to_Call_op_ (mcontext_symops M_int $1 $3) pri "^" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term AND_TIGHT term {sp_same $2 $3; sp_p $2; let pri = P_tight_and in to_Call_op_ (mcontext_rightops M_scalar $1 $3) pri "&&" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term OR_TIGHT term {sp_same $2 $3; sp_p $2; let pri = P_tight_or in to_Call_op_ (mcontext_symops M_scalar $1 $3) pri "||" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term MULT term {sp_same $2 $3; let pri = P_mul in to_Call_op_ (mcontext_symops M_float $1 $3) pri $2.any [prio_lo_concat $1; prio_lo_after pri $3] $1 $3} -| 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 PLUS term {sp_same $2 $3; let pri = P_add in to_Call_op_ (mcontext_symops M_float $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term CONCAT term {sp_same $2 $3; let pri = P_add in to_Call_op_ (mcontext_symops M_string $1 $3) pri "." [prio_lo pri $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 DOTDOT term {sp_same $2 $3; let pri = P_paren_wanted P_expr in to_Call_op_ (mcontext_symops M_scalar $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term BIT_SHIFT term {sp_same $2 $3; let pri = P_paren_wanted P_tight in to_Call_op_ (mcontext_symops M_int $1 $3) pri $2.any [prio_lo pri $1; prio_lo_after pri $3] $1 $3} -| term XOR term {sp_same $2 $3; sp_p $2; let pri = P_paren_wanted P_expr in to_Call_op_ (mcontext_symops M_scalar $1 $3) pri "xor" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} + COMPARE_OP_STR term {sp_p $2; symops P_cmp M_string M_bool $2.any $1 $2 $3} +| term COMPARE_OP term {sp_p $2; symops P_cmp M_float M_bool $2.any $1 $2 $3} +| term LT term {sp_p $2; symops P_cmp M_float M_bool "<" $1 $2 $3} +| term GT term {sp_p $2; symops P_cmp M_float M_bool ">" $1 $2 $3} +| term EQ_OP term {sp_p $2; symops P_eq M_float M_bool $2.any $1 $2 $3} +| term EQ_OP_STR term {sp_p $2; symops P_eq M_string M_bool $2.any $1 $2 $3} + +| term BIT_AND term {sp_p $2; symops P_bit M_int M_int "&" $1 $2 $3} +| term BIT_OR term { symops P_bit M_int M_int "|" $1 $2 $3} +| term BIT_XOR term {sp_p $2; symops P_bit M_int M_int "^" $1 $2 $3} + +| term POWER term { symops P_tight M_float (mcontext_float_or_int [$1.mcontext; $3.mcontext]) "**" $1 $2 $3} +| term PLUS term { symops P_add M_float (mcontext_float_or_int [$1.mcontext; $3.mcontext]) $2.any $1 $2 $3} +| term CONCAT term { symops P_add M_string M_string "." $1 $2 $3} +| term BIT_SHIFT term { symops (P_paren_wanted P_tight) M_int M_int $2.any $1 $2 $3} +| term XOR term {sp_p $2; symops (P_paren_wanted P_expr) M_bool M_bool "xor" $1 $2 $3} +| term DOTDOT term { symops (P_paren_wanted P_expr) M_unknown_scalar M_string $2.any $1 $2 $3} + +| term AND_TIGHT term {sp_p $2; sp_same $2 $3; mcontext_check M_bool $1; let pri = P_tight_and in to_Call_op_ (mcontext_to_scalar $3.mcontext) pri "&&" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} +| term OR_TIGHT term {sp_p $2; sp_same $2 $3; mcontext_check M_bool $1; let pri = P_tight_or in to_Call_op_ (mcontext_to_scalar (mcontext_merge $1.mcontext $3.mcontext)) pri "||" [prio_lo pri $1; prio_lo_after pri $3] $1 $3} + +| term MULT term {sp_same $2 $3; let pri = P_mul in to_Call_op_ (mcontext_float_or_int [$1.mcontext; $3.mcontext]) pri $2.any [prio_lo_concat $1; prio_lo_after pri $3] $1 $3} +| 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 BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); to_Call_op_ (M_mixed [M_ref M_hash; M_none]) P_assign $2.any [prio_lo P_assign $1; hash_ref $4] $1 $5} -| term AND_TIGHT BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); to_Call_op_ M_scalar P_tight_and "&&" [prio_lo P_assign $1; hash_ref $4] $1 $5} -| term OR_TIGHT BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); to_Call_op_ M_scalar P_tight_or "||" [prio_lo P_assign $1; hash_ref $4] $1 $5} +| term AND_TIGHT BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); to_Call_op_ M_bool P_tight_and "&&" [prio_lo P_assign $1; hash_ref $4] $1 $5} +| term OR_TIGHT BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); to_Call_op_ M_bool P_tight_or "||" [prio_lo P_assign $1; hash_ref $4] $1 $5} | term PATTERN_MATCH PATTERN {sp_n($2); sp_p($3); check_unneeded_var_dollar_ ($1); mcontext_check M_string $1; to_Call_op_ M_array P_expr "m//" ($1.any.expr :: from_PATTERN $3) $1 $3} @@ -246,10 +252,10 @@ term: | term PATTERN_MATCH_NOT STRING {warn $3.pos "use a regexp, not a string"; to_Call_op_ M_int P_expr "!m//" [ $1.any.expr; to_String false $3 ] $1 $3} -| term QUESTION_MARK term COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); mcontext_check M_scalar $1; to_Call_op_ (mcontext_merge $3.mcontext $5.mcontext) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, prio_lo_after P_ternary $3, prio_lo_after P_ternary $5)) $1 $5} -| term QUESTION_MARK term COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); mcontext_check M_scalar $1; to_Call_op_ (mcontext_merge $3.mcontext (M_ref M_hash)) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, prio_lo_after P_ternary $3, hash_ref $6)) $1 $7} -| term QUESTION_MARK BRACKET expr BRACKET_END COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); mcontext_check M_scalar $1; to_Call_op_ (mcontext_merge $7.mcontext (M_ref M_hash)) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, hash_ref $4, prio_lo_after P_ternary $7)) $1 $7} -| term QUESTION_MARK BRACKET expr BRACKET_END COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); sp_p($8); sp_p($9); mcontext_check M_scalar $1; to_Call_op_ (M_ref M_hash) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, hash_ref $4, hash_ref $8)) $1 $9} +| term QUESTION_MARK term COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); mcontext_check M_bool $1; to_Call_op_ (mcontext_merge $3.mcontext $5.mcontext) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, prio_lo_after P_ternary $3, prio_lo_after P_ternary $5)) $1 $5} +| term QUESTION_MARK term COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); mcontext_check M_bool $1; to_Call_op_ (mcontext_merge $3.mcontext (M_ref M_hash)) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, prio_lo_after P_ternary $3, hash_ref $6)) $1 $7} +| term QUESTION_MARK BRACKET expr BRACKET_END COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); mcontext_check M_bool $1; to_Call_op_ (mcontext_merge $7.mcontext (M_ref M_hash)) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, hash_ref $4, prio_lo_after P_ternary $7)) $1 $7} +| term QUESTION_MARK BRACKET expr BRACKET_END COLON BRACKET expr BRACKET_END {sp_p($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); sp_p($8); sp_p($9); mcontext_check M_bool $1; to_Call_op_ (M_ref M_hash) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, hash_ref $4, hash_ref $8)) $1 $9} /* Unary operators and terms */ @@ -258,18 +264,18 @@ term: match $1.any with | "+" -> warn_rule "don't use unary +" ; - to_Call_op_ (mcontext_unop M_float $2) P_tight "+ unary" [$2.any.expr] $1 $2 + to_Call_op_ (mcontext_float_or_int [$2.mcontext]) P_tight "+ unary" [$2.any.expr] $1 $2 | "-" -> - to_Call_op_ (mcontext_unop M_float $2) P_tight "- unary" [$2.any.expr] $1 $2 + to_Call_op_ (mcontext_float_or_int [$2.mcontext]) P_tight "- unary" [$2.any.expr] $1 $2 | _ -> die_rule "syntax error" } -| TIGHT_NOT term {check_negatable_expr $2; mcontext_check M_scalar $2; to_Call_op_ M_bool P_tight "not" [$2.any.expr] $1 $2} -| BIT_NEG term {to_Call_op_ (mcontext_unop M_int $2) P_expr "~" [$2.any.expr] $1 $2} +| TIGHT_NOT term {check_negatable_expr $2; mcontext_check M_bool $2; to_Call_op_ M_bool P_tight "not" [$2.any.expr] $1 $2} +| BIT_NEG term { mcontext_check M_int $2; to_Call_op_ M_int P_expr "~" [$2.any.expr] $1 $2} | INCR term {sp_0($2); mcontext_check M_int $2; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "++" [$2.any.expr] $1 $2} | DECR term {sp_0($2); mcontext_check M_int $2; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "--" [$2.any.expr] $1 $2} | term INCR {sp_0($2); mcontext_check M_int $1; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "++ post" [$1.any.expr] $1 $2} | term DECR {sp_0($2); mcontext_check M_int $1; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "-- post" [$1.any.expr] $1 $2} -| NOT argexpr {warn_rule "don't use \"not\", use \"!\" instead"; to_Call_op_ (mcontext_unop_l M_scalar $2) P_and "not" ($2.any.expr) $1 $2} +| NOT argexpr {warn_rule "don't use \"not\", use \"!\" instead"; mcontext_check_unop_l M_bool $2; to_Call_op_ M_bool P_and "not" ($2.any.expr) $1 $2} /* Constructors for anonymous data */ @@ -291,7 +297,7 @@ term: | 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 */ +| 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_unknown_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 */ | variable { let e = @@ -369,25 +375,25 @@ diamond: subscripted: /* Some kind of subscripted expression */ | variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); new_esp M_unknown (Call(Too_complex, [$3.any])) $1 $3} /* $foo::{something} */ -| scalar bracket_subscript {sp_0($2); check_scalar_subscripted $1; new_esp M_scalar (to_Deref_with(I_hash , I_scalar, from_scalar $1, $2.any )) $1 $2} /* $foo{bar} */ -| scalar arrayref {sp_0($2); check_scalar_subscripted $1; new_esp M_scalar (to_Deref_with(I_array, I_scalar, from_scalar $1, only_one_array_ref $2)) $1 $2} /* $array[$element] */ -| term ARROW bracket_subscript {sp_0($2); sp_0($3); check_arrow_needed $1 $2; new_esp M_scalar (to_Deref_with(I_hash , I_scalar, $1.any.expr, $3.any )) $1 $3} /* somehref->{bar} */ -| term ARROW arrayref {sp_0($2); sp_0($3); check_arrow_needed $1 $2; new_esp M_scalar (to_Deref_with(I_array, I_scalar, $1.any.expr, only_one_array_ref $3)) $1 $3} /* somearef->[$element] */ +| scalar bracket_subscript {sp_0($2); check_scalar_subscripted $1; new_esp M_unknown_scalar (to_Deref_with(I_hash , I_scalar, from_scalar $1, $2.any )) $1 $2} /* $foo{bar} */ +| scalar arrayref {sp_0($2); check_scalar_subscripted $1; new_esp M_unknown_scalar (to_Deref_with(I_array, I_scalar, from_scalar $1, only_one_array_ref $2)) $1 $2} /* $array[$element] */ +| term ARROW bracket_subscript {sp_0($2); sp_0($3); check_arrow_needed $1 $2; new_esp M_unknown_scalar (to_Deref_with(I_hash , I_scalar, $1.any.expr, $3.any )) $1 $3} /* somehref->{bar} */ +| term ARROW arrayref {sp_0($2); sp_0($3); check_arrow_needed $1 $2; new_esp M_unknown_scalar (to_Deref_with(I_array, I_scalar, $1.any.expr, only_one_array_ref $3)) $1 $3} /* somearef->[$element] */ | term ARROW parenthesized {sp_0($2); sp_0($3); new_esp M_unknown (to_Deref_with(I_func , I_scalar, $1.any.expr, List($3.any.expr))) $1 $3} /* $subref->(@args) */ -| subscripted bracket_subscript {sp_0($2); new_esp M_scalar (to_Deref_with(I_hash , I_scalar, $1.any, $2.any )) $1 $2} /* $foo->[bar]{baz} */ -| subscripted arrayref {sp_0($2); new_esp M_scalar (to_Deref_with(I_array, I_scalar, $1.any, only_one_array_ref $2)) $1 $2} /* $foo->[$bar][$baz] */ +| subscripted bracket_subscript {sp_0($2); new_esp M_unknown_scalar (to_Deref_with(I_hash , I_scalar, $1.any, $2.any )) $1 $2} /* $foo->[bar]{baz} */ +| subscripted arrayref {sp_0($2); new_esp M_unknown_scalar (to_Deref_with(I_array, I_scalar, $1.any, only_one_array_ref $2)) $1 $2} /* $foo->[$bar][$baz] */ | subscripted parenthesized {sp_0($2); new_esp M_unknown (to_Deref_with(I_func , I_scalar, $1.any, List($2.any.expr))) $1 $2} /* $foo->{bar}(@args) */ restricted_subscripted: /* Some kind of subscripted expression */ | variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); new_esp M_unknown (Call(Too_complex, [$3.any])) $1 $3} /* $foo::{something} */ | word_paren parenthesized {new_esp M_unknown (call(Deref(I_func, $1.any), $2.any.expr)) $1 $2} -| scalar bracket_subscript {sp_0($2); check_scalar_subscripted $1; new_esp M_scalar (to_Deref_with(I_hash , I_scalar, from_scalar $1, $2.any )) $1 $2} /* $foo{bar} */ -| scalar arrayref {sp_0($2); check_scalar_subscripted $1; new_esp M_scalar (to_Deref_with(I_array, I_scalar, from_scalar $1, only_one_array_ref $2)) $1 $2} /* $array[$element] */ -| restricted_subscripted ARROW bracket_subscript {sp_0($2); sp_0($3); new_esp M_scalar (to_Deref_with(I_hash , I_scalar, $1.any, $3.any )) $1 $3} /* somehref->{bar} */ -| restricted_subscripted ARROW arrayref {sp_0($2); sp_0($3); new_esp M_scalar (to_Deref_with(I_array, I_scalar, $1.any, only_one_array_ref $3)) $1 $3} /* somearef->[$element] */ +| scalar bracket_subscript {sp_0($2); check_scalar_subscripted $1; new_esp M_unknown_scalar (to_Deref_with(I_hash , I_scalar, from_scalar $1, $2.any )) $1 $2} /* $foo{bar} */ +| scalar arrayref {sp_0($2); check_scalar_subscripted $1; new_esp M_unknown_scalar (to_Deref_with(I_array, I_scalar, from_scalar $1, only_one_array_ref $2)) $1 $2} /* $array[$element] */ +| restricted_subscripted ARROW bracket_subscript {sp_0($2); sp_0($3); new_esp M_unknown_scalar (to_Deref_with(I_hash , I_scalar, $1.any, $3.any )) $1 $3} /* somehref->{bar} */ +| restricted_subscripted ARROW arrayref {sp_0($2); sp_0($3); new_esp M_unknown_scalar (to_Deref_with(I_array, I_scalar, $1.any, only_one_array_ref $3)) $1 $3} /* somearef->[$element] */ | restricted_subscripted ARROW parenthesized {sp_0($2); sp_0($3); new_esp M_unknown (to_Deref_with(I_func , I_scalar, $1.any, List($3.any.expr))) $1 $3} /* $subref->(@args) */ -| restricted_subscripted bracket_subscript {sp_0($2); new_esp M_scalar (to_Deref_with(I_hash , I_scalar, $1.any, $2.any )) $1 $2} /* $foo->[bar]{baz} */ -| restricted_subscripted arrayref {sp_0($2); new_esp M_scalar (to_Deref_with(I_array, I_scalar, $1.any, only_one_array_ref $2)) $1 $2} /* $foo->[$bar][$baz] */ +| restricted_subscripted bracket_subscript {sp_0($2); new_esp M_unknown_scalar (to_Deref_with(I_hash , I_scalar, $1.any, $2.any )) $1 $2} /* $foo->[bar]{baz} */ +| restricted_subscripted arrayref {sp_0($2); new_esp M_unknown_scalar (to_Deref_with(I_array, I_scalar, $1.any, only_one_array_ref $2)) $1 $2} /* $foo->[$bar][$baz] */ | restricted_subscripted parenthesized {sp_0($2); new_esp M_unknown (to_Deref_with(I_func , I_scalar, $1.any, List($2.any.expr))) $1 $2} /* $foo->{bar}(@args) */ | restricted_subscripted ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); if $4.any.expr = [] then warn $4.pos "remove these unneeded parentheses"; new_esp M_unknown (to_Method_call($1.any, $3.any, $4.any.expr)) $1 $4} /* $foo->bar(list) */ @@ -411,10 +417,10 @@ parenthesized_start: my_our: /* Things that can be "my"'d */ | my_our_paren PAREN_END {sp_0($2); 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 SCALAR_IDENT PAREN_END {check_my_our_paren $1 $2; new_esp (M_mixed [ mtuple_context_concat $1.mcontext M_unknown_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 SCALAR_IDENT {new_esp (M_mixed [M_unknown_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} @@ -422,7 +428,7 @@ my_our_paren: | 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 SCALAR_IDENT {check_my_our_paren $1 $2; new_esp (mtuple_context_concat $1.mcontext M_unknown_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} @@ -468,7 +474,7 @@ word_paren: arraylen: ARRAYLEN_IDENT {new_esp M_int (deref_arraylen (to_Ident $1)) $1 $1} | ARRAYLEN scalar {sp_0($2); new_esp M_int (deref_arraylen $2.any ) $1 $1 } | ARRAYLEN bracket_subscript {new_esp M_int (deref_arraylen $2.any) $1 $2} -scalar: SCALAR_IDENT {new_esp M_scalar (Deref(I_scalar, to_Ident $1)) $1 $1} | DOLLAR scalar {sp_0($2); new_esp M_scalar (Deref(I_scalar, $2.any)) $1 $1 } | DOLLAR bracket_subscript {new_esp M_scalar (deref_raw I_scalar $2.any) $1 $2} | DOLLAR BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_0($2); sp_0($3); sp_p($5); sp_0($6); new_esp M_scalar (Deref(I_scalar, hash_ref $4)) $1 $6} +scalar: SCALAR_IDENT {new_esp M_unknown_scalar (Deref(I_scalar, to_Ident $1)) $1 $1} | DOLLAR scalar {sp_0($2); new_esp M_unknown_scalar (Deref(I_scalar, $2.any)) $1 $1 } | DOLLAR bracket_subscript {new_esp M_unknown_scalar (deref_raw I_scalar $2.any) $1 $2} | DOLLAR BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_0($2); sp_0($3); sp_p($5); sp_0($6); new_esp M_unknown_scalar (Deref(I_scalar, hash_ref $4)) $1 $6} func: FUNC_IDENT {new_esp M_unknown (Deref(I_func , to_Ident $1)) $1 $1} | AMPERSAND scalar {sp_0($2); new_esp M_unknown (Deref(I_func , $2.any)) $1 $1 } | AMPERSAND bracket_subscript {new_esp M_unknown (deref_raw I_func $2.any) $1 $2} array: ARRAY_IDENT {new_esp M_array (Deref(I_array , to_Ident $1)) $1 $1} | AT scalar {sp_0($2); new_esp M_array (Deref(I_array , $2.any)) $1 $1 } | AT bracket_subscript {new_esp M_array (deref_raw I_array $2.any) $1 $2} hash: HASH_IDENT {new_esp M_hash (Deref(I_hash , to_Ident $1)) $1 $1} | PERCENT scalar {sp_0($2); new_esp M_hash (Deref(I_hash , $2.any)) $1 $1 } | PERCENT bracket_subscript {new_esp M_hash (deref_raw I_hash $2.any) $1 $2} diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml index 9eca21a..cfe3c9e 100644 --- a/perl_checker.src/parser_helper.ml +++ b/perl_checker.src/parser_helper.ml @@ -343,6 +343,30 @@ let sp_same esp1 esp2 = if esp1.spaces <> Space_0 then sp_p esp2 else if esp2.spaces <> Space_0 then sp_p esp1 +let function_to_context = function + | "map" | "grep" | "grep_index" | "map_index" -> M_array + | "partition" -> M_tuple [ M_ref M_array ; M_ref M_array ] + | "find" -> M_unknown_scalar + | "any" | "every" -> M_bool + | "find_index" -> M_int + | "each_index" -> M_none + | "N" | "N_" -> M_string + + | "chop" | "chomp" -> M_none + | "hex" | "length" | "time" | "fork" | "getppid" -> M_int + | "eof" | "wantarray" -> M_int + | "stat" | "lstat" -> M_list + | "arch" | "quotemeta" | "join" | "lc" | "lcfirst" | "uc" | "ucfirst" -> M_string + + | "split" -> M_array + | "shift" | "pop" -> M_unknown_scalar + | "die" | "return" | "redo" | "next" | "last" -> M_unknown + | "caller" -> M_mixed [M_string ; M_list] + | "undef" -> M_undef + + | "ref" -> M_ref M_unknown_scalar + | _ -> M_unknown + let word_alone esp = let word = esp.any in let mcontext, e = match word with @@ -365,22 +389,7 @@ let word_alone esp = Deref(I_func, word) | _ -> word in - let mcontext = match f with - | "chop" | "chomp" -> M_none - | "hex" | "length" | "time" | "fork" | "getppid" -> M_int - | "eof" | "wantarray" -> M_int - | "stat" | "lstat" -> M_list - | "arch" | "quotemeta" | "join" | "lc" | "lcfirst" | "uc" | "ucfirst" -> M_string - - | "split" -> M_array - | "shift" | "pop" -> M_scalar - | "die" | "return" | "redo" | "next" | "last" -> M_unknown - | "caller" -> M_mixed [M_string ; M_list] - | "undef" -> M_undef - - | "ref" -> M_ref M_scalar - | _ -> M_unknown - in mcontext, e + function_to_context f, e | _ -> M_unknown, word in new_pesp mcontext P_tok e esp esp @@ -919,15 +928,7 @@ let check_return esp_func esp_para = let call_and_context(e, para) force_non_builtin_func priority esp_start esp_end = let context = match e with - | Deref(I_func, Ident(None, f, _)) -> - (match f with - | "map" | "grep" | "grep_index" | "map_index" | "partition" -> M_list - | "find" -> M_scalar - | "any" | "every" -> M_scalar - | "find_index" -> M_int - | "each_index" -> M_none - | "N" | "N_" -> M_string - | _ -> M_unknown) + | Deref(I_func, Ident(None, f, _)) -> function_to_context f | _ -> M_unknown in new_pesp context priority (call_raw force_non_builtin_func (e, para)) esp_start esp_end @@ -1047,7 +1048,7 @@ let rec mcontext2s = function | M_revision -> "revision" | M_undef -> "undef" | M_sub -> "sub" - | M_scalar -> "scalar" + | M_unknown_scalar -> "scalar" | M_tuple l -> "tuple(" ^ String.concat ", " (List.map mcontext2s l) ^ ")" | M_list -> "list" @@ -1058,62 +1059,68 @@ let rec mcontext2s = function | M_unknown -> "unknown" | M_mixed l -> String.concat " | " (List.map mcontext2s l) -let mcontext_is_scalar = function - | M_int | M_float | M_string | M_ref _ | M_revision | M_undef - | M_scalar | M_array -> true - | _ -> false - 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_tuple _ | M_array, M_list - | M_hash, M_hash | M_hash, M_scalar | M_hash, M_tuple _ | M_hash, M_list + | M_unknown, _ + | _, M_unknown -> true - | M_bool, M_bool | M_bool, M_scalar | M_bool, M_list + | M_none, M_none | M_sub, M_sub | M_hash, M_hash -> true + | M_none, _ | M_sub, _ | M_hash, _ -> false - | M_int, M_int | M_int, M_float | M_int, M_string | M_int, M_scalar | M_int, M_list - | M_float, M_float | M_float, M_string | M_float, M_scalar | M_float, M_list - | M_ref _, M_scalar | M_ref _, M_list - | 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_undef, M_undef | M_undef, M_scalar | M_undef, M_list - | M_scalar, M_scalar | M_scalar, M_list - -> true + | _, M_list -> true - | 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_list, M_bool - | M_tuple t1, M_tuple t2 -> - List.length t1 <= List.length t2 && for_all2_true mcontext_lower t1 t2 - | M_tuple _, M_list + (* M_unknown_scalar is M_mixed [ M_int ; M_float ; M_string ; M_bool ; M_ref _ ; M_revision ; M_undef ] *) + | M_unknown_scalar, M_int | M_unknown_scalar, M_float | M_unknown_scalar, M_string | M_unknown_scalar, M_bool + | M_unknown_scalar, M_ref _ | M_unknown_scalar, M_revision | M_unknown_scalar, M_undef | M_unknown_scalar, M_unknown_scalar - | M_list, M_list - | M_none, M_none - | M_sub, M_sub + | M_array, M_array | M_array, M_int | M_array, M_float | M_array, M_bool | M_array, M_unknown_scalar | M_array, M_tuple _ + | M_int, M_int | M_int, M_float | M_int, M_string | M_int, M_bool | M_int, M_unknown_scalar + | M_float, M_float | M_float, M_string | M_float, M_bool | M_float, M_unknown_scalar + | M_string, M_string | M_string, M_bool | M_string, M_unknown_scalar + | M_bool, M_bool | M_bool, M_unknown_scalar - | _, M_unknown + | M_ref _, M_unknown_scalar + | M_revision, M_revision | M_revision, M_unknown_scalar + | M_undef, M_undef | M_undef, M_unknown_scalar -> true - | M_ref a, M_ref b -> mcontext_lower a b - | c, M_mixed l -> List.exists (mcontext_lower c) l + | M_tuple t1, M_tuple t2 -> + List.length t1 <= List.length t2 && for_all2_true mcontext_lower t1 t2 + + | M_int, M_tuple (c :: _) | M_float, M_tuple (c :: _) | M_string, M_tuple (c :: _) | M_bool, M_tuple (c :: _) + | M_ref _, M_tuple (c :: _) | M_revision, M_tuple (c :: _) | M_undef, M_tuple (c :: _) | M_unknown_scalar, M_tuple (c :: _) + -> mcontext_lower c1 c + +(* | M_ref a, M_ref b -> mcontext_lower a b *) + +(* | c, M_mixed l -> List.exists (mcontext_lower c) l*) | M_mixed l, c -> List.exists (fun a -> mcontext_lower a c) l | _ -> false +let mcontext_is_scalar = function + | M_unknown -> false + | c -> mcontext_lower c M_unknown_scalar + +let mcontext_to_scalar = function + | M_array -> M_int + | c -> if mcontext_is_scalar c then c else M_unknown_scalar + let mcontext_merge_raw c1 c2 = match c1, c2 with | M_unknown, _ | _, M_unknown -> Some M_unknown | M_mixed _, _ | _, M_mixed _ -> internal_error "mcontext_merge_raw" | _ -> - (* if mcontext_lower c1 c2 then Some c2 else if mcontext_lower c2 c1 then Some c1 else - *) if c1 = c2 then Some c1 else if mcontext_is_scalar c1 && mcontext_is_scalar c2 - then Some M_scalar + then Some M_unknown_scalar else None let rec mcontext_lmerge_add l = function @@ -1138,48 +1145,24 @@ let mcontext_merge c1 c2 = mcontext_lmerge [ c1 ; c2 ] let mcontext_lmaybe esp = if esp.any = [] then [] else [esp.mcontext] -let mcontext_check_raw wanted_mcontext esp f_lower f_greater f_err = - if mcontext_lower esp.mcontext wanted_mcontext then - f_lower() - else if mcontext_lower wanted_mcontext esp.mcontext then - f_greater() - else - (warn_rule (sprintf "context %s is not compatible with context %s" (mcontext2s esp.mcontext) (mcontext2s wanted_mcontext)); - f_err()) +let mcontext_check_raw wanted_mcontext mcontext = + if not (mcontext_lower mcontext wanted_mcontext) then + warn_rule (sprintf "context %s is not compatible with context %s" (mcontext2s mcontext) (mcontext2s wanted_mcontext)) let mcontext_check wanted_mcontext esp = (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 boolean context, use \"any\" instead of \"grep\"" + | Call(Deref(I_func, Ident(None, "grep", _)), _) -> + warn_rule (if wanted_mcontext = M_bool then + "in boolean context, use \"any\" instead of \"grep\"" else + "you may use \"find\" instead of \"grep\"") | _ -> ()); - mcontext_check_raw wanted_mcontext esp (fun () -> ()) (fun () -> ()) (fun () -> ()) - -let mcontext_symops wanted_mcontext esp1 esp2 = - mcontext_check_raw wanted_mcontext esp1 - (fun () -> - mcontext_check_raw wanted_mcontext esp2 - (fun () -> - match mcontext_merge esp1.mcontext esp2.mcontext with - | M_array when mcontext_is_scalar wanted_mcontext -> M_int (* don't allow @a + @b to return M_array *) - | r -> r) - (fun () -> mcontext_merge esp1.mcontext wanted_mcontext) - (fun () -> wanted_mcontext)) - (fun () -> - mcontext_check_raw wanted_mcontext esp2 - (fun () -> mcontext_merge wanted_mcontext esp2.mcontext) - (fun () -> wanted_mcontext) - (fun () -> wanted_mcontext)) - (fun () -> wanted_mcontext) - -let mcontext_rightops wanted_mcontext esp1 esp2 = - mcontext_check wanted_mcontext esp1 ; - mcontext_check_raw wanted_mcontext esp2 (fun () -> esp2.mcontext) (fun () -> wanted_mcontext) (fun () -> wanted_mcontext) - -let mcontext_unop wanted_mcontext esp = mcontext_check wanted_mcontext esp ; wanted_mcontext - -let mcontext_unop_l wanted_mcontext esp = mcontext_unop wanted_mcontext { esp with any = { esp.any with expr = List esp.any.expr } } + mcontext_check_raw wanted_mcontext esp.mcontext + +let mcontext_check_unop_l wanted_mcontext esp = + mcontext_check wanted_mcontext { esp with any = { esp.any with expr = List esp.any.expr } } let mcontext_check_non_none esp = if esp.mcontext = M_none then warn_rule "() context not accepted here" @@ -1209,6 +1192,12 @@ let mcontext_check_none msg expr esp = in mcontext_check_none_rec msg expr esp.mcontext +let mcontext_float_or_int l = + List.fold_left (fun c1 c2 -> + if c1 = M_int && c2 = M_int then M_int else + (mcontext_check_raw M_float c2 ; M_float) + ) M_int l + let mcontext_op_assign left right = mcontext_check_non_none right; let left_context = @@ -1234,3 +1223,9 @@ let mtuple_context_concat c1 c2 = | M_hash, _ | _, M_hash -> M_list | M_tuple l, _ -> M_tuple (l @ [c2]) | _ -> M_tuple [c1 ; c2] + +let symops pri para_context return_context op_str left op right = + sp_same op right; + mcontext_check para_context left ; + mcontext_check para_context right ; + to_Call_op_ return_context pri op_str [prio_lo pri left; prio_lo_after pri right] left right diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli index 0478477..b12a9ca 100644 --- a/perl_checker.src/parser_helper.mli +++ b/perl_checker.src/parser_helper.mli @@ -252,8 +252,9 @@ val from_PATTERN_SUBST : (string * ((int * int) * 'a) list) list * string) Types.any_spaces_pos -> Types.fromparser list val mcontext2s : Types.maybe_context -> string -val mcontext_is_scalar : Types.maybe_context -> bool val mcontext_lower : Types.maybe_context -> Types.maybe_context -> bool +val mcontext_is_scalar : Types.maybe_context -> bool +val mcontext_to_scalar : Types.maybe_context -> Types.maybe_context val mcontext_merge_raw : Types.maybe_context -> Types.maybe_context -> Types.maybe_context option val mcontext_lmerge_add : @@ -263,34 +264,29 @@ val mcontext_merge : Types.maybe_context -> Types.maybe_context -> Types.maybe_context val mcontext_lmaybe : 'a list Types.any_spaces_pos -> Types.maybe_context list -val mcontext_check_raw : - Types.maybe_context -> - 'a Types.any_spaces_pos -> - (unit -> 'b) -> (unit -> 'b) -> (unit -> 'b) -> 'b +val mcontext_check_raw : Types.maybe_context -> Types.maybe_context -> unit val mcontext_check : Types.maybe_context -> Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> unit -val mcontext_symops : - Types.maybe_context -> - 'a Types.any_spaces_pos -> 'b Types.any_spaces_pos -> Types.maybe_context -val mcontext_rightops : +val mcontext_check_unop_l : Types.maybe_context -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> - 'a Types.any_spaces_pos -> Types.maybe_context -val mcontext_unop : - Types.maybe_context -> - Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> - Types.maybe_context -val mcontext_unop_l : - Types.maybe_context -> - Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> - Types.maybe_context + Types.fromparser list Types.prio_anyexpr Types.any_spaces_pos -> unit val mcontext_check_non_none : 'a Types.any_spaces_pos -> unit val mcontext_check_none : string -> Types.fromparser list -> 'a Types.any_spaces_pos -> unit +val mcontext_float_or_int : Types.maybe_context list -> Types.maybe_context val mcontext_op_assign : Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> 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 +val symops : + Types.priority -> + Types.maybe_context -> + Types.maybe_context -> + string -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> + 'a Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos -> + Types.fromparser Types.prio_anyexpr Types.any_spaces_pos diff --git a/perl_checker.src/test/context.t b/perl_checker.src/test/context.t index edb0452..c0bc221 100644 --- a/perl_checker.src/test/context.t +++ b/perl_checker.src/test/context.t @@ -1,4 +1,5 @@ -foreach (%h) {} foreach with a hash is usually an error +foreach (%h) {} context hash is not compatible with context list + foreach with a hash is usually an error map { 'xxx' } %h a hash is not a valid parameter to function map @@ -10,8 +11,11 @@ length @l never use "length @l", it returns the l %h . 'yyy' context hash is not compatible with context string -'xxx' > 'yyy' you should use a string operator, not the number operator ">" +'xxx' > 'yyy' context string is not compatible with context float + context string is not compatible with context float + you should use a string operator, not the number operator ">" 1 cmp 2 you should use a number operator, not the string operator "cmp" (or replace the number with a string) $xxx == undef context undef is not compatible with context float + diff --git a/perl_checker.src/test/return_value.t b/perl_checker.src/test/return_value.t index e826c08..fd8eafd 100644 --- a/perl_checker.src/test/return_value.t +++ b/perl_checker.src/test/return_value.t @@ -1,8 +1,8 @@ if ($xxx or $yyy) {} value should be dropped - context () is not compatible with context scalar + context () is not compatible with context bool if ($xxx and $yyy) {} value should be dropped - context () is not compatible with context scalar + context () is not compatible with context bool $xxx && yyy(); value is dropped @@ -14,3 +14,4 @@ map { xxx($_) } @l; if you don't use the return value, use $xxx = chomp; () context not accepted here context () is not compatible with context scalar + diff --git a/perl_checker.src/types.mli b/perl_checker.src/types.mli index bff90ca..0a5e62b 100644 --- a/perl_checker.src/types.mli +++ b/perl_checker.src/types.mli @@ -16,14 +16,19 @@ type context = I_scalar | I_hash | I_array | I_func | I_raw | I_star type maybe_context = | M_none - | M_bool - | M_int | M_float | M_string | M_ref of maybe_context | M_revision | M_sub | M_undef - | M_scalar + (* scalars *) + | M_bool | M_int | M_float + | M_revision + | M_string + | M_ref of maybe_context + | M_undef + | M_unknown_scalar | M_tuple of maybe_context list | M_list | M_array | M_hash + | M_sub | M_special | M_unknown |