git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

exp_ch7.ads, [...]: Minor reformatting. 

2011-08-05  Robert Dewar  <dewar@adacore.com>

	* 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
This commit is contained in:
Robert Dewar 2011-08-05 13:35:04 +00:00 committed by Arnaud Charlet
parent 406935b64c
commit 9aff36e9f1
16 changed files with 97 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/ada/ChangeLog
View File

@ -1,3 +1,10 @@
2011-08-05 Robert Dewar <dewar@adacore.com>
* 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 <moy@adacore.com>
* exp_ch7.adb (Establish_Transient_Scope): in formal verification mode,

7
gcc/ada/exp_ch7.ads
View File

@ -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

7
gcc/ada/make.adb
View File

@ -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

59
gcc/ada/prj-conf.adb
View File

@ -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;

2
gcc/ada/prj-conf.ads
View File

@ -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;

5
gcc/ada/restrict.ads
View File

@ -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.

2
gcc/ada/s-atocou-builtin.adb
View File

@ -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

7
gcc/ada/s-atocou-x86.adb
View File

@ -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 --
---------------

7
gcc/ada/s-atocou.adb
View File

@ -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

11
gcc/ada/s-atocou.ads
View File

@ -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.

4
gcc/ada/sem_attr.adb
View File

@ -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);

4
gcc/ada/sem_ch6.adb
View File

@ -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

2
gcc/ada/sem_prag.adb
View File

@ -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;

6
gcc/ada/sem_type.adb
View File

@ -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;

14
gcc/ada/sem_util.adb
View File

@ -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;

23
gcc/ada/sem_util.ads
View File

@ -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