summaryrefslogtreecommitdiffstats
path: root/perl_checker.src
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2002-12-02 20:12:35 +0000
committerPascal Rigaux <pixel@mandriva.com>2002-12-02 20:12:35 +0000
commitcbfb3ba09991893db180d37e7498077fbe5d0042 (patch)
treeed282c3602541cbefa25946257c82f2f8ed06729 /perl_checker.src
parentb35aca09551a220f0b603cbc6aad2702a0c36bfd (diff)
downloadperl-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 ***
Diffstat (limited to 'perl_checker.src')
-rw-r--r--perl_checker.src/common.ml4
-rw-r--r--perl_checker.src/common.mli1
-rw-r--r--perl_checker.src/parser.mly4
-rw-r--r--perl_checker.src/parser_helper.ml17
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"