This patch detects an error that was previously undetected. In particular, it
is illegal to rename a subcomponent of an object designated by an
access-to-constant value if that subcomponent depends on discriminants.
The following test should get an error:
% gnatmake -f -q acc_const_test.adb
acc_const_test.adb:17:46: illegal renaming of discriminant-dependent component
gnatmake: "acc_const_test.adb" compilation error
%
with Ada.Text_IO; use Ada.Text_IO;
procedure Acc_Const_Test is
subtype Int is Integer range 1..100;
type Desig (Discrim : Int := 1) is
record
Discrim_Dependent : String (1..Discrim);
end record;
type Ref_Const is access constant Desig;
Var : aliased Desig := (Discrim => 4, Discrim_Dependent => "abcd");
Ref_Const_Obj : Ref_Const := Var'Access;
Char : Character renames Ref_Const_Obj.all.Discrim_Dependent(4);
-- Illegal in Ada 2005.
begin
Var := (Discrim => 1, Discrim_Dependent => "X");
-- Raises C_E in Ada 95.
Put_Line ("Char = " & Char);
end Acc_Const_Test;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-05-21 Bob Duff <d...@adacore.com>
* sem_util.adb (Is_Dependent_Component_Of_Mutable_Object):
This was returning False if the Object is a constant view. Fix
it to return True in that case, because it might be a view of
a variable.
(Has_Discriminant_Dependent_Constraint): Fix latent
bug; this function was crashing when passed a discriminant.
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 210689)
+++ sem_util.adb (working copy)
@@ -7300,39 +7300,46 @@
(Comp : Entity_Id) return Boolean
is
Comp_Decl : constant Node_Id := Parent (Comp);
- Subt_Indic : constant Node_Id :=
- Subtype_Indication (Component_Definition (Comp_Decl));
+ Subt_Indic : Node_Id;
Constr : Node_Id;
Assn : Node_Id;
begin
- if Nkind (Subt_Indic) = N_Subtype_Indication then
- Constr := Constraint (Subt_Indic);
+ -- Discriminants can't depend on discriminants
- if Nkind (Constr) = N_Index_Or_Discriminant_Constraint then
- Assn := First (Constraints (Constr));
- while Present (Assn) loop
- case Nkind (Assn) is
- when N_Subtype_Indication |
- N_Range |
- N_Identifier
- =>
- if Depends_On_Discriminant (Assn) then
- return True;
- end if;
+ if Ekind (Comp) = E_Discriminant then
+ return False;
- when N_Discriminant_Association =>
- if Depends_On_Discriminant (Expression (Assn)) then
- return True;
- end if;
+ else
+ Subt_Indic := Subtype_Indication (Component_Definition (Comp_Decl));
- when others =>
- null;
+ if Nkind (Subt_Indic) = N_Subtype_Indication then
+ Constr := Constraint (Subt_Indic);
- end case;
+ if Nkind (Constr) = N_Index_Or_Discriminant_Constraint then
+ Assn := First (Constraints (Constr));
+ while Present (Assn) loop
+ case Nkind (Assn) is
+ when N_Subtype_Indication |
+ N_Range |
+ N_Identifier
+ =>
+ if Depends_On_Discriminant (Assn) then
+ return True;
+ end if;
- Next (Assn);
- end loop;
+ when N_Discriminant_Association =>
+ if Depends_On_Discriminant (Expression (Assn)) then
+ return True;
+ end if;
+
+ when others =>
+ null;
+ end case;
+
+ Next (Assn);
+ end loop;
+ end if;
end if;
end if;
@@ -9740,11 +9747,6 @@
function Is_Dependent_Component_Of_Mutable_Object
(Object : Node_Id) return Boolean
is
- P : Node_Id;
- Prefix_Type : Entity_Id;
- P_Aliased : Boolean := False;
- Comp : Entity_Id;
-
function Is_Declared_Within_Variant (Comp : Entity_Id) return Boolean;
-- Returns True if and only if Comp is declared within a variant part
@@ -9759,17 +9761,41 @@
return Nkind (Parent (Comp_List)) = N_Variant;
end Is_Declared_Within_Variant;
+ P : Node_Id;
+ Prefix_Type : Entity_Id;
+ P_Aliased : Boolean := False;
+ Comp : Entity_Id;
+
+ Deref : Node_Id := Object;
+ -- Dereference node, in something like X.all.Y(2)
+
-- Start of processing for Is_Dependent_Component_Of_Mutable_Object
begin
- if Is_Variable (Object) then
+ -- Find the dereference node if any
+ while Nkind_In (Deref, N_Indexed_Component,
+ N_Selected_Component,
+ N_Slice)
+ loop
+ Deref := Prefix (Deref);
+ end loop;
+
+ -- Ada 2005: If we have a component or slice of a dereference,
+ -- something like X.all.Y (2), and the type of X is access-to-constant,
+ -- Is_Variable will return False, because it is indeed a constant
+ -- view. But it might be a view of a variable object, so we want the
+ -- following condition to be True in that case.
+
+ if Is_Variable (Object)
+ or else (Ada_Version >= Ada_2005
+ and then Nkind (Deref) = N_Explicit_Dereference)
+ then
if Nkind (Object) = N_Selected_Component then
P := Prefix (Object);
Prefix_Type := Etype (P);
if Is_Entity_Name (P) then
-
if Ekind (Entity (P)) = E_Generic_In_Out_Parameter then
Prefix_Type := Base_Type (Prefix_Type);
end if;
@@ -9801,10 +9827,10 @@
-- the dereferenced case, since the access value might denote an
-- unconstrained aliased object, whereas in Ada 95 the designated
-- object is guaranteed to be constrained. A worst-case assumption
- -- has to apply in Ada 2005 because we can't tell at compile time
- -- whether the object is "constrained by its initial value"
- -- (despite the fact that 3.10.2(26/2) and 8.5.1(5/2) are
- -- semantic rules -- these rules are acknowledged to need fixing).
+ -- has to apply in Ada 2005 because we can't tell at compile
+ -- time whether the object is "constrained by its initial value"
+ -- (despite the fact that 3.10.2(26/2) and 8.5.1(5/2) are semantic
+ -- rules (these rules are acknowledged to need fixing).
if Ada_Version < Ada_2005 then
if Is_Access_Type (Prefix_Type)
@@ -9813,7 +9839,7 @@
return False;
end if;
- elsif Ada_Version >= Ada_2005 then
+ else pragma Assert (Ada_Version >= Ada_2005);
if Is_Access_Type (Prefix_Type) then
-- If the access type is pool-specific, and there is no
