X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fsem_ch9.adb;h=f9aab6a235db6a926e0c877ed205d84205552aca;hb=43537c9651f05e0ad6ba2c752dcfdfb762ef8376;hp=db3eed737e0bea46df77d7e9fa697ebb93d66670;hpb=11deeeb67deda574374ddaa763be7306a2fb9bd3;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index db3eed737e0..f9aab6a235d 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -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; + + <> + 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; + + <> + 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