[m-rev.] diff: atomic scope state variable fix

[Peter Wang]

Branches: main

compiler/state_var.m:
        In svar_start_inner_atomic_scope, remember the SInfo from before the
        introduction of the inner state variable, not after.

        Delete a sanity check with atomic scopes which turns out to be wrong.

tests/stm/Mmakefile:
tests/stm/atomic_scope.m:
        Add test case which requires the svar_start_inner_atomic_scope fix.

tests/stm/atomic_mvar.m:
        Add test for the sanity check that was removed.

diff --git a/compiler/state_var.m b/compiler/state_var.m
index b7bbfb4..7d4b1ba 100644
--- a/compiler/state_var.m
+++ b/compiler/state_var.m
@@ -693,10 +693,11 @@ svar_finish_outer_atomic_scope(OuterScopeInfo, !SInfo) :-
 
 svar_start_inner_atomic_scope(_Context, InnerStateVar, InnerScopeInfo,
         !VarSet, !SInfo, !Specs) :-
+    BeforeSInfo = !.SInfo,
     new_dot_state_var(InnerStateVar, InnerDI, !VarSet, !SInfo),
     new_colon_state_var(InnerStateVar, _, !VarSet, !SInfo),
     InnerScopeInfo = svar_inner_atomic_scope_info(InnerStateVar, InnerDI,
-        !.SInfo).
+        BeforeSInfo).
 
 svar_finish_inner_atomic_scope(Context, InnerScopeInfo, InnerDI, InnerUO,
         !VarSet, !SInfo, !Specs) :-
@@ -719,12 +720,6 @@ svar_finish_inner_atomic_scope(Context, InnerScopeInfo, InnerDI, InnerUO,
         ;
             unexpected(this_file, "transform_goal_2: |Vars| != 2")
         )
-    ),
-    ( InnerDI = InnerUO ->
-        unexpected(this_file,
-            "svar_inner_atomic_scope_info: InnerDI = InnerUO")
-    ;
-        true
     ).
 
 %-----------------------------------------------------------------------------%
diff --git a/tests/stm/Mmakefile b/tests/stm/Mmakefile
index 69676fe..8b3f149 100644
--- a/tests/stm/Mmakefile
+++ b/tests/stm/Mmakefile
@@ -15,6 +15,7 @@ VALID_PROGS = 			\
 	atomic_conj			\
 	atomic_ite			\
 	atomic_mvar			\
+	atomic_scope		\
 	#demo				\
 	par-asm_test7		\
 	par-asm_test8		\
diff --git a/tests/stm/atomic_mvar.m b/tests/stm/atomic_mvar.m
index 3a43d9f..87f5529 100644
--- a/tests/stm/atomic_mvar.m
+++ b/tests/stm/atomic_mvar.m
@@ -75,5 +75,13 @@ try_put_mvar(MVar, T, Success, !STM) :-
         Success = no
     ).
 
+:- pred nonsense(io::di, io::uo) is det.
+
+nonsense(!IO) :-
+    atomic [outer(!IO), inner(!STM)] (
+        % !STM not mentioned
+        true
+    ).
+
 %-----------------------------------------------------------------------------%
 % vim: ft=mercury ts=8 sts=4 sw=4 et
diff --git a/tests/stm/atomic_scope.exp b/tests/stm/atomic_scope.exp
new file mode 100644
index 0000000..e69de29
diff --git a/tests/stm/atomic_scope.m b/tests/stm/atomic_scope.m
new file mode 100644
index 0000000..da58a12
--- /dev/null
+++ b/tests/stm/atomic_scope.m
@@ -0,0 +1,40 @@
+:- module atomic_scope.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module stm_builtin.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    new_stm_var(10, Var, !IO),
+    atomic [outer(!IO), inner(!STM)] (
+        foo(Var, !STM)
+    ).
+
+:- pred foo(stm_var(int)::in, stm::di, stm::uo) is det.
+
+foo(Var, !IO) :-
+    atomic [outer(!IO), inner(!STM)] (
+        read_stm_var(Var, X, !STM)
+    ),
+    ( X = 1 ->
+        atomic [outer(!IO), inner(!STM)] (
+            write_stm_var(Var, 2, !STM)
+        )
+    ;
+        % Unification for !:STM = !.STM was being added here.
+        true
+    ).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sts=4 sw=4 et
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------