[Ada] Ada2020: AI12-0279 more dispatching points with aspect Yield

2020-06-17  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* aspects.ads (type Aspect_Id): Add Aspect_Yield as a Boolean
	aspect, and update the Is_Representation_Aspect, Aspect_Names,
	and Aspect_Delay arrays.
	* einfo.ads, einfo.adb (Has_Yield_Aspect, Yield_Aspect): New
	subprograms.
	* exp_ch6.adb (Add_Return, Expand_Non_Function_Return,
	Expand_Simple_Function_Return): Add calls to Yield.
	* exp_ch9.adb (Build_Accept_Body, Expand_N_Accept_Statement):
	Add calls to Yield.
	* rtsfind.ads (RE_Yield): Adding support to generate calls to
	the runtime service Ada.Dispatching.Yield
	* sem_ch13.adb (Analyze_Aspect_Yield): New subprogram.
	* sem_ch3.adb (Derive_Subprogram): Inherit attribute
	Has_Yield_Aspect.
	* sem_ch8.adb (Analyze_Subprogram_Renaming): Check consistency
	of Has_Yield in the actual subprogram of a generic
	instantiation.
	* sem_disp.adb (Check_Dispatching_Operation): Check that if the
	Yield aspect is specified for a dispatching subprogram that
	inherits the aspect, the specified value shall be confirming.
	* sem_prag.adb (Analyze_Pragma [Pragma_Implemented]): Check that
	the implementation kind By_Protected_Procedure cannot be applied
	to a procedure that has aspect Yield.

11 files changed, 320 insertions, 25 deletions

diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index e6425a8..2c12452 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -218,7 +218,8 @@ package Aspects is
       Aspect_Unreferenced_Objects,          -- GNAT
       Aspect_Volatile,
       Aspect_Volatile_Components,
-      Aspect_Volatile_Full_Access);         -- GNAT
+      Aspect_Volatile_Full_Access,          -- GNAT
+      Aspect_Yield);
 
    subtype Aspect_Id_Exclude_No_Aspect is
      Aspect_Id range Aspect_Id'Succ (No_Aspect) .. Aspect_Id'Last;
@@ -566,7 +567,8 @@ package Aspects is
       Aspect_Unreferenced_Objects         => False,
       Aspect_Volatile                     => True,
       Aspect_Volatile_Components          => True,
-      Aspect_Volatile_Full_Access         => True);
+      Aspect_Volatile_Full_Access         => True,
+      Aspect_Yield                        => False);
 
    -----------------------------------------
    -- Table Linking Names and Aspect_Id's --
@@ -709,7 +711,8 @@ package Aspects is
       Aspect_Volatile_Full_Access         => Name_Volatile_Full_Access,
       Aspect_Volatile_Function            => Name_Volatile_Function,
       Aspect_Warnings                     => Name_Warnings,
-      Aspect_Write                        => Name_Write);
+      Aspect_Write                        => Name_Write,
+      Aspect_Yield                        => Name_Yield);
 
    function Get_Aspect_Id (Name : Name_Id) return Aspect_Id;
    pragma Inline (Get_Aspect_Id);
@@ -943,6 +946,7 @@ package Aspects is
       Aspect_Unimplemented                => Never_Delay,
       Aspect_Volatile_Function            => Never_Delay,
       Aspect_Warnings                     => Never_Delay,
+      Aspect_Yield                        => Never_Delay,
 
       Aspect_Alignment                    => Rep_Aspect,
       Aspect_Atomic                       => Rep_Aspect,
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 62f61c4..8280d3b 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -522,8 +522,8 @@ package body Einfo is
    --    Known_To_Have_Preelab_Init      Flag207
    --    Must_Have_Preelab_Init          Flag208
    --    Is_Return_Object                Flag209
-   --    Elaborate_Body_Desirable        Flag210
 
