https://gcc.gnu.org/g:17f38a8d6f7fdc3dfd3542034f2989b3b0331f00
commit r16-6631-g17f38a8d6f7fdc3dfd3542034f2989b3b0331f00 Author: Viljar Indus <[email protected]> Date: Fri Dec 12 15:18:02 2025 +0200 ada: Add quickfixes for -gnawk warnings 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]> Diff: --- 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 59993da9608b..e5b739200dd1 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 40b5155f3f7f..6a420b0337f5 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 9c7c59e8643a..cd7a460a5450 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);
