diff mbox series

[COMMITTED,04/35] ada: Fix checking range constraints within composite types

Message ID 20240517083207.130391-4-poulhies@adacore.com
State New
Headers show
Series [COMMITTED,01/35] ada: Add support for 'Object_Size to pragma Compile_Time_{Warning, Error} | expand

Commit Message

Marc Poulhiès May 17, 2024, 8:31 a.m. UTC
From: Viljar Indus <indus@adacore.com>

Subtype indications were never analyzed if they were
within composite types. Analyze them explicitly within
Analyze_Component_Declaration.

gcc/ada/

	* sem_ch3.adb (Analyze_Component_Declaration):
	Add Range_Checks for Subtype_Indications

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_ch3.adb | 50 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 50 insertions(+)
diff mbox series

Patch

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index c3f216c826c..7ee4ca299d9 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1965,6 +1965,9 @@  package body Sem_Ch3 is
       --  a limited type. Used to validate declaration against that of
       --  enclosing record.
 
+      procedure Add_Range_Checks (Subt_Indic : Node_Id);
+      --  Adds range constraint checks for a subtype indication
+
       ----------------------
       -- Is_Known_Limited --
       ----------------------
@@ -1999,6 +2002,50 @@  package body Sem_Ch3 is
          end if;
       end Is_Known_Limited;
 
+      ----------------------
+      -- Add_Range_Checks --
+      ----------------------
+
+      procedure Add_Range_Checks (Subt_Indic : Node_Id)
+      is
+
+      begin
+         if Present (Subt_Indic) and then
+           Nkind (Subt_Indic) = N_Subtype_Indication and then
+           Nkind (Constraint (Subt_Indic)) = N_Index_Or_Discriminant_Constraint
+         then
+
+            declare
+               Typ : constant Entity_Id := Entity (Subtype_Mark (Subt_Indic));
+               Indic_Typ    : constant Entity_Id := Underlying_Type (Typ);
+               Subt_Index   : Node_Id;
+               Target_Index : Node_Id;
+            begin
+
+               if Present (Indic_Typ) and then Is_Array_Type (Indic_Typ) then
+
+                  Target_Index := First_Index (Indic_Typ);
+                  Subt_Index := First (Constraints (Constraint (Subt_Indic)));
+
+                  while Present (Target_Index) loop
+                     if Nkind (Subt_Index) in N_Expanded_Name | N_Identifier
+                     and then Nkind
+                        (Scalar_Range (Entity (Subt_Index))) = N_Range
+                     then
+                        Apply_Range_Check
+                           (Expr        => Scalar_Range (Entity (Subt_Index)),
+                            Target_Typ  => Etype (Target_Index),
+                            Insert_Node => Subt_Indic);
+                     end if;
+
+                     Next (Subt_Index);
+                     Next_Index (Target_Index);
+                  end loop;
+               end if;
+            end;
+         end if;
+      end Add_Range_Checks;
+
    --  Start of processing for Analyze_Component_Declaration
 
    begin
@@ -2224,6 +2271,9 @@  package body Sem_Ch3 is
       Analyze_Aspect_Specifications (N, Id);
 
       Analyze_Dimension (N);
+
+      Add_Range_Checks (Subtype_Indication (Component_Definition (N)));
+
    end Analyze_Component_Declaration;
 
    --------------------------