91 lines
3.0 KiB
Diff
91 lines
3.0 KiB
Diff
|
From e6dfa704c0f7847fe8e7a2a153714b4075019a0f Mon Sep 17 00:00:00 2001
|
||
|
From: Chris Casinghino <chris.casinghino@gmail.com>
|
||
|
Date: Fri, 2 Sep 2022 10:28:55 -0400
|
||
|
Subject: [PATCH 21/24] Fix [@deprecated_mutable], which couldn't be triggered.
|
||
|
(#11524)
|
||
|
|
||
|
Fixes #11516
|
||
|
|
||
|
(cherry picked from commit 024ca164ab844a9be94e0675bb5a1693bab7c08f)
|
||
|
---
|
||
|
Changes | 2 ++
|
||
|
.../warnings/deprecated_mutable.compilers.reference | 4 ++++
|
||
|
testsuite/tests/warnings/deprecated_mutable.ml | 13 +++++++++++++
|
||
|
typing/env.ml | 9 ++++++++-
|
||
|
4 files changed, 27 insertions(+), 1 deletion(-)
|
||
|
create mode 100644 testsuite/tests/warnings/deprecated_mutable.compilers.reference
|
||
|
create mode 100644 testsuite/tests/warnings/deprecated_mutable.ml
|
||
|
|
||
|
diff --git a/Changes b/Changes
|
||
|
index 92d0837eb6..aa8880ad07 100644
|
||
|
--- a/Changes
|
||
|
+++ b/Changes
|
||
|
@@ -47,6 +47,8 @@ OCaml 4.14 maintenance branch
|
||
|
- #11489, #11496: More prudent deallocation of alternate signal stack
|
||
|
(Xavier Leroy, report by @rajdakin, review by Florian Angeletti)
|
||
|
|
||
|
+- #11516, #11524: Fix the `deprecated_mutable` attribute.
|
||
|
+ (Chris Casinghino, review by Nicolás Ojeda Bär and Florian Angeletti)
|
||
|
|
||
|
OCaml 4.14.0 (28 March 2022)
|
||
|
----------------------------
|
||
|
diff --git a/testsuite/tests/warnings/deprecated_mutable.compilers.reference b/testsuite/tests/warnings/deprecated_mutable.compilers.reference
|
||
|
new file mode 100644
|
||
|
index 0000000000..620dc57de9
|
||
|
--- /dev/null
|
||
|
+++ b/testsuite/tests/warnings/deprecated_mutable.compilers.reference
|
||
|
@@ -0,0 +1,4 @@
|
||
|
+File "deprecated_mutable.ml", line 13, characters 11-12:
|
||
|
+13 | let () = y.x <- 42
|
||
|
+ ^
|
||
|
+Alert deprecated: mutating field x
|
||
|
diff --git a/testsuite/tests/warnings/deprecated_mutable.ml b/testsuite/tests/warnings/deprecated_mutable.ml
|
||
|
new file mode 100644
|
||
|
index 0000000000..78fb12ac41
|
||
|
--- /dev/null
|
||
|
+++ b/testsuite/tests/warnings/deprecated_mutable.ml
|
||
|
@@ -0,0 +1,13 @@
|
||
|
+(* TEST
|
||
|
+
|
||
|
+flags = "-w +A-70"
|
||
|
+
|
||
|
+* bytecode
|
||
|
+
|
||
|
+*)
|
||
|
+
|
||
|
+type t = {mutable x : int [@deprecated_mutable]}
|
||
|
+
|
||
|
+let y : t = {x = 5}
|
||
|
+
|
||
|
+let () = y.x <- 42
|
||
|
diff --git a/typing/env.ml b/typing/env.ml
|
||
|
index 06b99f4159..29d7cdb0e4 100644
|
||
|
--- a/typing/env.ml
|
||
|
+++ b/typing/env.ml
|
||
|
@@ -104,6 +104,10 @@ let add_label_usage lu usage =
|
||
|
lu.lu_mutation <- true;
|
||
|
lu.lu_construct <- true
|
||
|
|
||
|
+let is_mutating_label_usage = function
|
||
|
+ | Mutation -> true
|
||
|
+ | (Projection | Construct | Exported_private | Exported) -> false
|
||
|
+
|
||
|
let label_usages () =
|
||
|
{lu_projection = false; lu_mutation = false; lu_construct = false}
|
||
|
|
||
|
@@ -2723,7 +2727,10 @@ let use_cltype ~use ~loc path desc =
|
||
|
let use_label ~use ~loc usage env lbl =
|
||
|
if use then begin
|
||
|
mark_label_description_used usage env lbl;
|
||
|
- Builtin_attributes.check_alerts loc lbl.lbl_attributes lbl.lbl_name
|
||
|
+ Builtin_attributes.check_alerts loc lbl.lbl_attributes lbl.lbl_name;
|
||
|
+ if is_mutating_label_usage usage then
|
||
|
+ Builtin_attributes.check_deprecated_mutable loc lbl.lbl_attributes
|
||
|
+ lbl.lbl_name
|
||
|
end
|
||
|
|
||
|
let use_constructor_desc ~use ~loc usage env cstr =
|
||
|
--
|
||
|
2.37.0.rc2
|
||
|
|