From 9aff36e9f183e2f4590a9e03d79ee1e3d21724a2 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Fri, 5 Aug 2011 13:35:04 +0000 Subject: [PATCH] exp_ch7.ads, [...]: Minor reformatting. 2011-08-05 Robert Dewar * exp_ch7.ads, sem_type.adb, make.adb, sem_prag.adb, sem_util.adb, sem_util.ads, sem_attr.adb, restrict.ads, sem_ch6.adb, prj-conf.adb, prj-conf.ads, s-atocou.ads, s-atocou.adb, s-atocou-x86.adb, s-atocou-builtin.adb: Minor reformatting. From-SVN: r177433 --- gcc/ada/ChangeLog | 7 +++++ gcc/ada/exp_ch7.ads | 7 ++--- gcc/ada/make.adb | 7 +++-- gcc/ada/prj-conf.adb | 59 ++++++++++++++++++------------------ gcc/ada/prj-conf.ads | 2 +- gcc/ada/restrict.ads | 5 +++ gcc/ada/s-atocou-builtin.adb | 2 +- gcc/ada/s-atocou-x86.adb | 7 +++-- gcc/ada/s-atocou.adb | 7 ++++- gcc/ada/s-atocou.ads | 11 ++++--- gcc/ada/sem_attr.adb | 4 ++- gcc/ada/sem_ch6.adb | 4 +-- gcc/ada/sem_prag.adb | 2 +- gcc/ada/sem_type.adb | 6 ++-- gcc/ada/sem_util.adb | 14 ++++----- gcc/ada/sem_util.ads | 23 +++++++------- 16 files changed, 97 insertions(+), 70 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5759eaedfa1..82d1301481b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2011-08-05 Robert Dewar + + * exp_ch7.ads, sem_type.adb, make.adb, sem_prag.adb, sem_util.adb, + sem_util.ads, sem_attr.adb, restrict.ads, sem_ch6.adb, prj-conf.adb, + prj-conf.ads, s-atocou.ads, s-atocou.adb, s-atocou-x86.adb, + s-atocou-builtin.adb: Minor reformatting. + 2011-08-05 Yannick Moy * exp_ch7.adb (Establish_Transient_Scope): in formal verification mode, diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads index 68e5e7538d9..4b937d8a7c6 100644 --- a/gcc/ada/exp_ch7.ads +++ b/gcc/ada/exp_ch7.ads @@ -94,10 +94,9 @@ package Exp_Ch7 is function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean; -- True if T is a class-wide type, or if it has controlled parts ("part" - -- means T or any of its subcomponents). This is the same as - -- Needs_Finalization, except when pragma Restrictions (No_Finalization) - -- applies, in which case we know that class-wide objects do not contain - -- controlled parts. + -- means T or any of its subcomponents). Same as Needs_Finalization, except + -- when pragma Restrictions (No_Finalization) applies, in which case we + -- know that class-wide objects do not contain controlled parts. function Get_Global_Pool_For_Access_Type (T : Entity_Id) return Entity_Id; -- Return the pool id for access type T. This is generally the node diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index f6f889d3cb0..b25c220aa8d 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -4874,9 +4874,8 @@ package body Make is -- If the objects were up-to-date check if the executable file is also -- up-to-date. For now always bind and link on the JVM since there is - -- currently no simple way to check whether objects are up-to-date wrt - -- the executable. Similarly in CodePeer mode where there is no - -- executable. + -- currently no simple way to check whether objects are up to date wrt + -- the executable. Same in CodePeer mode where there is no executable. if Targparm.VM_Target /= JVM_Target and then not CodePeer_Mode @@ -7833,6 +7832,8 @@ package body Make is Operating_Mode := Check_Semantics; Check_Object_Consistency := False; + -- Comment needed here, what is going on??? + if Argv'Last >= 7 and then Argv (7) = 'C' then CodePeer_Mode := True; else diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index ab297e5ef97..2fa66ac4496 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -911,7 +911,7 @@ package body Prj.Conf is if Subdirs /= null then Add_Char_To_Name_Buffer (Directory_Separator); - Add_Str_To_Name_Buffer (Subdirs.all); + Add_Str_To_Name_Buffer (Subdirs.all); end if; for J in 1 .. Name_Len loop @@ -924,9 +924,8 @@ package body Prj.Conf is Obj_Dir : constant String := Name_Buffer (1 .. Name_Len); Config_Switches : Argument_List_Access; Args : Argument_List (1 .. 5); - Arg_Last : Positive; - - Obj_Dir_Exists : Boolean := True; + Arg_Last : Positive; + Obj_Dir_Exists : Boolean := True; begin -- Check if the object directory exists. If Setup_Projects is True @@ -958,11 +957,13 @@ package body Prj.Conf is when Error => Raise_Invalid_Config ("object directory " & Obj_Dir & " does not exist"); + when Warning => Prj.Err.Error_Msg (Env.Flags, "?object directory " & Obj_Dir & " does not exist"); Obj_Dir_Exists := False; + when Silent => null; end case; @@ -974,7 +975,8 @@ package body Prj.Conf is if RTS_Languages.Get_First = No_Name then declare Builder : constant Package_Id := - Value_Of (Name_Builder, Project.Decl.Packages, Shared); + Value_Of + (Name_Builder, Project.Decl.Packages, Shared); Switch_Array_Id : Array_Element_Id; procedure Check_RTS_Switches; @@ -988,17 +990,18 @@ package body Prj.Conf is procedure Check_RTS_Switches is Switch_Array : Array_Element; - Switch_List : String_List_Id := Nil_String; - Switch : String_Element; + Switch_List : String_List_Id := Nil_String; + Switch : String_Element; + + Lang : Name_Id; + Lang_Last : Positive; - Lang : Name_Id; - Lang_Last : Positive; begin while Switch_Array_Id /= No_Array_Element loop Switch_Array := Shared.Array_Elements.Table (Switch_Array_Id); - Switch_List := Switch_Array.Value.Values; + Switch_List := Switch_Array.Value.Values; while Switch_List /= Nil_String loop Switch := Shared.String_Elements.Table (Switch_List); @@ -1027,23 +1030,21 @@ package body Prj.Conf is Lang_Last := Lang_Last + 1; end loop; - if - Name_Buffer (Lang_Last + 1) = '=' - then + if Name_Buffer (Lang_Last + 1) = '=' then declare RTS : constant String := - Name_Buffer (Lang_Last + 2 .. - Name_Len); + Name_Buffer (Lang_Last + 2 .. + Name_Len); begin - Name_Buffer (1 .. Lang_Last - 6) - := Name_Buffer (7 .. Lang_Last); + Name_Buffer (1 .. Lang_Last - 6) := + Name_Buffer (7 .. Lang_Last); Name_Len := Lang_Last - 6; To_Lower (Name_Buffer (1 .. Name_Len)); Lang := Name_Find; - if - not Runtime_Name_Set_For (Lang) + if not + Runtime_Name_Set_For (Lang) then Set_Runtime_For (Lang, RTS); end if; @@ -1245,8 +1246,8 @@ package body Prj.Conf is -- If the config file is not auto-generated, warn if there is any --RTS -- switch on the command line. - elsif RTS_Languages.Get_First /= No_Name and then - Opt.Warning_Mode /= Opt.Suppress + elsif RTS_Languages.Get_First /= No_Name + and then Opt.Warning_Mode /= Opt.Suppress then Write_Line ("warning: --RTS is taken into account only in auto-configuration"); @@ -1266,14 +1267,14 @@ package body Prj.Conf is elsif Config_File_Path /= null then Prj.Part.Parse - (In_Tree => Project_Node_Tree, - Project => Config_Project_Node, - Project_File_Name => Config_File_Path.all, - Errout_Handling => Prj.Part.Finalize_If_Error, - Packages_To_Check => Packages_To_Check, - Current_Directory => Current_Directory, - Is_Config_File => True, - Env => Env); + (In_Tree => Project_Node_Tree, + Project => Config_Project_Node, + Project_File_Name => Config_File_Path.all, + Errout_Handling => Prj.Part.Finalize_If_Error, + Packages_To_Check => Packages_To_Check, + Current_Directory => Current_Directory, + Is_Config_File => True, + Env => Env); else Config_Project_Node := Empty_Node; end if; diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads index 977344d455e..bc672cf868c 100644 --- a/gcc/ada/prj-conf.ads +++ b/gcc/ada/prj-conf.ads @@ -187,6 +187,6 @@ package Prj.Conf is -- runtime was specified for the language using option --RTS. function Runtime_Name_Set_For (Language : Name_Id) return Boolean; - -- Returns True only of Set_Runtime_For has been called for the Language + -- Returns True only if Set_Runtime_For has been called for the Language end Prj.Conf; diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index 0c1c5b6cbfa..f022bceccc8 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -206,6 +206,11 @@ package Restrict is -- Subprograms -- ----------------- + -- Note: several of these subprograms can generate error messages (e.g. + -- Check_Restriction). These routines should be called in the analyzer + -- rather than the expander, so that the associated error messages are + -- correctly generated in semantics only (-gnatc) mode. + function Abort_Allowed return Boolean; pragma Inline (Abort_Allowed); -- Tests to see if abort is allowed by the current restrictions settings. diff --git a/gcc/ada/s-atocou-builtin.adb b/gcc/ada/s-atocou-builtin.adb index 38ef24a202b..8ec851e8f20 100644 --- a/gcc/ada/s-atocou-builtin.adb +++ b/gcc/ada/s-atocou-builtin.adb @@ -29,7 +29,7 @@ -- -- ------------------------------------------------------------------------------ --- This package provides implementation of atomic counter for platforms where +-- This package implements Atomic_Counter operatiobns for platforms where -- GCC supports __sync_add_and_fetch_4 and __sync_sub_and_fetch_4 builtins. package body System.Atomic_Counters is diff --git a/gcc/ada/s-atocou-x86.adb b/gcc/ada/s-atocou-x86.adb index 8f0c7fb8e05..1625ebaecbe 100644 --- a/gcc/ada/s-atocou-x86.adb +++ b/gcc/ada/s-atocou-x86.adb @@ -30,13 +30,16 @@ ------------------------------------------------------------------------------ -- This implementation of the package for x86 processor. GCC can't generate --- code for atomic builtins for 386 CPU there only increment/decrement --- instructions are supported, thus implementaton use assembler code. +-- code for atomic builtins for 386 CPU. Only increment/decrement instructions +-- are supported, thus this implementaton uses machine code insertions to +-- access the necessary instructions. with System.Machine_Code; package body System.Atomic_Counters is + -- Add comments showing in normal asm language what we generate??? + --------------- -- Decrement -- --------------- diff --git a/gcc/ada/s-atocou.adb b/gcc/ada/s-atocou.adb index 709d3889e04..8f2ca01b6d9 100644 --- a/gcc/ada/s-atocou.adb +++ b/gcc/ada/s-atocou.adb @@ -29,7 +29,12 @@ -- -- ------------------------------------------------------------------------------ --- This is dummy version of the package. +-- This is dummy version of the package, for use on platforms where this +-- capability is not supported. Any use of any of the routines in this +-- package will raise Program_Error. + +-- Why don't we use pragma Unimplemented_Unit in a dummy spec, this would +-- seem much more useful than raising an exception at run time ??? package body System.Atomic_Counters is diff --git a/gcc/ada/s-atocou.ads b/gcc/ada/s-atocou.ads index 20ef9e50144..5efcb354847 100644 --- a/gcc/ada/s-atocou.ads +++ b/gcc/ada/s-atocou.ads @@ -29,7 +29,10 @@ -- -- ------------------------------------------------------------------------------ --- This package provides atomic counter on platforms where it is supported. +-- This package provides atomic counter on platforms where it is supported: +-- ??? Please provide a list of such platforms + +-- Why isn't this package available to application programs??? package System.Atomic_Counters is @@ -37,11 +40,11 @@ package System.Atomic_Counters is type Atomic_Counter is limited private; -- Type for atomic counter objects. Note, initial value of the counter is - -- one. This allows to use atomic counter as member of record types when - -- object of these types are created at library level on preelaboratable + -- one. This allows using an atomic counter as member of record types when + -- object of these types are created at library level in preelaborable -- compilation units. -- - -- Atomic counter is declared as private limited type to provide highest + -- Atomic_Counter is declared as private limited type to provide highest -- level of protection from unexpected use. All available operations are -- declared below, and this set should be as small as possible. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 0f00423a850..9ee6a5fca29 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1641,9 +1641,11 @@ package body Sem_Attr is if Restriction_Active (No_Default_Stream_Attributes) then declare T : Entity_Id; + begin if Nam = TSS_Stream_Input - or else Nam = TSS_Stream_Read + or else + Nam = TSS_Stream_Read then T := Type_Without_Stream_Operation (P_Type, TSS_Stream_Read); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 537aa029e94..5f7b1a79ea3 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -4528,8 +4528,8 @@ package body Sem_Ch6 is elsif Ekind (T) = E_Incomplete_Type and then From_With_Type (T) then Set_Has_Delayed_Freeze (Designator); - -- AI05-0151 : incomplete types can now appear in the profile of a - -- subprogram or entry declaration. + -- AI05-0151: In Ada 2012, Incomplete types can appear in the profile + -- of a subprogram or entry declaration. elsif Ekind (T) = E_Incomplete_Type and then Ada_Version >= Ada_2012 diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index de3e3071608..e338b4b70e3 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5061,7 +5061,7 @@ package body Sem_Prag is begin -- Ignore all Restrictions pragma in CodePeer and ALFA modes - if CodePeer_Mode or else ALFA_Mode then + if CodePeer_Mode or ALFA_Mode then return; end if; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 14746773fd8..3d99e185f17 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -1956,9 +1956,9 @@ package body Sem_Type is (Ada_Version = Ada_83 or else (Ada_Version >= Ada_2012 - and then - In_Same_Declaration_List - (Typ, Unit_Declaration_Node (User_Subp)))) + and then + In_Same_Declaration_List + (Typ, Unit_Declaration_Node (User_Subp)))) then if It2.Nam = Predef_Subp then return It1; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 47a8c35f68f..e910dd33983 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -10786,7 +10786,6 @@ package body Sem_Util is while Present (Component) and then Comes_From_Source (Component) loop - -- Skip anonymous types generated by constrained components if not Is_Type (Component) then @@ -12235,10 +12234,12 @@ package body Sem_Util is ------------------------------------ function Type_Without_Stream_Operation - (T : Entity_Id; Op : TSS_Name_Type := TSS_Null) return Entity_Id + (T : Entity_Id; + Op : TSS_Name_Type := TSS_Null) return Entity_Id is - BT : constant Entity_Id := Base_Type (T); + BT : constant Entity_Id := Base_Type (T); Op_Missing : Boolean; + begin if not Restriction_Active (No_Default_Stream_Attributes) then return Empty; @@ -12247,8 +12248,8 @@ package body Sem_Util is if Is_Elementary_Type (T) then if Op = TSS_Null then Op_Missing := - No (TSS (BT, TSS_Stream_Read)) - or else No (TSS (BT, TSS_Stream_Write)); + No (TSS (BT, TSS_Stream_Read)) + or else No (TSS (BT, TSS_Stream_Write)); else Op_Missing := No (TSS (BT, Op)); @@ -12256,7 +12257,6 @@ package body Sem_Util is if Op_Missing then return T; - else return Empty; end if; @@ -12273,6 +12273,7 @@ package body Sem_Util is Comp := First_Component (T); while Present (Comp) loop C_Typ := Type_Without_Stream_Operation (Etype (Comp), Op); + if Present (C_Typ) then return C_Typ; end if; @@ -12287,7 +12288,6 @@ package body Sem_Util is and then Present (Full_View (T)) then return Type_Without_Stream_Operation (Full_View (T), Op); - else return Empty; end if; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index ae04cc44e4c..1b9babda944 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -25,14 +25,14 @@ -- Package containing utility procedures used throughout the semantics -with Einfo; use Einfo; +with Einfo; use Einfo; with Exp_Tss; use Exp_Tss; -with Namet; use Namet; -with Nmake; use Nmake; -with Snames; use Snames; -with Types; use Types; -with Uintp; use Uintp; -with Urealp; use Urealp; +with Namet; use Namet; +with Nmake; use Nmake; +with Snames; use Snames; +with Types; use Types; +with Uintp; use Uintp; +with Urealp; use Urealp; package Sem_Util is @@ -1379,10 +1379,11 @@ package Sem_Util is -- Return the accessibility level of Typ function Type_Without_Stream_Operation - (T : Entity_Id; Op : TSS_Name_Type := TSS_Null) return Entity_Id; - -- AI05-0161 : if the restriction No_Default_Stream_Attributes is active - -- then we cannot generate stream subprograms for composite types with - -- elementary subcomponents that lack user-defined stream subprograms. + (T : Entity_Id; + Op : TSS_Name_Type := TSS_Null) return Entity_Id; + -- AI05-0161: In Ada 2012, if the restriction No_Default_Stream_Attributes + -- is active then we cannot generate stream subprograms for composite types + -- with elementary subcomponents that lack user-defined stream subprograms. -- This predicate determines whether a type has such an elementary -- subcomponent. If Op is TSS_Null, a type that lacks either Read or Write -- prevents the construction of a composite stream operation. If Op is -- 2.30.2