From: Viljar Indus <[email protected]>
gcc/ada/ChangeLog:
* errout.adb (Insert): New function to create an insertion fix.
(Deletion): New function to create a deletion fix.
* errout.ads: Likewise.
* sem_warn.adb (Create_Add_Constant_Fix): New function to create
a fix for adding a constant qualifier for a variable declaration.
(Change_In_Out_To_In_Fix): New function to create a fix for
convertinting an in out parameter direction to a an in direction.
Co-authored-by: Eric Botcazou <[email protected]>
Tested on x86_64-pc-linux-gnu (before the recent bootstrap breakage), committed
on master.
---
gcc/ada/errout.adb | 25 ++++++
gcc/ada/errout.ads | 6 ++
gcc/ada/sem_warn.adb | 177 ++++++++++++++++++++++++++++++++++++++++++-
3 files changed, 206 insertions(+), 2 deletions(-)
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 59993da9608..e5b739200dd 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -455,6 +455,31 @@ package body Errout is
return (Text => new String'(Text), Span => Span, Next => No_Edit);
end Edit;
+ ---------------
+ -- Insertion --
+ ---------------
+
+ function Insertion (Text : String; Location : Source_Ptr) return Edit_Type
+ is
+ function Location_Span (Loc : Source_Ptr) return Source_Span
+ is ((Ptr => Loc, First => Loc, Last => Loc - 1));
+ -- Returns a span for a given location without a span length. This is
+ -- useful for insertion edits where we want to distinguish it from a
+ -- span with a length of 1.
+
+ begin
+ return Edit (Text => Text, Span => Location_Span (Location));
+ end Insertion;
+
+ --------------
+ -- Deletion --
+ --------------
+
+ function Deletion (Span : Source_Span) return Edit_Type is
+ begin
+ return Edit (Text => "", Span => Span);
+ end Deletion;
+
---------
-- Fix --
---------
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 40b5155f3f7..6a420b0337f 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -1048,6 +1048,12 @@ package Errout is
function Edit (Text : String; Span : Source_Span) return Edit_Type;
-- Constructs a Edit structure with all of its attributes.
+ function Insertion (Text : String; Location : Source_Ptr) return Edit_Type;
+ -- Constructs a Edit used to insert Text into the given Location
+
+ function Deletion (Span : Source_Span) return Edit_Type;
+ -- Constructs a Edit used to delete a given section of the source file
+
function Fix (Description : String; Edits : Edit_Array) return Fix_Type;
-- Constructs a Fix structure with all of its attributes.
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 9c7c59e8643..cd7a460a545 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -49,6 +49,7 @@ with Sinput; use Sinput;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
+with System.Case_Util;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
with Warnsw; use Warnsw;
@@ -824,6 +825,13 @@ package body Sem_Warn is
-- For an entry formal entity from an entry declaration, find the
-- corresponding body formal from the given accept statement.
+ function Create_Add_Constant_Fix (E : Entity_Id) return Fix_Array;
+ -- Creates a fix for adding the constant modifier in the declaration for
+ -- E.
+ --
+ -- No fix is generated when the declaration was using multiple
+ -- identifiers.
+
function Generic_Body_Formal (E : Entity_Id) return Entity_Id;
-- Warnings on unused formals of subprograms are placed on the entity
-- in the subprogram body, which seems preferable because it suggests
@@ -1201,6 +1209,34 @@ package body Sem_Warn is
or else Warnings_Off_Check_Spec (E1);
end Warnings_Off_E1;
+ -----------------------------
+ -- Create_Add_Constant_Fix --
+ -----------------------------
+
+ function Create_Add_Constant_Fix (E : Entity_Id) return Fix_Array is
+ Decl : constant Node_Id := Parent (E);
+ begin
+ if Nkind (Decl) not in N_Object_Declaration then
+ return No_Fixes;
+ end if;
+
+ -- Only generate a fix in the simplest scenario where a declaration
+ -- is used to define one entity.
+
+ if Prev_Ids (Decl) or else More_Ids (Decl) then
+ return No_Fixes;
+ end if;
+
+ return
+ (1 =>
+ (Fix
+ (Description => "Add constant",
+ Edits =>
+ (1 =>
+ Insertion
+ ("constant ", Sloc (Object_Definition (Decl)))))));
+ end Create_Add_Constant_Fix;
+
-- Start of processing for Check_References
begin
@@ -1334,7 +1370,9 @@ package body Sem_Warn is
Error_Msg_N -- CODEFIX
("?k?& is not modified, could be declared constant!",
E1,
- GNAT0008);
+ GNAT0008,
+ Fixes => Create_Add_Constant_Fix (E1));
+
end if;
-- Other cases of a variable or parameter never set in source
@@ -3050,6 +3088,140 @@ package body Sem_Warn is
-- context may force use of IN OUT, even if the parameter is not
-- modified for this particular case).
+ function Change_In_Out_To_In_Fix (Body_E : Entity_Id) return Fix_Array;
+ -- Scan the location of the IN OUT token in the parameter
+ -- specification of Body_E and create:
+ -- * A fix for removing the IN OUT modifier
+ -- * A fix for replacing the IN OUT modifier with the IN modifier
+ --
+ -- If multiple identifiers were used in the specification then no fix is
+ -- generated.
+
+ -----------------------------
+ -- Change_In_Out_To_In_Fix --
+ -----------------------------
+
+ function Change_In_Out_To_In_Fix (Body_E : Entity_Id) return Fix_Array is
+ Spec_E : constant Entity_Id := Spec_Entity (Body_E);
+ Body_E_Param : constant Node_Id := Parent (Body_E);
+ Spec_E_Param : Node_Id;
+ Body_In_Out_Span : Source_Span;
+ Spec_In_Out_Span : Source_Span;
+ Found : Boolean;
+
+ procedure Location_Of_In_Out
+ (Param_Spec : Node_Id;
+ In_Out_Span : out Source_Span;
+ Found : out Boolean);
+ -- Scan the location of the IN OUT token in the parameter
+ -- specfication.
+
+ ------------------------
+ -- Location_Of_In_Out --
+ ------------------------
+
+ procedure Location_Of_In_Out
+ (Param_Spec : Node_Id;
+ In_Out_Span : out Source_Span;
+ Found : out Boolean)
+ is
+ SI : constant Source_File_Index :=
+ Get_Source_File_Index (Sloc (Param_Spec));
+ Src : constant Source_Buffer_Ptr := Source_Text (SI);
+
+ F : constant Source_Ptr :=
+ Last_Sloc (Defining_Identifier (Param_Spec));
+ L : constant Source_Ptr :=
+ First_Sloc (Parameter_Type (Param_Spec));
+
+ Tok : constant String := "in out ";
+
+ S : Source_Ptr;
+ begin
+ S := F;
+ while S + Tok'Length <= L loop
+ declare
+ SS : String := String (Src (S .. S + Tok'Length - 1));
+
+ begin
+ -- Note that the instance of System.Case_Util.To_Lower that
+ -- has signature
+ --
+ -- function To_Lower (A : String) return String
+ --
+ -- cannot be used here because it is not present in the
+ -- run-time library used by the bootstrap compiler at the
+ -- time of writing.
+
+ System.Case_Util.To_Lower (SS);
+
+ if SS = Tok then
+ Found := True;
+ In_Out_Span := To_Span (S, S, S + Tok'Length - 1);
+ return;
+ end if;
+ end;
+
+ S := S + 1;
+ end loop;
+
+ Found := False;
+ In_Out_Span := To_Span (No_Location);
+ end Location_Of_In_Out;
+ begin
+ if Nkind (Body_E_Param) not in N_Parameter_Specification then
+ return No_Fixes;
+ end if;
+
+ if Prev_Ids (Body_E_Param) or else More_Ids (Body_E_Param) then
+ return No_Fixes;
+ end if;
+
+ Location_Of_In_Out (Body_E_Param, Body_In_Out_Span, Found);
+
+ -- This probably indicates a problem in the scanner, but we should
+ -- not crash when producing an error message.
+
+ if not Found then
+ return No_Fixes;
+ end if;
+
+ -- Just update the body if no spec available
+
+ if No (Spec_E) then
+ return
+ (1 =>
+ (Fix
+ (Description => "Remove IN OUT",
+ Edits => (1 => Deletion (Body_In_Out_Span)))),
+ 2 =>
+ Fix
+ (Description => "Replace IN OUT with IN",
+ Edits => (1 => Edit ("in ", Body_In_Out_Span))));
+ end if;
+
+ Spec_E_Param := Parent (Spec_E);
+ Location_Of_In_Out (Spec_E_Param, Spec_In_Out_Span, Found);
+
+ if not Found then
+ return No_Fixes;
+ end if;
+
+ return
+ (1 =>
+ (Fix
+ (Description => "Remove IN OUT",
+ Edits =>
+ (1 => Deletion (Spec_In_Out_Span),
+ 2 => Deletion (Body_In_Out_Span)))),
+ 2 =>
+ Fix
+ (Description => "Replace IN OUT with IN",
+ Edits =>
+ (1 => Edit ("in ", Spec_In_Out_Span),
+ 2 => Edit ("in ", Body_In_Out_Span))));
+ end Change_In_Out_To_In_Fix;
+
--------------------
-- Warn_On_In_Out --
--------------------
@@ -3108,7 +3280,8 @@ package body Sem_Warn is
Error_Msg_N
("?k?formal parameter & is not modified!",
E1,
- GNAT0009);
+ GNAT0009,
+ Fixes => Change_In_Out_To_In_Fix (E1));
Error_Msg_N
("\?k?mode could be IN instead of `IN OUT`!", E1);
--
2.51.0
