From e7cd165c2fdf395c487a13db8c17a678620e2716 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Fri, 17 Oct 2014 08:47:56 +0000 Subject: [PATCH] sem_ch3.adb, [...]: Minor reformatting. 2014-10-17 Robert Dewar * sem_ch3.adb, a-strsea.adb: Minor reformatting. * par-ch6.adb (P_Subprogram): Fix bad handling of null procedures. From-SVN: r216375 --- gcc/ada/ChangeLog | 5 +++ gcc/ada/a-strsea.adb | 4 +-- gcc/ada/par-ch6.adb | 13 ++++++-- gcc/ada/sem_ch3.adb | 78 +++++++++++++++++++------------------------- 4 files changed, 50 insertions(+), 50 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c5d6122afd2..45f4f31f798 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2014-10-17 Robert Dewar + + * sem_ch3.adb, a-strsea.adb: Minor reformatting. + * par-ch6.adb (P_Subprogram): Fix bad handling of null procedures. + 2014-10-17 Ed Schonberg * sem_ch3.adb (Build_Derived_Enumeration_Type): Propagate aspect diff --git a/gcc/ada/a-strsea.adb b/gcc/ada/a-strsea.adb index d45c7955a47..82acd1a6bf3 100644 --- a/gcc/ada/a-strsea.adb +++ b/gcc/ada/a-strsea.adb @@ -482,7 +482,7 @@ package body Ada.Strings.Search is is begin - -- AI05-056 : if source is empty result is always 0. + -- AI05-056: If source is empty result is always zero if Source'Length = 0 then return 0; @@ -514,7 +514,7 @@ package body Ada.Strings.Search is is begin - -- AI05-056 : if source is empty result is always 0. + -- AI05-056: If source is empty result is always zero if Source'Length = 0 then return 0; diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index 5307f851d83..7cc2f5da1da 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -938,7 +938,7 @@ package body Ch6 is Aspects := Get_Aspect_Specifications (Semicolon => False); -- Aspects may be present on a subprogram body. The source parsed - -- so far is that of its specification, go parse the body and attach + -- so far is that of its specification. Go parse the body and attach -- the collected aspects, if any, to the body. if Token = Tok_Is then @@ -959,7 +959,14 @@ package body Ch6 is -- Semicolon Used in Place of IS" in body of Parser package) -- Note that SIS_Missing_Semicolon_Message is already set properly. - if Pf_Flags.Pbod then + if Pf_Flags.Pbod + + -- Disconnnect this processing if we have scanned a null procedure + -- because in this case the spec is complete anyway with no body. + + and then (Nkind (Specification_Node) /= N_Procedure_Specification + or else not Null_Present (Specification_Node)) + then SIS_Labl := Scope.Table (Scope.Last).Labl; SIS_Sloc := Scope.Table (Scope.Last).Sloc; SIS_Ecol := Scope.Table (Scope.Last).Ecol; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 5cf186a66e1..473bff83716 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3285,19 +3285,20 @@ package body Sem_Ch3 is -- Enter_Name will handle the visibility. or else - (Is_Discriminal (Id) + (Is_Discriminal (Id) and then Ekind (Discriminal_Link (Id)) = - E_Entry_Index_Parameter) + E_Entry_Index_Parameter) -- The current object is the renaming for a generic declared -- within the instance. or else - (Ekind (Prev_Entity) = E_Package - and then Nkind (Parent (Prev_Entity)) = - N_Package_Renaming_Declaration - and then not Comes_From_Source (Prev_Entity) - and then Is_Generic_Instance (Renamed_Entity (Prev_Entity)))) + (Ekind (Prev_Entity) = E_Package + and then Nkind (Parent (Prev_Entity)) = + N_Package_Renaming_Declaration + and then not Comes_From_Source (Prev_Entity) + and then + Is_Generic_Instance (Renamed_Entity (Prev_Entity)))) then Prev_Entity := Empty; end if; @@ -4236,9 +4237,7 @@ package body Sem_Ch3 is Parent_Type := Find_Type_Of_Subtype_Indic (Indic); Parent_Base := Base_Type (Parent_Type); - if Parent_Type = Any_Type - or else Etype (Parent_Type) = Any_Type - then + if Parent_Type = Any_Type or else Etype (Parent_Type) = Any_Type then Set_Ekind (T, Ekind (Parent_Type)); Set_Etype (T, Any_Type); goto Leave; @@ -6374,9 +6373,9 @@ package body Sem_Ch3 is -- this right??? if Nkind (Indic) = N_Subtype_Indication then - Apply_Range_Check (Range_Expression (Constraint (Indic)), - Parent_Type, - Source_Typ => Entity (Subtype_Mark (Indic))); + Apply_Range_Check + (Range_Expression (Constraint (Indic)), Parent_Type, + Source_Typ => Entity (Subtype_Mark (Indic))); end if; end if; end Build_Derived_Enumeration_Type; @@ -8024,7 +8023,7 @@ package body Sem_Ch3 is elsif Is_Limited_Record (Parent_Type) or else (Present (Full_View (Parent_Type)) - and then Is_Limited_Record (Full_View (Parent_Type))) + and then Is_Limited_Record (Full_View (Parent_Type))) then if not Is_Interface (Parent_Type) or else Is_Synchronized_Interface (Parent_Type) @@ -8210,7 +8209,7 @@ package body Sem_Ch3 is Set_Is_Constrained (Derived_Type, not (Inherit_Discrims - or else Has_Unknown_Discriminants (Derived_Type))); + or else Has_Unknown_Discriminants (Derived_Type))); end if; -- STEP 3: initialize fields of derived type @@ -8607,7 +8606,7 @@ package body Sem_Ch3 is -- Set SSO default for record or array type if (Is_Array_Type (Derived_Type) - or else Is_Record_Type (Derived_Type)) + or else Is_Record_Type (Derived_Type)) and then Is_Base_Type (Derived_Type) then Set_Default_SSO (Derived_Type); @@ -8909,8 +8908,7 @@ package body Sem_Ch3 is elsif Nkind (Constr) = N_Range or else (Nkind (Constr) = N_Attribute_Reference - and then - Attribute_Name (Constr) = Name_Range) + and then Attribute_Name (Constr) = Name_Range) then Error_Msg_N ("a range is not a valid discriminant constraint", Constr); @@ -12181,7 +12179,8 @@ package body Sem_Ch3 is Get_Index_Bounds (Old_Index, Lo_Expr, Hi_Expr); if Is_Discriminant (Lo_Expr) - or else Is_Discriminant (Hi_Expr) + or else + Is_Discriminant (Hi_Expr) then Need_To_Create_Itype := True; end if; @@ -12401,7 +12400,7 @@ package body Sem_Ch3 is -- were declared in Typ's private view. or else (Is_Private_Type (Discrim_Scope) - and then Chars (Discrim_Scope) = Chars (Typ)) + and then Chars (Discrim_Scope) = Chars (Typ)) -- or else we are deriving from the full view and the -- discriminant is declared in the private entity. @@ -13371,9 +13370,7 @@ package body Sem_Ch3 is -- The tag and the possible parent component are unconditionally in -- the subtype. - if Is_Tagged_Type (Typ) - or else Has_Controlled_Component (Typ) - then + if Is_Tagged_Type (Typ) or else Has_Controlled_Component (Typ) then Old_C := First_Component (Typ); while Present (Old_C) loop if Nam_In (Chars (Old_C), Name_uTag, Name_uParent) then @@ -15015,8 +15012,8 @@ package body Sem_Ch3 is loop exit when No (Partial_View) or else (Has_Private_Declaration (Partial_View) - and then - Full_View (Partial_View) = Derived_Type); + and then + Full_View (Partial_View) = Derived_Type); Next_Entity (Partial_View); end loop; @@ -15373,9 +15370,7 @@ package body Sem_Ch3 is -- subtype of Any_Type, and set a few attributes to prevent cascaded -- errors. If this is a self-definition, emit error now. - if T = Parent_Type - or else T = Etype (Parent_Type) - then + if T = Parent_Type or else T = Etype (Parent_Type) then Error_Msg_N ("type cannot be used in its own definition", Indic); end if; @@ -15858,9 +15853,7 @@ package body Sem_Ch3 is -- Start of processing for Expand_To_Stored_Constraint begin - if No (Constraint) - or else Is_Empty_Elmt_List (Constraint) - then + if No (Constraint) or else Is_Empty_Elmt_List (Constraint) then return No_Elist; end if; @@ -16242,7 +16235,7 @@ package body Sem_Ch3 is if Is_Type (Prev) and then (Is_Tagged_Type (Prev) - or else Present (Class_Wide_Type (Prev))) + or else Present (Class_Wide_Type (Prev))) then -- Ada 2012 (AI05-0162): A private type may be the completion of -- an incomplete type. @@ -16937,8 +16930,7 @@ package body Sem_Ch3 is elsif Nkind (C) = N_Digits_Constraint then return Is_Decimal_Fixed_Point_Type (Entity (Subtype_Mark (N))) - or else - Present (Range_Constraint (C)); + or else Present (Range_Constraint (C)); elsif Nkind (C) = N_Delta_Constraint then return Present (Range_Constraint (C)); @@ -17028,7 +17020,7 @@ package body Sem_Ch3 is -- Start of processing for Inherit_Component begin - pragma Assert (not Is_Tagged or else not Stored_Discrim); + pragma Assert (not Is_Tagged or not Stored_Discrim); Set_Parent (New_C, Parent (Old_C)); @@ -17073,7 +17065,7 @@ package body Sem_Ch3 is elsif (Is_Private_Type (Derived_Base) and then not Is_Generic_Type (Derived_Base)) or else (Is_Empty_Elmt_List (Discs) - and then not Expander_Active) + and then not Expander_Active) then Set_Etype (New_C, Etype (Old_C)); @@ -17215,9 +17207,9 @@ package body Sem_Ch3 is and then Present (First_Discriminant (Derived_Base)) and then (not Is_Private_Type (Derived_Base) - or else Is_Completely_Hidden - (First_Stored_Discriminant (Derived_Base)) - or else Is_Generic_Type (Derived_Base)) + or else Is_Completely_Hidden + (First_Stored_Discriminant (Derived_Base)) + or else Is_Generic_Type (Derived_Base)) then D := First_Discriminant (Derived_Base); while Present (D) loop @@ -18779,9 +18771,7 @@ package body Sem_Ch3 is begin -- Abstract interfaces are only associated with tagged record types - if not Is_Tagged_Type (Typ) - or else not Is_Record_Type (Typ) - then + if not Is_Tagged_Type (Typ) or else not Is_Record_Type (Typ) then return; end if; @@ -20488,9 +20478,7 @@ package body Sem_Ch3 is -- Normal case - if Ada_Version < Ada_2005 - or else not Interface_Present (Def) - then + if Ada_Version < Ada_2005 or else not Interface_Present (Def) then if Limited_Present (Def) then Check_SPARK_05_Restriction ("limited is not allowed", N); end if; -- 2.30.2