From f5cc2579bce72277386478933b97011d5417519a Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 16 Jun 2016 10:39:14 +0000 Subject: [PATCH] 2016-06-16 Gary Dismukes * sem_util.adb: Minor typo fix. 2016-06-16 Emmanuel Briot * s-regpat.adb: Further fix for invalid index in GNAT.Regexp. 2016-06-16 Eric Botcazou * sem_ch13.adb (Validate_Address_Clauses): Use the same logic to issue the warning on the offset for the size as for the alignment and tweak the wording for the sake of consistency. 2016-06-16 Ed Schonberg * sem_prag.adb (Check_Class_Wide_COndition): New procedure, subsidiary of Analyze_Pre_Post_ Condition_In_Decl_Part, to check legality rules that follow from the revised semantics of class-wide pre/postconditions described in AI12-0113. (Build_Pragma_Check_Equivalent): Abstract subprogram declarations must be included in list of overriding primitives of a derived type. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@237521 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 24 ++++++++++++++++ gcc/ada/s-regpat.adb | 24 ++++++++++++---- gcc/ada/sem_ch13.adb | 4 +-- gcc/ada/sem_prag.adb | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++- gcc/ada/sem_util.adb | 2 +- 5 files changed, 122 insertions(+), 10 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6cf68c482eb..b661d38e5d4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2016-06-16 Gary Dismukes + + * sem_util.adb: Minor typo fix. + +2016-06-16 Emmanuel Briot + + * s-regpat.adb: Further fix for invalid index in GNAT.Regexp. + +2016-06-16 Eric Botcazou + + * sem_ch13.adb (Validate_Address_Clauses): Use the same logic to + issue the warning on the offset for the size as for the alignment + and tweak the wording for the sake of consistency. + +2016-06-16 Ed Schonberg + + * sem_prag.adb (Check_Class_Wide_COndition): New procedure, + subsidiary of Analyze_Pre_Post_ Condition_In_Decl_Part, to + check legality rules that follow from the revised semantics of + class-wide pre/postconditions described in AI12-0113. + (Build_Pragma_Check_Equivalent): Abstract subprogram declarations + must be included in list of overriding primitives of a derived + type. + 2016-06-16 Ed Schonberg * sem_util.adb (May_Be_Lvalue): An actual in an unexpanded diff --git a/gcc/ada/s-regpat.adb b/gcc/ada/s-regpat.adb index f672b9e92a1..7675f70b1aa 100644 --- a/gcc/ada/s-regpat.adb +++ b/gcc/ada/s-regpat.adb @@ -2614,16 +2614,28 @@ package body System.Regpat is exit State_Machine when Input_Pos /= BOL_Pos; when EOL => - exit State_Machine when Input_Pos <= Last_In_Data - and then ((Self.Flags and Multiple_Lines) = 0 - or else Data (Input_Pos) /= ASCII.LF); + -- A combination of MEOL and SEOL + if (Self.Flags and Multiple_Lines) = 0 then + -- single line mode + exit State_Machine when Input_Pos <= Data'Last; + elsif Input_Pos <= Last_In_Data then + exit State_Machine when Data (Input_Pos) /= ASCII.LF; + else + exit State_Machine when Last_In_Data /= Data'Last; + end if; when MEOL => - exit State_Machine when Input_Pos <= Last_In_Data - and then Data (Input_Pos) /= ASCII.LF; + if Input_Pos <= Last_In_Data then + exit State_Machine when Data (Input_Pos) /= ASCII.LF; + else + exit State_Machine when Last_In_Data /= Data'Last; + end if; when SEOL => - exit State_Machine when Input_Pos <= Last_In_Data; + -- If we have a character before Data'Last (even if + -- Last_In_Data stops before then), we can't have + -- the end of the line. + exit State_Machine when Input_Pos <= Data'Last; when BOUND | NBOUND => diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 1d732b9b590..28ccf5666b5 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -13730,9 +13730,9 @@ package body Sem_Ch13 is Error_Msg_Uint_1 := Y_Size; Error_Msg_NE ("\??size of & is ^", ACCR.N, ACCR.Y); - if X_Offs /= Uint_0 then + if Y_Size >= X_Size then Error_Msg_Uint_1 := X_Offs; - Error_Msg_NE ("\??and offset of & is ^", ACCR.N, ACCR.X); + Error_Msg_NE ("\??but offset of & is ^", ACCR.N, ACCR.X); end if; -- Check for inadequate alignment, both of the base object diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index fd835239858..51f2e83822a 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -23279,6 +23279,74 @@ package body Sem_Prag is Disp_Typ : Entity_Id; Restore_Scope : Boolean := False; + function Check_References (N : Node_Id) return Traverse_Result; + -- Check that the expression does not mention non-primitives of + -- the type, global objects of the type, or other illegalities + -- described and implied by AI12-0113. + + ---------------------- + -- Check_References -- + ---------------------- + + function Check_References (N : Node_Id) return Traverse_Result is + begin + if Nkind (N) = N_Function_Call + and then Is_Entity_Name (Name (N)) + then + declare + Func : constant Entity_Id := Entity (Name (N)); + Form : Entity_Id; + begin + + -- An operation of the type must be a primitive. + + if No (Find_Dispatching_Type (Func)) then + Form := First_Formal (Func); + while Present (Form) loop + if Etype (Form) = Disp_Typ then + Error_Msg_NE ("operation in class-wide condition " + & "must be primitive of&", N, Disp_Typ); + end if; + Next_Formal (Form); + end loop; + + -- A return object of the type is illegal as well. + + if Etype (Func) = Disp_Typ + or else Etype (Func) = Class_Wide_Type (Disp_Typ) + then + Error_Msg_NE ("operation in class-wide condition " + & "must be primitive of&", N, Disp_Typ); + end if; + end if; + end; + + elsif Is_Entity_Name (N) + and then + (Etype (N) = Disp_Typ + or else Etype (N) = Class_Wide_Type (Disp_Typ)) + and then Ekind_In (Entity (N), E_Variable, E_Constant) + then + Error_Msg_NE + ("object in class-wide condition must be formal of type&", + N, Disp_Typ); + + elsif Nkind (N) = N_Explicit_Dereference + and then (Etype (N) = Disp_Typ + or else Etype (N) = Class_Wide_Type (Disp_Typ)) + and then (not Is_Entity_Name (Prefix (N)) + or else not Is_Formal (Entity (Prefix (N)))) + then + Error_Msg_NE ("operation in class-wide condition " + & "must be primitive of&", N, Disp_Typ); + end if; + + return OK; + end Check_References; + + procedure Check_Class_Wide_Condition is new + Traverse_Proc (Check_References); + -- Start of processing for Analyze_Pre_Post_Condition_In_Decl_Part begin @@ -23345,7 +23413,13 @@ package body Sem_Prag is ("pragma % can only be specified for a primitive operation " & "of a tagged type", N); end if; + + else + -- Remaining semantic checks require a full tree traversal. + + Check_Class_Wide_Condition (Expr); end if; + end if; if Restore_Scope then @@ -26379,7 +26453,9 @@ package body Sem_Prag is -- overridings between them. while Present (Decl) loop - if Nkind (Decl) = N_Subprogram_Declaration then + if Nkind_In (Decl, + N_Subprogram_Declaration, N_Abstract_Subprogram_Declaration) + then Prim := Defining_Entity (Decl); if Is_Subprogram (Prim) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 9e2aba4dab2..936b814f96b 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1231,7 +1231,7 @@ package body Sem_Util is pragma Assert (Has_Default_Init_Cond (Typ)); pragma Assert (Present (Prag)); - -- Nothing to do if the slec was not built. This occurs when the + -- Nothing to do if the spec was not built. This occurs when the -- expression of the Default_Initial_Condition is missing or is -- null. -- 2.11.4.GIT