From 95ac2d90ea5ca02ad6934b0769bfaaa7c982e417 Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 2 Mar 2015 09:28:56 +0000 Subject: [PATCH] 2015-03-02 Robert Dewar * sem_ch3.adb, exp_attr.adb, checks.adb, exp_aggr.adb: Minor reformatting. 2015-03-02 Ed Schonberg * sem_ch8.adb: extend use of Available_Subtype. 2015-03-02 Hristian Kirtchev * sem_prag.adb (Duplication_Error): Remove the special handling of 'Class or _Class in the context of pre/postconditions. (Process_Class_Wide_Condition): Remove the special handling of 'Class or _Class in the context of pre/postconditions. * sem_util.adb (Original_Aspect_Pragma_Name): Names Pre_Class and Post_Class no longer need to be converted to _Pre and _Post. * sem_util.ads (Original_Aspect_Pragma_Name): Update the comment on usage. 2015-03-02 Hristian Kirtchev * exp_ch6.adb (Process_Preconditions): Modify the mechanism that find the first source declaration to correct exit the loop once it has been found. 2015-03-02 Gary Dismukes * a-strsea.adb: Minor typo fix. 2015-03-02 Bob Duff * einfo.ads: Minor comment fixes. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@221103 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 34 ++++++++++++++++++++++++++++++ gcc/ada/a-strsea.adb | 4 ++-- gcc/ada/checks.adb | 2 +- gcc/ada/einfo.ads | 6 +++--- gcc/ada/exp_aggr.adb | 2 +- gcc/ada/exp_attr.adb | 9 ++++---- gcc/ada/exp_ch6.adb | 5 +++-- gcc/ada/sem_ch3.adb | 2 +- gcc/ada/sem_ch8.adb | 3 +-- gcc/ada/sem_prag.adb | 59 ++++++++++------------------------------------------ gcc/ada/sem_util.adb | 7 ++----- gcc/ada/sem_util.ads | 2 -- 12 files changed, 64 insertions(+), 71 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index daa095167dc..ca3de2d8f43 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2015-03-02 Robert Dewar + + * sem_ch3.adb, exp_attr.adb, checks.adb, exp_aggr.adb: Minor + reformatting. + +2015-03-02 Ed Schonberg + + * sem_ch8.adb: extend use of Available_Subtype. + +2015-03-02 Hristian Kirtchev + + * sem_prag.adb (Duplication_Error): Remove the special handling + of 'Class or _Class in the context of pre/postconditions. + (Process_Class_Wide_Condition): Remove the special handling of + 'Class or _Class in the context of pre/postconditions. + * sem_util.adb (Original_Aspect_Pragma_Name): Names Pre_Class + and Post_Class no longer need to be converted to _Pre and _Post. + * sem_util.ads (Original_Aspect_Pragma_Name): Update the comment + on usage. + +2015-03-02 Hristian Kirtchev + + * exp_ch6.adb (Process_Preconditions): Modify the + mechanism that find the first source declaration to correct exit + the loop once it has been found. + +2015-03-02 Gary Dismukes + + * a-strsea.adb: Minor typo fix. + +2015-03-02 Bob Duff + + * einfo.ads: Minor comment fixes. + 2015-03-02 Gary Dismukes * einfo.adb, checks.adb: Minor reformatting and typo fixes. diff --git a/gcc/ada/a-strsea.adb b/gcc/ada/a-strsea.adb index dd3d75c143a..42d57dfc283 100644 --- a/gcc/ada/a-strsea.adb +++ b/gcc/ada/a-strsea.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -263,7 +263,7 @@ package body Ada.Strings.Search is -- Here if no token found - -- RM 2005 A.4.3 (68/1)) specifies that an exception must be raised if + -- RM 2005 A.4.3 (68/1) specifies that an exception must be raised if -- Source'First is not positive and is assigned to First. Formulation -- is slightly different in RM 2012, but the intent seems similar, so -- we check explicitly for that condition. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 759f94075a3..e869605c2de 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -2576,7 +2576,7 @@ package body Checks is or else Is_Formal_Subprogram (Subp) - -- Do not process imported subprograms since pre- and postconditions + -- Do not process imported subprograms since pre and postconditions -- are never verified on routines coming from a different language. or else Is_Imported (Subp) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 129e0d0fade..43ae961cc96 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2882,7 +2882,7 @@ package Einfo is -- Is_Public (Flag10) -- Defined in all entities. Set to indicate that an entity defined in -- one compilation unit can be referenced from other compilation units. --- If this reference causes a reference in the generated variable, for +-- If this reference causes a reference in the generated code, for -- example in the case of a variable name, then the backend will generate -- an appropriate external name for use by the linker. @@ -3875,8 +3875,8 @@ package Einfo is -- Defined in all entities. Points to the entity for the scope (block, -- loop, subprogram, package etc.) in which the entity is declared. -- Since this field is in the base part of the entity node, the access --- routines for this field are in Sinfo. Note that for a child package, --- the Scope will be the parent package, and for a non-child package, +-- routines for this field are in Sinfo. Note that for a child unit, +-- the Scope will be the parent package, and for a root library unit, -- the Scope will be Standard. -- Scope_Depth (synthesized) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 2539033fce5..b53b28febf5 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -1542,12 +1542,12 @@ package body Exp_Aggr is if Is_Scalar_Type (Ctype) then if Present (Default_Aspect_Component_Value (Typ)) then return Default_Aspect_Component_Value (Typ); - elsif Present (Default_Aspect_Value (Ctype)) then return Default_Aspect_Value (Ctype); else return Empty; end if; + else return Empty; end if; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index a19b2e19fe6..a4f6f5a8082 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3654,16 +3654,17 @@ package body Exp_Attr is Expr := Make_Function_Call (Loc, - Name => + Name => New_Occurrence_Of (RTE (RE_Descendant_Tag), Loc), Parameter_Associations => New_List ( Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Standard_String, Loc), + Prefix => + New_Occurrence_Of (Standard_String, Loc), Attribute_Name => Name_Input, - Expressions => New_List ( + Expressions => New_List ( Relocate_Node (Duplicate_Subexpr (Strm)))), Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (P_Type, Loc), + Prefix => New_Occurrence_Of (P_Type, Loc), Attribute_Name => Name_Tag))); Set_Etype (Expr, RTE (RE_Tag)); diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 01130cb186a..1311615c8a7 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -7718,9 +7718,10 @@ package body Exp_Ch6 is Decl := First (Decls); while Present (Decl) loop - if not Comes_From_Source (Decl) then - Insert_Node := Decl; + if Comes_From_Source (Decl) then exit; + else + Insert_Node := Decl; end if; Next (Decl); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 1e4addacae5..537be5ea6f3 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -16466,7 +16466,7 @@ package body Sem_Ch3 is Set_Has_Private_Declaration (Prev); Set_Has_Private_Declaration (Id); - -- AI12-0133: indicate whether we have a partial view with + -- AI12-0133: Indicate whether we have a partial view with -- unknown discriminants, in which case initialization of objects -- of the type do not receive an invariant check. diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 9f2600fd570..3e7d5ab70a7 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6593,8 +6593,7 @@ package body Sem_Ch8 is and then (not Is_Entity_Name (P) or else Chars (Entity (P)) /= Name_uInit) then - if Is_Entity_Name (P) - and then Ekind (Etype (P)) = E_Record_Subtype + if Ekind (Etype (P)) = E_Record_Subtype and then Nkind (Parent (Etype (P))) = N_Subtype_Declaration and then Is_Array_Type (Etype (Selector)) and then not Is_Packed (Etype (Selector)) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index e81e951e1fb..04d73173453 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -21445,10 +21445,6 @@ package body Sem_Prag is procedure Replace_Types is new Traverse_Proc (Replace_Type); - -- Local variables - - Prag_Nam : constant Name_Id := Original_Aspect_Pragma_Name (N); - -- Start of processing for Process_Class_Wide_Condition begin @@ -21456,8 +21452,9 @@ package body Sem_Prag is -- dispatching type, therefore the aspect/pragma is illegal. if No (Disp_Typ) then + Error_Msg_Name_1 := Original_Aspect_Pragma_Name (N); + if From_Aspect_Specification (N) then - Error_Msg_Name_1 := Prag_Nam; Error_Msg_N ("aspect % can only be specified for a primitive operation " & "of a tagged type", Corresponding_Aspect (N)); @@ -21465,12 +21462,6 @@ package body Sem_Prag is -- The pragma is a source construct else - if Prag_Nam = Name_Precondition then - Error_Msg_Name_1 := Name_Pre_Class; - else - Error_Msg_Name_1 := Name_Post_Class; - end if; - Error_Msg_N ("pragma % can only be specified for a primitive operation " & "of a tagged type", N); @@ -24973,11 +24964,11 @@ package body Sem_Prag is procedure Duplication_Error (Prag : Node_Id; Prev : Node_Id) is Prag_From_Asp : constant Boolean := From_Aspect_Specification (Prag); - Prag_Nam : constant Name_Id := Original_Aspect_Pragma_Name (Prag); Prev_From_Asp : constant Boolean := From_Aspect_Specification (Prev); begin - Error_Msg_Sloc := Sloc (Prev); + Error_Msg_Sloc := Sloc (Prev); + Error_Msg_Name_1 := Original_Aspect_Pragma_Name (Prag); -- Emit a precise message to distinguish between source pragmas and -- pragmas generated from aspects. The ordering of the two pragmas is @@ -24989,42 +24980,14 @@ package body Sem_Prag is -- No error is emitted when both pragmas come from aspects because this -- is already detected by the general aspect analysis mechanism. - if Prag_Nam = Name_uPre then - Error_Msg_Name_1 := Name_Pre; - elsif Prag_Nam = Name_uPost then - Error_Msg_Name_1 := Name_Post; - else - Error_Msg_Name_1 := Prag_Nam; - end if; - - -- The item appears as aspect XXX'Class or pragma XXX_Class - - if Class_Present (Prag) then - if Prag_From_Asp and Prev_From_Asp then - null; - elsif Prag_From_Asp then - Error_Msg_N - ("aspect `%'Class` duplicates pragma declared #", Prag); - elsif Prev_From_Asp then - Error_Msg_N - ("pragma `%_Class` duplicates aspect declared #", Prag); - else - Error_Msg_N - ("pragma `%_Class` duplicates pragma declared #", Prag); - end if; - - -- Otherwise the pragma appears in its normal form - + if Prag_From_Asp and Prev_From_Asp then + null; + elsif Prag_From_Asp then + Error_Msg_N ("aspect % duplicates pragma declared #", Prag); + elsif Prev_From_Asp then + Error_Msg_N ("pragma % duplicates aspect declared #", Prag); else - if Prag_From_Asp and Prev_From_Asp then - null; - elsif Prag_From_Asp then - Error_Msg_N ("aspect % duplicates pragma declared #", Prag); - elsif Prev_From_Asp then - Error_Msg_N ("pragma % duplicates aspect declared #", Prag); - else - Error_Msg_N ("pragma % duplicates pragma declared #", Prag); - end if; + Error_Msg_N ("pragma % duplicates pragma declared #", Prag); end if; end Duplication_Error; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 8bde5795efb..d9ab705bd13 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -15538,15 +15538,12 @@ package body Sem_Util is if Item_Nam = Name_Invariant then Item_Nam := Name_uInvariant; - elsif Nam_In (Item_Nam, Name_Post, Name_Post_Class) then + elsif Item_Nam = Name_Post then Item_Nam := Name_uPost; - elsif Nam_In (Item_Nam, Name_Pre, Name_Pre_Class) then + elsif Item_Nam = Name_Pre then Item_Nam := Name_uPre; - elsif Item_Nam = Name_Invariant then - Item_Nam := Name_uInvariant; - elsif Nam_In (Item_Nam, Name_Type_Invariant, Name_Type_Invariant_Class) then diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index b24f261cfdf..e0781ab9372 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1683,9 +1683,7 @@ package Sem_Util is -- returns the following values: -- -- Invariant -> Name_uInvariant - -- Post -> Name_uPost -- Post'Class -> Name_uPost - -- Pre -> Name_uPre -- Pre'Class -> Name_uPre -- Type_Invariant -> Name_uType_Invariant -- Type_Invariant'Class -> Name_uType_Invariant -- 2.11.4.GIT