From e11b776b63c214d3e0792fa49ca2153df64d11d9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 6 Jan 2017 12:06:24 +0100 Subject: [PATCH] [multiple changes] 2017-01-06 Ed Schonberg * sem_ch5.adb (Analyze_Loop_Statement): If the loop includes an iterator specification with a serious syntactic error, transform construct into an infinite loop in order to continue analysis and prevent a compiler abort. 2017-01-06 Tristan Gingold * exp_ch9.adb (Expand_N_Protected_Type_Declaration): Do not generate max_queue_lengths_array if unused. 2017-01-06 Bob Duff * errout.adb (Set_Msg_Text): Protect against out-of-bounds array access, in case "\" is at the end of Text. * stylesw.adb (Set_Style_Check_Options): Don't include input characters in the error message template, because they could be control characters such as "\", which Errout will try to interpret. 2017-01-06 Ed Schonberg * sem_ch4.adb (Find_Indexing_Operations, Inspect_Declarations): For a private type examine the visible declarations that follow the partial view, not just the private declarations that follow the full view. 2017-01-06 Hristian Kirtchev * exp_ch5.adb, sem_ch3.adb, checks.adb: Minor reformatting and code cleanup. From-SVN: r244133 --- gcc/ada/ChangeLog | 33 +++++++++++++++++++++++++++++++++ gcc/ada/checks.adb | 6 +++--- gcc/ada/errout.adb | 2 +- gcc/ada/exp_ch5.adb | 7 ++++--- gcc/ada/exp_ch9.adb | 5 ++++- gcc/ada/sem_ch3.adb | 5 +++-- gcc/ada/sem_ch4.adb | 11 ++++++++++- gcc/ada/sem_ch5.adb | 13 +++++++++++++ gcc/ada/stylesw.adb | 6 +++--- 9 files changed, 74 insertions(+), 14 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e5f4d17b70b..ac0d8b20365 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,36 @@ +2017-01-06 Ed Schonberg + + * sem_ch5.adb (Analyze_Loop_Statement): If the loop includes an + iterator specification with a serious syntactic error, transform + construct into an infinite loop in order to continue analysis + and prevent a compiler abort. + +2017-01-06 Tristan Gingold + + * exp_ch9.adb (Expand_N_Protected_Type_Declaration): Do not generate + max_queue_lengths_array if unused. + +2017-01-06 Bob Duff + + * errout.adb (Set_Msg_Text): Protect against out-of-bounds + array access, in case "\" is at the end of Text. + * stylesw.adb (Set_Style_Check_Options): Don't include input + characters in the error message template, because they could + be control characters such as "\", which Errout will try to + interpret. + +2017-01-06 Ed Schonberg + + * sem_ch4.adb (Find_Indexing_Operations, Inspect_Declarations): + For a private type examine the visible declarations that follow + the partial view, not just the private declarations that follow + the full view. + +2017-01-06 Hristian Kirtchev + + * exp_ch5.adb, sem_ch3.adb, checks.adb: Minor reformatting and + code cleanup. + 2017-01-06 Ed Schonberg * exp_ch5.adb (Get_Default_Iterator): For a derived type, the diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 83703b6cb9a..efb36840185 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -2638,14 +2638,14 @@ package body Checks is elsif Present (S) and then S = Predicate_Function (Typ) then Error_Msg_NE - ("predicate check includes a call to& that " - & "requires a predicate check??", Parent (N), Fun); + ("predicate check includes a call to& that requires a " + & "predicate check??", Parent (N), Fun); Error_Msg_N ("\this will result in infinite recursion??", Parent (N)); if Is_First_Subtype (Typ) then Error_Msg_NE - ("\use an explicit subtype of& to carry the predicate", + ("\use an explicit subtype of& to carry the predicate", Parent (N), Typ); end if; diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 09e8e591f15..49aa2a7765f 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -2992,7 +2992,7 @@ package body Errout is when '\' => Continuation := True; - if Text (P) = '\' then + if P <= Text'Last and then Text (P) = '\' then Continuation_New_Line := True; P := P + 1; end if; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index ac7699d98ae..dff953b404d 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3777,9 +3777,10 @@ package body Exp_Ch5 is Op := Node (Prim); if Alias (Op) = Iter - or else (Chars (Op) = Chars (Iter) - and then Present (DTC_Entity (Op)) - and then DT_Position (Op) = DT_Position (Iter)) + or else + (Chars (Op) = Chars (Iter) + and then Present (DTC_Entity (Op)) + and then DT_Position (Op) = DT_Position (Iter)) then return Op; end if; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index a7dd4db71be..b2e821ca119 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -9767,7 +9767,10 @@ package body Exp_Ch9 is -- type. This object is later passed to the appropriate protected object -- initialization routine. - if Has_Entries (Prot_Typ) then + if Has_Entries (Prot_Typ) + and then Corresponding_Runtime_Package (Prot_Typ) = + System_Tasking_Protected_Objects_Entries + then declare Count : Int; Item : Entity_Id; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index d00a31c406a..92d3003999d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -11960,7 +11960,7 @@ package body Sem_Ch3 is if (No (Item) or else Nkind (Item) /= N_Aspect_Specification or else Entity (Item) = Full_Base) - and then Present (First_Rep_Item (Priv)) + and then Present (First_Rep_Item (Priv)) then Set_First_Rep_Item (Full, Priv_Item); @@ -14182,7 +14182,8 @@ package body Sem_Ch3 is Governed_By => Assoc_List, Into => Comp_List, Report_Errors => Errors); - pragma Assert (not Errors); + pragma Assert (not Errors + or else Serious_Errors_Detected > 0); Create_All_Components; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 9060fb1b723..253a12dabbb 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -7798,7 +7798,16 @@ package body Sem_Ch4 is Ref := Empty; Typ := Underlying_Type (Base_Type (Typ)); - Inspect_Primitives (Typ, Ref); + Inspect_Primitives (Typ, Ref); + + -- Now look for explicit declarations of an indexing operation. + -- If the type is private the operation may be declared in the + -- visible part that contains the partial view. + + if Is_Private_Type (T) then + Inspect_Declarations (T, Ref); + end if; + Inspect_Declarations (Typ, Ref); return Ref; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 5897454d427..fefdbc31b2a 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -3273,6 +3273,19 @@ package body Sem_Ch5 is Set_Has_Created_Identifier (N); end if; + -- If the iterator specification has a syntactic error, transform + -- construct into an infinite loop to prevent a crash and perform + -- some analysis. + + if Present (Iter) + and then Present (Iterator_Specification (Iter)) + and then Error_Posted (Iterator_Specification (Iter)) + then + Set_Iteration_Scheme (N, Empty); + Analyze (N); + return; + end if; + -- Iteration over a container in Ada 2012 involves the creation of a -- controlled iterator object. Wrap the loop in a block to ensure the -- timely finalization of the iterator and release of container locks. diff --git a/gcc/ada/stylesw.adb b/gcc/ada/stylesw.adb index a708da9e5bc..8ff3ce6db54 100644 --- a/gcc/ada/stylesw.adb +++ b/gcc/ada/stylesw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -471,7 +471,7 @@ package body Stylesw is Write_Line ("unrecognized switch -gnaty" & C & " ignored"); else Err_Col := Err_Col - 1; - Bad_Style_Switch ("invalid style switch: " & C); + Bad_Style_Switch ("invalid style switch"); return; end if; end case; @@ -580,7 +580,7 @@ package body Stylesw is Write_Line ("unrecognized switch -gnaty-" & C & " ignored"); else Err_Col := Err_Col - 1; - Bad_Style_Switch ("invalid style switch: " & C); + Bad_Style_Switch ("invalid style switch"); return; end if; end case; -- 2.30.2