1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213 | ------------------------------------------------------------------------------
-- --
-- Libadalang Tools --
-- --
-- Copyright (C) 2020, AdaCore --
-- --
-- Libadalang Tools is free software; you can redistribute it and/or modi- --
-- fy it under terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 3, or (at your option) any --
-- later version. This software is distributed in the hope that it will be --
-- useful but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and a --
-- copy of the GCC Runtime Library Exception along with this program; see --
-- the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
------------------------------------------------------------------------------
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Containers.Vectors;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO; use Ada.Text_IO;
with GNATCOLL.Opt_Parse; use GNATCOLL.Opt_Parse;
with GNATCOLL.Projects; use GNATCOLL.Projects;
with GNATCOLL.VFS; use GNATCOLL.VFS;
with Langkit_Support.Slocs; use Langkit_Support.Slocs;
with Langkit_Support.Text; use Langkit_Support.Text;
with Laltools.Common; use Laltools.Common;
with Laltools.Refactor.Safe_Rename; use Laltools.Refactor.Safe_Rename;
with Libadalang.Analysis; use Libadalang.Analysis;
with Libadalang.Helpers; use Libadalang.Helpers;
with Printers; use Printers;
-- This procedure defines the Refactor Safe Rename Tool. Given the location of
-- an identifier in a source code file, and the project it belongs to, it
-- finds all references of the node's referenced declaration and checks
-- if the rename will cause an issue.
-- Usage:
-- safe_rename -P <project_file> -S <source_code_file> -L <line_number>
-- -R <column_number> -N <new_name> -A <algorithm>
--
-- -P, --project Project file to use
-- -S, --source Source code file of the identifier
-- -L, --line Line number of the identifier
-- -R, --column Column number of the identifier
-- -N, --new-name New name
-- -A, --algorithm Algorithm used to check for rename conflicts:
-- 'map_references' or 'analyse_ast'
procedure Safe_Rename is
procedure Safe_Rename_App_Setup
(Context : App_Context;
Jobs : App_Job_Context_Array);
-- This procedure is called right after command line options are parsed,
-- the project is loaded (if present) and the list of files to process
-- is computed.
package Safe_Rename_App is new Libadalang.Helpers.App
(Name => "safe_rename",
Description => "Safe_Rename",
App_setup => Safe_Rename_App_Setup);
package Args is
package Source is new GNATCOLL.Opt_Parse.Parse_Option
(Parser => Safe_Rename_App.Args.Parser,
Short => "-S",
Long => "--source",
Help => "Source code file of the node",
Arg_Type => Unbounded_String,
Convert => To_Unbounded_String,
Default_Val => Null_Unbounded_String,
Enabled => True);
package Line is new GNATCOLL.Opt_Parse.Parse_Option
(Parser => Safe_Rename_App.Args.Parser,
Short => "-L",
Long => "--line",
Help => "Line of the node",
Arg_Type => Natural,
Convert => Natural'Value,
Default_Val => 1,
Enabled => True);
package Column is new GNATCOLL.Opt_Parse.Parse_Option
(Parser => Safe_Rename_App.Args.Parser,
Short => "-R",
Long => "--column",
Help => "Column of the node",
Arg_Type => Natural,
Convert => Natural'Value,
Default_Val => 1,
Enabled => True);
package New_Name is new GNATCOLL.Opt_Parse.Parse_Option
(Parser => Safe_Rename_App.Args.Parser,
Short => "-N",
Long => "--new-name",
Help => "New name",
Arg_Type => Unbounded_String,
Convert => To_Unbounded_String,
Default_Val => Null_Unbounded_String,
Enabled => True);
package Algorithm is new GNATCOLL.Opt_Parse.Parse_Enum_Option
(Parser => Safe_Rename_App.Args.Parser,
Short => "-A",
Long => "--algorithm",
Help => "Algorithm used to check for rename conflicts: ",
Arg_Type => Problem_Finder_Algorithm_Kind,
Default_Val => Map_References,
Enabled => True);
end Args;
---------------------------
-- Safe_Rename_App_Setup --
---------------------------
procedure Safe_Rename_App_Setup
(Context : App_Context;
Jobs : App_Job_Context_Array)
is
Source_File : constant String := To_String (Args.Source.Get);
Sloc : constant Source_Location :=
(Line_Number (Args.Line.Get), Column_Number (Args.Column.Get));
New_Name : constant String := To_String (Args.New_Name.Get);
Algorithm : constant Problem_Finder_Algorithm_Kind :=
Args.Algorithm.Get;
All_Sources : constant GNATCOLL.VFS.File_Array_Access :=
Context.Provider.Project.Root_Project.Source_Files (Recursive => True);
Set : File_Info_Set;
package Analysis_Unit_Vectors is new Ada.Containers.Vectors
(Index_Type => Positive,
Element_Type => Analysis_Unit,
"=" => "=");
subtype Analysis_Unit_Vector is Analysis_Unit_Vectors.Vector;
Units : Analysis_Unit_Vector;
Main_Unit : Analysis_Unit;
Node : Ada_Node;
begin
Main_Unit := Jobs (1).Analysis_Ctx.Get_From_File (Source_File);
Node := Main_Unit.Root.Lookup (Sloc);
Put_Line ("# Renaming node " & Image (Node.Full_Sloc_Image));
for J in All_Sources'Range loop
Set := Context.Provider.Project.Info_Set (All_Sources (J));
if not Set.Is_Empty then
-- The file can be listed in several projects with different
-- Info_Sets, in the case of aggregate projects. However, assume
-- that the language is the same in all projects, so look only at
-- the first entry in the set.
declare
Info : constant File_Info'Class :=
File_Info'Class (Set.First_Element);
Filename : constant Filesystem_String :=
All_Sources (J).Full_Name;
begin
if To_Lower (Info.Language) = "ada" then
Units.Append
(Jobs (1).Analysis_Ctx.Get_From_File (String (Filename)));
end if;
end;
end if;
end loop;
declare
Renamer : constant Safe_Renamer :=
Create_Safe_Renamer
(Definition =>
Resolve_Name_Precisely (Get_Node_As_Name (Node)),
New_Name => To_Unbounded_Text (To_Text (New_Name)),
Algorithm => Algorithm);
Units_Array : Analysis_Unit_Array (1 .. Integer (Units.Length));
function Analysis_Units return Analysis_Unit_Array is (Units_Array);
begin
for J in 1 .. Units.Length loop
Units_Array (Integer (J)) := Units.Element (Integer (J));
end loop;
PP (Renamer.Refactor (Analysis_Units'Access));
end;
New_Line;
end Safe_Rename_App_Setup;
begin
Safe_Rename_App.Run;
end Safe_Rename;
|