OSDN Git Service

2012-01-10 Bob Duff <duff@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / sem_ch9.adb
index db3eed7..f9aab6a 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -30,7 +30,6 @@ with Errout;   use Errout;
 with Exp_Ch9;  use Exp_Ch9;
 with Elists;   use Elists;
 with Freeze;   use Freeze;
-with Itypes;   use Itypes;
 with Lib.Xref; use Lib.Xref;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
@@ -45,6 +44,7 @@ with Sem_Ch3;  use Sem_Ch3;
 with Sem_Ch5;  use Sem_Ch5;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
+with Sem_Ch13; use Sem_Ch13;
 with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Type; use Sem_Type;
@@ -100,19 +100,21 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
+      Check_SPARK_Restriction ("abort statement is not allowed", N);
+
       T_Name := First (Names (N));
       while Present (T_Name) loop
          Analyze (T_Name);
 
          if Is_Task_Type (Etype (T_Name))
-           or else (Ada_Version >= Ada_05
+           or else (Ada_Version >= Ada_2005
                       and then Ekind (Etype (T_Name)) = E_Class_Wide_Type
                       and then Is_Interface (Etype (T_Name))
                       and then Is_Task_Interface (Etype (T_Name)))
          then
             Resolve (T_Name);
          else
-            if Ada_Version >= Ada_05 then
+            if Ada_Version >= Ada_2005 then
                Error_Msg_N ("expect task name or task interface class-wide "
                           & "object for ABORT", T_Name);
             else
@@ -167,75 +169,9 @@ package body Sem_Ch9 is
       Kind      : Entity_Kind;
       Task_Nam  : Entity_Id;
 
-      -----------------------
-      -- Actual_Index_Type --
-      -----------------------
-
-      function Actual_Index_Type (E : Entity_Id) return Entity_Id;
-      --  If the bounds of an entry family depend on task discriminants, create
-      --  a new index type where a discriminant is replaced by the local
-      --  variable that renames it in the task body.
-
-      -----------------------
-      -- Actual_Index_Type --
-      -----------------------
-
-      function Actual_Index_Type (E : Entity_Id) return Entity_Id is
-         Typ   : constant Entity_Id := Entry_Index_Type (E);
-         Lo    : constant Node_Id   := Type_Low_Bound  (Typ);
-         Hi    : constant Node_Id   := Type_High_Bound (Typ);
-         New_T : Entity_Id;
-
-         function Actual_Discriminant_Ref (Bound : Node_Id) return Node_Id;
-         --  If bound is discriminant reference, replace with corresponding
-         --  local variable of the same name.
-
-         -----------------------------
-         -- Actual_Discriminant_Ref --
-         -----------------------------
-
-         function Actual_Discriminant_Ref (Bound : Node_Id) return Node_Id is
-            Typ : constant Entity_Id := Etype (Bound);
-            Ref : Node_Id;
-         begin
-            if not Is_Entity_Name (Bound)
-              or else Ekind (Entity (Bound)) /= E_Discriminant
-            then
-               return Bound;
-            else
-               Ref := Make_Identifier (Sloc (N), Chars (Entity (Bound)));
-               Analyze (Ref);
-               Resolve (Ref, Typ);
-               return Ref;
-            end if;
-         end Actual_Discriminant_Ref;
-
-      --  Start of processing for Actual_Index_Type
-
-      begin
-         if not Has_Discriminants (Task_Nam)
-           or else (not Is_Entity_Name (Lo)
-                     and then not Is_Entity_Name (Hi))
-         then
-            return Entry_Index_Type (E);
-         else
-            New_T := Create_Itype (Ekind (Typ), N);
-            Set_Etype        (New_T, Base_Type (Typ));
-            Set_Size_Info    (New_T, Typ);
-            Set_RM_Size      (New_T, RM_Size (Typ));
-            Set_Scalar_Range (New_T,
-              Make_Range (Sloc (N),
-                Low_Bound  => Actual_Discriminant_Ref (Lo),
-                High_Bound => Actual_Discriminant_Ref (Hi)));
-
-            return New_T;
-         end if;
-      end Actual_Index_Type;
-
-   --  Start of processing for Analyze_Accept_Statement
-
    begin
       Tasking_Used := True;
+      Check_SPARK_Restriction ("accept statement is not allowed", N);
 
       --  Entry name is initialized to Any_Id. It should get reset to the
       --  matching entry entity. An error is signalled if it is not reset.
@@ -260,11 +196,11 @@ package body Sem_Ch9 is
          return;
       end if;
 
-      --  In order to process the parameters, we create a defining
-      --  identifier that can be used as the name of the scope. The
-      --  name of the accept statement itself is not a defining identifier,
-      --  and we cannot use its name directly because the task may have
-      --  any number of accept statements for the same entry.
+      --  In order to process the parameters, we create a defining identifier
+      --  that can be used as the name of the scope. The name of the accept
+      --  statement itself is not a defining identifier, and we cannot use
+      --  its name directly because the task may have any number of accept
+      --  statements for the same entry.
 
       if Present (Index) then
          Accept_Id := New_Internal_Entity
@@ -343,7 +279,6 @@ package body Sem_Ch9 is
          if Entry_Nam = Scope_Stack.Table (J).Entity then
             Error_Msg_N ("duplicate accept statement for same entry", N);
          end if;
-
       end loop;
 
       declare
@@ -370,7 +305,7 @@ package body Sem_Ch9 is
             Error_Msg_N ("missing entry index in accept for entry family", N);
          else
             Analyze_And_Resolve (Index, Entry_Index_Type (E));
-            Apply_Range_Check (Index, Actual_Index_Type (E));
+            Apply_Range_Check (Index, Entry_Index_Type (E));
          end if;
 
       elsif Present (Index) then
@@ -467,10 +402,11 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
+      Check_SPARK_Restriction ("select statement is not allowed", N);
       Check_Restriction (Max_Asynchronous_Select_Nesting, N);
       Check_Restriction (No_Select_Statements, N);
 
-      if Ada_Version >= Ada_05 then
+      if Ada_Version >= Ada_2005 then
          Trigger := Triggering_Statement (Triggering_Alternative (N));
 
          Analyze (Trigger);
@@ -511,12 +447,13 @@ package body Sem_Ch9 is
       Is_Disp_Select : Boolean := False;
 
    begin
-      Check_Restriction (No_Select_Statements, N);
       Tasking_Used := True;
+      Check_SPARK_Restriction ("select statement is not allowed", N);
+      Check_Restriction (No_Select_Statements, N);
 
       --  Ada 2005 (AI-345): The trigger may be a dispatching call
 
-      if Ada_Version >= Ada_05 then
+      if Ada_Version >= Ada_2005 then
          Analyze (Trigger);
          Check_Triggering_Statement (Trigger, N, Is_Disp_Select);
       end if;
@@ -607,8 +544,9 @@ package body Sem_Ch9 is
    procedure Analyze_Delay_Relative (N : Node_Id) is
       E : constant Node_Id := Expression (N);
    begin
-      Check_Restriction (No_Relative_Delay, N);
       Tasking_Used := True;
+      Check_SPARK_Restriction ("delay statement is not allowed", N);
+      Check_Restriction (No_Relative_Delay, N);
       Check_Restriction (No_Delay, N);
       Check_Potentially_Blocking_Operation (N);
       Analyze_And_Resolve (E, Standard_Duration);
@@ -625,6 +563,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
+      Check_SPARK_Restriction ("delay statement is not allowed", N);
       Check_Restriction (No_Delay, N);
       Check_Potentially_Blocking_Operation (N);
       Analyze (E);
@@ -787,7 +726,7 @@ package body Sem_Ch9 is
       --  for the discriminals and privals and finally a declaration for the
       --  entry family index (if applicable).
 
-      if Expander_Active
+      if Full_Expander_Active
         and then Is_Protected_Type (P_Type)
       then
          Install_Private_Data_Declarations
@@ -911,6 +850,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
+      Check_SPARK_Restriction ("entry call is not allowed", N);
 
       if Present (Pragmas_Before (N)) then
          Analyze_List (Pragmas_Before (N));
@@ -944,21 +884,114 @@ package body Sem_Ch9 is
 
    begin
       Generate_Definition (Def_Id);
+      Set_Contract (Def_Id, Make_Contract (Sloc (Def_Id)));
       Tasking_Used := True;
 
+      --  Case of no discrete subtype definition
+
       if No (D_Sdef) then
          Set_Ekind (Def_Id, E_Entry);
+
+      --  Processing for discrete subtype definition present
+
       else
          Enter_Name (Def_Id);
          Set_Ekind (Def_Id, E_Entry_Family);
          Analyze (D_Sdef);
          Make_Index (D_Sdef, N, Def_Id);
+
+         --  Check subtype with predicate in entry family
+
+         Bad_Predicated_Subtype_Use
+           ("subtype& has predicate, not allowed in entry family",
+            D_Sdef, Etype (D_Sdef));
+
+         --  Check entry family static bounds outside allowed limits
+
+         --  Note: originally this check was not performed here, but in that
+         --  case the check happens deep in the expander, and the message is
+         --  posted at the wrong location, and omitted in -gnatc mode.
+         --  If the type of the entry index is a generic formal, no check
+         --  is possible. In an instance, the check is not static and a run-
+         --  time exception will be raised if the bounds are unreasonable.
+
+         declare
+            PEI : constant Entity_Id := RTE (RE_Protected_Entry_Index);
+            LB  : constant Uint      := Expr_Value (Type_Low_Bound (PEI));
+            UB  : constant Uint      := Expr_Value (Type_High_Bound (PEI));
+
+            LBR : Node_Id;
+            UBR : Node_Id;
+
+         begin
+
+            --  No bounds checking if the type is generic or if previous error.
+            --  In an instance the check is dynamic.
+
+            if Is_Generic_Type (Etype (D_Sdef))
+              or else In_Instance
+              or else Error_Posted (D_Sdef)
+            then
+               goto Skip_LB;
+
+            elsif Nkind (D_Sdef) = N_Range then
+               LBR := Low_Bound (D_Sdef);
+
+            elsif Is_Entity_Name (D_Sdef)
+              and then Is_Type (Entity (D_Sdef))
+            then
+               LBR := Type_Low_Bound (Entity (D_Sdef));
+
+            else
+               goto Skip_LB;
+            end if;
+
+            if Is_Static_Expression (LBR)
+              and then Expr_Value (LBR) < LB
+            then
+               Error_Msg_Uint_1 := LB;
+               Error_Msg_N ("entry family low bound must be '>'= ^!", D_Sdef);
+            end if;
+
+         <<Skip_LB>>
+            if Is_Generic_Type (Etype (D_Sdef))
+              or else In_Instance
+              or else Error_Posted (D_Sdef)
+            then
+               goto Skip_UB;
+
+            elsif Nkind (D_Sdef) = N_Range then
+               UBR := High_Bound (D_Sdef);
+
+            elsif Is_Entity_Name (D_Sdef)
+              and then Is_Type (Entity (D_Sdef))
+            then
+               UBR := Type_High_Bound (Entity (D_Sdef));
+
+            else
+               goto Skip_UB;
+            end if;
+
+            if Is_Static_Expression (UBR)
+              and then Expr_Value (UBR) > UB
+            then
+               Error_Msg_Uint_1 := UB;
+               Error_Msg_N ("entry family high bound must be '<'= ^!", D_Sdef);
+            end if;
+
+         <<Skip_UB>>
+            null;
+         end;
       end if;
 
+      --  Decorate Def_Id
+
       Set_Etype          (Def_Id, Standard_Void_Type);
       Set_Convention     (Def_Id, Convention_Entry);
       Set_Accept_Address (Def_Id, New_Elmt_List);
 
+      --  Process formals
+
       if Present (Formals) then
          Set_Scope (Def_Id, Current_Scope);
          Push_Scope (Def_Id);
@@ -972,6 +1005,10 @@ package body Sem_Ch9 is
       end if;
 
       Generate_Reference_To_Formals (Def_Id);
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Def_Id);
+      end if;
    end Analyze_Entry_Declaration;
 
    ---------------------------------------
