mirror of git://gcc.gnu.org/git/gcc.git
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.
This commit is contained in:
parent
c591c2aff5
commit
cdb08b4bd2
|
@ -578,7 +578,7 @@ package body Aspects is
|
||||||
return UAD_Pragma_Map_Header
|
return UAD_Pragma_Map_Header
|
||||||
is (UAD_Pragma_Map_Header (Chars mod UAD_Pragma_Map_Size));
|
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,
|
(Header_Num => UAD_Pragma_Map_Header,
|
||||||
Key => Name_Id,
|
Key => Name_Id,
|
||||||
Element => Opt_N_Pragma_Id,
|
Element => Opt_N_Pragma_Id,
|
||||||
|
|
|
@ -151,7 +151,7 @@ package body Inline is
|
||||||
function Node_Hash (Id : Node_Id) return Node_Header_Num;
|
function Node_Hash (Id : Node_Id) return Node_Header_Num;
|
||||||
-- Simple hash function for Node_Ids
|
-- 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,
|
(Header_Num => Node_Header_Num,
|
||||||
Element => Int,
|
Element => Int,
|
||||||
No_Element => -1,
|
No_Element => -1,
|
||||||
|
|
|
@ -901,7 +901,7 @@ private
|
||||||
function Unit_Name_Hash (Id : Unit_Name_Type) return Unit_Name_Header_Num;
|
function Unit_Name_Hash (Id : Unit_Name_Type) return Unit_Name_Header_Num;
|
||||||
-- Simple hash function for Unit_Name_Types
|
-- 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,
|
(Header_Num => Unit_Name_Header_Num,
|
||||||
Element => Unit_Number_Type,
|
Element => Unit_Number_Type,
|
||||||
No_Element => No_Unit,
|
No_Element => No_Unit,
|
||||||
|
|
|
@ -119,7 +119,7 @@ package body Repinfo is
|
||||||
function Entity_Hash (Id : Entity_Id) return Entity_Header_Num;
|
function Entity_Hash (Id : Entity_Id) return Entity_Header_Num;
|
||||||
-- Simple hash function for Entity_Ids
|
-- 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,
|
(Header_Num => Entity_Header_Num,
|
||||||
Element => Boolean,
|
Element => Boolean,
|
||||||
No_Element => False,
|
No_Element => False,
|
||||||
|
|
|
@ -4990,14 +4990,6 @@ package body Sem_Ch12 is
|
||||||
|
|
||||||
Preanalyze_Actuals (N, Act_Decl_Id);
|
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;
|
Init_Env;
|
||||||
Env_Installed := True;
|
Env_Installed := True;
|
||||||
|
|
||||||
|
@ -5016,6 +5008,14 @@ package body Sem_Ch12 is
|
||||||
Check_Generic_Child_Unit (Gen_Id, Parent_Installed);
|
Check_Generic_Child_Unit (Gen_Id, Parent_Installed);
|
||||||
end if;
|
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);
|
Gen_Unit := Entity (Gen_Id);
|
||||||
|
|
||||||
-- A package instantiation is Ghost when it is subject to pragma Ghost
|
-- A package instantiation is Ghost when it is subject to pragma Ghost
|
||||||
|
|
|
@ -206,7 +206,7 @@ package body Sem_Ch7 is
|
||||||
function Node_Hash (Id : Entity_Id) return Entity_Header_Num;
|
function Node_Hash (Id : Entity_Id) return Entity_Header_Num;
|
||||||
-- Simple hash function for Entity_Ids
|
-- 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,
|
(Header_Num => Entity_Header_Num,
|
||||||
Element => Boolean,
|
Element => Boolean,
|
||||||
No_Element => False,
|
No_Element => False,
|
||||||
|
@ -216,7 +216,7 @@ package body Sem_Ch7 is
|
||||||
-- Hash table to record which subprograms are referenced. It is declared
|
-- Hash table to record which subprograms are referenced. It is declared
|
||||||
-- at library level to avoid elaborating it for every call to Analyze.
|
-- 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,
|
(Header_Num => Entity_Header_Num,
|
||||||
Element => Boolean,
|
Element => Boolean,
|
||||||
No_Element => False,
|
No_Element => False,
|
||||||
|
|
|
@ -31148,7 +31148,7 @@ package body Sem_Util is
|
||||||
----------------------
|
----------------------
|
||||||
|
|
||||||
package Interval_Sorting 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 --
|
-- Is_Null --
|
||||||
|
|
|
@ -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;
|
Loading…
Reference in New Issue