Commit d7f94401 by Arnaud Charlet

[multiple changes]

2009-04-20  Bob Duff  <duff@adacore.com>

	* rtsfind.adb: Minor comment fix

2009-04-20  Robert Dewar  <dewar@adacore.com>

	* exp_aggr.adb: Minor reformatting
	Minor code reorganization (use Nkind_In)

	* g-socket.adb: Minor reformatting

	* g-socket.ads: Minor comment fix

	* s-auxdec.ads: Minor comment and organization update.

	* s-auxdec-vms_64.ads: Minor comment and organization update.

	* sem_ch10.adb: Minor addition of ??? comment

	* sem_disp.adb: Minor reformatting

From-SVN: r146375
parent f8b86c2d
2009-04-20 Bob Duff <duff@adacore.com>
* rtsfind.adb: Minor comment fix
2009-04-20 Robert Dewar <dewar@adacore.com>
* exp_aggr.adb: Minor reformatting
Minor code reorganization (use Nkind_In)
* g-socket.adb: Minor reformatting
* g-socket.ads: Minor comment fix
* s-auxdec.ads: Minor comment and organization update.
* s-auxdec-vms_64.ads: Minor comment and organization update.
* sem_ch10.adb: Minor addition of ??? comment
* sem_disp.adb: Minor reformatting
2009-04-20 Ed Schonberg <schonberg@adacore.com> 2009-04-20 Ed Schonberg <schonberg@adacore.com>
* inline.adb (Add_Inlined_Subprogram): Do not place on the back-end * inline.adb (Add_Inlined_Subprogram): Do not place on the back-end
...@@ -1069,16 +1069,14 @@ package body Exp_Aggr is ...@@ -1069,16 +1069,14 @@ package body Exp_Aggr is
-- default initialized components (otherwise Expr_Q is not present). -- default initialized components (otherwise Expr_Q is not present).
if Present (Expr_Q) if Present (Expr_Q)
and then (Nkind (Expr_Q) = N_Aggregate and then Nkind_In (Expr_Q, N_Aggregate, N_Extension_Aggregate)
or else Nkind (Expr_Q) = N_Extension_Aggregate)
then then
-- At this stage the Expression may not have been -- At this stage the Expression may not have been analyzed yet
-- analyzed yet because the array aggregate code has not -- because the array aggregate code has not been updated to use
-- been updated to use the Expansion_Delayed flag and -- the Expansion_Delayed flag and avoid analysis altogether to
-- avoid analysis altogether to solve the same problem -- solve the same problem (see Resolve_Aggr_Expr). So let us do
-- (see Resolve_Aggr_Expr). So let us do the analysis of -- the analysis of non-array aggregates now in order to get the
-- non-array aggregates now in order to get the value of -- value of Expansion_Delayed flag for the inner aggregate ???
-- Expansion_Delayed flag for the inner aggregate ???
if Present (Comp_Type) and then not Is_Array_Type (Comp_Type) then if Present (Comp_Type) and then not Is_Array_Type (Comp_Type) then
Analyze_And_Resolve (Expr_Q, Comp_Type); Analyze_And_Resolve (Expr_Q, Comp_Type);
...@@ -2551,10 +2549,8 @@ package body Exp_Aggr is ...@@ -2551,10 +2549,8 @@ package body Exp_Aggr is
-- of one such. -- of one such.
elsif Is_Limited_Type (Etype (A)) elsif Is_Limited_Type (Etype (A))
and then (Nkind (Unqualify (A)) = N_Aggregate and then Nkind_In (Unqualify (A), N_Aggregate,
or else N_Extension_Aggregate)
Nkind (Unqualify (A)) = N_Extension_Aggregate)
and then Nkind (Unqualify (A)) /= N_Explicit_Dereference
then then
Ancestor_Is_Expression := True; Ancestor_Is_Expression := True;
...@@ -2589,8 +2585,8 @@ package body Exp_Aggr is ...@@ -2589,8 +2585,8 @@ package body Exp_Aggr is
-- If the ancestor part is an aggregate, force its full -- If the ancestor part is an aggregate, force its full
-- expansion, which was delayed. -- expansion, which was delayed.
if Nkind (Unqualify (A)) = N_Aggregate if Nkind_In (Unqualify (A), N_Aggregate,
or else Nkind (Unqualify (A)) = N_Extension_Aggregate N_Extension_Aggregate)
then then
Set_Analyzed (A, False); Set_Analyzed (A, False);
Set_Analyzed (Expression (A), False); Set_Analyzed (Expression (A), False);
...@@ -3495,7 +3491,7 @@ package body Exp_Aggr is ...@@ -3495,7 +3491,7 @@ package body Exp_Aggr is
(Is_Inherently_Limited_Type (Typ) (Is_Inherently_Limited_Type (Typ)
and then and then
(Nkind (Parent (Parent_Node)) = N_Extended_Return_Statement (Nkind (Parent (Parent_Node)) = N_Extended_Return_Statement
or else Nkind (Parent_Node) = N_Simple_Return_Statement)) or else Nkind (Parent_Node) = N_Simple_Return_Statement))
then then
Set_Expansion_Delayed (N); Set_Expansion_Delayed (N);
return; return;
...@@ -3691,7 +3687,7 @@ package body Exp_Aggr is ...@@ -3691,7 +3687,7 @@ package body Exp_Aggr is
if Nkind (Elmt) = N_Aggregate if Nkind (Elmt) = N_Aggregate
and then Present (Next_Index (Ix)) and then Present (Next_Index (Ix))
and then and then
not Flatten (Elmt, Next_Index (Ix), Next_Index (Ixb)) not Flatten (Elmt, Next_Index (Ix), Next_Index (Ixb))
then then
return False; return False;
end if; end if;
...@@ -5022,8 +5018,8 @@ package body Exp_Aggr is ...@@ -5022,8 +5018,8 @@ package body Exp_Aggr is
else else
Maybe_In_Place_OK := Maybe_In_Place_OK :=
(Nkind (Parent (N)) = N_Assignment_Statement (Nkind (Parent (N)) = N_Assignment_Statement
and then Comes_From_Source (N) and then Comes_From_Source (N)
and then In_Place_Assign_OK) and then In_Place_Assign_OK)
or else or else
(Nkind (Parent (Parent (N))) = N_Allocator (Nkind (Parent (Parent (N))) = N_Allocator
...@@ -5389,8 +5385,8 @@ package body Exp_Aggr is ...@@ -5389,8 +5385,8 @@ package body Exp_Aggr is
-- an atomic move for it. -- an atomic move for it.
if Is_Atomic (Typ) if Is_Atomic (Typ)
and then (Nkind (Parent (N)) = N_Object_Declaration and then Nkind_In (Parent (N), N_Object_Declaration,
or else Nkind (Parent (N)) = N_Assignment_Statement) N_Assignment_Statement)
and then Comes_From_Source (Parent (N)) and then Comes_From_Source (Parent (N))
then then
Expand_Atomic_Aggregate (N, Typ); Expand_Atomic_Aggregate (N, Typ);
...@@ -5777,8 +5773,7 @@ package body Exp_Aggr is ...@@ -5777,8 +5773,7 @@ package body Exp_Aggr is
C : Node_Id; C : Node_Id;
Expr : Node_Id; Expr : Node_Id;
begin begin
pragma Assert (Nkind (N) = N_Aggregate pragma Assert (Nkind_In (N, N_Aggregate, N_Extension_Aggregate));
or else Nkind (N) = N_Extension_Aggregate);
if No (Comps) then if No (Comps) then
return False; return False;
...@@ -5806,8 +5801,8 @@ package body Exp_Aggr is ...@@ -5806,8 +5801,8 @@ package body Exp_Aggr is
Expr := Expression (C); Expr := Expression (C);
if Present (Expr) if Present (Expr)
and then (Nkind (Expr) = N_Aggregate and then
or else Nkind (Expr) = N_Extension_Aggregate) Nkind_In (Expr, N_Aggregate, N_Extension_Aggregate)
and then Has_Default_Init_Comps (Expr) and then Has_Default_Init_Comps (Expr)
then then
return True; return True;
...@@ -6423,8 +6418,8 @@ package body Exp_Aggr is ...@@ -6423,8 +6418,8 @@ package body Exp_Aggr is
return False; return False;
else else
-- The aggregate is static if all components are literals, or -- The aggregate is static if all components are literals,
-- else all its components are static aggregates for the -- or else all its components are static aggregates for the
-- component type. We also limit the size of a static aggregate -- component type. We also limit the size of a static aggregate
-- to prevent runaway static expressions. -- to prevent runaway static expressions.
......
...@@ -1690,6 +1690,7 @@ package body GNAT.Sockets is ...@@ -1690,6 +1690,7 @@ package body GNAT.Sockets is
if EAGAIN /= EWOULDBLOCK and then Error_Value = EAGAIN then if EAGAIN /= EWOULDBLOCK and then Error_Value = EAGAIN then
return Resource_Temporarily_Unavailable; return Resource_Temporarily_Unavailable;
end if; end if;
pragma Warnings (On); pragma Warnings (On);
case Error_Value is case Error_Value is
......
...@@ -1083,7 +1083,7 @@ package GNAT.Sockets is ...@@ -1083,7 +1083,7 @@ package GNAT.Sockets is
E_Socket_Set : in out Socket_Set_Type; E_Socket_Set : in out Socket_Set_Type;
Status : out Selector_Status; Status : out Selector_Status;
Timeout : Selector_Duration := Forever); Timeout : Selector_Duration := Forever);
-- This refined version of Check_Selector allows to watch for exception -- This refined version of Check_Selector allows watching for exception
-- events (i.e. notifications of out-of-band transmission and reception). -- events (i.e. notifications of out-of-band transmission and reception).
-- As above, all of R_Socket_Set, W_Socket_Set and E_Socket_Set must be -- As above, all of R_Socket_Set, W_Socket_Set and E_Socket_Set must be
-- different objects. -- different objects.
......
...@@ -720,9 +720,9 @@ package body Rtsfind is ...@@ -720,9 +720,9 @@ package body Rtsfind is
-- If the RTS Unit *does* depend on the current unit, for instance, -- If the RTS Unit *does* depend on the current unit, for instance,
-- when you are compiling System, then you had better have finished -- when you are compiling System, then you had better have finished
-- analyzing the part of System that is depended on before you try -- analyzing the part of System that is depended on before you try to
-- to load the RTS Unit. This means having the System ordered in an -- load the RTS Unit. This means having the code in System ordered in
-- appropriate manner. -- an appropriate manner.
Set_Analyzed (Cunit (Current_Sem_Unit), True); Set_Analyzed (Cunit (Current_Sem_Unit), True);
......
...@@ -63,22 +63,22 @@ package System.Aux_DEC is ...@@ -63,22 +63,22 @@ package System.Aux_DEC is
type Integer_8 is range -2 ** (8 - 1) .. +2 ** (8 - 1) - 1; type Integer_8 is range -2 ** (8 - 1) .. +2 ** (8 - 1) - 1;
for Integer_8'Size use 8; for Integer_8'Size use 8;
type Integer_8_Array is array (Integer range <>) of Integer_8;
type Integer_16 is range -2 ** (16 - 1) .. +2 ** (16 - 1) - 1; type Integer_16 is range -2 ** (16 - 1) .. +2 ** (16 - 1) - 1;
for Integer_16'Size use 16; for Integer_16'Size use 16;
type Integer_16_Array is array (Integer range <>) of Integer_16;
type Integer_32 is range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1; type Integer_32 is range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1;
for Integer_32'Size use 32; for Integer_32'Size use 32;
type Integer_32_Array is array (Integer range <>) of Integer_32;
type Integer_64 is range -2 ** (64 - 1) .. +2 ** (64 - 1) - 1; type Integer_64 is range -2 ** (64 - 1) .. +2 ** (64 - 1) - 1;
for Integer_64'Size use 64; for Integer_64'Size use 64;
type Integer_8_Array is array (Integer range <>) of Integer_8;
type Integer_16_Array is array (Integer range <>) of Integer_16;
type Integer_32_Array is array (Integer range <>) of Integer_32;
type Integer_64_Array is array (Integer range <>) of Integer_64; type Integer_64_Array is array (Integer range <>) of Integer_64;
-- These array types are not in all versions of DEC System, and in fact it
-- is not quite clear why they are in some and not others, but since they
-- definitely appear in some versions, we include them unconditionally.
type Largest_Integer is range Min_Int .. Max_Int; type Largest_Integer is range Min_Int .. Max_Int;
......
...@@ -53,22 +53,22 @@ package System.Aux_DEC is ...@@ -53,22 +53,22 @@ package System.Aux_DEC is
type Integer_8 is range -2 ** (8 - 1) .. +2 ** (8 - 1) - 1; type Integer_8 is range -2 ** (8 - 1) .. +2 ** (8 - 1) - 1;
for Integer_8'Size use 8; for Integer_8'Size use 8;
type Integer_8_Array is array (Integer range <>) of Integer_8;
type Integer_16 is range -2 ** (16 - 1) .. +2 ** (16 - 1) - 1; type Integer_16 is range -2 ** (16 - 1) .. +2 ** (16 - 1) - 1;
for Integer_16'Size use 16; for Integer_16'Size use 16;
type Integer_16_Array is array (Integer range <>) of Integer_16;
type Integer_32 is range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1; type Integer_32 is range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1;
for Integer_32'Size use 32; for Integer_32'Size use 32;
type Integer_32_Array is array (Integer range <>) of Integer_32;
type Integer_64 is range -2 ** (64 - 1) .. +2 ** (64 - 1) - 1; type Integer_64 is range -2 ** (64 - 1) .. +2 ** (64 - 1) - 1;
for Integer_64'Size use 64; for Integer_64'Size use 64;
type Integer_8_Array is array (Integer range <>) of Integer_8;
type Integer_16_Array is array (Integer range <>) of Integer_16;
type Integer_32_Array is array (Integer range <>) of Integer_32;
type Integer_64_Array is array (Integer range <>) of Integer_64; type Integer_64_Array is array (Integer range <>) of Integer_64;
-- These array types are not in all versions of DEC System, and in fact it
-- is not quite clear why they are in some and not others, but since they
-- definitely appear in some versions, we include them unconditionally.
type Largest_Integer is range Min_Int .. Max_Int; type Largest_Integer is range Min_Int .. Max_Int;
......
...@@ -774,6 +774,8 @@ package body Sem_Ch10 is ...@@ -774,6 +774,8 @@ package body Sem_Ch10 is
Version_Update (N, Lib_Unit); Version_Update (N, Lib_Unit);
end if; end if;
-- Comment needed here ???
if Nkind (Defining_Unit_Name (Specification (Unit_Node))) = if Nkind (Defining_Unit_Name (Specification (Unit_Node))) =
N_Defining_Program_Unit_Name N_Defining_Program_Unit_Name
then then
......
...@@ -739,8 +739,8 @@ package body Sem_Disp is ...@@ -739,8 +739,8 @@ package body Sem_Disp is
then then
pragma Assert pragma Assert
((Ekind (Subp) = E_Function ((Ekind (Subp) = E_Function
and then Is_Dispatching_Operation (Old_Subp) and then Is_Dispatching_Operation (Old_Subp)
and then Is_Null_Extension (Base_Type (Etype (Subp)))) and then Is_Null_Extension (Base_Type (Etype (Subp))))
or else Get_TSS_Name (Subp) = TSS_Stream_Read or else Get_TSS_Name (Subp) = TSS_Stream_Read
or else Get_TSS_Name (Subp) = TSS_Stream_Write); or else Get_TSS_Name (Subp) = TSS_Stream_Write);
...@@ -769,12 +769,11 @@ package body Sem_Disp is ...@@ -769,12 +769,11 @@ package body Sem_Disp is
null; null;
-- If the type is already frozen, the overriding is not allowed -- If the type is already frozen, the overriding is not allowed
-- except when Old_Subp is not a dispatching operation (which -- except when Old_Subp is not a dispatching operation (which can
-- can occur when Old_Subp was inherited by an untagged type). -- occur when Old_Subp was inherited by an untagged type). However,
-- However, a body with no previous spec freezes the type "after" -- a body with no previous spec freezes the type "after" its
-- its declaration, and therefore is a legal overriding (unless -- declaration, and therefore is a legal overriding (unless the type
-- the type has already been frozen). Only the first such body -- has already been frozen). Only the first such body is legal.
-- is legal.
elsif Present (Old_Subp) elsif Present (Old_Subp)
and then Is_Dispatching_Operation (Old_Subp) and then Is_Dispatching_Operation (Old_Subp)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment