From 82a30bac62a071ae5b668f849b7fb3be449c1eab Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Sat, 3 Nov 2018 12:08:55 +0000 Subject: [PATCH 1/5] Warn on literal patterns found anywhere in a constructor's arguments. --- typing/typecore.ml | 41 +++++++++++++++++++++++++++++++++-------- 1 file changed, 33 insertions(+), 8 deletions(-) diff --git a/typing/typecore.ml b/typing/typecore.ml index c26a2b3fb370..f5d2be026b10 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -1063,6 +1063,33 @@ let all_idents_cases half_typed_cases = half_typed_cases; Hashtbl.fold (fun x () rest -> x :: rest) idents [] +let rec has_literal_pattern p = match p.ppat_desc with + | Ppat_constant _ + | Ppat_interval _ -> + true + | Ppat_any + | Ppat_variant (_, None) + | Ppat_construct (_, None) + | Ppat_type _ + | Ppat_var _ + | Ppat_unpack _ + | Ppat_extension _ -> + false + | Ppat_exception p + | Ppat_variant (_, Some p) + | Ppat_construct (_, Some p) + | Ppat_constraint (p, _) + | Ppat_alias (p, _) + | Ppat_lazy p + | Ppat_open (_, p) -> + has_literal_pattern p + | Ppat_tuple ps + | Ppat_array ps -> + List.exists has_literal_pattern ps + | Ppat_record (ps, _) -> + List.exists (fun (_,p) -> has_literal_pattern p) ps + | Ppat_or (p, q) -> + has_literal_pattern p || has_literal_pattern q exception Need_backtrack @@ -1273,14 +1300,12 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode Warnings.Wildcard_arg_to_constant_constr; replicate_list sp constr.cstr_arity | Some sp -> [sp] in - begin match sargs with - | [{ppat_desc = Ppat_constant _} as sp] - when Builtin_attributes.warn_on_literal_pattern - constr.cstr_attributes -> - Location.prerr_warning sp.ppat_loc - Warnings.Fragile_literal_pattern - | _ -> () - end; + if Builtin_attributes.warn_on_literal_pattern constr.cstr_attributes then + begin match List.filter has_literal_pattern sargs with + | sp :: _ -> + Location.prerr_warning sp.ppat_loc Warnings.Fragile_literal_pattern + | _ -> () + end; if List.length sargs <> constr.cstr_arity then raise(Error(loc, !env, Constructor_arity_mismatch(lid.txt, constr.cstr_arity, List.length sargs))); From 3d18694fa13d9dc38a8527353de8ca72b9db48f7 Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Mon, 5 Nov 2018 09:16:54 +0000 Subject: [PATCH 2/5] Generalized warn_on_literal_pattern: test cases for deep matching --- .../tests/warnings/w52.compilers.reference | 26 ++++++++++++++++--- testsuite/tests/warnings/w52.ml | 23 +++++++++++++--- 2 files changed, 41 insertions(+), 8 deletions(-) diff --git a/testsuite/tests/warnings/w52.compilers.reference b/testsuite/tests/warnings/w52.compilers.reference index 39aa1ff446eb..9526f809049b 100644 --- a/testsuite/tests/warnings/w52.compilers.reference +++ b/testsuite/tests/warnings/w52.compilers.reference @@ -4,15 +4,33 @@ File "w52.ml", line 12, characters 38-43: Warning 52: Code should not depend on the actual values of this constructor's arguments. They are only for information and may change in future versions. (See manual section 9.5) -File "w52.ml", line 20, characters 7-17: -20 | | Warn "anything" -> () +File "w52.ml", line 14, characters 35-46: +14 | let () = try () with Match_failure ("Any",_,_) -> ();; + ^^^^^^^^^^^ +Warning 52: Code should not depend on the actual values of +this constructor's arguments. They are only for information +and may change in future versions. (See manual section 9.5) +File "w52.ml", line 16, characters 35-42: +16 | let () = try () with Match_failure (_,0,_) -> ();; + ^^^^^^^ +Warning 52: Code should not depend on the actual values of +this constructor's arguments. They are only for information +and may change in future versions. (See manual section 9.5) +File "w52.ml", line 25, characters 7-17: +25 | | Warn "anything" -> () ^^^^^^^^^^ Warning 52: Code should not depend on the actual values of this constructor's arguments. They are only for information and may change in future versions. (See manual section 9.5) -File "w52.ml", line 25, characters 8-10: -25 | | Warn' 0n -> () +File "w52.ml", line 30, characters 8-10: +30 | | Warn' 0n -> () ^^ Warning 52: Code should not depend on the actual values of this constructor's arguments. They are only for information and may change in future versions. (See manual section 9.5) +File "w52.ml", line 46, characters 7-34: +46 | | Deep (_ :: _ :: ("deep",_) :: _) -> () + ^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Warning 52: Code should not depend on the actual values of +this constructor's arguments. They are only for information +and may change in future versions. (See manual section 9.5) diff --git a/testsuite/tests/warnings/w52.ml b/testsuite/tests/warnings/w52.ml index 58dec69d8978..97bd6033d3e2 100644 --- a/testsuite/tests/warnings/w52.ml +++ b/testsuite/tests/warnings/w52.ml @@ -11,23 +11,38 @@ compile_only = "true" let () = try () with Invalid_argument "Any" -> ();; +let () = try () with Match_failure ("Any",_,_) -> ();; + +let () = try () with Match_failure (_,0,_) -> ();; + type t = | Warn of string [@ocaml.warn_on_literal_pattern] | Without_warning of string - | Warn' of nativeint [@ocaml.warn_on_literal_pattern];; + | Warn' of nativeint [@ocaml.warn_on_literal_pattern] + | Deep of (string * int) list [@ocaml.warn_on_literal_pattern];; let f = function | Warn "anything" -> () -| Warn _ | Warn' _ | Without_warning _ -> () +| Warn _ | Warn' _ | Without_warning _ | Deep _ -> () ;; let g = function | Warn' 0n -> () -| Warn _ | Warn' _ | Without_warning _ -> () +| Warn _ | Warn' _ | Without_warning _ | Deep _ -> () ;; let h = function | Without_warning "outside" -> () -| Warn _ | Warn' _ | Without_warning _ -> () +| Warn _ | Warn' _ | Without_warning _ | Deep _ -> () +;; + +let i = function +| Deep (_ :: _ :: _ :: _) -> () +| Warn _ | Warn' _ | Without_warning _ | Deep _ -> () +;; + +let j = function +| Deep (_ :: _ :: ("deep",_) :: _) -> () +| Warn _ | Warn' _ | Without_warning _ | Deep _ -> () ;; From 5f14aa19c4ebfad9ef808958023ccb1d596522f3 Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Mon, 5 Nov 2018 16:40:26 +0000 Subject: [PATCH 3/5] Generalized warn_on_literal_pattern: Changes entry. --- Changes | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Changes b/Changes index 6b446e16e314..c4cfe3c99a68 100644 --- a/Changes +++ b/Changes @@ -145,6 +145,10 @@ Working version ### Compiler user-interface and warnings: +- GPR#2133: Warn on literal patterns found anywhere in a constructor's + arguments. + (Jeremy Yallop, review by Gabriel Scherer) + - PR#2096: Add source highlighting for errors & warnings in batch mode (Armaël Guéneau, review by Gabriel Scherer and Jérémie Dimino) From 5521787ae914dd0aacbf6fddb6e43e54e29b0984 Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Mon, 5 Nov 2018 17:27:00 +0000 Subject: [PATCH 4/5] Convert warning 52 tests to expect style. --- .../tests/warnings/w52.compilers.reference | 36 -------- testsuite/tests/warnings/w52.ml | 90 +++++++++++++++---- 2 files changed, 71 insertions(+), 55 deletions(-) delete mode 100644 testsuite/tests/warnings/w52.compilers.reference diff --git a/testsuite/tests/warnings/w52.compilers.reference b/testsuite/tests/warnings/w52.compilers.reference deleted file mode 100644 index 9526f809049b..000000000000 --- a/testsuite/tests/warnings/w52.compilers.reference +++ /dev/null @@ -1,36 +0,0 @@ -File "w52.ml", line 12, characters 38-43: -12 | let () = try () with Invalid_argument "Any" -> ();; - ^^^^^ -Warning 52: Code should not depend on the actual values of -this constructor's arguments. They are only for information -and may change in future versions. (See manual section 9.5) -File "w52.ml", line 14, characters 35-46: -14 | let () = try () with Match_failure ("Any",_,_) -> ();; - ^^^^^^^^^^^ -Warning 52: Code should not depend on the actual values of -this constructor's arguments. They are only for information -and may change in future versions. (See manual section 9.5) -File "w52.ml", line 16, characters 35-42: -16 | let () = try () with Match_failure (_,0,_) -> ();; - ^^^^^^^ -Warning 52: Code should not depend on the actual values of -this constructor's arguments. They are only for information -and may change in future versions. (See manual section 9.5) -File "w52.ml", line 25, characters 7-17: -25 | | Warn "anything" -> () - ^^^^^^^^^^ -Warning 52: Code should not depend on the actual values of -this constructor's arguments. They are only for information -and may change in future versions. (See manual section 9.5) -File "w52.ml", line 30, characters 8-10: -30 | | Warn' 0n -> () - ^^ -Warning 52: Code should not depend on the actual values of -this constructor's arguments. They are only for information -and may change in future versions. (See manual section 9.5) -File "w52.ml", line 46, characters 7-34: -46 | | Deep (_ :: _ :: ("deep",_) :: _) -> () - ^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Warning 52: Code should not depend on the actual values of -this constructor's arguments. They are only for information -and may change in future versions. (See manual section 9.5) diff --git a/testsuite/tests/warnings/w52.ml b/testsuite/tests/warnings/w52.ml index 97bd6033d3e2..2f9e77be79d7 100644 --- a/testsuite/tests/warnings/w52.ml +++ b/testsuite/tests/warnings/w52.ml @@ -1,48 +1,100 @@ (* TEST - -flags = "-w A" - -* setup-ocamlc.byte-build-env -** ocamlc.byte -compile_only = "true" -*** check-ocamlc.byte-output - + flags = "-w A" + * expect *) let () = try () with Invalid_argument "Any" -> ();; +[%%expect{| +Line 1, characters 38-43: +1 | let () = try () with Invalid_argument "Any" -> ();; + ^^^^^ +Warning 52: Code should not depend on the actual values of +this constructor's arguments. They are only for information +and may change in future versions. (See manual section 9.5) +|}];; let () = try () with Match_failure ("Any",_,_) -> ();; +[%%expect{| +Line 1, characters 35-46: +1 | let () = try () with Match_failure ("Any",_,_) -> ();; + ^^^^^^^^^^^ +Warning 52: Code should not depend on the actual values of +this constructor's arguments. They are only for information +and may change in future versions. (See manual section 9.5) +|}];; let () = try () with Match_failure (_,0,_) -> ();; +[%%expect{| +Line 1, characters 35-42: +1 | let () = try () with Match_failure (_,0,_) -> ();; + ^^^^^^^ +Warning 52: Code should not depend on the actual values of +this constructor's arguments. They are only for information +and may change in future versions. (See manual section 9.5) +|}];; type t = | Warn of string [@ocaml.warn_on_literal_pattern] | Without_warning of string | Warn' of nativeint [@ocaml.warn_on_literal_pattern] | Deep of (string * int) list [@ocaml.warn_on_literal_pattern];; +[%%expect{| +type t = + Warn of string + | Without_warning of string + | Warn' of nativeint + | Deep of (string * int) list +|}];; let f = function | Warn "anything" -> () -| Warn _ | Warn' _ | Without_warning _ | Deep _ -> () -;; +| Warn _ | Warn' _ | Without_warning _ | Deep _ -> ();; +[%%expect{| +Line 2, characters 7-17: +2 | | Warn "anything" -> () + ^^^^^^^^^^ +Warning 52: Code should not depend on the actual values of +this constructor's arguments. They are only for information +and may change in future versions. (See manual section 9.5) +val f : t -> unit = +|}];; let g = function | Warn' 0n -> () -| Warn _ | Warn' _ | Without_warning _ | Deep _ -> () -;; - +| Warn _ | Warn' _ | Without_warning _ | Deep _ -> ();; +[%%expect{| +Line 2, characters 8-10: +2 | | Warn' 0n -> () + ^^ +Warning 52: Code should not depend on the actual values of +this constructor's arguments. They are only for information +and may change in future versions. (See manual section 9.5) +val g : t -> unit = +|}];; let h = function | Without_warning "outside" -> () -| Warn _ | Warn' _ | Without_warning _ | Deep _ -> () -;; +| Warn _ | Warn' _ | Without_warning _ | Deep _ -> ();; +[%%expect{| +val h : t -> unit = +|}];; let i = function | Deep (_ :: _ :: _ :: _) -> () -| Warn _ | Warn' _ | Without_warning _ | Deep _ -> () -;; +| Warn _ | Warn' _ | Without_warning _ | Deep _ -> ();; +[%%expect{| +val i : t -> unit = +|}];; let j = function | Deep (_ :: _ :: ("deep",_) :: _) -> () -| Warn _ | Warn' _ | Without_warning _ | Deep _ -> () -;; +| Warn _ | Warn' _ | Without_warning _ | Deep _ -> ();; +[%%expect{| +Line 2, characters 7-34: +2 | | Deep (_ :: _ :: ("deep",_) :: _) -> () + ^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Warning 52: Code should not depend on the actual values of +this constructor's arguments. They are only for information +and may change in future versions. (See manual section 9.5) +val j : t -> unit = +|}];; From 894df106a16314cb4d7904092cb94fb4e9d7fa15 Mon Sep 17 00:00:00 2001 From: Jeremy Yallop Date: Mon, 5 Nov 2018 17:30:03 +0000 Subject: [PATCH 5/5] Update the manual for the generalized warning 52. --- manual/manual/cmds/comp.etex | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/manual/manual/cmds/comp.etex b/manual/manual/cmds/comp.etex index 32eeb8e07b69..6cdd93674667 100644 --- a/manual/manual/cmds/comp.etex +++ b/manual/manual/cmds/comp.etex @@ -423,6 +423,11 @@ let dy { y; _ } = y (* explicit field elision: do not trigger warning 9 *) this attribute set: "Invalid_argument", "Failure", "Sys_error" will all raise this warning if you match for a specific string argument. + Additionally, built-in exceptions with a structured argument that + includes a string also have the attribute set: "Assert_failure" and + "Match_failure" will raise the warning for a pattern that uses a + literal string to match the first element of their tuple argument. + If your code raises this warning, you should {\em not} change the way you test for the specific string to avoid the warning (for example using a string equality inside the right-hand-side instead