@@ -1154,6 +1191,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
+      Check_SPARK_Restriction ("protected definition is not allowed", N);
       Analyze_Declarations (Visible_Declarations (N));
 
       if Present (Private_Declarations (N))
@@ -1190,11 +1228,11 @@ package body Sem_Ch9 is
       Process_End_Label (N, 'e', Current_Scope);
    end Analyze_Protected_Definition;
 
-   ----------------------------
-   -- Analyze_Protected_Type --
-   ----------------------------
+   ----------------------------------------
+   -- Analyze_Protected_Type_Declaration --
+   ----------------------------------------
 
-   procedure Analyze_Protected_Type (N : Node_Id) is
+   procedure Analyze_Protected_Type_Declaration (N : Node_Id) is
       Def_Id : constant Entity_Id := Defining_Identifier (N);
       E      : Entity_Id;
       T      : Entity_Id;
@@ -1202,6 +1240,11 @@ package body Sem_Ch9 is
    begin
       if No_Run_Time_Mode then
          Error_Msg_CRT ("protected type", N);
+
+         if Has_Aspects (N) then
+            Analyze_Aspect_Specifications (N, Def_Id);
+         end if;
+
          return;
       end if;
 
@@ -1226,7 +1269,7 @@ package body Sem_Ch9 is
       Set_Stored_Constraint  (T, No_Elist);
       Push_Scope (T);
 
