Blob Blame History Raw
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