@@ -722,7 +722,7 @@ package body Checks is
-- Generate a check to raise PE if alignment may be inappropriate
else
- -- If the original expression is a non-static constant, use the name
+ -- If the original expression is a nonstatic constant, use the name
-- of the constant itself rather than duplicating its initialization
-- expression, which was extracted above.
@@ -4563,6 +4563,17 @@ package body Checks is
or else Assume_No_Invalid_Values
or else Assume_Valid
then
+ -- If this is a known valid constant with a nonstatic value, it may
+ -- have inherited a narrower subtype from its initial value; use this
+ -- saved subtype (see sem_ch3.adb).
+
+ if Is_Entity_Name (N)
+ and then Ekind (Entity (N)) = E_Constant
+ and then Present (Actual_Subtype (Entity (N)))
+ then
+ Typ := Actual_Subtype (Entity (N));
+ end if;
+
null;
else
Typ := Underlying_Type (Base_Type (Typ));
@@ -3657,7 +3657,7 @@ package body Sem_Ch3 is
Prev_Entity : Entity_Id := Empty;
procedure Check_Dynamic_Object (Typ : Entity_Id);
- -- A library-level object with non-static discriminant constraints may
+ -- A library-level object with nonstatic discriminant constraints may
-- require dynamic allocation. The declaration is illegal if the
-- profile includes the restriction No_Implicit_Heap_Allocations.
@@ -3672,7 +3672,7 @@ package body Sem_Ch3 is
-- This function is called when a non-generic library level object of a
-- task type is declared. Its function is to count the static number of
-- tasks declared within the type (it is only called if Has_Task is set
- -- for T). As a side effect, if an array of tasks with non-static bounds
+ -- for T). As a side effect, if an array of tasks with nonstatic bounds
-- or a variant record type is encountered, Check_Restriction is called
-- indicating the count is unknown.
@@ -4357,8 +4357,24 @@ package body Sem_Ch3 is
Set_Current_Value (Id, E);
end if;
- elsif Is_Scalar_Type (T) and then Is_OK_Static_Expression (E) then
+ elsif Is_Scalar_Type (T)
+ and then Is_OK_Static_Expression (E)
+ then
+ Set_Is_Known_Valid (Id);
+
+ -- If it is a constant initialized with a valid nonstatic entity,
+ -- the constant is known valid as well, and can inherit the subtype
+ -- of the entity if it is a subtype of the given type. This info
+ -- is preserved on the actual subtype of the constant.
+
+ elsif Is_Scalar_Type (T)
+ and then Is_Entity_Name (E)
+ and then Is_Known_Valid (Entity (E))
+ and then In_Subrange_Of (Etype (Entity (E)), T)
+ then
Set_Is_Known_Valid (Id);
+ Set_Ekind (Id, E_Constant);
+ Set_Actual_Subtype (Id, Etype (Entity (E)));
end if;
-- Deal with setting of null flags
@@ -5399,7 +5415,7 @@ package body Sem_Ch3 is
("subtype mark required", One_Cstr);
-- String subtype must have a lower bound of 1 in SPARK.
- -- Note that we do not need to test for the non-static case
+ -- Note that we do not need to test for the nonstatic case
-- here, since that was already taken care of in
-- Process_Range_Expr_In_Decl.
@@ -12471,7 +12487,7 @@ package body Sem_Ch3 is
end if;
-- It is unsafe to share the bounds of a scalar type, because the Itype
- -- is elaborated on demand, and if a bound is non-static then different
+ -- is elaborated on demand, and if a bound is nonstatic, then different
-- orders of elaboration in different units will lead to different
-- external symbols.
@@ -16421,7 +16437,7 @@ package body Sem_Ch3 is
-- Because the implicit base is used in the conversion of the bounds, we
-- have to freeze it now. This is similar to what is done for numeric
- -- types, and it equally suspicious, but otherwise a non-static bound
+ -- types, and it equally suspicious, but otherwise a nonstatic bound
-- will have a reference to an unfrozen type, which is rejected by Gigi
-- (???). This requires specific care for definition of stream
-- attributes. For details, see comments at the end of
@@ -19343,8 +19359,8 @@ package body Sem_Ch3 is
end if;
-- In the subtype indication case, if the immediate parent of the
- -- new subtype is non-static, then the subtype we create is non-
- -- static, even if its bounds are static.
+ -- new subtype is nonstatic, then the subtype we create is nonstatic,
+ -- even if its bounds are static.
if Nkind (N) = N_Subtype_Indication
and then not Is_OK_Static_Subtype (Entity (Subtype_Mark (N)))
This patch recognizes additional object declarations whose defining identifier is known statically to be valid. This allows additional optimizations to be performed by the front-end. Executing: gcc -c -gnatDG p.ads On the following sources: ---- with G; With Q; package P is Val : constant Positive := Q.Config_Value ("Size"); package My_G is new G (Val); end P; ---- generic Num : Natural := 0; package G is Multi : constant Boolean := Num > 0; type Info is array (True .. Multi) of Integer; type Arr is array (Natural range <>) of Boolean; type Rec (D : Natural) is record C : character; I : Info; E : Arr (0 .. D); end record; end G; ---- package Q is function Config_Value (S : String) return Integer; end Q; ---- Must yield (note that variable Multi has been statically optimized to true): ---- with g; with q; p_E : short_integer := 0; package p is p__R2s : constant integer := q.q__config_value ("Size"); [constraint_error when not (p__R2s >= 1) "range check failed"] p__val : constant positive := p__R2s; package p__my_g is p__my_g__num : constant natural := p__val; package p__my_g__g renames p__my_g; package p__my_g__gGH renames p__my_g__g; p__my_g__multi : constant boolean := true; type p__my_g__info is array (true .. p__my_g__multi) of integer; type p__my_g__arr is array (0 .. 16#7FFF_FFFF# range <>) of boolean; type p__my_g__rec (d : natural) is record c : character; i : p__my_g__info; e : p__my_g__arr (0 .. d); end record; [type p__my_g__TinfoB is array (true .. p__my_g__multi range <>) of integer] freeze p__my_g__TinfoB [ procedure p__my_g__TinfoBIP (_init : in out p__my_g__TinfoB) is begin null; return; end p__my_g__TinfoBIP; ] freeze p__my_g__info [] freeze p__my_g__arr [ procedure p__my_g__arrIP (_init : in out p__my_g__arr) is begin null; return; end p__my_g__arrIP; ] freeze p__my_g__rec [ procedure p__my_g__recIP (_init : in out p__my_g__rec; d : natural) is begin _init.d := d; null; return; end p__my_g__recIP; ] end p__my_g; package my_g is new g (p__val); end p; freeze_generic info [subtype TinfoD1 is boolean range true .. multi] freeze_generic TinfoD1 [type TinfoB is array (true .. multi range <>) of integer] freeze_generic TinfoB freeze_generic arr freeze_generic rec ---- Tested on x86_64-pc-linux-gnu, committed on trunk 2018-11-14 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * sem_ch3.adb (Analyze_Object_Declaration): Use the Actual_Subtype to preserve information about a constant initialized with a non-static entity that is known to be valid, when the type of the entity has a narrower range than that of the nominal subtype of the constant. * checks.adb (Determine_Range): If the expression is a constant entity that is known-valid and has a defined Actual_Subtype, use it to determine the actual bounds of the value, to enable additional optimizations.