[Ada] New flag to indicate whether aspect appears on partial view

2019-12-13  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sinfo.ads, sinfo.adb (Aspect_On_Partial_View,
	Set_Aspect_On_Partial_View): New flag for use by SPARK, to
	indicate whether an aspect that appears on a type declaration
	applies to the partial view of that type.
	* sem_ch13.adb (Analyze_Aspect_Specification): Set new flag
	appropriately.

From-SVN: r279339

4 files changed, 49 insertions, 0 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3423e2e..1c5d5bc 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2019-12-13  Ed Schonberg  <schonberg@adacore.com>
+
+	* sinfo.ads, sinfo.adb (Aspect_On_Partial_View,
+	Set_Aspect_On_Partial_View): New flag for use by SPARK, to
+	indicate whether an aspect that appears on a type declaration
+	applies to the partial view of that type.
+	* sem_ch13.adb (Analyze_Aspect_Specification): Set new flag
+	appropriately.
+
 2019-12-12  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch13.adb (Same_Reprewentation): if the actual in a call is
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index b6d9705..9c8a0cf 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -3788,6 +3788,15 @@ package body Sem_Ch13 is
                Set_From_Aspect_Specification (Aitem);
             end if;
 
+            --  For an aspect that applies to a type, indicate whether it
+            --  appears on a partial view of the type.
+
+            if Is_Type (E)
+              and then Is_Private_Type (E)
+            then
+               Set_Aspect_On_Partial_View (Aspect);
+            end if;
+
             --  In the context of a compilation unit, we directly put the
             --  pragma in the Pragmas_After list of the N_Compilation_Unit_Aux
             --  node (no delay is required here) except for aspects on a
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 2689ebe..b99a32d 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -269,6 +269,14 @@ package body Sinfo is
       return Node3 (N);
    end Array_Aggregate;
 
+   function Aspect_On_Partial_View
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Aspect_Specification);
+      return Flag18 (N);
+   end Aspect_On_Partial_View;
+
    function Aspect_Rep_Item
       (N : Node_Id) return Node_Id is
    begin
@@ -3763,6 +3771,14 @@ package body Sinfo is
       Set_Node3_With_Parent (N, Val);
    end Set_Array_Aggregate;
 
+   procedure Set_Aspect_On_Partial_View
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Aspect_Specification);
+      Set_Flag18 (N, Val);
+   end Set_Aspect_On_Partial_View;
+
    procedure Set_Aspect_Rep_Item
       (N : Node_Id; Val : Node_Id) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index c64a76f..5e04772 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -933,6 +933,12 @@ package Sinfo is
    --    is used for translation of the at end handler into a normal exception
    --    handler.
 
+   --  Aspect_On_Partial_View (Flag18)
+   --    Present on an N_Aspect_Specification node. For an aspect that applies
+   --    to a type entity, indicates whether the specification appears on the
+   --    partial view of a private type or extension. Undefined for aspects
+   --    that apply to other entities.
+
    --  Aspect_Rep_Item (Node2-Sem)
    --    Present in N_Aspect_Specification nodes. Points to the corresponding
    --    pragma/attribute definition node used to process the aspect.
@@ -7638,6 +7644,7 @@ package Sinfo is
       --  Is_Disabled (Flag15-Sem)
       --  Is_Boolean_Aspect (Flag16-Sem)
       --  Split_PPC (Flag17) Set if split pre/post attribute
+      --  Aspect_On_Partial_View (Flag18-Sem)
 
       --  Note: Aspect_Specification is an Ada 2012 feature
 
@@ -9299,6 +9306,9 @@ package Sinfo is
    function Array_Aggregate
      (N : Node_Id) return Node_Id;    -- Node3
 
+   function Aspect_On_Partial_View
+     (N : Node_Id) return Boolean;    -- Flag18
+
    function Aspect_Rep_Item
      (N : Node_Id) return Node_Id;    -- Node2
 
@@ -10411,6 +10421,9 @@ package Sinfo is
    procedure Set_Array_Aggregate
      (N : Node_Id; Val : Node_Id);            -- Node3
 
+   procedure Set_Aspect_On_Partial_View
+     (N : Node_Id; Val : Boolean := True);    -- Flag18
+
    procedure Set_Aspect_Rep_Item
      (N : Node_Id; Val : Node_Id);            -- Node2
 
@@ -13324,6 +13337,7 @@ package Sinfo is
    pragma Inline (Ancestor_Part);
    pragma Inline (Atomic_Sync_Required);
    pragma Inline (Array_Aggregate);
+   pragma Inline (Aspect_On_Partial_View);
    pragma Inline (Aspect_Rep_Item);
    pragma Inline (Assignment_OK);
    pragma Inline (Associated_Node);
@@ -13690,6 +13704,7 @@ package Sinfo is
    pragma Inline (Set_Alternatives);
    pragma Inline (Set_Ancestor_Part);
    pragma Inline (Set_Array_Aggregate);
+   pragma Inline (Set_Aspect_On_Partial_View);
    pragma Inline (Set_Aspect_Rep_Item);
    pragma Inline (Set_Assignment_OK);
    pragma Inline (Set_Associated_Node);