File 0501-syntax-tools-Fix-reverting-discarding-pos-changes.patch of Package erlang

From 5bbee0e2fa4f549035765ab5ad4ce033d8f8605a Mon Sep 17 00:00:00 2001
From: Max Nordlund kivra <max.nordlund@kivra.com>
Date: Tue, 13 Jun 2023 17:15:21 +0200
Subject: [PATCH 1/2] syntax tools: Fix reverting discarding pos changes

This changes `erl_syntax:set_pos/2` for `#wrapper` nodes to also update
the `pos` (really the erl_anno annotation) of the wrapped node. This
means the pos/annotation in `#attr` stay in sync with the actual node.

Together with the change to `erl_syntax:revert/1` this means that
reverting a node will correctly keep any changes to the pos/annotation
for both `#tree` and `#wrapper` nodes.
---
 lib/syntax_tools/src/erl_syntax.erl          | 29 +++++++++-----------
 lib/syntax_tools/test/syntax_tools_SUITE.erl | 18 +++++++++++-
 2 files changed, 30 insertions(+), 17 deletions(-)

diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl
index 74a73832df..f3e8a106ea 100644
--- a/lib/syntax_tools/src/erl_syntax.erl
+++ b/lib/syntax_tools/src/erl_syntax.erl
@@ -928,14 +928,18 @@ get_pos(Node) ->
 
 set_pos(Node, Pos) ->
     case Node of
-	#tree{attr = Attr} ->
-	    Node#tree{attr = Attr#attr{pos = Pos}};
-	#wrapper{attr = Attr} ->
-	    Node#wrapper{attr = Attr#attr{pos = Pos}};
-	_ ->
-	    %% We then assume we have an `erl_parse' node, and create a
-	    %% wrapper around it to make things more uniform.
-	    set_pos(wrap(Node), Pos)
+        #tree{attr = Attr} ->
+            Node#tree{attr = Attr#attr{pos = Pos}};
+        #wrapper{attr = Attr, tree = {error, {_, Module, Reason}}} ->
+            Node#wrapper{attr = Attr#attr{pos = Pos}, tree = {error, {Pos, Module, Reason}}};
+        #wrapper{attr = Attr, tree = {warning, {_, Module, Reason}}} ->
+            Node#wrapper{attr = Attr#attr{pos = Pos}, tree = {warning, {Pos, Module, Reason}}};
+        #wrapper{attr = Attr, tree = Tree} ->
+            Node#wrapper{attr = Attr#attr{pos = Pos}, tree = setelement(2, Tree, Pos)};
+        _ ->
+            %% We then assume we have an `erl_parse' node, and create a
+            %% wrapper around it to make things more uniform.
+            set_pos(wrap(Node), Pos)
     end.
 
 
@@ -7769,13 +7773,7 @@ is_literal_map_field(F) ->
 -spec revert(syntaxTree()) -> syntaxTree().
 
 revert(Node) ->
-    case is_tree(Node) of
-	false ->
-	    %% Just remove any wrapper. `erl_parse' nodes never contain
-	    %% abstract syntax tree nodes as subtrees.
-	    unwrap(Node);
-	true ->
-	    case is_leaf(Node) of
+    case is_leaf(Node) of
 		true ->
 		    revert_root(Node);
 		false ->
@@ -7789,7 +7787,6 @@ revert(Node) ->
 		    %% parts, and revert the node itself.
 		    Node1 = update_tree(Node, Gs),
 		    revert_root(Node1)
-	    end
     end.
 
 %% Note: The concept of "compatible root node" is not strictly defined.
diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl
index 3553f7a71f..d335fc9452 100644
--- a/lib/syntax_tools/test/syntax_tools_SUITE.erl
+++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl
@@ -24,7 +24,8 @@
 
 %% Test cases
 -export([app_test/1,appup_test/1,smoke_test/1,revert/1,revert_map/1,
-         revert_map_type/1,wrapped_subtrees/1,
+         revert_map_type/1,revert_preserve_pos_changes/1,
+         wrapped_subtrees/1,
          t_abstract_type/1,t_erl_parse_type/1,t_type/1,
          t_epp_dodger/1,t_epp_dodger_clever/1,
          t_comment_scan/1,t_prettypr/1,test_named_fun_bind_ann/1]).
@@ -33,6 +34,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
 
 all() -> 
     [app_test,appup_test,smoke_test,revert,revert_map,revert_map_type,
+     revert_preserve_pos_changes,
      wrapped_subtrees,
      t_abstract_type,t_erl_parse_type,t_type,
      t_epp_dodger,t_epp_dodger_clever,
@@ -147,6 +149,20 @@ revert_map_type(Config) when is_list(Config) ->
     Form2 = erl_syntax:revert(Mapped2),
     test_server:timetrap_cancel(Dog).
 
+revert_preserve_pos_changes(Config) when is_list(Config) ->
+    Dog = test_server:timetrap(test_server:minutes(1)),
+    Pos0 = 1,
+    Var0 = {var, Pos0, 'Var'},
+    %% Adding any user annotation makes erl_syntax change to it's internal
+    %% representation
+    Var1 = erl_syntax:add_ann({env, []}, Var0),
+    %% Change the `pos' of the node
+    Pos1 = erl_anno:set_generated(true, Pos0),
+    Var2 = erl_syntax:set_pos(Var1, Pos1),
+    %% The must be equal when reverted
+    {var, Pos1, 'Var'} = erl_syntax:revert(Var2),
+    test_server:timetrap_cancel(Dog).
+
 %% Read with erl_parse, wrap each tree node with erl_syntax and check that
 %% erl_syntax:subtrees can access the wrapped node.
 wrapped_subtrees(Config) when is_list(Config) ->
-- 
2.35.3

openSUSE Build Service is sponsored by