ada: Fix bogus error about null exclusion for designated type with multiple views

It comes from the new legality check retroactively introduced by AI12-0289,
but the implementation is fooled by the presence of both an incomplete and
a partial view for a tagged type.

gcc/ada/ChangeLog:

	PR ada/111433
	* sem_util.ads (Incomplete_Or_Partial_View): Add Partial_Only formal
	parameter.
	* sem_util.adb (Incomplete_Or_Partial_View): Likewise.  Do not look
	for an incomplete view if it is set to True.
	* sem_ch6.adb (Check_Conformance.Null_Exclusions_Match): Pass True
	for Partial_Only in the call to Incomplete_Or_Partial_View.

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 53c292742815084457ef7634b392b57938910f5a..a6db10512b6248a3a0ec77e01cc96516eb821eb4 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -5732,7 +5732,7 @@ package body Sem_Ch6 is
             declare
                D : constant Entity_Id := Directly_Designated_Type (Etype (F1));
                Partial_View_Of_Desig : constant Entity_Id :=
-                 Incomplete_Or_Partial_View (D);
+                 Incomplete_Or_Partial_View (D, Partial_Only => True);
             begin
                return No (Partial_View_Of_Desig)
                  or else Is_Tagged_Type (Partial_View_Of_Desig)

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 8ee218d0cde842f06da1a8f5434c919d80357dc8..e23d875f3f4f9803537e40a2fd023421493bc1ed 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -14914,7 +14914,9 @@ package body Sem_Util is
    -- Incomplete_Or_Partial_View --
    --------------------------------
 
-   function Incomplete_Or_Partial_View (Id : Entity_Id) return Entity_Id is
+   function Incomplete_Or_Partial_View
+     (Id : Entity_Id; Partial_Only : Boolean := False) return Entity_Id
+   is
       S : constant Entity_Id := Scope (Id);
 
       function Inspect_Decls
@@ -14997,6 +14999,7 @@ package body Sem_Util is
         and then (Is_Incomplete_Type (Prev) or else Ekind (Prev) = E_Constant)
         and then Present (Full_View (Prev))
         and then Full_View (Prev) = Id
+        and then not Partial_Only
       then
          return Prev;
       end if;
@@ -15008,7 +15011,7 @@ package body Sem_Util is
             Pkg_Decl : constant Node_Id := Package_Specification (S);
 
          begin
-            --  It is knows that Typ has a private view, look for it in the
+            --  It is known that Typ has a private view, look for it in the
             --  visible declarations of the enclosing scope. A special case
             --  of this is when the two views have been exchanged - the full
             --  appears earlier than the private.
@@ -15028,7 +15031,7 @@ package body Sem_Util is
             --  Taft amendment type. The incomplete view should be located in
             --  the private declarations of the enclosing scope.
 
-            elsif In_Package_Body (S) then
+            elsif In_Package_Body (S) and then not Partial_Only then
                return Inspect_Decls (Private_Declarations (Pkg_Decl), True);
             end if;
          end;

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 144fcd151bf1a37467377346d6b4833bf4593871..ab0f305425d73eb62d7aa1df70937fb9515a2b95 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1751,9 +1751,11 @@ package Sem_Util is
    --  package specification. The package must be on the scope stack, and the
    --  corresponding private part must not.
 
-   function Incomplete_Or_Partial_View (Id : Entity_Id) return Entity_Id;
+   function Incomplete_Or_Partial_View
+     (Id : Entity_Id; Partial_Only : Boolean := False) return Entity_Id;
    --  Given the entity of a constant or a type, retrieve the incomplete or
-   --  partial view of the same entity. Note that Id may not have a partial
+   --  partial view of the same entity. If Partial_Only is True, retrieve
+   --  only the partial view of a type. Note that Id may not have a partial
    --  view in which case the function returns Empty.
 
    function Incomplete_View_From_Limited_With