https://gcc.gnu.org/g:cdb08b4bd24912f22c2f41798b3bd1b7395c87c6
commit r16-4467-gcdb08b4bd24912f22c2f41798b3bd1b7395c87c6 Author: Eric Botcazou <[email protected]> Date: Fri Oct 17 11:02:28 2025 +0200 Fix missing style violation report for package instantiation Unlike for subprogram instantiation, -gnatyr does not report style violation for package instantiation, more precisely for the generic package's name. Fixing it uncovered style violations in the sources of the compiler itself! gcc/ada/ 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. gcc/testsuite/ * gnat.dg/specs/style1.ads: New test. Diff: --- gcc/ada/aspects.adb | 2 +- gcc/ada/inline.adb | 2 +- gcc/ada/lib.ads | 2 +- gcc/ada/repinfo.adb | 2 +- gcc/ada/sem_ch12.adb | 16 ++++++++-------- gcc/ada/sem_ch7.adb | 4 ++-- gcc/ada/sem_util.adb | 2 +- gcc/testsuite/gnat.dg/specs/style1.ads | 19 +++++++++++++++++++ 8 files changed, 34 insertions(+), 15 deletions(-) diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 44b7494b9247..c9eaea1b7f94 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/inline.adb b/gcc/ada/inline.adb index a592494500fd..9e60fa81de9e 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 928f6f840c87..f5c6571ced32 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 e236e4e54be1..41afbb7ecbf6 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 de9cff14246e..3575b04ad963 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 1d838e24bf48..90219ac82168 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 9e2083b8383d..7f864d66ffaf 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 -- diff --git a/gcc/testsuite/gnat.dg/specs/style1.ads b/gcc/testsuite/gnat.dg/specs/style1.ads new file mode 100644 index 000000000000..e7fd92310cec --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/style1.ads @@ -0,0 +1,19 @@ +-- { dg-do compile } +-- { dg-options "-gnatyr" } + +with Ada.Containers.Vectors; +with Ada.Unchecked_Conversion; + +package Style1 is + + package My_Vector is new ada.containers.vectors -- { dg-warning " bad casing" } + (Index_Type => Positive, + Element_Type => Integer); + + type Word is mod 2**32; + + function My_Conv is new ada.unchecked_conversion -- { dg-warning " bad casing" } + (Source => Integer, + Target => Word); + +end Style1;
