From 92cbddaa2ae10e2cb208067b0fc2871ab81a62bc Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 12 Oct 2010 11:42:31 +0200 Subject: [PATCH] [multiple changes] 2010-10-12 Robert Dewar * par-endh.adb (Check_End): Don't swallow semicolon or aspects after END RECORD. * sem_attr.adb (Eval_Attribute): Code clean up. 2010-10-12 Robert Dewar * par-ch12.adb (P_Formal_Private_Type_Definition): Improve error messages and recovery for case of out of order Abstract/Tagged/Private keywords. * par-ch3.adb (P_Type_Declaration): Improve error messages and recovery for case of out of order Abstract/Tagged/Private keywords. 2010-10-12 Ed Schonberg * inline.adb (Analyze_Inlined_Bodies): Restrict previous change to case where child unit is main unit of compilation. From-SVN: r165354 --- gcc/ada/ChangeLog | 19 ++++++++++++ gcc/ada/inline.adb | 25 ++++++++++------ gcc/ada/par-ch12.adb | 14 +++++++++ gcc/ada/par-ch3.adb | 26 ++++++++++++---- gcc/ada/par-endh.adb | 71 +++++++++++++++++++++++--------------------- gcc/ada/sem_attr.adb | 39 ++++++++---------------- 6 files changed, 120 insertions(+), 74 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9f1aff012f2..02f1e543cd7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2010-10-12 Robert Dewar + + * par-endh.adb (Check_End): Don't swallow semicolon or aspects after + END RECORD. + * sem_attr.adb (Eval_Attribute): Code clean up. + +2010-10-12 Robert Dewar + + * par-ch12.adb (P_Formal_Private_Type_Definition): Improve error + messages and recovery for case of out of order Abstract/Tagged/Private + keywords. + * par-ch3.adb (P_Type_Declaration): Improve error messages and recovery + for case of out of order Abstract/Tagged/Private keywords. + +2010-10-12 Ed Schonberg + + * inline.adb (Analyze_Inlined_Bodies): Restrict previous change to case + where child unit is main unit of compilation. + 2010-10-12 Robert Dewar * aspects.ads, aspects.adb (Move_Aspects): New procedure. diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index f7e2b305ffd..e5371445ea3 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -626,19 +626,19 @@ package body Inline is Pack : Entity_Id; S : Succ_Index; - function Is_Ancestor + function Is_Ancestor_Of_Main (U_Name : Entity_Id; Nam : Node_Id) return Boolean; -- Determine whether the unit whose body is loaded is an ancestor of - -- a unit mentioned in a with_clause of that body. The body is not + -- the main unit, and has a with_clause on it. The body is not -- analyzed yet, so the check is purely lexical: the name of the with -- clause is a selected component, and names of ancestors must match. - ----------------- - -- Is_Ancestor -- - ----------------- + ------------------------- + -- Is_Ancestor_Of_Main -- + ------------------------- - function Is_Ancestor + function Is_Ancestor_Of_Main (U_Name : Entity_Id; Nam : Node_Id) return Boolean is @@ -649,6 +649,12 @@ package body Inline is return False; else + if Chars (Selector_Name (Nam)) /= + Chars (Cunit_Entity (Main_Unit)) + then + return False; + end if; + Pref := Prefix (Nam); if Nkind (Pref) = N_Identifier then @@ -666,10 +672,10 @@ package body Inline is else -- A is an ancestor of A.B.C if it is an ancestor of A.B - return Is_Ancestor (U_Name, Pref); + return Is_Ancestor_Of_Main (U_Name, Pref); end if; end if; - end Is_Ancestor; + end Is_Ancestor_Of_Main; -- Start of processing for Analyze_Inlined_Bodies @@ -751,7 +757,8 @@ package body Inline is Item := First (Context_Items (Body_Unit)); while Present (Item) loop if Nkind (Item) = N_With_Clause - and then Is_Ancestor (U_Id, Name (Item)) + and then + Is_Ancestor_Of_Main (U_Id, Name (Item)) then Set_Is_Inlined (U_Id, False); exit; diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb index 81f5e257c02..20dfde989dc 100644 --- a/gcc/ada/par-ch12.adb +++ b/gcc/ada/par-ch12.adb @@ -834,6 +834,20 @@ package body Ch12 is Set_Sloc (Def_Node, Token_Ptr); T_Private; + + if Token = Tok_Tagged then -- CODEFIX + Error_Msg_SC ("TAGGED must come before PRIVATE"); + Scan; -- past TAGGED + + elsif Token = Tok_Abstract then -- CODEFIX + Error_Msg_SC ("`ABSTRACT TAGGED` must come before PRIVATE"); + Scan; -- past ABSTRACT + + if Token = Tok_Tagged then + Scan; -- past TAGGED + end if; + end if; + return Def_Node; end P_Formal_Private_Type_Definition; diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 9cca962a069..27a9cfc8cf1 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -309,11 +309,11 @@ package body Ch3 is -- Error recovery: can raise Error_Resync - -- Note: The processing for full type declaration, incomplete type - -- declaration, private type declaration and type definition is - -- included in this function. The processing for concurrent type - -- declarations is NOT here, but rather in chapter 9 (i.e. this - -- function handles only declarations starting with TYPE). + -- The processing for full type declarations, incomplete type declarations, + -- private type declarations and type definitions is included in this + -- function. The processing for concurrent type declarations is NOT here, + -- but rather in chapter 9 (this function handles only declarations + -- starting with TYPE). function P_Type_Declaration return Node_Id is Abstract_Present : Boolean := False; @@ -770,6 +770,22 @@ package body Ch3 is when Tok_Private => Decl_Node := New_Node (N_Private_Type_Declaration, Type_Loc); Scan; -- past PRIVATE + + -- Check error cases of private [abstract] tagged + + if Token = Tok_Abstract then + Error_Msg_SC ("`ABSTRACT TAGGED` must come before PRIVATE"); + Scan; -- past ABSTRACT + + if Token = Tok_Tagged then + Scan; -- past TAGGED + end if; + + elsif Token = Tok_Tagged then + Error_Msg_SC ("TAGGED must come before PRIVATE"); + Scan; -- past TAGGED + end if; + exit; -- Ada 2005 (AI-345): Protected, synchronized or task interface diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb index 6e12a179935..8bb75f831e3 100644 --- a/gcc/ada/par-endh.adb +++ b/gcc/ada/par-endh.adb @@ -387,48 +387,51 @@ package body Endh is end if; end if; - -- Scan aspect specifications if permitted here + -- Deal with terminating aspect specifications and following semi- + -- colon. We skip this in the case of END RECORD, since in this + -- case the aspect specifications and semicolon are handled at + -- a higher level. - if Aspect_Specifications_Present then - if No (Decl) then - P_Aspect_Specifications (Error); - else - P_Aspect_Specifications (Decl); - end if; + if End_Type /= E_Record then - -- Except in case of END RECORD, semicolon must follow. For END - -- RECORD, a semicolon does follow, but it is part of a higher level - -- construct. In any case, a missing semicolon is not serious enough - -- to consider the END statement to be bad in the sense that we - -- are dealing with (i.e. to be suspicious that it is not in fact - -- the END statement we are looking for!) + -- Scan aspect specifications if permitted here - elsif End_Type /= E_Record then - if Token = Tok_Semicolon then - T_Semicolon; + if Aspect_Specifications_Present then + if No (Decl) then + P_Aspect_Specifications (Error); + else + P_Aspect_Specifications (Decl); + end if; - -- Semicolon is missing. If the missing semicolon is at the end - -- of the line, i.e. we are at the start of the line now, then - -- a missing semicolon gets flagged, but is not serious enough - -- to consider the END statement to be bad in the sense that we - -- are dealing with (i.e. to be suspicious that this END is not - -- the END statement we are looking for). + -- If no aspect specifications, must have a semicolon - -- Similarly, if we are at a colon, we flag it but a colon for - -- a semicolon is not serious enough to consider the END to be - -- incorrect. Same thing for a period in place of a semicolon. + elsif End_Type /= E_Record then + if Token = Tok_Semicolon then + T_Semicolon; - elsif Token_Is_At_Start_Of_Line - or else Token = Tok_Colon - or else Token = Tok_Dot - then - T_Semicolon; + -- Semicolon is missing. If the missing semicolon is at the end + -- of the line, i.e. we are at the start of the line now, then + -- a missing semicolon gets flagged, but is not serious enough + -- to consider the END statement to be bad in the sense that we + -- are dealing with (i.e. to be suspicious that this END is not + -- the END statement we are looking for). - -- If the missing semicolon is not at the start of the line, - -- then we do consider the END line to be dubious in this sense. + -- Similarly, if we are at a colon, we flag it but a colon for + -- a semicolon is not serious enough to consider the END to be + -- incorrect. Same thing for a period in place of a semicolon. - else - End_OK := False; + elsif Token_Is_At_Start_Of_Line + or else Token = Tok_Colon + or else Token = Tok_Dot + then + T_Semicolon; + + -- If the missing semicolon is not at the start of the line, + -- then we consider the END line to be dubious in this sense. + + else + End_OK := False; + end if; end if; end if; end if; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 469e77cb7c9..3c8a03d723d 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -5375,33 +5375,20 @@ package body Sem_Attr is -- constructs from this test comes from some internal usage in packed -- arrays, which otherwise fails, could use more analysis perhaps??? - declare - function Within_Aspect (N : Node_Id) return Boolean; - -- True if within aspect expression. Giant kludge, do this test only - -- within an aspect, since doing it more widely, even though clearly - -- correct, causes regressions notably in GA19-001 ??? + -- We do however go ahead with generic actual types, otherwise we get + -- some regressions, probably these types should be frozen anyway??? - function Within_Aspect (N : Node_Id) return Boolean - is - begin - if No (Parent (N)) then - return False; - elsif Nkind (N) = N_Aspect_Specification then - return True; - else - return Within_Aspect (Parent (N)); - end if; - end Within_Aspect; - - begin - if In_Spec_Expression - and then Comes_From_Source (N) - and then not (Is_Entity_Name (P) and then Is_Frozen (Entity (P))) - and then Within_Aspect (N) - then - return; - end if; - end; + if In_Spec_Expression + and then Comes_From_Source (N) + and then not (Is_Entity_Name (P) + and then + (Is_Frozen (Entity (P)) + or else (Is_Type (Entity (P)) + and then + Is_Generic_Actual_Type (Entity (P))))) + then + return; + end if; -- Acquire first two expressions (at the moment, no attributes take more -- than two expressions in any case).