+   --    Elaborate_Body_Desirable        Flag210
    --    Has_Static_Discriminants        Flag211
    --    Has_Pragma_Unreferenced_Objects Flag212
    --    Requires_Overriding             Flag213
@@ -533,8 +533,8 @@ package body Einfo is
    --    Suppress_Value_Tracking_On_Call Flag217
    --    Is_Primitive                    Flag218
    --    Has_Initial_Value               Flag219
-   --    Has_Dispatch_Table              Flag220
 
+   --    Has_Dispatch_Table              Flag220
    --    Has_Pragma_Preelab_Init         Flag221
    --    Used_As_Generic_Actual          Flag222
    --    Is_Descendant_Of_Address        Flag223
@@ -544,8 +544,8 @@ package body Einfo is
    --    Referenced_As_Out_Parameter     Flag227
    --    Has_Thunks                      Flag228
    --    Can_Use_Internal_Rep            Flag229
-   --    Has_Pragma_Inline_Always        Flag230
 
+   --    Has_Pragma_Inline_Always        Flag230
    --    Renamed_In_Spec                 Flag231
    --    Has_Own_Invariants              Flag232
    --    Has_Pragma_Unmodified           Flag233
@@ -555,8 +555,8 @@ package body Einfo is
    --    Warnings_Off_Used_Unmodified    Flag237
    --    Warnings_Off_Used_Unreferenced  Flag238
    --    No_Reordering                   Flag239
-   --    Has_Expanded_Contract           Flag240
 
+   --    Has_Expanded_Contract           Flag240
    --    Optimize_Alignment_Space        Flag241
    --    Optimize_Alignment_Time         Flag242
    --    Overlays_Constant               Flag243
@@ -566,8 +566,8 @@ package body Einfo is
    --    OK_To_Rename                    Flag247
    --    Has_Inheritable_Invariants      Flag248
    --    Is_Safe_To_Reevaluate           Flag249
-   --    Has_Predicates                  Flag250
 
+   --    Has_Predicates                  Flag250
    --    Has_Implicit_Dereference        Flag251
    --    Is_Finalized_Transient          Flag252
    --    Disable_Controlled              Flag253
@@ -577,8 +577,8 @@ package body Einfo is
    --    Is_Invariant_Procedure          Flag257
    --    Has_Dynamic_Predicate_Aspect    Flag258
    --    Has_Static_Predicate_Aspect     Flag259
-   --    Has_Loop_Entry_Attributes       Flag260
 
+   --    Has_Loop_Entry_Attributes       Flag260
    --    Has_Delayed_Rep_Aspects         Flag261
    --    May_Inherit_Delayed_Rep_Aspects Flag262
    --    Has_Visible_Refinement          Flag263
@@ -588,8 +588,8 @@ package body Einfo is
    --    Has_Shift_Operator              Flag267
    --    Is_Independent                  Flag268
    --    Has_Static_Predicate            Flag269
-   --    Stores_Attribute_Old_Prefix     Flag270
 
+   --    Stores_Attribute_Old_Prefix     Flag270
    --    Has_Protected                   Flag271
    --    SSO_Set_Low_By_Default          Flag272
    --    SSO_Set_High_By_Default         Flag273
@@ -599,8 +599,8 @@ package body Einfo is
    --    Is_Checked_Ghost_Entity         Flag277
    --    Is_Ignored_Ghost_Entity         Flag278
    --    Contains_Ignored_Ghost_Code     Flag279
-   --    Partial_View_Has_Unknown_Discr  Flag280
 
+   --    Partial_View_Has_Unknown_Discr  Flag280
    --    Is_Static_Type                  Flag281
    --    Has_Nested_Subprogram           Flag282
    --    Is_Uplevel_Referenced_Entity    Flag283
@@ -610,8 +610,8 @@ package body Einfo is
    --    Rewritten_For_C                 Flag287
    --    Predicates_Ignored              Flag288
    --    Has_Timing_Event                Flag289
