]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fix missing style violation report for package instantiation
authorEric Botcazou <ebotcazou@adacore.com>
Fri, 17 Oct 2025 09:02:28 +0000 (11:02 +0200)
committerEric Botcazou <ebotcazou@adacore.com>
Fri, 17 Oct 2025 09:05:08 +0000 (11:05 +0200)
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.

gcc/ada/aspects.adb
gcc/ada/inline.adb
gcc/ada/lib.ads
gcc/ada/repinfo.adb
gcc/ada/sem_ch12.adb
gcc/ada/sem_ch7.adb
gcc/ada/sem_util.adb
gcc/testsuite/gnat.dg/specs/style1.ads [new file with mode: 0644]

index 44b7494b924724500c69f105a938defc9f4af65b..c9eaea1b7f94b67cf1c51d446016bbaad9748b11 100644 (file)
@@ -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,
index a592494500fd7ce6a33d35f1dbd3c34ed70d18aa..9e60fa81de9e51c0993aa9c03fc134d419ecb845 100644 (file)
@@ -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,
index 928f6f840c87d60ab28a965fc4f8a8dccd553a4c..f5c6571ced32a02a346c88cee951f2c311b6e2ce 100644 (file)
@@ -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,
index e236e4e54be1237718f442e9e5f5d70bfe32fded..41afbb7ecbf6b2162ced60ffa84f266a9ac534c8 100644 (file)
@@ -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,
index de9cff14246ee51e6f249cca4d7d096f35052643..3575b04ad963ce14d810ddb7f466cc6daaabf641 100644 (file)
@@ -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
index 1d838e24bf4817c29fd67bc8ad7a3cb33da97222..90219ac821682b2f6d95702477c79911d0109365 100644 (file)
@@ -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,
index 9e2083b8383d24916e981f49e02d480ca9c321cd..7f864d66ffafa806bb8a5ec193a58b8955eb45af 100644 (file)
@@ -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 (file)
index 0000000..e7fd923
--- /dev/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;