diff options
Diffstat (limited to 'gcc/ada/sem_prag.adb')
| -rw-r--r-- | gcc/ada/sem_prag.adb | 86 |
1 files changed, 46 insertions, 40 deletions
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index eae149805fa..b071aa8c892 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -217,7 +217,7 @@ package body Sem_Prag is Freeze_Id : Entity_Id); -- Subsidiary to the analysis of pragmas Contract_Cases, Part_Of, Post, and -- Pre. Emit a freezing-related error message where Freeze_Id is the entity - -- of a body which caused contract "freezing" and Contract_Id denotes the + -- of a body which caused contract freezing and Contract_Id denotes the -- entity of the affected contstruct. procedure Duplication_Error (Prag : Node_Id; Prev : Node_Id); @@ -432,7 +432,7 @@ package body Sem_Prag is -- Emit a clarification message when the case guard contains -- at least one undefined reference, possibly due to contract - -- "freezing". + -- freezing. if Errors /= Serious_Errors_Detected and then Present (Freeze_Id) @@ -447,7 +447,7 @@ package body Sem_Prag is -- Emit a clarification message when the consequence contains -- at least one undefined reference, possibly due to contract - -- "freezing". + -- freezing. if Errors /= Serious_Errors_Detected and then Present (Freeze_Id) @@ -3287,8 +3287,8 @@ package body Sem_Prag is if not Is_Child_Or_Sibling (Pack_Id, Scope (Encap_Id)) then SPARK_Msg_NE - ("indicator Part_Of must denote abstract state or public " - & "descendant of & (SPARK RM 7.2.6(3))", + ("indicator Part_Of must denote abstract state of & " + & "or of its public descendant (SPARK RM 7.2.6(3))", Indic, Parent_Unit); return; @@ -3301,8 +3301,8 @@ package body Sem_Prag is else SPARK_Msg_NE - ("indicator Part_Of must denote abstract state or public " - & "descendant of & (SPARK RM 7.2.6(3))", + ("indicator Part_Of must denote abstract state of & " + & "or of its public descendant (SPARK RM 7.2.6(3))", Indic, Parent_Unit); return; end if; @@ -3327,7 +3327,7 @@ package body Sem_Prag is elsif Placement = Private_State_Space then if Scope (Encap_Id) /= Pack_Id then SPARK_Msg_NE - ("indicator Part_Of must designate an abstract state of " + ("indicator Part_Of must denote an abstract state of " & "package & (SPARK RM 7.2.6(2))", Indic, Pack_Id); Error_Msg_Name_1 := Chars (Pack_Id); SPARK_Msg_NE @@ -3510,7 +3510,7 @@ package body Sem_Prag is end if; -- Emit a clarification message when the encapsulator is undefined, - -- possibly due to contract "freezing". + -- possibly due to contract freezing. if Errors /= Serious_Errors_Detected and then Present (Freeze_Id) @@ -5817,8 +5817,8 @@ package body Sem_Prag is procedure Check_Grouping (L : List_Id) is HSS : Node_Id; - Prag : Node_Id; Stmt : Node_Id; + Prag : Node_Id := Empty; -- init to avoid warning begin -- Inspect the list of declarations or statements looking for @@ -5872,16 +5872,15 @@ package body Sem_Prag is else while Present (Stmt) loop - -- The current pragma is either the first pragma - -- of the group or is a member of the group. Stop - -- the search as the placement is legal. + -- of the group or is a member of the group. + -- Stop the search as the placement is legal. if Stmt = N then raise Stop_Search; - -- Skip group members, but keep track of the last - -- pragma in the group. + -- Skip group members, but keep track of the + -- last pragma in the group. elsif Is_Loop_Pragma (Stmt) then Prag := Stmt; @@ -11390,6 +11389,7 @@ package body Sem_Prag is SPARK_Msg_N ("expression of external state property must be " & "static", Expr); + return; end if; -- The lack of expression defaults the property to True @@ -16474,6 +16474,20 @@ package body Sem_Prag is return; end if; + -- Ada 2012 (AI05-0030): Cannot apply the implementation_kind + -- By_Protected_Procedure to the primitive procedure of a task + -- interface. + + if Chars (Arg2) = Name_By_Protected_Procedure + and then Is_Interface (Typ) + and then Is_Task_Interface (Typ) + then + Error_Pragma_Arg + ("implementation kind By_Protected_Procedure cannot be " + & "applied to a task interface primitive", Arg2); + return; + end if; + -- Procedures declared inside a protected type must be accepted elsif Ekind (Proc_Id) = E_Procedure @@ -16489,20 +16503,6 @@ package body Sem_Prag is return; end if; - -- Ada 2012 (AI05-0030): Cannot apply the implementation_kind - -- By_Protected_Procedure to the primitive procedure of a task - -- interface. - - if Chars (Arg2) = Name_By_Protected_Procedure - and then Is_Interface (Typ) - and then Is_Task_Interface (Typ) - then - Error_Pragma_Arg - ("implementation kind By_Protected_Procedure cannot be " - & "applied to a task interface primitive", Arg2); - return; - end if; - Record_Rep_Item (Proc_Id, N); end Implemented; @@ -24253,11 +24253,16 @@ package body Sem_Prag is else OK := Set_Warning_Switch (Chr); end if; - end if; - if not OK then + if not OK then + Error_Pragma_Arg + ("invalid warning switch character " & Chr, + Arg1); + end if; + + else Error_Pragma_Arg - ("invalid warning switch character " & Chr, + ("invalid wide character in warning switch ", Arg1); end if; @@ -24608,7 +24613,7 @@ package body Sem_Prag is Preanalyze_Assert_Expression (Expr, Standard_Boolean); -- Emit a clarification message when the expression contains at least - -- one undefined reference, possibly due to contract "freezing". + -- one undefined reference, possibly due to contract freezing. if Errors /= Serious_Errors_Detected and then Present (Freeze_Id) @@ -27358,7 +27363,7 @@ package body Sem_Prag is Constit_Id := Entity_Of (Constit); -- When a constituent is declared after a subprogram body - -- that caused "freezing" of the related contract where + -- that caused freezing of the related contract where -- pragma Refined_State resides, the constituent appears -- undefined and carries Any_Id as its entity. @@ -28398,8 +28403,8 @@ package body Sem_Prag is end if; end if; - -- When the item appears in the private state space of a packge, it must - -- be a part of some state declared by the said package. + -- When the item appears in the private state space of a package, it + -- must be a part of some state declared by the said package. else pragma Assert (Placement = Private_State_Space); @@ -28747,7 +28752,7 @@ package body Sem_Prag is Depends : Node_Id; Formal : Entity_Id; Global : Node_Id; - Spec_Id : Entity_Id; + Spec_Id : Entity_Id := Empty; Subp_Decl : Node_Id; Typ : Entity_Id; @@ -29290,7 +29295,7 @@ package body Sem_Prag is elsif Present (Corresponding_Aspect (Prag)) then return Parent (Corresponding_Aspect (Prag)); - -- No candidate packge [body] found + -- No candidate package [body] found else return Empty; @@ -29364,10 +29369,11 @@ package body Sem_Prag is elsif N = Name_Off then return Off; - -- Any other argument is illegal + -- Any other argument is illegal. Assume that no SPARK mode applies to + -- avoid potential cascaded errors. else - raise Program_Error; + return None; end if; end Get_SPARK_Mode_Type; |