[multiple changes]

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.

From-SVN: r198185

7 files changed, 60 insertions, 15 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b81550c..984e97d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+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
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index f63cd2b..b72debb 100644
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -163,6 +163,12 @@ package body Aspects is
          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
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 789a420..aa254f5 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -7168,15 +7168,25 @@ package body Einfo is
 
    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;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 08e93c4..bbb7bde 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1720,15 +1720,19 @@ package body Exp_Ch6 is
             --  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)
@@ -1738,6 +1742,12 @@ package body Exp_Ch6 is
                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;
 
diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads
index 172356f..1c72fa7 100644
--- a/gcc/ada/prj-conf.ads
+++ b/gcc/ada/prj-conf.ads
@@ -89,8 +89,10 @@ package Prj.Conf is
    --
    --  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;
diff --git a/gcc/ada/prj-part.ads b/gcc/ada/prj-part.ads
index 438ec9d..1bf1366 100644
--- a/gcc/ada/prj-part.ads
+++ b/gcc/ada/prj-part.ads
@@ -70,7 +70,9 @@ package Prj.Part is
    --
    --  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;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index db6ecf7..ee2483b 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3946,12 +3946,13 @@ package body Sem_Res is
 
                --  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;