-   --    Is_Class_Wide_Clone             Flag290
 
+   --    Is_Class_Wide_Clone             Flag290
    --    Has_Inherited_Invariants        Flag291
    --    Is_Partial_Invariant_Procedure  Flag292
    --    Is_Actual_Subtype               Flag293
@@ -621,8 +621,8 @@ package body Einfo is
    --    Is_Entry_Wrapper                Flag297
    --    Is_Underlying_Full_View         Flag298
    --    Body_Needed_For_Inlining        Flag299
-   --    Has_Private_Extension           Flag300
 
+   --    Has_Private_Extension           Flag300
    --    Ignore_SPARK_Mode_Pragmas       Flag301
    --    Is_Initial_Condition_Procedure  Flag302
    --    Suppress_Elaboration_Warnings   Flag303
@@ -630,8 +630,8 @@ package body Einfo is
    --    Is_Activation_Record            Flag305
    --    Needs_Activation_Record         Flag306
    --    Is_Loop_Parameter               Flag307
+   --    Has_Yield_Aspect                Flag308
 
-   --    (unused)                        Flag308
    --    (unused)                        Flag309
 
    --  Note: Flag310-317 are defined in atree.ads/adb, but not yet in atree.h
@@ -1989,6 +1989,11 @@ package body Einfo is
       return Flag182 (Id);
    end Has_Xref_Entry;
 
+   function Has_Yield_Aspect (Id : E) return B is
+   begin
+      return Flag308 (Id);
+   end Has_Yield_Aspect;
+
    function Hiding_Loop_Variable (Id : E) return E is
    begin
       pragma Assert (Ekind (Id) = E_Variable);
@@ -5192,6 +5197,13 @@ package body Einfo is
       Set_Flag182 (Id, V);
    end Set_Has_Xref_Entry;
 
+   procedure Set_Has_Yield_Aspect (Id : E; V : B := True) is
+   begin
+      pragma Assert
+        (Is_Entry (Id) or else Is_Subprogram_Or_Generic_Subprogram (Id));
+      Set_Flag308 (Id, V);
+   end Set_Has_Yield_Aspect;
+
    procedure Set_Hiding_Loop_Variable (Id : E; V : E) is
    begin
       pragma Assert (Ekind (Id) = E_Variable);
@@ -9812,6 +9824,7 @@ package body Einfo is
       W ("Has_Visible_Refinement",          Flag263 (Id));
       W ("Has_Volatile_Components",         Flag87  (Id));
       W ("Has_Xref_Entry",                  Flag182 (Id));
+      W ("Has_Yield_Aspect",                Flag308 (Id));
       W ("Ignore_SPARK_Mode_Pragmas",       Flag301 (Id));
       W ("In_Package_Body",                 Flag48  (Id));
       W ("In_Private_Part",                 Flag45  (Id));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index ba15d48..8cf9d2e 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2189,6 +2189,10 @@ package Einfo is
 --       references an entity with a type reference. See package Lib.Xref for
 --       further details).
 
+--    Has_Yield_Aspect (Flag308)
+--       Defined in subprograms, generic subprograms, entries, entry families.
+--       Set if the entity has aspect Yield.
+
 --    Hiding_Loop_Variable (Node8)
 --       Defined in variables. Set only if a variable of a discrete type is
 --       hidden by a loop variable in the same local scope, in which case
@@ -6092,6 +6096,7 @@ package Einfo is
    --    SPARK_Pragma                        (Node40)   (protected kind)
    --    Default_Expressions_Processed       (Flag108)
    --    Entry_Accepted                      (Flag152)
+   --    Has_Yield_Aspect                    (Flag308)
    --    Has_Expanded_Contract               (Flag240)
    --    Ignore_SPARK_Mode_Pragmas           (Flag301)
    --    Is_Elaboration_Checks_OK_Id         (Flag148)
