+2013-04-23 Vincent Celier <celier@adacore.com>
+
+ * prj-part.ads, prj-conf.ads: Minor comment updates.
+
+2013-04-23 Ed Schonberg <schonberg@adacore.com>
+
+ * einfo.adb (Predicate_Function): For a private type, retrieve
+ predicate function from full view.
+ * aspects.adb (Find_Aspect): Ditto.
+ * exp_ch6.adb (Expand_Actuals): If the formal is class-wide and
+ the actual is a definite type, apply predicate check after call.
+ * sem_res.adb: Do not apply a predicate check before the call to
+ a generated Init_Proc.
+
2013-04-23 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications): Significant
if Is_Class_Wide_Type (Owner) and then Inherited_Aspect (A) then
Owner := Root_Type (Owner);
end if;
+
+ if Is_Private_Type (Owner)
+ and then Present (Full_View (Owner))
+ then
+ Owner := Full_View (Owner);
+ end if;
end if;
-- Search the representation items for the desired aspect
function Predicate_Function (Id : E) return E is
S : Entity_Id;
+ T : Entity_Id;
begin
pragma Assert (Is_Type (Id));
- if No (Subprograms_For_Type (Id)) then
+ -- If type is private and has a completion, predicate may be defined
+ -- on the full view.
+
+ if Is_Private_Type (Id) and then Present (Full_View (Id)) then
+ T := Full_View (Id);
+ else
+ T := Id;
+ end if;
+
+ if No (Subprograms_For_Type (T)) then
return Empty;
else
- S := Subprograms_For_Type (Id);
+ S := Subprograms_For_Type (T);
while Present (S) loop
if Is_Predicate_Function (S) then
return S;
-- this is harder to verify, and there may be a redundant check.
-- Note also that Subp may be either a subprogram entity for
- -- direct calls, or a type entity for indirect calls, hence the
- -- test that Is_Overloadable returns True before testing whether
- -- Subp is an inherited operation.
+ -- direct calls, or a type entity for indirect calls, which must
+ -- be handled separately because the name does not denote an
+ -- overloadable entity.
- if (Present (Find_Aspect (E_Actual, Aspect_Predicate))
+ -- If the formal is class-wide the corresponding postcondition
+ -- procedure does not include a predicate call, so it has to be
+ -- generated explicitly.
+
+ if (Has_Aspect (E_Actual, Aspect_Predicate)
or else
- Present (Find_Aspect (E_Actual, Aspect_Dynamic_Predicate))
+ Has_Aspect (E_Actual, Aspect_Dynamic_Predicate)
or else
- Present (Find_Aspect (E_Actual, Aspect_Static_Predicate)))
+ Has_Aspect (E_Actual, Aspect_Static_Predicate))
and then not Is_Init_Proc (Subp)
then
if (Is_Derived_Type (E_Actual)
then
Append_To
(Post_Call, Make_Predicate_Check (E_Actual, Actual));
+
+ elsif Is_Class_Wide_Type (E_Formal)
+ and then not Is_Class_Wide_Type (E_Actual)
+ then
+ Append_To
+ (Post_Call, Make_Predicate_Check (E_Actual, Actual));
end if;
end if;
--
-- If Implicit_Project is True, the main project file being parsed is
-- deemed to be in the current working directory, even if it is not the
- -- case.
- -- Why is this ever useful???
+ -- case. Implicit_Project is set to True when a tool such as gprbuild is
+ -- invoked without a project file and is using an implicit project file
+ -- that is virtually in the current working directory, but is physically
+ -- in another directory.
procedure Process_Project_And_Apply_Config
(Main_Project : out Prj.Project_Id;
--
-- If Implicit_Project is True, the main project file being parsed is
-- deemed to be in the current working directory, even if it is not the
- -- case.
- -- Why is this ever useful???
+ -- case. Implicit_Project is set to True when a tool such as gprbuild is
+ -- invoked without a project file and is using an implicit project file
+ -- that is virtually in the current working directory, but is physically
+ -- in another directory.
end Prj.Part;
-- Apply predicate checks, unless this is a call to the
-- predicate check function itself, which would cause an
- -- infinite recursion.
+ -- infinite recursion, or it is a call to an initialization
+ -- procedure whose operand is of course an unfinished object.
if not (Ekind (Nam) = E_Function
and then (Is_Predicate_Function (Nam)
- or else
- Is_Predicate_Function_M (Nam)))
+ or else Is_Predicate_Function_M (Nam)))
+ and then not Is_Init_Proc (Nam)
then
Apply_Predicate_Check (A, F_Typ);
end if;