-      if Ada_Version >= Ada_05 then
+      if Ada_Version >= Ada_2005 then
          Check_Interfaces (N, T);
       end if;
 
@@ -1244,18 +1287,36 @@ package body Sem_Ch9 is
 
       Set_Is_Constrained (T, not Has_Discriminants (T));
 
-      --  Perform minimal expansion of protected type while inside a generic.
-      --  The corresponding record is needed for various semantic checks.
+      --  If aspects are present, analyze them now. They can make references
+      --  to the discriminants of the type, but not to any components.
 
-      if Ada_Version >= Ada_05
-        and then Inside_A_Generic
-      then
-         Insert_After_And_Analyze (N,
-           Build_Corresponding_Record (N, T, Sloc (T)));
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Def_Id);
       end if;
 
       Analyze (Protected_Definition (N));
 
+      --  In the case where the protected type is declared at a nested level
+      --  and the No_Local_Protected_Objects restriction applies, issue a
+      --  warning that objects of the type will violate the restriction.
+
+      if Restriction_Check_Required (No_Local_Protected_Objects)
+        and then not Is_Library_Level_Entity (T)
+        and then Comes_From_Source (T)
+      then
+         Error_Msg_Sloc := Restrictions_Loc (No_Local_Protected_Objects);
+
+         if Error_Msg_Sloc = No_Location then
+            Error_Msg_N
+              ("objects of this type will violate " &
+               "`No_Local_Protected_Objects`?", N);
+         else
+            Error_Msg_N
+              ("objects of this type will violate " &
+               "`No_Local_Protected_Objects`?#", N);
+         end if;
+      end if;
+
       --  Protected types with entries are controlled (because of the
       --  Protection component if nothing else), same for any protected type
       --  with interrupt handlers. Note that we need to analyze the protected