@@ -6229,6 +6234,7 @@ package Einfo is
    --    Has_Nested_Subprogram               (Flag282)
    --    Has_Out_Or_In_Out_Parameter         (Flag110)
    --    Has_Recursive_Call                  (Flag143)
+   --    Has_Yield_Aspect                    (Flag308)
    --    Ignore_SPARK_Mode_Pragmas           (Flag301)
    --    Is_Abstract_Subprogram              (Flag19)   (non-generic case only)
    --    Is_Called                           (Flag102)  (non-generic case only)
@@ -6554,6 +6560,7 @@ package Einfo is
    --    Has_Master_Entity                   (Flag21)
    --    Has_Nested_Block_With_Handler       (Flag101)
    --    Has_Nested_Subprogram               (Flag282)
+   --    Has_Yield_Aspect                    (Flag308)
    --    Ignore_SPARK_Mode_Pragmas           (Flag301)
    --    Is_Abstract_Subprogram              (Flag19)   (non-generic case only)
    --    Is_Asynchronous                     (Flag81)
@@ -7297,6 +7304,7 @@ package Einfo is
    function Has_Visible_Refinement              (Id : E) return B;
    function Has_Volatile_Components             (Id : E) return B;
    function Has_Xref_Entry                      (Id : E) return B;
+   function Has_Yield_Aspect                    (Id : E) return B;
    function Hiding_Loop_Variable                (Id : E) return E;
    function Hidden_In_Formal_Instance           (Id : E) return L;
    function Homonym                             (Id : E) return E;
@@ -8008,6 +8016,7 @@ package Einfo is
    procedure Set_Has_Visible_Refinement          (Id : E; V : B := True);
    procedure Set_Has_Volatile_Components         (Id : E; V : B := True);
    procedure Set_Has_Xref_Entry                  (Id : E; V : B := True);
+   procedure Set_Has_Yield_Aspect                (Id : E; V : B := True);
    procedure Set_Hiding_Loop_Variable            (Id : E; V : E);
    procedure Set_Hidden_In_Formal_Instance       (Id : E; V : L);
    procedure Set_Homonym                         (Id : E; V : E);
@@ -8839,6 +8848,7 @@ package Einfo is
    pragma Inline (Has_Visible_Refinement);
    pragma Inline (Has_Volatile_Components);
    pragma Inline (Has_Xref_Entry);
+   pragma Inline (Has_Yield_Aspect);
    pragma Inline (Hiding_Loop_Variable);
    pragma Inline (Hidden_In_Formal_Instance);
    pragma Inline (Homonym);
@@ -9452,6 +9462,7 @@ package Einfo is
    pragma Inline (Set_Has_Visible_Refinement);
    pragma Inline (Set_Has_Volatile_Components);
    pragma Inline (Set_Has_Xref_Entry);
+   pragma Inline (Set_Has_Yield_Aspect);
    pragma Inline (Set_Hiding_Loop_Variable);
    pragma Inline (Set_Hidden_In_Formal_Instance);
    pragma Inline (Set_Homonym);
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index daa672f..1e0047b 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -6463,6 +6463,19 @@ package body Exp_Ch6 is
                    Name =>
                      New_Occurrence_Of (Postconditions_Proc (Spec_Id), Loc)));
             end if;
+
+            --  Ada 2020 (AI12-0279): append the call to 'Yield unless this is
+            --  a generic subprogram (since in such case it will be added to
+            --  the instantiations).
+
+            if Has_Yield_Aspect (Spec_Id)
+              and then Ekind (Spec_Id) /= E_Generic_Procedure
+              and then RTE_Available (RE_Yield)
+            then
+               Insert_Action (Stmt,
+                 Make_Procedure_Call_Statement (Loc,
+                   New_Occurrence_Of (RTE (RE_Yield), Loc)));
+            end if;
          end if;
       end Add_Return;
 
@@ -6896,6 +6909,16 @@ package body Exp_Ch6 is
              Name => New_Occurrence_Of (Postconditions_Proc (Scope_Id), Loc)));
       end if;
 
