]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Fix usage of Table.Table in Sem_Ch12
authorRonan Desplanques <desplanques@adacore.com>
Thu, 25 Sep 2025 09:33:13 +0000 (11:33 +0200)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Tue, 28 Oct 2025 10:24:05 +0000 (11:24 +0100)
Before this patch, Sem_Ch12 jumped through questionable hoops in the way
it used its Generics_Renaming table that involved defensive calls to the
'Valid attribute. No known bug has been caused by this, but valgrind
reported incorrect memory operations because of it.

After analysis, the problem seems to be a mix 0-based and 1-based
indexing in the uses of Generic_Renamings and a convoluted interface for
the Set_Instance_Of procedure, leading to an unclear status for
Generic_Renamings.Table (0).

This patch fixes those problems and removes the accompanying defensive
code.

gcc/ada/ChangeLog:

* sem_ch12.adb (Build_Local_Package)
(Analyze_Package_Instantiation, Analyze_Subprogram_Instantiation):
Fix Set_Last calls.
(Set_Instance_Of): Use Table.Table.Append.
(Save_And_Reset): Remove useless call. Remove defensive code.
(Restore): Remove incorrect Set_Last call and adapt to
Set_Instance_Of change.

gcc/ada/sem_ch12.adb

index 9acf193267868eaef8536559dc3c6e5a3405c4b0..fa68c3eea2007ae42c1b038488c8feb7d0dcba30 100644 (file)
@@ -3653,7 +3653,7 @@ package body Sem_Ch12 is
                                Instantiating => True);
 
             begin
-               Generic_Renamings.Set_Last (0);
+               Generic_Renamings.Set_Last (-1);
                Generic_Renamings_HTable.Reset;
                Instantiation_Node := N;
 
@@ -5014,7 +5014,7 @@ package body Sem_Ch12 is
       --  inherited from formal packages of parent units, and these are
       --  constructed when the parents are installed.
 
-      Generic_Renamings.Set_Last (0);
+      Generic_Renamings.Set_Last (-1);
       Generic_Renamings_HTable.Reset;
 
       --  Except for an abbreviated instance created to check a formal package,
@@ -6979,7 +6979,7 @@ package body Sem_Ch12 is
 
          --  Initialize renamings map, for error checking
 
-         Generic_Renamings.Set_Last (0);
+         Generic_Renamings.Set_Last (-1);
          Generic_Renamings_HTable.Reset;
 
          Create_Instantiation_Source (N, Gen_Unit, S_Adjustment);
@@ -7254,7 +7254,7 @@ package body Sem_Ch12 is
          Restore_Hidden_Primitives (Vis_Prims_List);
          Restore_Env;
          Env_Installed := False;
-         Generic_Renamings.Set_Last (0);
+         Generic_Renamings.Set_Last (-1);
          Generic_Renamings_HTable.Reset;
       end if;
 
@@ -18721,9 +18721,8 @@ package body Sem_Ch12 is
 
    procedure Set_Instance_Of (A : Entity_Id; B : Entity_Id) is
    begin
-      Generic_Renamings.Table (Generic_Renamings.Last) := (A, B, Assoc_Null);
+      Generic_Renamings.Append ((A, B, Assoc_Null));
       Generic_Renamings_HTable.Set (Generic_Renamings.Last);
-      Generic_Renamings.Increment_Last;
    end Set_Instance_Of;
 
    --------------------
@@ -19364,31 +19363,12 @@ package body Sem_Ch12 is
                                                   (Assoc_Ptr (Index));
                   Result_Pair : Binding_Pair renames Result (Index);
                begin
-                  --  If we have called Increment_Last but have not yet
-                  --  initialized the new last element of the table, then
-                  --  that last element might be invalid. Saving and
-                  --  restoring (especially restoring, it turns out) invalid
-                  --  values can result in exceptions if predicate checking
-                  --  is enabled, so replace invalid values with Empty.
-
-                  if Indexed_Assoc.Gen_Id'Valid then
-                     Result_Pair.Formal_Id := Indexed_Assoc.Gen_Id;
-                  else
-                     pragma Assert (Index = Result'Last);
-                     Result_Pair.Formal_Id := Empty;
-                  end if;
-
-                  if Indexed_Assoc.Act_Id'Valid then
-                     Result_Pair.Actual_Id := Indexed_Assoc.Act_Id;
-                  else
-                     pragma Assert (Index = Result'Last);
-                     Result_Pair.Actual_Id := Empty;
-                  end if;
+                  Result_Pair.Formal_Id := Indexed_Assoc.Gen_Id;
+                  Result_Pair.Actual_Id := Indexed_Assoc.Act_Id;
                end;
             end loop;
 
             Generic_Renamings.Init;
-            Generic_Renamings.Set_Last (-1);
             Generic_Renamings_HTable.Reset;
          end return;
       end Save_And_Reset;
@@ -19400,13 +19380,10 @@ package body Sem_Ch12 is
       procedure Restore (Saved : Context) is
       begin
          Generic_Renamings.Init;
-         Generic_Renamings.Set_Last (0);
          Generic_Renamings_HTable.Reset;
-         Generic_Renamings.Increment_Last;
          for Pair of Saved loop
             Set_Instance_Of (Pair.Formal_Id, Pair.Actual_Id);
          end loop;
-         Generic_Renamings.Decrement_Last;
       end Restore;
 
    end Instance_Context;