[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b81550c73383b5d8469d28cab99c8694233d1a98..984e97d15235d2c9f53eed9bea605cec07065070 100644 (file)
--- 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 f63cd2b387a5c331de8f0268399560f4caef392f..b72debb8600c341ad4541a5bb0dce695d4d82f97 100644 (file)
--- 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 789a420704daa3d5637d13d50e308be90e226196..aa254f5f16d6dfd6139d4d804cd132cfb2ff3724 100644 (file)
--- 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 08e93c4a4a956081cf5b0384b257e818eeeca584..bbb7bde6bc0e926800efef834f29bc63d8ba9e21 100644 (file)
--- 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 172356f48ec1ddfbe455f5bb233c079c9180e6ac..1c72fa769baf3137062e46d89c569b94f2191120 100644 (file)
--- 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 438ec9dda945a868af519c7c85c256eefbc2b89b..1bf1366fb5c9704832cd841cce7ea7bc33ee18c7 100644 (file)
--- 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 db6ecf7ecfb82d8dd7a23a7c3930bc612743a565..ee2483bc53b09b558681764d0175992efe2f8100 100644 (file)
--- 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;