+      --  Ada 2020 (AI12-0279)
+
+      if Has_Yield_Aspect (Scope_Id)
+        and then RTE_Available (RE_Yield)
+      then
+         Insert_Action (N,
+           Make_Procedure_Call_Statement (Loc,
+             New_Occurrence_Of (RTE (RE_Yield), Loc)));
+      end if;
+
       --  If it is a return from a procedure do no extra steps
 
       if Kind = E_Procedure or else Kind = E_Generic_Procedure then
@@ -8045,6 +8068,16 @@ package body Exp_Ch6 is
             Set_Original_Node (Exp, New_Copy_Of_Exp);
          end if;
       end if;
+
+      --  Ada 2020 (AI12-0279)
+
+      if Has_Yield_Aspect (Scope_Id)
+        and then RTE_Available (RE_Yield)
+      then
+         Insert_Action (N,
+           Make_Procedure_Call_Statement (Loc,
+             New_Occurrence_Of (RTE (RE_Yield), Loc)));
+      end if;
    end Expand_Simple_Function_Return;
 
    -----------------------
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index f4dc5d3..651ca1f 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -826,6 +826,16 @@ package body Exp_Ch9 is
       Insert_Before (Last (Statements (Stats)), Call);
       Analyze (Call);
 
+      --  Ada 2020 (AI12-0279)
+
+      if Has_Yield_Aspect (Entity (Entry_Direct_Name (Astat)))
+        and then RTE_Available (RE_Yield)
+      then
+         Insert_Action_After (Call,
+           Make_Procedure_Call_Statement (Loc,
+             New_Occurrence_Of (RTE (RE_Yield), Loc)));
+      end if;
+
       --  If exception handlers are present, then append Complete_Rendezvous
       --  calls to the handlers, and construct the required outer block. As
       --  above, the Sloc is copied from the last statement in the sequence.
@@ -838,6 +848,17 @@ package body Exp_Ch9 is
                 (Sloc (Last (Statements (Hand))), RE_Complete_Rendezvous);
             Append (Call, Statements (Hand));
             Analyze (Call);
+
+            --  Ada 2020 (AI12-0279)
+
+            if Has_Yield_Aspect (Entity (Entry_Direct_Name (Astat)))
+              and then RTE_Available (RE_Yield)
+            then
+               Insert_Action_After (Call,
+                 Make_Procedure_Call_Statement (Loc,
+                   New_Occurrence_Of (RTE (RE_Yield), Loc)));
+            end if;
+
             Next (Hand);
          end loop;
 
@@ -861,6 +882,16 @@ package body Exp_Ch9 is
       --  We handle Abort_Signal to make sure that we properly catch the abort
       --  case and wake up the caller.
 
+      Call :=
+        Make_Procedure_Call_Statement (Sloc (Stats),
+          Name                   => New_Occurrence_Of (
+            RTE (RE_Exceptional_Complete_Rendezvous), Sloc (Stats)),
+          Parameter_Associations => New_List (
+            Make_Function_Call (Sloc (Stats),
+              Name =>
+                New_Occurrence_Of
+                  (RTE (RE_Get_GNAT_Exception), Sloc (Stats)))));
+
       Ohandle := Make_Others_Choice (Loc);
       Set_All_Others (Ohandle);
 
