+2011-09-05 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_disp.adb (Find_Controlling_Arg): Add checks for
+ interface type conversions, that are expanded into dereferences.
+
+2011-09-05 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch6.adb (Analyze_Subprogram_Body_Helper):
+ Examine the parameter and return profile of a subprogram and swap
+ any incomplete types coming from a limited context with their
+ corresponding non-limited views.
+ (Exchange_Limited_Views): New routine.
+
+2011-09-05 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb (Prepare_Private_Subtype_Completion): Set parent
+ of internal entity to the subtype declaration, so that when
+ entities are subsequently exchanged in a package body, the tree
+ remains properly formatted for ASIS.
+
2011-09-05 Johannes Kanig <kanig@adacore.com>
* g-comlin.adb (Set_Usage): Additional optional argument to set help
-- The Base_Type is already completed, we can complete the subtype
-- now. We have to create a new entity with the same name, Thus we
- -- can't use Create_Itype.
+ -- can't use Create_Itype. The entity may be exchanged when entering
+ -- exiting a package body, so it has to have a proper parent field,
+ -- so that the tree is always properly formatted for ASIS.
-- This is messy, should be fixed ???
Full := Make_Defining_Identifier (Sloc (Id), Chars (Id));
Set_Is_Itype (Full);
Set_Associated_Node_For_Itype (Full, Related_Nod);
+ Set_Parent (Full, Parent (Id));
Complete_Private_Subtype (Id, Full, Full_B, Related_Nod);
end if;
-- mechanism is used to find the corresponding spec of the primitive
-- body.
+ procedure Exchange_Limited_Views (Subp_Id : Entity_Id);
+ -- Ada 2012 (AI05-0151): Detect whether the profile of Subp_Id contains
+ -- incomplete types coming from a limited context and swap their limited
+ -- views with the non-limited ones.
+
function Is_Private_Concurrent_Primitive
(Subp_Id : Entity_Id) return Boolean;
-- Determine whether subprogram Subp_Id is a primitive of a concurrent
return Spec_N;
end Disambiguate_Spec;
+ ----------------------------
+ -- Exchange_Limited_Views --
+ ----------------------------
+
+ procedure Exchange_Limited_Views (Subp_Id : Entity_Id) is
+ procedure Detect_And_Exchange (Id : Entity_Id);
+ -- Determine whether Id's type denotes an incomplete type associated
+ -- with a limited with clause and exchange the limited view with the
+ -- non-limited one.
+
+ -------------------------
+ -- Detect_And_Exchange --
+ -------------------------
+
+ procedure Detect_And_Exchange (Id : Entity_Id) is
+ Typ : constant Entity_Id := Etype (Id);
+
+ begin
+ if Ekind (Typ) = E_Incomplete_Type
+ and then From_With_Type (Typ)
+ and then Present (Non_Limited_View (Typ))
+ then
+ Set_Etype (Id, Non_Limited_View (Typ));
+ end if;
+ end Detect_And_Exchange;
+
+ -- Local variables
+
+ Formal : Entity_Id;
+
+ -- Start of processing for Exchange_Limited_Views
+
+ begin
+ if No (Subp_Id) then
+ return;
+
+ -- Do not process subprogram bodies as they already use the non-
+ -- limited view of types.
+
+ elsif not Ekind_In (Subp_Id, E_Function, E_Procedure) then
+ return;
+ end if;
+
+ -- Examine all formals and swap views when applicable
+
+ Formal := First_Formal (Subp_Id);
+ while Present (Formal) loop
+ Detect_And_Exchange (Formal);
+
+ Next_Formal (Formal);
+ end loop;
+
+ -- Process the return type of a function
+
+ if Ekind (Subp_Id) = E_Function then
+ Detect_And_Exchange (Subp_Id);
+ end if;
+ end Exchange_Limited_Views;
+
-------------------------------------
-- Is_Private_Concurrent_Primitive --
-------------------------------------
(Sloc (N), Spec_Id, Prot_Typ, N, Declarations (N));
end if;
+ -- Ada 2012 (AI05-0151): Incomplete types coming from a limited context
+ -- may now appear in parameter and result profiles. Since the analysis
+ -- of a subprogram body may use the parameter and result profile of the
+ -- spec, swap any limited views with their non-limited counterpart.
+
+ if Ada_Version >= Ada_2012 then
+ Exchange_Limited_Views (Spec_Id);
+ end if;
+
-- Analyze the declarations (this call will analyze the precondition
-- Check pragmas we prepended to the list, as well as the declaration
-- of the _Postconditions procedure).
then
return Controlling_Argument (Orig_Node);
+ -- Type conversions are dynamically tagged if the target type, or its
+ -- designated type, are classwide. An interface conversion expands into
+ -- a dereference, so test must be performed on the original node.
+
+ elsif Nkind (Orig_Node) = N_Type_Conversion
+ and then Nkind (N) = N_Explicit_Dereference
+ and then Is_Controlling_Actual (N)
+ then
+ declare
+ Target_Type : constant Entity_Id :=
+ Entity (Subtype_Mark (Orig_Node));
+
+ begin
+ if Is_Class_Wide_Type (Target_Type) then
+ return N;
+
+ elsif Is_Access_Type (Target_Type)
+ and then Is_Class_Wide_Type (Designated_Type (Target_Type))
+ then
+ return N;
+
+ else
+ return Empty;
+ end if;
+ end;
+
-- Normal case
elsif Is_Controlling_Actual (N)
projects / platform / upstream / gcc.git / commitdiff