@@ -1301,17 +1362,21 @@ package body Sem_Ch9 is
          end if;
 
          --  Create corresponding record now, because some private dependents
-         --  may be subtypes of the partial view. Skip if errors are present,
-         --  to prevent cascaded messages.
+         --  may be subtypes of the partial view.
+
+         --  Skip if errors are present, to prevent cascaded messages
 
          if Serious_Errors_Detected = 0
-           and then Expander_Active
+
+           --  Also skip if expander is not active
+
+           and then Full_Expander_Active
          then
             Expand_N_Protected_Type_Declaration (N);
             Process_Full_View (N, T, Def_Id);
          end if;
       end if;
-   end Analyze_Protected_Type;
+   end Analyze_Protected_Type_Declaration;
 
    ---------------------
    -- Analyze_Requeue --
@@ -1330,9 +1395,10 @@ package body Sem_Ch9 is
       Outer_Ent   : Entity_Id;
 
    begin
+      Tasking_Used := True;
+      Check_SPARK_Restriction ("requeue statement is not allowed", N);
       Check_Restriction (No_Requeue_Statements, N);
       Check_Unreachable_Code (N);
-      Tasking_Used := True;
 
       Enclosing := Empty;
       for J in reverse 0 .. Scope_Stack.Last loop
@@ -1480,18 +1546,17 @@ package body Sem_Ch9 is
          Entry_Id := Entity (Entry_Name);
       end if;
 
