* sysdep.c (__gnat_localtime_tzoff for RTX):
SystemTimeToTzSpecificLocalTime is not supported by RTX. Use
GetTimeZoneInformation instead.
2009-06-22 Robert Dewar <dewar@adacore.com>
* sem_res.adb (Check_No_Direct_Boolean_Operators): New procedure
2009-06-22 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Collect_Previous_Instances): Do not collect
instantiations declared in a previous generic package body.
2009-06-22 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Add doc that X=True and X=False is allowed for the
restriction No_Direct_Boolean_Operators.
2009-06-22 Thomas Quinot <quinot@adacore.com>
* bindusg.adb: Minor fixes to gnatbind usage message
* sem_eval.adb: Minor reformatting
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@148794
138bc75d-0d04-0410-961f-
82ee72b054a4
+2009-06-22 Jose Ruiz <ruiz@adacore.com>
+
+ * sysdep.c (__gnat_localtime_tzoff for RTX):
+ SystemTimeToTzSpecificLocalTime is not supported by RTX. Use
+ GetTimeZoneInformation instead.
+
+2009-06-22 Robert Dewar <dewar@adacore.com>
+
+ * sem_res.adb (Check_No_Direct_Boolean_Operators): New procedure
+
+2009-06-22 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb (Collect_Previous_Instances): Do not collect
+ instantiations declared in a previous generic package body.
+
+2009-06-22 Robert Dewar <dewar@adacore.com>
+
+ * gnat_rm.texi: Add doc that X=True and X=False is allowed for the
+ restriction No_Direct_Boolean_Operators.
+
+2009-06-22 Thomas Quinot <quinot@adacore.com>
+
+ * bindusg.adb: Minor fixes to gnatbind usage message
+
+ * sem_eval.adb: Minor reformatting
+
2009-06-22 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Analyze_Object_Declaration, Freeze_Entity): Move to the
2009-06-22 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Analyze_Object_Declaration, Freeze_Entity): Move to the
-- --
-- B o d y --
-- --
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
-- --
-- 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- --
-- Line for D switch
Write_Line (" -Dnn[k|m] Default secondary stack " &
-- Line for D switch
Write_Line (" -Dnn[k|m] Default secondary stack " &
- "size = nnn [kilo|mega] bytes");
+ "size = nn [kilo|mega] bytes");
- Write_Line (" -E Store tracebacks in Exception occurrences");
+ Write_Line (" -E Store tracebacks in exception occurrences");
-- The -f switch is voluntarily omitted, because it is obsolete
-- The -f switch is voluntarily omitted, because it is obsolete
operators are used on operands of type Boolean (or any type derived
from Boolean). This is intended for use in safety critical programs
where the certification protocol requires the use of short-circuit
operators are used on operands of type Boolean (or any type derived
from Boolean). This is intended for use in safety critical programs
where the certification protocol requires the use of short-circuit
-(and then, or else) forms for all composite boolean operations.
+(and then, or else) forms for all composite boolean operations. An
+exception is that an explicit equality test with True or False as the
+right operand is not considered to violate this restriction.
@item No_Dispatching_Calls
@findex No_Dispatching_Calls
@item No_Dispatching_Calls
@findex No_Dispatching_Calls
-- declared without a box (see Instantiate_Formal_Package). Such
-- an instantiation does not generate any code (the actual code
-- comes from actual) and thus does not need to be analyzed here.
-- declared without a box (see Instantiate_Formal_Package). Such
-- an instantiation does not generate any code (the actual code
-- comes from actual) and thus does not need to be analyzed here.
+ -- If the instantiation appears with a generic package body it is
+ -- not analyzed here either.
elsif Nkind (Decl) = N_Package_Instantiation
and then not Is_Internal (Defining_Entity (Decl))
then
Append_Elmt (Decl, Previous_Instances);
elsif Nkind (Decl) = N_Package_Instantiation
and then not Is_Internal (Defining_Entity (Decl))
then
Append_Elmt (Decl, Previous_Instances);
- -- For a subprogram instantiation, omit instantiations of
- -- intrinsic operations (Unchecked_Conversions, etc.) that
- -- have no bodies.
+ -- For a subprogram instantiation, omit instantiations intrinsic
+ -- operations (Unchecked_Conversions, etc.) that have no bodies.
elsif Nkind_In (Decl, N_Function_Instantiation,
N_Procedure_Instantiation)
elsif Nkind_In (Decl, N_Function_Instantiation,
N_Procedure_Instantiation)
Collect_Previous_Instances
(Private_Declarations (Specification (Decl)));
Collect_Previous_Instances
(Private_Declarations (Specification (Decl)));
- elsif Nkind (Decl) = N_Package_Body then
+ elsif Nkind (Decl) = N_Package_Body
+ and then Ekind (Corresponding_Spec (Decl)) /= E_Generic_Package
+ then
Collect_Previous_Instances (Declarations (Decl));
end if;
Collect_Previous_Instances (Declarations (Decl));
end if;
and then Nkind (True_Parent) /= N_Compilation_Unit
loop
if Nkind (True_Parent) = N_Package_Declaration
and then Nkind (True_Parent) /= N_Compilation_Unit
loop
if Nkind (True_Parent) = N_Package_Declaration
- and then
- Nkind (Original_Node (True_Parent)) = N_Package_Instantiation
+ and then
+ Nkind (Original_Node (True_Parent)) = N_Package_Instantiation
then
-- Parent is a compilation unit that is an instantiation.
-- Instantiation node has been replaced with package decl.
then
-- Parent is a compilation unit that is an instantiation.
-- Instantiation node has been replaced with package decl.
Set_Unit (Parent (True_Parent), Inst_Node);
end if;
Set_Unit (Parent (True_Parent), Inst_Node);
end if;
- -- Now complete instantiation of enclosing body, if it appears
- -- in some other unit. If it appears in the current unit, the
- -- body will have been instantiated already.
+ -- Now complete instantiation of enclosing body, if it appears in
+ -- some other unit. If it appears in the current unit, the body
+ -- will have been instantiated already.
if No (Corresponding_Body (Instance_Spec (Inst_Node))) then
if No (Corresponding_Body (Instance_Spec (Inst_Node))) then
Scop := Scope (Scop);
end loop;
Scop := Scope (Scop);
end loop;
- -- Collect previous instantiations in the unit that
- -- contains the desired generic.
+ -- Collect previous instantiations in the unit that contains
+ -- the desired generic.
if Nkind (Parent (True_Parent)) /= N_Compilation_Unit
and then not Body_Optional
if Nkind (Parent (True_Parent)) /= N_Compilation_Unit
and then not Body_Optional
(Private_Declarations (Specification (Par)));
else
(Private_Declarations (Specification (Par)));
else
- -- Enclosing unit is a subprogram body, In this
+ -- Enclosing unit is a subprogram body. In this
-- case all instance bodies are processed in order
-- and there is no need to collect them separately.
-- case all instance bodies are processed in order
-- and there is no need to collect them separately.
E1 := First_Entity (Form);
E2 := First_Entity (Act);
E1 := First_Entity (Form);
E2 := First_Entity (Act);
- while Present (E1)
- and then E1 /= First_Private_Entity (Form)
- loop
+ while Present (E1) and then E1 /= First_Private_Entity (Form) loop
-- Could this test be a single condition???
-- Seems like it could, and isn't FPE (Form) a constant anyway???
-- Could this test be a single condition???
-- Seems like it could, and isn't FPE (Form) a constant anyway???
and then not Is_Class_Wide_Type (E1)
and then not Is_Internal_Name (Chars (E1))
then
and then not Is_Class_Wide_Type (E1)
and then not Is_Internal_Name (Chars (E1))
then
- while Present (E2)
- and then Chars (E2) /= Chars (E1)
- loop
+ while Present (E2) and then Chars (E2) /= Chars (E1) loop
Next_Entity (E2);
end loop;
Next_Entity (E2);
end loop;
else
Set_Instance_Of (E1, E2);
else
Set_Instance_Of (E1, E2);
- if Is_Type (E1)
- and then Is_Tagged_Type (E2)
- then
- Set_Instance_Of
- (Class_Wide_Type (E1), Class_Wide_Type (E2));
+ if Is_Type (E1) and then Is_Tagged_Type (E2) then
+ Set_Instance_Of (Class_Wide_Type (E1), Class_Wide_Type (E2));
end if;
if Is_Constrained (E1) then
end if;
if Is_Constrained (E1) then
- Set_Instance_Of
- (Base_Type (E1), Base_Type (E2));
+ Set_Instance_Of (Base_Type (E1), Base_Type (E2));
- if Ekind (E1) = E_Package
- and then No (Renamed_Object (E1))
- then
+ if Ekind (E1) = E_Package and then No (Renamed_Object (E1)) then
Map_Formal_Package_Entities (E1, E2);
end if;
end if;
Map_Formal_Package_Entities (E1, E2);
end if;
end if;
-- recurse. Nested generic packages will have been processed from the
-- inside out.
-- recurse. Nested generic packages will have been processed from the
-- inside out.
- if Nkind (Decl) = N_Package_Declaration then
- Spec := Specification (Decl);
+ case Nkind (Decl) is
+ when N_Package_Declaration =>
+ Spec := Specification (Decl);
- elsif Nkind (Decl) = N_Task_Type_Declaration then
- Spec := Task_Definition (Decl);
+ when N_Task_Type_Declaration =>
+ Spec := Task_Definition (Decl);
- elsif Nkind (Decl) = N_Protected_Type_Declaration then
- Spec := Protected_Definition (Decl);
+ when N_Protected_Type_Declaration =>
+ Spec := Protected_Definition (Decl);
- else
- Spec := Empty;
- end if;
+ when others =>
+ Spec := Empty;
+ end case;
- Move_Freeze_Nodes (Out_Of, Next_Node,
- Visible_Declarations (Spec));
- Move_Freeze_Nodes (Out_Of, Next_Node,
- Private_Declarations (Spec));
+ Move_Freeze_Nodes (Out_Of, Next_Node, Visible_Declarations (Spec));
+ Move_Freeze_Nodes (Out_Of, Next_Node, Private_Declarations (Spec));
procedure Remove_Parent (In_Body : Boolean := False) is
S : Entity_Id := Current_Scope;
procedure Remove_Parent (In_Body : Boolean := False) is
S : Entity_Id := Current_Scope;
- -- S is the scope containing the instantiation just completed. The
- -- scope stack contains the parent instances of the instantiation,
- -- followed by the original S.
+ -- S is the scope containing the instantiation just completed. The scope
+ -- stack contains the parent instances of the instantiation, followed by
+ -- the original S.
E : Entity_Id;
P : Entity_Id;
E : Entity_Id;
P : Entity_Id;
and then P /= Current_Scope
then
-- We are within an instance of some sibling. Retain
and then P /= Current_Scope
then
-- We are within an instance of some sibling. Retain
- -- visibility of parent, for proper subsequent cleanup,
- -- and reinstall private declarations as well.
+ -- visibility of parent, for proper subsequent cleanup, and
+ -- reinstall private declarations as well.
Set_In_Private_Part (P);
Install_Private_Declarations (P);
end if;
-- If the ultimate parent is a top-level unit recorded in
Set_In_Private_Part (P);
Install_Private_Declarations (P);
end if;
-- If the ultimate parent is a top-level unit recorded in
- -- Instance_Parent_Unit, then reset its visibility to what
- -- it was before instantiation. (It's not clear what the
- -- purpose is of testing whether Scope (P) is In_Open_Scopes,
- -- but that test was present before the ultimate parent test
- -- was added.???)
+ -- Instance_Parent_Unit, then reset its visibility to what is was
+ -- before instantiation. (It's not clear what the purpose is of
+ -- testing whether Scope (P) is In_Open_Scopes, but that test was
+ -- present before the ultimate parent test was added.???)
elsif not In_Open_Scopes (Scope (P))
or else (P = Instance_Parent_Unit
elsif not In_Open_Scopes (Scope (P))
or else (P = Instance_Parent_Unit
-- subunit of a generic contains an instance of a child unit of
-- its generic parent unit.
-- subunit of a generic contains an instance of a child unit of
-- its generic parent unit.
- elsif S = Current_Scope
- and then Is_Generic_Instance (S)
- then
+ elsif S = Current_Scope and then Is_Generic_Instance (S) then
declare
Par : constant Entity_Id :=
Generic_Parent
declare
Par : constant Entity_Id :=
Generic_Parent
- -- Each body is analyzed separately, and there is no context
- -- that needs preserving from one body instance to the next,
- -- so remove all parent scopes that have been installed.
+ -- Each body is analyzed separately, and there is no context that
+ -- needs preserving from one body instance to the next, so remove all
+ -- parent scopes that have been installed.
while Present (S) loop
End_Package_Scope (S);
while Present (S) loop
End_Package_Scope (S);
begin
if No (Current_Instantiated_Parent.Act_Id) then
begin
if No (Current_Instantiated_Parent.Act_Id) then
-- Restore environment after subprogram inlining
Restore_Private_Views (Empty);
-- Restore environment after subprogram inlining
Restore_Private_Views (Empty);
Dep_Typ : Node_Id;
procedure Restore_Nested_Formal (Formal : Entity_Id);
Dep_Typ : Node_Id;
procedure Restore_Nested_Formal (Formal : Entity_Id);
- -- Hide the generic formals of formal packages declared with box
- -- which were reachable in the current instantiation.
+ -- Hide the generic formals of formal packages declared with box which
+ -- were reachable in the current instantiation.
---------------------------
-- Restore_Nested_Formal --
---------------------------
-- Restore_Nested_Formal --
-- Subtypes of types whose views have been exchanged, and that
-- are defined within the instance, were not on the list of
-- Subtypes of types whose views have been exchanged, and that
-- are defined within the instance, were not on the list of
- -- Private_Dependents on entry to the instance, so they have to
- -- be exchanged explicitly now, in order to remain consistent with
- -- the view of the parent type.
+ -- Private_Dependents on entry to the instance, so they have to be
+ -- exchanged explicitly now, in order to remain consistent with the
+ -- view of the parent type.
if Ekind (Typ) = E_Private_Type
or else Ekind (Typ) = E_Limited_Private_Type
if Ekind (Typ) = E_Private_Type
or else Ekind (Typ) = E_Limited_Private_Type
- -- Make the generic formal parameters private, and make the formal
- -- types into subtypes of the actuals again.
+ -- Make the generic formal parameters private, and make the formal types
+ -- into subtypes of the actuals again.
E := First_Entity (Pack_Id);
while Present (E) loop
E := First_Entity (Pack_Id);
while Present (E) loop
return Unknown;
-- For access types, the only time we know the result at compile time
return Unknown;
-- For access types, the only time we know the result at compile time
- -- (apart from identical operands, which we handled already, is if we
+ -- (apart from identical operands, which we handled already) is if we
-- know one operand is null and the other is not, or both operands are
-- known null.
-- know one operand is null and the other is not, or both operands are
-- known null.
- elsif Known_Non_Null (L)
- and then Known_Null (R)
- then
+ elsif Known_Non_Null (L) and then Known_Null (R) then
-- For remaining scalar cases we know exactly (note that this does
-- include the fixed-point case, where we know the run time integer
-- For remaining scalar cases we know exactly (note that this does
-- include the fixed-point case, where we know the run time integer
-- initialization of individual components within the init proc itself.
-- Could be optimized away perhaps?
-- initialization of individual components within the init proc itself.
-- Could be optimized away perhaps?
+ procedure Check_No_Direct_Boolean_Operators (N : Node_Id);
+ -- N is the node for a comparison or logical operator. If the operator
+ -- is predefined, and the root type of the operands is Standard.Boolean,
+ -- then a check is made for restriction No_Direct_Boolean_Operators.
+
function Is_Definite_Access_Type (E : Entity_Id) return Boolean;
-- Determine whether E is an access type declared by an access
-- declaration, and not an (anonymous) allocator type.
function Is_Definite_Access_Type (E : Entity_Id) return Boolean;
-- Determine whether E is an access type declared by an access
-- declaration, and not an (anonymous) allocator type.
end if;
end Check_Initialization_Call;
end if;
end Check_Initialization_Call;
+ ---------------------------------------
+ -- Check_No_Direct_Boolean_Operators --
+ ---------------------------------------
+
+ procedure Check_No_Direct_Boolean_Operators (N : Node_Id) is
+ begin
+ if Scope (Entity (N)) = Standard_Standard
+ and then Root_Type (Etype (Left_Opnd (N))) = Standard_Boolean
+ then
+ -- Restriction does not apply to generated code
+
+ if not Comes_From_Source (N) then
+ null;
+
+ -- Restriction does not apply for A=False, A=True
+
+ elsif Nkind (N) = N_Op_Eq
+ and then (Is_Entity_Name (Right_Opnd (N))
+ and then (Entity (Right_Opnd (N)) = Standard_True
+ or else
+ Entity (Right_Opnd (N)) = Standard_False))
+ then
+ null;
+
+ -- Otherwise restriction applies
+
+ else
+ Check_Restriction (No_Direct_Boolean_Operators, N);
+ end if;
+ end if;
+ end Check_No_Direct_Boolean_Operators;
+
------------------------------
-- Check_Parameterless_Call --
------------------------------
------------------------------
-- Check_Parameterless_Call --
------------------------------
+ Check_No_Direct_Boolean_Operators (N);
+
-- If this is an intrinsic operation which is not predefined, use the
-- types of its declared arguments to resolve the possibly overloaded
-- operands. Otherwise the operands are unambiguous and specify the
-- If this is an intrinsic operation which is not predefined, use the
-- types of its declared arguments to resolve the possibly overloaded
-- operands. Otherwise the operands are unambiguous and specify the
-- Start of processing for Resolve_Equality_Op
begin
-- Start of processing for Resolve_Equality_Op
begin
+ Check_No_Direct_Boolean_Operators (N);
+
Set_Etype (N, Base_Type (Typ));
Generate_Reference (T, N, ' ');
Set_Etype (N, Base_Type (Typ));
Generate_Reference (T, N, ' ');
procedure Resolve_Logical_Op (N : Node_Id; Typ : Entity_Id) is
B_Typ : Entity_Id;
procedure Resolve_Logical_Op (N : Node_Id; Typ : Entity_Id) is
B_Typ : Entity_Id;
- N_Opr : constant Node_Kind := Nkind (N);
+ Check_No_Direct_Boolean_Operators (N);
+
-- Predefined operations on scalar types yield the base type. On the
-- other hand, logical operations on arrays yield the type of the
-- arguments (and the context).
-- Predefined operations on scalar types yield the base type. On the
-- other hand, logical operations on arrays yield the type of the
-- arguments (and the context).
Set_Etype (N, B_Typ);
Generate_Operator_Reference (N, B_Typ);
Eval_Logical_Op (N);
Set_Etype (N, B_Typ);
Generate_Operator_Reference (N, B_Typ);
Eval_Logical_Op (N);
-
- -- Check for violation of restriction No_Direct_Boolean_Operators
- -- if the operator was not eliminated by the Eval_Logical_Op call.
-
- if Nkind (N) = N_Opr
- and then Root_Type (Etype (Left_Opnd (N))) = Standard_Boolean
- then
- Check_Restriction (No_Direct_Boolean_Operators, N);
- end if;
end Resolve_Logical_Op;
---------------------------
end Resolve_Logical_Op;
---------------------------
+#ifdef RTX
+
+ tzi_status = GetTimeZoneInformation (&tzi);
+ *off = tzi.Bias;
+ if (tzi_status == TIME_ZONE_ID_STANDARD)
+ /* The system is operating in the range covered by the StandardDate
+ member. */
+ *off = *off + tzi.StandardBias;
+ else if (tzi_status == TIME_ZONE_ID_DAYLIGHT)
+ /* The system is operating in the range covered by the DaylightDate
+ member. */
+ *off = *off + tzi.DaylightBias;
+ *off = *off * -60;
+
+#else
+
/* First convert unix time_t structure to windows FILETIME format. */
utc_time.ull_time = ((unsigned long long) *timer + w32_epoch_offset)
* 10000000ULL;
/* First convert unix time_t structure to windows FILETIME format. */
utc_time.ull_time = ((unsigned long long) *timer + w32_epoch_offset)
* 10000000ULL;
else
*off = - (long) ((utc_time.ull_time - local_time.ull_time) / 10000000ULL);
else
*off = - (long) ((utc_time.ull_time - local_time.ull_time) / 10000000ULL);