diff options
author | Pascal Rigaux <pixel@mandriva.com> | 2002-12-02 20:12:35 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 2002-12-02 20:12:35 +0000 |
commit | cbfb3ba09991893db180d37e7498077fbe5d0042 (patch) | |
tree | ed282c3602541cbefa25946257c82f2f8ed06729 | |
parent | b35aca09551a220f0b603cbc6aad2702a0c36bfd (diff) | |
download | perl-MDK-Common-cbfb3ba09991893db180d37e7498077fbe5d0042.tar perl-MDK-Common-cbfb3ba09991893db180d37e7498077fbe5d0042.tar.gz perl-MDK-Common-cbfb3ba09991893db180d37e7498077fbe5d0042.tar.bz2 perl-MDK-Common-cbfb3ba09991893db180d37e7498077fbe5d0042.tar.xz perl-MDK-Common-cbfb3ba09991893db180d37e7498077fbe5d0042.zip |
*** empty log message ***
-rw-r--r-- | perl_checker.src/common.ml | 4 | ||||
-rw-r--r-- | perl_checker.src/common.mli | 1 | ||||
-rw-r--r-- | perl_checker.src/parser.mly | 4 | ||||
-rw-r--r-- | perl_checker.src/parser_helper.ml | 17 |
4 files changed, 20 insertions, 6 deletions
diff --git a/perl_checker.src/common.ml b/perl_checker.src/common.ml index a4d0789..07e138e 100644 --- a/perl_checker.src/common.ml +++ b/perl_checker.src/common.ml @@ -715,6 +715,10 @@ let char_is_alpha c = Char.code 'a' <= i && i <= Char.code 'z' || Char.code 'A' <= i && i <= Char.code 'Z' +let char_is_number c = + let i = Char.code c in + Char.code '0' <= i && i <= Char.code '9' + let rec string_forall_with f i s = try f s.[i] && string_forall_with f (i+1) s diff --git a/perl_checker.src/common.mli b/perl_checker.src/common.mli index cfb4780..ee2bb01 100644 --- a/perl_checker.src/common.mli +++ b/perl_checker.src/common.mli @@ -193,6 +193,7 @@ val is_lowercase : char -> bool val char_is_alphanumerical : char -> bool val char_is_alphanumerical_ : char -> bool val char_is_alpha : char -> bool +val char_is_number : char -> bool val string_forall_with : (char -> bool) -> int -> string -> bool val starts_with_non_lowercase : string -> bool val fold_lines : ('a -> string -> 'a) -> 'a -> in_channel -> 'a diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly index 7d7948a..695e88a 100644 --- a/perl_checker.src/parser.mly +++ b/perl_checker.src/parser.mly @@ -220,8 +220,8 @@ term: | term PATTERN_MATCH PATTERN {sp_n($2); sp_p($3); check_unneeded_var_dollar_ ($1); to_Call_op_(P_expr, "m//", sndfst $1 :: from_PATTERN $3) (sp_pos_range $1 $3)} -| term PATTERN_MATCH_NOT PATTERN {sp_n($2); sp_p($3); check_unneeded_var_dollar_s ($1); to_Call_op_(P_expr, "!m//", sndfst $1 :: from_PATTERN $3) (sp_pos_range $1 $3)} -| term PATTERN_MATCH PATTERN_SUBST {sp_n($2); sp_p($3); check_unneeded_var_dollar_not($1); to_Call_op_(P_expr, "s///", sndfst $1 :: from_PATTERN_SUBST $3) (sp_pos_range $1 $3)} +| term PATTERN_MATCH_NOT PATTERN {sp_n($2); sp_p($3); check_unneeded_var_dollar_not($1); to_Call_op_(P_expr, "!m//", sndfst $1 :: from_PATTERN $3) (sp_pos_range $1 $3)} +| term PATTERN_MATCH PATTERN_SUBST {sp_n($2); sp_p($3); check_unneeded_var_dollar_s ($1); to_Call_op_(P_expr, "s///", sndfst $1 :: from_PATTERN_SUBST $3) (sp_pos_range $1 $3)} | term PATTERN_MATCH_NOT PATTERN_SUBST {die_with_rawpos (sndsnd $2) "use =~ instead of !~ and negate the return value"} | term PATTERN_MATCH scalar { (P_expr, Too_complex), sp_pos_range $1 $3} diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml index d377109..1e03f0e 100644 --- a/perl_checker.src/parser_helper.ml +++ b/perl_checker.src/parser_helper.ml @@ -14,10 +14,13 @@ let var_STDOUT = Deref(I_star, Ident(None, "STDOUT", raw_pos2pos bpos)) let is_var_dollar_ = function | Deref(I_scalar, Ident(None, "_", _)) -> true | _ -> false +let is_var_number_match = function + | Deref(I_scalar, Ident(None, s, _)) -> String.length s = 1 && char_is_number s.[0] + | _ -> false let is_parenthesized = function | List[] - | List[List[_]] -> true + | List[List _] -> true | _ -> false let un_parenthesize = function @@ -276,9 +279,15 @@ let check_arrow_needed ((_, e), _) ter = | Deref_with _ -> warn (sndsnd ter) "the arrow \"->\" is unneeded" | _ -> () -let check_unneeded_var_dollar_ ((_, e), (_, pos)) = if is_var_dollar_ e then warn pos "\"$_ =~ /regexp/\" can be written \"/regexp/\"" -let check_unneeded_var_dollar_s ((_, e), (_, pos)) = if is_var_dollar_ e then warn pos "\"$_ =~ s/regexp/.../\" can be written \"s/regexp/.../\"" -let check_unneeded_var_dollar_not ((_, e), (_, pos)) = if is_var_dollar_ e then warn pos "\"$_ !~ /regexp/\" can be written \"!/regexp/\"" +let check_unneeded_var_dollar_ ((_, e), (_, pos)) = + if is_var_dollar_ e then warn pos "\"$_ =~ /regexp/\" can be written \"/regexp/\"" else + if is_var_number_match e then warn pos "do not use the result of a match (eg: $1) to match another pattern" +let check_unneeded_var_dollar_not ((_, e), (_, pos)) = + if is_var_dollar_ e then warn pos "\"$_ !~ /regexp/\" can be written \"!/regexp/\"" else + if is_var_number_match e then warn pos "do not use the result of a match (eg: $1) to match another pattern" +let check_unneeded_var_dollar_s ((_, e), (_, pos)) = + if is_var_dollar_ e then warn pos "\"$_ =~ s/regexp/.../\" can be written \"s/regexp/.../\"" else + if is_var_number_match e then die_with_rawpos pos "do not modify the result of a match (eg: $1)" let check_MULT_is_x (s, _) = if s <> "x" then die_rule "syntax error" let check_my (s, _) = if s <> "my" then die_rule "syntax error" |