@@ -869,15 +900,17 @@ package body Exp_Ch9 is
           Make_Implicit_Exception_Handler (Loc,
             Exception_Choices => New_List (Ohandle),
 
-            Statements => New_List (
-              Make_Procedure_Call_Statement (Sloc (Stats),
-                Name                   => New_Occurrence_Of (
-                  RTE (RE_Exceptional_Complete_Rendezvous), Sloc (Stats)),
-                Parameter_Associations => New_List (
-                  Make_Function_Call (Sloc (Stats),
-                    Name =>
-                      New_Occurrence_Of
-                        (RTE (RE_Get_GNAT_Exception), Sloc (Stats)))))))));
+            Statements => New_List (Call))));
+
+      --  Ada 2020 (AI12-0279)
+
+      if Has_Yield_Aspect (Entity (Entry_Direct_Name (Astat)))
+        and then RTE_Available (RE_Yield)
+      then
+         Insert_Action_After (Call,
+           Make_Procedure_Call_Statement (Loc,
+             New_Occurrence_Of (RTE (RE_Yield), Loc)));
+      end if;
 
       Set_Parent (New_S, Astat); -- temp parent for Analyze call
       Analyze_Exception_Handlers (Exception_Handlers (New_S));
@@ -6548,6 +6581,16 @@ package body Exp_Ch9 is
 
          Analyze (N);
 
+         --  Ada 2020 (AI12-0279)
+
+         if Has_Yield_Aspect (Eent)
+           and then RTE_Available (RE_Yield)
+         then
+            Insert_Action_After (N,
+              Make_Procedure_Call_Statement (Loc,
+                New_Occurrence_Of (RTE (RE_Yield), Loc)));
+         end if;
+
          --  Discard Entry_Address that was created for it, so it will not be
          --  emitted if this accept statement is in the statement part of a
          --  delay alternative.
@@ -10842,7 +10885,23 @@ package body Exp_Ch9 is
          --  Accept with no body (followed by trailing statements)
 
          else
-            Alt_Stats := Empty_List;
+            declare
+               Entry_Id : constant Entity_Id :=
+                           Entity (Entry_Direct_Name (Accept_Statement (Alt)));
+            begin
+               --  Ada 2020 (AI12-0279)
+
+               if Has_Yield_Aspect (Entry_Id)
+                 and then RTE_Available (RE_Yield)
+               then
+                  Alt_Stats :=
+                    New_List (
+                      Make_Procedure_Call_Statement (Sloc (Proc),
+                        New_Occurrence_Of (RTE (RE_Yield), Sloc (Proc))));
+               else
+                  Alt_Stats := Empty_List;
+               end if;
+            end;
          end if;
 
          Ensure_Statement_Present (Sloc (Astmt), Alt);
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index f440147..d8420d7 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -428,6 +428,8 @@ package Rtsfind is
      RO_CA_Delay_Until,                  -- Ada.Calendar.Delays
      RO_CA_To_Duration,                  -- Ada.Calendar.Delays
 
+     RE_Yield,                           -- Ada_Dispatching
+
      RE_Set_Deadline,                    -- Ada.Dispatching.EDF
 
      RE_Code_Loc,                        -- Ada.Exceptions
@@ -1712,6 +1714,8 @@ package Rtsfind is
      RO_CA_Delay_Until                   => Ada_Calendar_Delays,
      RO_CA_To_Duration                   => Ada_Calendar_Delays,
 
+     RE_Yield                            => Ada_Dispatching,
+
      RE_Set_Deadline                     => Ada_Dispatching_EDF,
 
      RE_Code_Loc                         => Ada_Exceptions,
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 0edcb84..05a511f 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1792,6 +1792,9 @@ package body Sem_Ch13 is
             procedure Analyze_Aspect_Relaxed_Initialization;
             --  Perform analysis of aspect Relaxed_Initialization
 
+            procedure Analyze_Aspect_Yield;
+            --  Perform analysis of aspect Yield
+
             procedure Analyze_Aspect_Static;
             --  Ada 202x (AI12-0075): Perform analysis of aspect Static
 
@@ -2466,6 +2469,97 @@ package body Sem_Ch13 is
                end if;
             end Analyze_Aspect_Static;
 