-      --  Ada 2005 (AI05-0030): Potential dispatching requeue statement. The
+      --  Ada 2012 (AI05-0030): Potential dispatching requeue statement. The
       --  target type must be a concurrent interface class-wide type and the
-      --  entry name must be a procedure, flagged by pragma Implemented_By_
-      --  Entry.
+      --  target must be a procedure, flagged by pragma Implemented.
 
       Is_Disp_Req :=
-        Ada_Version >= Ada_05
+        Ada_Version >= Ada_2012
           and then Present (Target_Obj)
           and then Is_Class_Wide_Type (Etype (Target_Obj))
           and then Is_Concurrent_Interface (Etype (Target_Obj))
           and then Ekind (Entry_Id) = E_Procedure
-          and then Implemented_By_Entry (Entry_Id);
+          and then Has_Rep_Pragma (Entry_Id, Name_Implemented);
 
       --  Resolve entry, and check that it is subtype conformant with the
       --  enclosing construct if this construct has formals (RM 9.5.4(5)).
@@ -1519,11 +1584,13 @@ package body Sem_Ch9 is
                return;
             end if;
 
-            --  Ada 2005 (AI05-0030): Perform type conformance after skipping
+            --  Ada 2012 (AI05-0030): Perform type conformance after skipping
             --  the first parameter of Entry_Id since it is the interface
             --  controlling formal.
 
-            if Is_Disp_Req then
+            if Ada_Version >= Ada_2012
+              and then Is_Disp_Req
+            then
                declare
                   Enclosing_Formal : Entity_Id;
                   Target_Formal    : Entity_Id;
@@ -1602,8 +1669,9 @@ package body Sem_Ch9 is
       Alt_Count         : Uint    := Uint_0;
 
    begin
-      Check_Restriction (No_Select_Statements, N);
       Tasking_Used := True;
+      Check_SPARK_Restriction ("select statement is not allowed", N);
+      Check_Restriction (No_Select_Statements, N);
 
       --  Loop to analyze alternatives
 
@@ -1707,11 +1775,11 @@ package body Sem_Ch9 is
       end if;
    end Analyze_Selective_Accept;
 
-   ------------------------------
-   -- Analyze_Single_Protected --
-   ------------------------------
+   ------------------------------------------
+   -- Analyze_Single_Protected_Declaration --
+   ------------------------------------------
 
-   procedure Analyze_Single_Protected (N : Node_Id) is
+   procedure Analyze_Single_Protected_Declaration (N : Node_Id) is
       Loc    : constant Source_Ptr := Sloc (N);
       Id     : constant Node_Id    := Defining_Identifier (N);
       T      : Entity_Id;
@@ -1760,14 +1828,18 @@ package body Sem_Ch9 is
       --  procedure directly. Otherwise the node would be expanded twice, with
       --  disastrous result.
 
-      Analyze_Protected_Type (N);
-   end Analyze_Single_Protected;
+      Analyze_Protected_Type_Declaration (N);
 
-   -------------------------
-   -- Analyze_Single_Task --
-   -------------------------
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
+   end Analyze_Single_Protected_Declaration;
+
+   -------------------------------------
+   -- Analyze_Single_Task_Declaration --
+   -------------------------------------
 
-   procedure Analyze_Single_Task (N : Node_Id) is
+   procedure Analyze_Single_Task_Declaration (N : Node_Id) is
       Loc    : constant Source_Ptr := Sloc (N);
       Id     : constant Node_Id    := Defining_Identifier (N);
       T      : Entity_Id;
@@ -1798,7 +1870,8 @@ package body Sem_Ch9 is
       --  entity is the new object declaration. The single_task_declaration
       --  is not used further in semantics or code generation, but is scanned
       --  when generating debug information, and therefore needs the updated
