This set of changes improves support for AI05-0234's rules about how the
accessibility level of a function result object may be determined
by the point of call. The following test is intended to test this support.
The test should execute without producing output. Because this is an Ada2012
test, it must be compiled with the -gnat2012 option specified.
procedure Check1 is
subtype Subtest_Id is Integer range 1 .. 6;
type Count is mod 3;
Counter : Count := 0;
Test_Failed : exception;
type Drec (Int_Ref : access Integer) is
record F1, F2 : Integer := 0; end record;
type Global_Ref is access Drec;
Global_Ptr : Global_Ref;
procedure Nested (Subtest : Subtest_Id) is
type Local_Ref is access Drec;
Local_Ptr : Local_Ref;
Local_Var : aliased Integer;
Local_Drec : Drec (Local_Var'Access);
function Checker return Drec is
begin
case Subtest is
when 1 =>
-- positional aggregate
return Drec'(Local_Var'Access, 123, 456);
when 2 =>
-- named aggregate
return Drec'(Int_Ref => Local_Var'Access,
F1 => 123, F2 => 456);
when 3 =>
-- mixed aggragate
return Drec'(F1 => 123,
Int_Ref => Local_Var'Access, F2 => 456);
when 4 =>
-- extended return object subtype constrained
return X : Drec (Local_Var'Access);
when 5 =>
-- extended return object subtype unconstrained
return X : Drec := Drec'(Local_Var'Access, 123, 455);
when 6 =>
-- return existing object
return Local_Drec;
end case;
end Checker;
function Checker_Wrapper return Drec is
begin
Counter := Counter + 1;
if Counter = 0 then
return Checker;
else
return Result : Drec := Checker;
end if;
end Checker_Wrapper;
Checkers : constant array (1..2) of access function return Drec
:= (Checker'Access, Checker_Wrapper'Access);
begin
Local_Ptr := new Drec'(Checker);
begin
Global_Ptr := new Drec'(Checker);
raise Test_Failed;
exception
when Program_Error =>
null;
end;
Local_Ptr := new Drec'(Checker_Wrapper);
begin
Global_Ptr := new Drec'(Checker_Wrapper);
raise Test_Failed;
exception
when Program_Error =>
null;
end;
for Index in Checkers'Range loop
Local_Ptr := new Drec'(Checkers (Index).all);
begin
Global_Ptr := new Drec'(Checkers (Index).all);
raise Test_Failed;
exception
when Program_Error =>
null;
end;
end loop;
end Nested;
begin
for Subtest in Subtest_Id loop
Nested (Subtest);
end loop;
end Check1;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-06 Steve Baird <ba...@adacore.com>
* einfo.ads (Extra_Accessibility): Update associated comment to use
the term "present" correctly ("present" just means that it is not
an error to query the value of the attribute - it does not imply
that the value must be non-null).
(Extra_Constrained): Ditto.
(Is_Visible_Formal): Ditto.
(Extra_Accessibility_Of_Result) Ditto; also add Inline pragma.
(Set_Extra_Accessibility_Of_Result): Add Inline pragma.
* exp_ch4.adb (Expand_Allocator_Expression): Improve a comment.
* exp_ch6.adb (Expand_Call): The callee may require an
Extra_Accessibility_Of_Result actual parameter even if Ada_Version
< Ada_2012. This can occur if the callee is exported from a Gnat
runtimes unit. Also improve a comment.
Index: einfo.ads
===================================================================
--- einfo.ads (revision 178567)
+++ einfo.ads (working copy)
@@ -1120,9 +1120,9 @@
-- or entry. Returns Empty if there are no extra formals.
-- Extra_Accessibility (Node13)
--- Present in formal parameters in the non-generic case if expansion is
--- active. Normally Empty, but if a parameter is one for which a dynamic
--- accessibility check is required, then an extra formal of type
+-- Present in formal parameters in the non-generic case. Normally Empty,
+-- but if expansion is active, and a parameter is one for which a
+-- dynamic accessibility check is required, then an extra formal of type
-- Natural is created (see description of field Extra_Formal), and the
-- Extra_Accessibility field of the formal parameter points to the entity
-- for this extra formal. Also present in variables when compiling
@@ -1133,16 +1133,16 @@
-- Extra_Accessibility_Of_Result (Node19)
-- Present in (non-generic) Function, Operator, and Subprogram_Type
--- entities if expansion is active. Normally Empty, but if a function is
--- one for which "the accessibility level of the result ... determined
+-- entities. Normally Empty, but if expansion is active, and a function
+-- is one for which "the accessibility level of the result ... determined
-- by the point of call" (AI05-0234) is needed, then an extra formal of
-- subtype Natural is created (see description of field Extra_Formal),
-- and the Extra_Accessibility_Of_Result field of the function points to
-- the entity for this extra formal.
-- Extra_Constrained (Node23)
--- Present in formal parameters in the non-generic case if expansion is
--- active. Normally Empty, but if a parameter is one for which a dynamic
+-- Present in formal parameters in the non-generic case. Normally Empty,
+-- but if expansion is active and a parameter is one for which a dynamic
-- indication of its constrained status is required, then an extra formal
-- of type Boolean is created (see description of field Extra_Formal),
-- and the Extra_Constrained field of the formal parameter points to the
@@ -2853,11 +2853,10 @@
-- visible by selected notation, or not.
-- Is_Visible_Formal (Flag206)
--- Present in all entities. Set for instances of the formals of a formal
--- package. Indicates that the entity must be made visible in the body
--- of the instance, to reproduce the visibility of the generic. This
--- simplifies visibility settings in instance bodies.
--- ??? confusion in above comments between being present and being set
+-- Present in all entities. Set True for instances of the formals of a
+-- formal package. Indicates that the entity must be made visible in the
+-- body of the instance, to reproduce the visibility of the generic.
+-- This simplifies visibility settings in instance bodies.
-- Is_VMS_Exception (Flag133)
-- Present in all entities. Set only for exception entities where the
@@ -7373,6 +7372,7 @@
pragma Inline (Esize);
pragma Inline (Exception_Code);
pragma Inline (Extra_Accessibility);
+ pragma Inline (Extra_Accessibility_Of_Result);
pragma Inline (Extra_Constrained);
pragma Inline (Extra_Formal);
pragma Inline (Extra_Formals);
@@ -7817,6 +7817,7 @@
pragma Inline (Set_Esize);
pragma Inline (Set_Exception_Code);
pragma Inline (Set_Extra_Accessibility);
+ pragma Inline (Set_Extra_Accessibility_Of_Result);
pragma Inline (Set_Extra_Constrained);
pragma Inline (Set_Extra_Formal);
pragma Inline (Set_Extra_Formals);
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 178567)
+++ exp_ch4.adb (working copy)
@@ -765,8 +765,6 @@
-- Start of processing for Expand_Allocator_Expression
begin
- -- Messy???
-
-- In the case of an Ada2012 allocator whose initial value comes from a
-- function call, pass "the accessibility level determined by the point
-- of call" (AI05-0234) to the function. Conceptually, this belongs in
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 178568)
+++ exp_ch6.adb (working copy)
@@ -2753,8 +2753,7 @@
-- "accessibility level determined by the point of call" (AI05-0234)
-- passed in to it, then pass it in.
- if Ada_Version >= Ada_2012
- and then Ekind_In (Subp, E_Function, E_Operator, E_Subprogram_Type)
+ if Ekind_In (Subp, E_Function, E_Operator, E_Subprogram_Type)
and then Present (Extra_Accessibility_Of_Result (Subp))
then
declare
@@ -2781,8 +2780,6 @@
case Nkind (Ancestor) is
when N_Allocator =>
- -- Messy code, could use a cleanup???
-
-- At this point, we'd like to assign
-- Level := Dynamic_Accessibility_Level (Ancestor);