+            --------------------------
+            -- Analyze_Aspect_Yield --
+            --------------------------
+
+            procedure Analyze_Aspect_Yield is
+               Expr_Value : Boolean := False;
+
+            begin
+               --  Check valid declarations for 'Yield
+
+               if (Nkind_In (N, N_Abstract_Subprogram_Declaration,
+                                N_Entry_Declaration,
+                                N_Generic_Subprogram_Declaration,
+                                N_Subprogram_Declaration)
+                     or else Nkind (N) in N_Formal_Subprogram_Declaration)
+                 and then not Within_Protected_Type (E)
+               then
+                  null;
+
+               elsif Within_Protected_Type (E) then
+                  Error_Msg_N
+                    ("aspect% not applicable to protected operations", Id);
+                  return;
+
+               else
+                  Error_Msg_N
+                    ("aspect% only applicable to subprogram and entry "
+                     & "declarations", Id);
+                  return;
+               end if;
+
+               --  Evaluate its static expression (if available); otherwise it
+               --  defaults to True.
+
+               if No (Expr) then
+                  Expr_Value := True;
+
+               --  Otherwise it must have a static boolean expression
+
+               else
+                  if Inside_A_Generic then
+                     Preanalyze_And_Resolve (Expr, Any_Boolean);
+                  else
+                     Analyze_And_Resolve (Expr, Any_Boolean);
+                  end if;
+
+                  if Is_OK_Static_Expression (Expr) then
+                     if Is_True (Static_Boolean (Expr)) then
+                        Expr_Value := True;
+                     end if;
+                  else
+                     Error_Msg_N
+                       ("expression of aspect % must be static", Aspect);
+                  end if;
+               end if;
+
+               if Expr_Value then
+
+                  --  Adding minimum decoration to generic subprograms to set
+                  --  the Yield attribute (since at this stage it may not be
+                  --  set; see Analyze_Generic_Subprogram_Declaration).
+
+                  if Nkind (N) in N_Generic_Subprogram_Declaration
+                    and then Ekind (E) = E_Void
+                  then
+                     if Nkind (Specification (N)) = N_Function_Specification
+                     then
+                        Set_Ekind (E, E_Function);
+                     else
+                        Set_Ekind (E, E_Procedure);
+                     end if;
+                  end if;
+
+                  Set_Has_Yield_Aspect (E);
+               end if;
+
+               --  If the Yield aspect is specified for a dispatching
+               --  subprogram that inherits the aspect, the specified
+               --  value shall be confirming.
+
+               if Present (Expr)
+                 and then Is_Dispatching_Operation (E)
+                 and then Present (Overridden_Operation (E))
+                 and then Has_Yield_Aspect (Overridden_Operation (E))
+                            /= Is_True (Static_Boolean (Expr))
+               then
+                  Error_Msg_N ("specification of inherited aspect% can only " &
+                               "confirm parent value", Id);
+               end if;
+            end Analyze_Aspect_Yield;
+
             -----------------------
             -- Make_Aitem_Pragma --
             -----------------------
@@ -4220,6 +4314,12 @@ package body Sem_Ch13 is
                   elsif A_Id = Aspect_Static then
                      Analyze_Aspect_Static;
                      goto Continue;
+
+                  --  Ada 2020 (AI12-0279)
+
+                  elsif A_Id = Aspect_Yield then
+                     Analyze_Aspect_Yield;
+                     goto Continue;
                   end if;
 
                   --  Library unit aspects require special handling in the case
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 4c3212d..6e0cfe2 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -15803,6 +15803,17 @@ package body Sem_Ch3 is
       if Ekind (New_Subp) = E_Function then
          Set_Mechanism (New_Subp, Mechanism (Parent_Subp));
       end if;