-      --  Sloc information for the entity (see Sprint).
+      --  Sloc information for the entity (see Sprint). Aspect specifications
+      --  are moved from the single task node to the object declaration node.
 
       O_Decl :=
         Make_Object_Declaration (Loc,
@@ -1824,8 +1897,12 @@ package body Sem_Ch9 is
       --  procedure directly. Otherwise the node would be expanded twice, with
       --  disastrous result.
 
-      Analyze_Task_Type (N);
-   end Analyze_Single_Task;
+      Analyze_Task_Type_Declaration (N);
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
+   end Analyze_Single_Task_Declaration;
 
    -----------------------
    -- Analyze_Task_Body --
@@ -1969,6 +2046,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
+      Check_SPARK_Restriction ("task definition is not allowed", N);
 
       if Present (Visible_Declarations (N)) then
          Analyze_Declarations (Visible_Declarations (N));
@@ -1991,11 +2069,11 @@ package body Sem_Ch9 is
       Process_End_Label (N, 'e', Current_Scope);
    end Analyze_Task_Definition;
 
-   -----------------------
-   -- Analyze_Task_Type --
-   -----------------------
+   -----------------------------------
+   -- Analyze_Task_Type_Declaration --
+   -----------------------------------
 
-   procedure Analyze_Task_Type (N : Node_Id) is
+   procedure Analyze_Task_Type_Declaration (N : Node_Id) is
       Def_Id : constant Entity_Id := Defining_Identifier (N);
       T      : Entity_Id;
 
@@ -2007,10 +2085,18 @@ package body Sem_Ch9 is
 
       --  In the case of an incomplete type, use the full view, unless it's not
       --  present (as can occur for an incomplete view from a limited with).
+      --  Initialize the Corresponding_Record_Type (which overlays the Private
+      --  Dependents field of the incomplete view).
 
-      if Ekind (T) = E_Incomplete_Type and then Present (Full_View (T)) then
-         T := Full_View (T);
-         Set_Completion_Referenced (T);
+      if Ekind (T) = E_Incomplete_Type then
+         if Present (Full_View (T)) then
+            T := Full_View (T);
+            Set_Completion_Referenced (T);
+
+         else
+            Set_Ekind (T, E_Task_Type);
+            Set_Corresponding_Record_Type (T, Empty);
+         end if;
       end if;
 
       Set_Ekind              (T, E_Task_Type);
@@ -2022,7 +2108,7 @@ package body Sem_Ch9 is
       Set_Stored_Constraint  (T, No_Elist);
       Push_Scope (T);
 
-      if Ada_Version >= Ada_05 then
+      if Ada_Version >= Ada_2005 then
          Check_Interfaces (N, T);
       end if;
 
@@ -2044,21 +2130,31 @@ package body Sem_Ch9 is
 
       Set_Is_Constrained (T, not Has_Discriminants (T));
 
-      --  Perform minimal expansion of the task type while inside a generic
-      --  context. The corresponding record is needed for various semantic
-      --  checks.
-
-      if Inside_A_Generic then
-         Insert_After_And_Analyze (N,
-           Build_Corresponding_Record (N, T, Sloc (T)));
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Def_Id);
       end if;
 
       if Present (Task_Definition (N)) then
          Analyze_Task_Definition (Task_Definition (N));
       end if;
 
-      if not Is_Library_Level_Entity (T) then
-         Check_Restriction (No_Task_Hierarchy, N);
+      --  In the case where the task type is declared at a nested level and the
+      --  No_Task_Hierarchy restriction applies, issue a warning that objects
+      --  of the type will violate the restriction.
+
+      if Restriction_Check_Required (No_Task_Hierarchy)
+        and then not Is_Library_Level_Entity (T)
+        and then Comes_From_Source (T)
+      then
+         Error_Msg_Sloc := Restrictions_Loc (No_Task_Hierarchy);
+
+         if Error_Msg_Sloc = No_Location then
+            Error_Msg_N
+              ("objects of this type will violate `No_Task_Hierarchy`?", N);
+         else
+            Error_Msg_N
+              ("objects of this type will violate `No_Task_Hierarchy`?#", N);
+         end if;
       end if;
 
       End_Scope;
@@ -2078,17 +2174,21 @@ package body Sem_Ch9 is
          end if;
 
          --  Create corresponding record now, because some private dependents
