Commit 8f66cda7 by Arnaud Charlet

[multiple changes]

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

	* sem_type.adb, einfo.ads, freeze.adb, exp_ch4.adb, sem_ch13.adb:
	Minor reformatting.

2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb (Requires_Cleanup_Actions (List_Id, Boolean, Boolean)):
	Correct the check which involves the freeze node of a controlled or
	access-to-controlled type.

2011-08-29  Geert Bosch  <bosch@adacore.com>

	* sem_warn.adb (Check_Code_Statement): Remove check for consecutive Asm
	statements.
	* s-vaflop-vms-alpha.adb: Remove bogus Volatile => True arguments from
	Asm statements.

From-SVN: r178160
parent cf161d66
2011-08-29 Robert Dewar <dewar@adacore.com>
* sem_type.adb, einfo.ads, freeze.adb, exp_ch4.adb, sem_ch13.adb:
Minor reformatting.
2011-08-29 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb (Requires_Cleanup_Actions (List_Id, Boolean, Boolean)):
Correct the check which involves the freeze node of a controlled or
access-to-controlled type.
2011-08-29 Geert Bosch <bosch@adacore.com>
* sem_warn.adb (Check_Code_Statement): Remove check for consecutive Asm
statements.
* s-vaflop-vms-alpha.adb: Remove bogus Volatile => True arguments from
Asm statements.
2011-08-29 Yannick Moy <moy@adacore.com> 2011-08-29 Yannick Moy <moy@adacore.com>
* sem_ch3.adb (Array_Type_Declaration): Insert a subtype declaration * sem_ch3.adb (Array_Type_Declaration): Insert a subtype declaration
......
...@@ -3515,12 +3515,12 @@ package Einfo is ...@@ -3515,12 +3515,12 @@ package Einfo is
-- by-reference-type or because it uses explicitly the secondary stack. -- by-reference-type or because it uses explicitly the secondary stack.
-- Reverse_Bit_Order (Flag164) [base type only] -- Reverse_Bit_Order (Flag164) [base type only]
-- Present in all record type entities. Set if a valid pragma an -- Present in all record type entities. Set if entity has a Bit_Order
-- attribute representation clause for Bit_Order has reversed the order -- aspect (set by an aspect clause or attribute definition clause) that
-- of bits from the default value. When this flag is set, a component -- has reversed the order of bits from the default value. When this flag
-- clause must specify a set of bits entirely contained in a single -- is set, a component clause must specify a set of bits entirely within
-- storage unit (Ada 95) or a single machine scalar (see Ada 2005 -- a single storage unit (Ada 95) or within a single machine scalar (see
-- AI-133), or must occupy in integral number of storage units. -- Ada 2005 AI-133), or must occupy an integral number of storage units.
-- RM_Size (Uint13) -- RM_Size (Uint13)
-- Present in all type and subtype entities. Contains the value of -- Present in all type and subtype entities. Contains the value of
......
...@@ -6193,6 +6193,12 @@ package body Exp_Ch4 is ...@@ -6193,6 +6193,12 @@ package body Exp_Ch4 is
begin begin
Binary_Op_Validity_Checks (N); Binary_Op_Validity_Checks (N);
-- CodePeer and GNATprove want to see the unexpanded N_Op_Expon node
if CodePeer_Mode or ALFA_Mode then
return;
end if;
-- If either operand is of a private type, then we have the use of an -- If either operand is of a private type, then we have the use of an
-- intrinsic operator, and we get rid of the privateness, by using root -- intrinsic operator, and we get rid of the privateness, by using root
-- types of underlying types for the actual operation. Otherwise the -- types of underlying types for the actual operation. Otherwise the
...@@ -6200,18 +6206,10 @@ package body Exp_Ch4 is ...@@ -6200,18 +6206,10 @@ package body Exp_Ch4 is
-- shifts etc. We also do this transformation if the result type is -- shifts etc. We also do this transformation if the result type is
-- different from the base type. -- different from the base type.
if CodePeer_Mode or ALFA_Mode then
-- CodePeer and GNATprove want to see the unexpanded N_Op_Expon node
return;
end if;
if Is_Private_Type (Etype (Base)) if Is_Private_Type (Etype (Base))
or else or else Is_Private_Type (Typ)
Is_Private_Type (Typ) or else Is_Private_Type (Exptyp)
or else or else Rtyp /= Root_Type (Bastyp)
Is_Private_Type (Exptyp)
or else
Rtyp /= Root_Type (Bastyp)
then then
declare declare
Bt : constant Entity_Id := Root_Type (Underlying_Type (Bastyp)); Bt : constant Entity_Id := Root_Type (Underlying_Type (Bastyp));
......
...@@ -6430,13 +6430,15 @@ package body Exp_Util is ...@@ -6430,13 +6430,15 @@ package body Exp_Util is
then then
Typ := Entity (Decl); Typ := Entity (Decl);
if (Is_Access_Type (Typ) if ((Is_Access_Type (Typ)
and then not Is_Access_Subprogram_Type (Typ) and then not Is_Access_Subprogram_Type (Typ)
and then Needs_Finalization and then Needs_Finalization
(Available_View (Designated_Type (Typ)))) (Available_View (Designated_Type (Typ))))
or else or else
(Is_Type (Typ) (Is_Type (Typ)
and then Needs_Finalization (Typ)) and then Needs_Finalization (Typ)))
and then Requires_Cleanup_Actions
(Actions (Decl), For_Package, Nested_Constructs)
then then
return True; return True;
end if; end if;
......
...@@ -2029,8 +2029,7 @@ package body Freeze is ...@@ -2029,8 +2029,7 @@ package body Freeze is
Next_Entity (Comp); Next_Entity (Comp);
end loop; end loop;
-- Deal with Bit_Order attribute definition specifying a non-default -- Deal with Bit_Order aspect specifying a non-default bit order
-- bit order.
if Reverse_Bit_Order (Rec) and then Base_Type (Rec) = Rec then if Reverse_Bit_Order (Rec) and then Base_Type (Rec) = Rec then
if not Placed_Component then if not Placed_Component then
......
...@@ -235,7 +235,7 @@ package body Sem_Ch13 is ...@@ -235,7 +235,7 @@ package body Sem_Ch13 is
-- Processing depends on version of Ada -- Processing depends on version of Ada
-- For Ada 95, we just renumber bits within a storage unit. We do the -- For Ada 95, we just renumber bits within a storage unit. We do the
-- same for Ada 83 mode, since we recognize attribute Bit_Order in -- same for Ada 83 mode, since we recognize the Bit_Order attribute in
-- Ada 83, and are free to add this extension. -- Ada 83, and are free to add this extension.
if Ada_Version < Ada_2005 then if Ada_Version < Ada_2005 then
......
...@@ -627,7 +627,7 @@ package body Sem_Type is ...@@ -627,7 +627,7 @@ package body Sem_Type is
-- within the instance must not be included. -- within the instance must not be included.
if (Scope (H) = Scope (Ent) if (Scope (H) = Scope (Ent)
or else Scope (H) = Scope (Scope (Ent))) or else Scope (H) = Scope (Scope (Ent)))
and then In_Instance and then In_Instance
and then H /= Renamed_Entity (Ent) and then H /= Renamed_Entity (Ent)
and then not Is_Inherited_Operation (H) and then not Is_Inherited_Operation (H)
......
...@@ -211,18 +211,6 @@ package body Sem_Warn is ...@@ -211,18 +211,6 @@ package body Sem_Warn is
("?code statement with no outputs should usually be Volatile!", N); ("?code statement with no outputs should usually be Volatile!", N);
return; return;
end if; end if;
-- Check multiple code statements in a row
if Is_List_Member (N)
and then Present (Prev (N))
and then Nkind (Prev (N)) = N_Code_Statement
then
Error_Msg_F
("?code statements in sequence should usually be Volatile!", N);
Error_Msg_F
("\?(suggest using template with multiple instructions)!", N);
end if;
end Check_Code_Statement; end Check_Code_Statement;
--------------------------------- ---------------------------------
......
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