* [Ada] Type conversion to String causes Constraint_Error
@ 2014-11-20 14:33 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2014-11-20 14:33 UTC (permalink / raw)
To: gcc-patches; +Cc: Hristian Kirtchev
[-- Attachment #1: Type: text/plain, Size: 1617 bytes --]
This patch modifies the mechanism which creates a subtype from an arbitrary
expression. The mechanism now captures the bounds of all index constraints
when the expression is of an array type.
------------
-- Source --
------------
-- pack.ads
with Ada.Finalization; use Ada.Finalization;
package Pack is
type Ctrl is new Controlled with record
Flag : Boolean := False;
end record;
type New_String is new String;
function Make_Ctrl return Ctrl;
function Make_String (Val : String) return New_String;
end Pack;
-- pack.adb
package body Pack is
function Make_Ctrl return Ctrl is
Result : Ctrl;
begin
return Result;
end Make_Ctrl;
function Make_String (Val : String) return New_String is
begin
return New_String (Val);
end Make_String;
end Pack;
-- pack2.ads
package Pack2 is
procedure Reproduce;
end Pack2;
-- pack2.adb
with Ada.Text_IO; use Ada.Text_IO;
with Pack; use Pack;
package body Pack2 is
Str : constant New_String := Make_String ("Hello");
Ctr : constant Ctrl := Make_Ctrl;
procedure Reproduce is
begin
Put_Line (String (Str));
end Reproduce;
end Pack2;
-- main.adb
with Pack2; use Pack2;
procedure Main is
begin
Reproduce;
end Main;
----------------------------
-- Compilation and output --
----------------------------
$ gnatmake -q main.adb
$ ./main
Hello
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-11-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb (Make_Subtype_From_Expr): Capture the bounds of
all index constracts when the expression is of an array type.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 4645 bytes --]
Index: exp_util.adb
===================================================================
--- exp_util.adb (revision 217854)
+++ exp_util.adb (working copy)
@@ -6399,22 +6399,24 @@
(E : Node_Id;
Unc_Typ : Entity_Id) return Node_Id
is
+ List_Constr : constant List_Id := New_List;
Loc : constant Source_Ptr := Sloc (E);
- List_Constr : constant List_Id := New_List;
D : Entity_Id;
+ Full_Exp : Node_Id;
+ Full_Subtyp : Entity_Id;
+ High_Bound : Entity_Id;
+ Index_Typ : Entity_Id;
+ Low_Bound : Entity_Id;
+ Priv_Subtyp : Entity_Id;
+ Utyp : Entity_Id;
- Full_Subtyp : Entity_Id;
- Priv_Subtyp : Entity_Id;
- Utyp : Entity_Id;
- Full_Exp : Node_Id;
-
begin
if Is_Private_Type (Unc_Typ)
and then Has_Unknown_Discriminants (Unc_Typ)
then
- -- Prepare the subtype completion, Go to base type to
- -- find underlying type, because the type may be a generic
- -- actual or an explicit subtype.
+ -- Prepare the subtype completion. Use the base type to find the
+ -- underlying type because the type may be a generic actual or an
+ -- explicit subtype.
Utyp := Underlying_Type (Base_Type (Unc_Typ));
Full_Subtyp := Make_Temporary (Loc, 'C');
@@ -6451,22 +6453,67 @@
return New_Occurrence_Of (Priv_Subtyp, Loc);
elsif Is_Array_Type (Unc_Typ) then
+ Index_Typ := First_Index (Unc_Typ);
for J in 1 .. Number_Dimensions (Unc_Typ) loop
- Append_To (List_Constr,
- Make_Range (Loc,
- Low_Bound =>
+
+ -- Capture the bounds of each index constraint in case the context
+ -- is an object declaration of an unconstrained type initialized
+ -- by a function call:
+
+ -- Obj : Unconstr_Typ := Func_Call;
+
+ -- This scenario requires secondary scope management and the index
+ -- constraint cannot depend on the temporary used to capture the
+ -- result of the function call.
+
+ -- SS_Mark;
+ -- Temp : Unconstr_Typ_Ptr := Func_Call'reference;
+ -- subtype S is Unconstr_Typ (Temp.all'First .. Temp.all'Last);
+ -- Obj : S := Temp.all;
+ -- SS_Release; -- Temp is gone at this point, bounds of S are
+ -- -- non existent.
+
+ -- The bounds are kept as variables rather than constants because
+ -- this prevents spurious optimizations down the line.
+
+ -- Generate:
+ -- Low_Bound : Base_Type (Index_Typ) := E'First (J);
+
+ Low_Bound := Make_Temporary (Loc, 'B');
+ Insert_Action (E,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Low_Bound,
+ Object_Definition =>
+ New_Occurrence_Of (Base_Type (Etype (Index_Typ)), Loc),
+ Expression =>
Make_Attribute_Reference (Loc,
- Prefix => Duplicate_Subexpr_No_Checks (E),
+ Prefix => Duplicate_Subexpr_No_Checks (E),
Attribute_Name => Name_First,
- Expressions => New_List (
- Make_Integer_Literal (Loc, J))),
+ Expressions => New_List (
+ Make_Integer_Literal (Loc, J)))));
- High_Bound =>
+ -- Generate:
+ -- High_Bound : Base_Type (Index_Typ) := E'Last (J);
+
+ High_Bound := Make_Temporary (Loc, 'B');
+ Insert_Action (E,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => High_Bound,
+ Object_Definition =>
+ New_Occurrence_Of (Base_Type (Etype (Index_Typ)), Loc),
+ Expression =>
Make_Attribute_Reference (Loc,
Prefix => Duplicate_Subexpr_No_Checks (E),
Attribute_Name => Name_Last,
Expressions => New_List (
Make_Integer_Literal (Loc, J)))));
+
+ Append_To (List_Constr,
+ Make_Range (Loc,
+ Low_Bound => New_Occurrence_Of (Low_Bound, Loc),
+ High_Bound => New_Occurrence_Of (High_Bound, Loc)));
+
+ Index_Typ := Next_Index (Index_Typ);
end loop;
elsif Is_Class_Wide_Type (Unc_Typ) then
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2014-11-20 14:29 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2014-11-20 14:33 [Ada] Type conversion to String causes Constraint_Error Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).