-         --  may be subtypes of the partial view. Skip if errors are present,
-         --  to prevent cascaded messages.
+         --  may be subtypes of the partial view.
+
+         --  Skip if errors are present, to prevent cascaded messages
 
          if Serious_Errors_Detected = 0
-           and then Expander_Active
+
+           --  Also skip if expander is not active
+
+           and then Full_Expander_Active
          then
             Expand_N_Task_Type_Declaration (N);
             Process_Full_View (N, T, Def_Id);
          end if;
       end if;
-   end Analyze_Task_Type;
+   end Analyze_Task_Type_Declaration;
 
    -----------------------------------
    -- Analyze_Terminate_Alternative --
@@ -2117,12 +2217,13 @@ package body Sem_Ch9 is
       Is_Disp_Select : Boolean := False;
 
    begin
-      Check_Restriction (No_Select_Statements, N);
       Tasking_Used := True;
+      Check_SPARK_Restriction ("select statement is not allowed", N);
+      Check_Restriction (No_Select_Statements, N);
 
       --  Ada 2005 (AI-345): The trigger may be a dispatching call
 
-      if Ada_Version >= Ada_05 then
+      if Ada_Version >= Ada_2005 then
          Analyze (Trigger);
          Check_Triggering_Statement (Trigger, N, Is_Disp_Select);
       end if;
@@ -2164,7 +2265,7 @@ package body Sem_Ch9 is
         and then Nkind (Trigger) not in N_Delay_Statement
         and then Nkind (Trigger) /= N_Entry_Call_Statement
       then
-         if Ada_Version < Ada_05 then
+         if Ada_Version < Ada_2005 then
             Error_Msg_N
              ("triggering statement must be delay or entry call", Trigger);
 
@@ -2244,18 +2345,10 @@ package body Sem_Ch9 is
                   --  Entry family with non-static bounds
 
                   else
-                     --  If restriction is set, then this is an error
+                     --  Record an unknown count restriction, and if the
+                     --  restriction is active, post a message or warning.
 
-                     if Restrictions.Set (R) then
-                        Error_Msg_N
-                          ("static subtype required by Restriction pragma",
-                           DSD);
-
-                     --  Otherwise we record an unknown count restriction
-
-                     else
-                        Check_Restriction (R, D);
-                     end if;
+                     Check_Restriction (R, D);
                   end if;
                end;
             end if;
@@ -2372,7 +2465,7 @@ package body Sem_Ch9 is
          --  declaration must be limited.
 
          if Present (Interface_List (N))
-           and then not Is_Limited_Record (Priv_T)
+           and then not Is_Limited_Type (Priv_T)
          then
             Error_Msg_Sloc := Sloc (Priv_T);
             Error_Msg_N ("(Ada 2005) limited type declaration expected for " &
@@ -2424,15 +2517,17 @@ package body Sem_Ch9 is
                Iface := Find_Hidden_Interface (Priv_T_Ifaces, Full_T_Ifaces);
 
                if Present (Iface) then
-                  Error_Msg_NE ("interface & not implemented by full type " &
-                                "(RM-2005 7.3 (7.3/2))", Priv_T, Iface);
+                  Error_Msg_NE
+                    ("interface & not implemented by full type " &
+                     "(RM-2005 7.3 (7.3/2))", Priv_T, Iface);
                end if;
 
                Iface := Find_Hidden_Interface (Full_T_Ifaces, Priv_T_Ifaces);
 
                if Present (Iface) then
-                  Error_Msg_NE ("interface & not implemented by partial " &
-                                "view (RM-2005 7.3 (7.3/2))", T, Iface);
+                  Error_Msg_NE
+                    ("interface & not implemented by partial " &
+                     "view (RM-2005 7.3 (7.3/2))", T, Iface);
                end if;
             end if;
          end if;
@@ -2456,7 +2551,7 @@ package body Sem_Ch9 is
       --  It is not possible to have a dispatching trigger if we are not in
       --  Ada 2005 mode.
 
-      if Ada_Version >= Ada_05
+      if Ada_Version >= Ada_2005
         and then Nkind (Trigger) = N_Procedure_Call_Statement
         and then Present (Parameter_Associations (Trigger))
       then