+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,
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
-- 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
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
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
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
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;
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;
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);
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;
-- 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");
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;
-- 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;
-- 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.
-- --
------------------------------------------------------------------------------
--- 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
------------------------------------------------------------------------------
-- 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 --
---------------
-- --
------------------------------------------------------------------------------
--- 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
-- --
------------------------------------------------------------------------------
--- 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
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.
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);
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
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;
(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;
while Present (Component)
and then Comes_From_Source (Component)
loop
-
-- Skip anonymous types generated by constrained components
if not Is_Type (Component) then
------------------------------------
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;
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));
if Op_Missing then
return T;
-
else
return Empty;
end if;
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;
and then Present (Full_View (T))
then
return Type_Without_Stream_Operation (Full_View (T), Op);
-
else
return Empty;
end if;
-- 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
-- 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
OSDN Git Service