+
+      --  Ada 2020 (AI12-0279): If a Yield aspect is specified True for a
+      --  primitive subprogram S of a type T, then the aspect is inherited
+      --  by the corresponding primitive subprogram of each descendant of T.
+
+      if Is_Tagged_Type (Derived_Type)
+        and then Is_Dispatching_Operation (New_Subp)
+        and then Has_Yield_Aspect (Alias (New_Subp))
+      then
+         Set_Has_Yield_Aspect (New_Subp, Has_Yield_Aspect (Alias (New_Subp)));
+      end if;
    end Derive_Subprogram;
 
    ------------------------
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index b189a52..acb5b21 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -3772,6 +3772,17 @@ package body Sem_Ch8 is
          Analyze_Aspect_Specifications (N, New_S);
       end if;
 
+      --  AI12-0279
+
+      if Is_Actual
+        and then Has_Yield_Aspect (Formal_Spec)
+        and then not Has_Yield_Aspect (Old_S)
+      then
+         Error_Msg_Name_1 := Name_Yield;
+         Error_Msg_N
+           ("actual subprogram& must have aspect% to match formal", Name (N));
+      end if;
+
       Ada_Version := Save_AV;
       Ada_Version_Pragma := Save_AVP;
       Ada_Version_Explicit := Save_AV_Exp;
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 3b40f4c..6e74098 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Debug;    use Debug;
 with Elists;   use Elists;
@@ -1636,6 +1637,42 @@ package body Sem_Disp is
          end;
       end if;
 
+      --  AI12-0279: If the Yield aspect is specified for a dispatching
+      --  subprogram that inherits the aspect, the specified value shall
+      --  be confirming.
+
+      if Is_Dispatching_Operation (Subp)
+        and then Is_Primitive_Wrapper (Subp)
+        and then Present (Wrapped_Entity (Subp))
+        and then Comes_From_Source (Wrapped_Entity (Subp))
+        and then Present (Overridden_Operation (Subp))
+        and then Has_Yield_Aspect (Overridden_Operation (Subp))
+                   /= Has_Yield_Aspect (Wrapped_Entity (Subp))
+      then
+         declare
+            W_Ent  : constant Entity_Id := Wrapped_Entity (Subp);
+            W_Decl : constant Node_Id := Parent (W_Ent);
+            Asp    : Node_Id;
+
+         begin
+            if Present (Aspect_Specifications (W_Decl)) then
+               Asp := First (Aspect_Specifications (W_Decl));
+               while Present (Asp) loop
+                  if Chars (Identifier (Asp)) = Name_Yield then
+                     Error_Msg_Name_1 := Name_Yield;
+                     Error_Msg_N
+                       ("specification of inherited aspect% can only confirm "
+                        & "parent value", Asp);
+                  end if;
+
+                  Next (Asp);
+               end loop;
+            end if;
+
+            Set_Has_Yield_Aspect (Wrapped_Entity (Subp));
+         end;
+      end if;
+
       --  For similarity with record extensions, in Ada 9X the language should
       --  have disallowed adding visible operations to a tagged type after
       --  deriving a private extension from it. Report a warning if this
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 740e3ea..32b4572 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -17195,7 +17195,7 @@ package body Sem_Prag is
                --  By_Protected_Procedure to the primitive procedure of a task
                --  interface.
 
-               if Chars (Arg2) = Name_By_Protected_Procedure
+               if Chars (Get_Pragma_Arg (Arg2)) = Name_By_Protected_Procedure
                  and then Is_Interface (Typ)
                  and then Is_Task_Interface (Typ)
                then
@@ -17220,6 +17220,18 @@ package body Sem_Prag is
                return;
             end if;
 
+            --  Ada 2012 (AI12-0279): Cannot apply the implementation_kind
+            --  By_Protected_Procedure to a procedure that has aspect Yield
+
+            if Chars (Get_Pragma_Arg (Arg2)) = Name_By_Protected_Procedure
+              and then Has_Yield_Aspect (Proc_Id)
+            then
+               Error_Pragma_Arg
+                 ("implementation kind By_Protected_Procedure cannot be "
+                  & "applied to entities with aspect 'Yield", Arg2);
+               return;
+            end if;
+
             Record_Rep_Item (Proc_Id, N);
          end Implemented;