diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 13 | ||||
| -rw-r--r-- | gcc/ada/aspects.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/exp_ch2.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/gnatchop.adb | 92 | ||||
| -rw-r--r-- | gcc/ada/inline.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/lib.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/repinfo.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/sem_ch7.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 2 |
10 files changed, 44 insertions, 99 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 08d7148..24d03d4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2025-10-17 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/122295 + * sem_ch12.adb (Analyze_Package_Instantiation): Force Style_Check + to False only after possibly installing the parent. + * aspects.adb (UAD_Pragma_Map): Fix style violation. + * inline.adb (To_Pending_Instantiations): Likewise. + * lib.ads (Unit_Names): Likewise. + * repinfo.adb (Relevant_Entities): Likewise. + * sem_ch7.adb (Subprogram_Table): Likewise. + (Traversed_Table): Likewise. + * sem_util.adb (Interval_Sorting): Likewise. + 2025-10-07 Eric Botcazou <ebotcazou@adacore.com> Revert: diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 44b7494..c9eaea1 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -578,7 +578,7 @@ package body Aspects is return UAD_Pragma_Map_Header is (UAD_Pragma_Map_Header (Chars mod UAD_Pragma_Map_Size)); - package UAD_Pragma_Map is new GNAT.Htable.Simple_Htable + package UAD_Pragma_Map is new GNAT.HTable.Simple_HTable (Header_Num => UAD_Pragma_Map_Header, Key => Name_Id, Element => Opt_N_Pragma_Id, diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index 612a461..d2f3df8 100644 --- a/gcc/ada/exp_ch2.adb +++ b/gcc/ada/exp_ch2.adb @@ -706,9 +706,15 @@ package body Exp_Ch2 is T : constant Entity_Id := Etype (N); begin + -- Mark the entity as referenced since this reference is going away + + Set_Referenced (E); + + -- Now rewrite the reference as a copy of the renamed object + Rewrite (N, New_Copy_Tree (Renamed_Object (E))); - -- We mark the copy as unanalyzed, so that it is sure to be reanalyzed + -- Mark the copy as unanalyzed to make sure that it is reanalyzed -- at the top level. This is needed in the packed case since we -- specifically avoided expanding packed array references when the -- renaming declaration was analyzed. diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index 8f9887e..bc045e1 100644 --- a/gcc/ada/gnatchop.adb +++ b/gcc/ada/gnatchop.adb @@ -36,6 +36,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.Heap_Sort_G; with GNAT.Table; +with Osint; with Switch; use Switch; with Types; @@ -44,12 +45,9 @@ procedure Gnatchop is Config_File_Name : constant String_Access := new String'("gnat.adc"); -- The name of the file holding the GNAT configuration pragmas - Gcc : String_Access := new String'("gcc"); + Gcc : String_Access := null; -- May be modified by switch --GCC= - Gcc_Set : Boolean := False; - -- True if a switch --GCC= is used - Gnat_Cmd : String_Access; -- Command to execute the GNAT compiler @@ -222,12 +220,6 @@ procedure Gnatchop is Integer'Image (Maximum_File_Name_Length); - function Locate_Executable - (Program_Name : String; - Look_For_Prefix : Boolean := True) return String_Access; - -- Locate executable for given program name. This takes into account - -- the target-prefix of the current command, if Look_For_Prefix is True. - subtype EOL_Length is Natural range 0 .. 2; -- Possible lengths of end of line sequence @@ -492,76 +484,6 @@ procedure Gnatchop is Unit.Table (Sorted_Units.Table (U + 1)).File_Name.all; end Is_Duplicated; - ----------------------- - -- Locate_Executable -- - ----------------------- - - function Locate_Executable - (Program_Name : String; - Look_For_Prefix : Boolean := True) return String_Access - is - Gnatchop_Str : constant String := "gnatchop"; - Current_Command : constant String := Normalize_Pathname (Command_Name); - End_Of_Prefix : Natural; - Start_Of_Prefix : Positive; - Start_Of_Suffix : Positive; - Result : String_Access; - - begin - Start_Of_Prefix := Current_Command'First; - Start_Of_Suffix := Current_Command'Last + 1; - End_Of_Prefix := Start_Of_Prefix - 1; - - if Look_For_Prefix then - - -- Find Start_Of_Prefix - - for J in reverse Current_Command'Range loop - if Current_Command (J) = '/' or else - Current_Command (J) = Directory_Separator or else - Current_Command (J) = ':' - then - Start_Of_Prefix := J + 1; - exit; - end if; - end loop; - - -- Find End_Of_Prefix - - for J in Start_Of_Prefix .. - Current_Command'Last - Gnatchop_Str'Length + 1 - loop - if Current_Command (J .. J + Gnatchop_Str'Length - 1) = - Gnatchop_Str - then - End_Of_Prefix := J - 1; - exit; - end if; - end loop; - end if; - - if End_Of_Prefix > Current_Command'First then - Start_Of_Suffix := End_Of_Prefix + Gnatchop_Str'Length + 1; - end if; - - declare - Command : constant String := - Current_Command (Start_Of_Prefix .. End_Of_Prefix) - & Program_Name - & Current_Command (Start_Of_Suffix .. - Current_Command'Last); - begin - Result := Locate_Exec_On_Path (Command); - - if Result = null then - Error_Msg - (Command & ": installation problem, executable not found"); - end if; - end; - - return Result; - end Locate_Executable; - --------------- -- Parse_EOL -- --------------- @@ -1088,8 +1010,8 @@ procedure Gnatchop is exit; when '-' => - Gcc := new String'(Parameter); - Gcc_Set := True; + Free (Gcc); + Gcc := new String'(Parameter); when 'c' => Compilation_Mode := True; @@ -1767,9 +1689,13 @@ begin -- Check presence of required executables - Gnat_Cmd := Locate_Executable (Gcc.all, not Gcc_Set); + if Gcc = null then + Gcc := Osint.Program_Name ("gcc", "gnatchop"); + end if; + Gnat_Cmd := Locate_Exec_On_Path (Gcc.all); if Gnat_Cmd = null then + Error_Msg (Gcc.all & ": installation problem, executable not found"); goto No_Files_Written; end if; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index a592494..9e60fa8 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -151,7 +151,7 @@ package body Inline is function Node_Hash (Id : Node_Id) return Node_Header_Num; -- Simple hash function for Node_Ids - package To_Pending_Instantiations is new GNAT.Htable.Simple_HTable + package To_Pending_Instantiations is new GNAT.HTable.Simple_HTable (Header_Num => Node_Header_Num, Element => Int, No_Element => -1, diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index 928f6f8..f5c6571 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -901,7 +901,7 @@ private function Unit_Name_Hash (Id : Unit_Name_Type) return Unit_Name_Header_Num; -- Simple hash function for Unit_Name_Types - package Unit_Names is new GNAT.Htable.Simple_HTable + package Unit_Names is new GNAT.HTable.Simple_HTable (Header_Num => Unit_Name_Header_Num, Element => Unit_Number_Type, No_Element => No_Unit, diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index e236e4e..41afbb7 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -119,7 +119,7 @@ package body Repinfo is function Entity_Hash (Id : Entity_Id) return Entity_Header_Num; -- Simple hash function for Entity_Ids - package Relevant_Entities is new GNAT.Htable.Simple_HTable + package Relevant_Entities is new GNAT.HTable.Simple_HTable (Header_Num => Entity_Header_Num, Element => Boolean, No_Element => False, diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index de9cff1..3575b04 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -4990,14 +4990,6 @@ package body Sem_Ch12 is Preanalyze_Actuals (N, Act_Decl_Id); - -- Turn off style checking in instances. If the check is enabled on the - -- generic unit, a warning in an instance would just be noise. If not - -- enabled on the generic, then a warning in an instance is just wrong. - -- This must be done after analyzing the actuals, which do come from - -- source and are subject to style checking. - - Style_Check := False; - Init_Env; Env_Installed := True; @@ -5016,6 +5008,14 @@ package body Sem_Ch12 is Check_Generic_Child_Unit (Gen_Id, Parent_Installed); end if; + -- Turn off style checking in instances. If the check is enabled on the + -- generic unit, a warning in an instance would just be noise. If not + -- enabled on the generic, then a warning in an instance is just wrong. + -- This must be done after analyzing the actuals and possibly installing + -- the parent, which come from source and are subject to style checking. + + Style_Check := False; + Gen_Unit := Entity (Gen_Id); -- A package instantiation is Ghost when it is subject to pragma Ghost diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 1d838e2..90219ac 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -206,7 +206,7 @@ package body Sem_Ch7 is function Node_Hash (Id : Entity_Id) return Entity_Header_Num; -- Simple hash function for Entity_Ids - package Subprogram_Table is new GNAT.Htable.Simple_HTable + package Subprogram_Table is new GNAT.HTable.Simple_HTable (Header_Num => Entity_Header_Num, Element => Boolean, No_Element => False, @@ -216,7 +216,7 @@ package body Sem_Ch7 is -- Hash table to record which subprograms are referenced. It is declared -- at library level to avoid elaborating it for every call to Analyze. - package Traversed_Table is new GNAT.Htable.Simple_HTable + package Traversed_Table is new GNAT.HTable.Simple_HTable (Header_Num => Entity_Header_Num, Element => Boolean, No_Element => False, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 9e2083b..7f864d6 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -31148,7 +31148,7 @@ package body Sem_Util is ---------------------- package Interval_Sorting is - new Gnat.Heap_Sort_G (Move_Interval, Lt_Interval); + new GNAT.Heap_Sort_G (Move_Interval, Lt_Interval); ------------- -- Is_Null -- |