OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2013-10-15  Thomas Quinot  <quinot@adacore.com>

	* exp_pakd.adb (Expand_Packed_Element_Set,
	Expand_Packed_Element_Reference): Adjust for the case of packed
	arrays of reverse-storage-order types.

2013-10-15  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb: Minor reformatting.

2013-10-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Analyze_Attribute_Specification, case
	To_Address): If the expression is an identifier, do not modify
	its type; it will be converted when necessary, and the type of
	the expression must remain consistent with that of the entity
	for back-end consistency.

2013-10-15  Robert Dewar  <dewar@adacore.com>

	* sem_ch7.adb (Unit_Requires_Body): Add flag
	Ignore_Abstract_State (Analyze_Package_Specification): Enforce
	rule requiring Elaborate_Body if a non-null abstract state is
	specified for a library-level package.
	* sem_ch7.ads (Unit_Requires_Body): Add flag Ignore_Abstract_State.

From-SVN: r203598
This commit is contained in:
Arnaud Charlet 2013-10-15 13:01:03 +02:00
parent ecbda48438
commit 7569f6972e
6 changed files with 184 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
gcc/ada/ChangeLog
View File

@ -1,3 +1,29 @@
2013-10-15 Thomas Quinot <quinot@adacore.com>
* exp_pakd.adb (Expand_Packed_Element_Set,
Expand_Packed_Element_Reference): Adjust for the case of packed
arrays of reverse-storage-order types.
2013-10-15 Robert Dewar <dewar@adacore.com>
* sem_prag.adb: Minor reformatting.
2013-10-15 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Analyze_Attribute_Specification, case
To_Address): If the expression is an identifier, do not modify
its type; it will be converted when necessary, and the type of
the expression must remain consistent with that of the entity
for back-end consistency.
2013-10-15 Robert Dewar <dewar@adacore.com>
* sem_ch7.adb (Unit_Requires_Body): Add flag
Ignore_Abstract_State (Analyze_Package_Specification): Enforce
rule requiring Elaborate_Body if a non-null abstract state is
specified for a library-level package.
* sem_ch7.ads (Unit_Requires_Body): Add flag Ignore_Abstract_State.
2013-10-15 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Constituent): When

114
gcc/ada/exp_pakd.adb
View File

@ -543,39 +543,78 @@ package body Exp_Pakd is
-- array type on the fly). Such actions are inserted into the tree
-- directly using Insert_Action.
function Byte_Swap (N : Node_Id) return Node_Id;
function Byte_Swap
(N : Node_Id;
Left_Justify : Boolean := False;
Right_Justify : Boolean := False) return Node_Id;
-- Wrap N in a call to a byte swapping function, with appropriate type
-- conversions.
-- conversions. If Left_Justify is set True, the value is left justified
-- before swapping. If Right_Justify is set True, the value is right
-- justified after swapping. The Etype of the returned node is an
-- integer type of an appropriate power-of-2 size.
---------------
-- Byte_Swap --
---------------
function Byte_Swap (N : Node_Id) return Node_Id is
function Byte_Swap
(N : Node_Id;
Left_Justify : Boolean := False;
Right_Justify : Boolean := False) return Node_Id
is
Loc : constant Source_Ptr := Sloc (N);
T : constant Entity_Id := Etype (N);
T_Size : constant Uint := RM_Size (T);
Swap_RE : RE_Id;
Swap_F : Entity_Id;
Swap_T : Entity_Id;
-- Swapping function
Arg : Node_Id;
Swapped : Node_Id;
Shift : Uint;
begin
pragma Assert (Esize (T) > 8);
pragma Assert (T_Size > 8);
if Esize (T) <= 16 then
if T_Size <= 16 then
Swap_RE := RE_Bswap_16;
elsif Esize (T) <= 32 then
elsif T_Size <= 32 then
Swap_RE := RE_Bswap_32;
else pragma Assert (Esize (T) <= 64);
else pragma Assert (T_Size <= 64);
Swap_RE := RE_Bswap_64;
end if;
Swap_F := RTE (Swap_RE);
Swap_T := Etype (Swap_F);
Shift := Esize (Swap_T) - T_Size;
return
Unchecked_Convert_To (T,
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Swap_F, Loc),
Parameter_Associations =>
New_List (Unchecked_Convert_To (Etype (Swap_F), N))));
Arg := RJ_Unchecked_Convert_To (Swap_T, N);
if Left_Justify and then Shift > Uint_0 then
Arg :=
Make_Op_Shift_Left (Loc,
Left_Opnd => Arg,
Right_Opnd => Make_Integer_Literal (Loc, Shift));
end if;
Swapped :=
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Swap_F, Loc),
Parameter_Associations => New_List (Arg));
if Right_Justify and then Shift > Uint_0 then
Swapped :=
Make_Op_Shift_Right (Loc,
Left_Opnd => Swapped,
Right_Opnd => Make_Integer_Literal (Loc, Shift));
end if;
Set_Etype (Swapped, Swap_T);
return Swapped;
end Byte_Swap;
------------------------------
@ -1537,7 +1576,9 @@ package body Exp_Pakd is
and then not In_Reverse_Storage_Order_Object (Obj)
then
Require_Byte_Swapping := True;
New_Rhs := Byte_Swap (New_Rhs);
New_Rhs := Byte_Swap (New_Rhs,
Left_Justify => Bytes_Big_Endian,
Right_Justify => not Bytes_Big_Endian);
end if;
end;
@ -1610,7 +1651,6 @@ package body Exp_Pakd is
-- not a left justified conversion.
Rhs := RJ_Unchecked_Convert_To (Etype (Obj), Rhs);
end Fixup_Rhs;
begin
@ -1660,18 +1700,24 @@ package body Exp_Pakd is
if Nkind (New_Rhs) = N_Op_And then
Set_Paren_Count (New_Rhs, 1);
Set_Etype (New_Rhs, Etype (Left_Opnd (New_Rhs)));
end if;
New_Rhs :=
Make_Op_Or (Loc,
Left_Opnd => New_Rhs,
Right_Opnd => Or_Rhs);
Right_Opnd => Unchecked_Convert_To
(Etype (New_Rhs), Or_Rhs));
end;
end if;
if Require_Byte_Swapping then
Set_Etype (New_Rhs, Etype (Obj));
New_Rhs := Byte_Swap (New_Rhs);
New_Rhs :=
Unchecked_Convert_To (Etype (Obj),
Byte_Swap (New_Rhs,
Left_Justify => not Bytes_Big_Endian,
Right_Justify => Bytes_Big_Endian));
end if;
-- Now do the rewrite
@ -1991,6 +2037,11 @@ package body Exp_Pakd is
Lit : Node_Id;
Arg : Node_Id;
Byte_Swapped : Boolean;
-- Set true if bytes were swapped for the purpose of extracting the
-- element, in which case we must swap back if the component type is
-- a composite type with reverse scalar storage order.
begin
-- If the node is an actual in a call, the prefix has not been fully
-- expanded, to account for the additional expansion for in-out actuals
@ -2057,7 +2108,13 @@ package body Exp_Pakd is
and then Esize (Atyp) > 8
and then not In_Reverse_Storage_Order_Object (Obj)
then
Obj := Byte_Swap (Obj);
Obj := Byte_Swap (Obj,
Left_Justify => Bytes_Big_Endian,
Right_Justify => not Bytes_Big_Endian);
Byte_Swapped := True;
else
Byte_Swapped := False;
end if;
-- We generate a shift right to position the field, followed by a
@ -2075,6 +2132,15 @@ package body Exp_Pakd is
Left_Opnd => Make_Shift_Right (Obj, Shift),
Right_Opnd => Lit);
-- Swap back if necessary
Set_Etype (Arg, Ctyp);
if Byte_Swapped and then Reverse_Storage_Order (Ctyp) then
Arg := Byte_Swap (Arg,
Left_Justify => not Bytes_Big_Endian,
Right_Justify => False);
end if;
-- We needed to analyze this before we do the unchecked convert
-- below, but we need it temporarily attached to the tree for
-- this analysis (hence the temporary Set_Parent call).
@ -2597,6 +2663,18 @@ package body Exp_Pakd is
Source_Siz := UI_To_Int (RM_Size (Source_Typ));
Target_Siz := UI_To_Int (RM_Size (Target_Typ));
-- For a little-endian target type stored byte-swapped on a
-- big-endian machine, do not mask to Target_Siz bits.
if Bytes_Big_Endian
and then (Is_Record_Type (Target_Typ)
or else
Is_Array_Type (Target_Typ))
and then Reverse_Storage_Order (Target_Typ)
then
Source_Siz := Target_Siz;
end if;
-- First step, if the source type is not a discrete type, then we first
-- convert to a modular type of the source length, since otherwise, on
-- a big-endian machine, we get left-justification. We do it for little-

9
gcc/ada/sem_attr.adb
View File

@ -5627,9 +5627,16 @@ package body Sem_Attr is
Error_Attr ("address value out of range for % attribute", E1);
end if;
-- In most cases the expression is a numeric literal or some other
-- address expression, but if it is a declared constant it may be
-- of a compatible type that must be left on the node.
if Is_Entity_Name (E1) then
null;
-- Set type to universal integer if negative
if Val < 0 then
elsif Val < 0 then
Set_Etype (E1, Universal_Integer);
-- Otherwise set type to Unsigned_64 to accomodate max values

47
gcc/ada/sem_ch7.adb
View File

@ -1483,7 +1483,38 @@ package body Sem_Ch7 is
Clear_Constants (Id, First_Private_Entity (Id));
end if;
-- Issue an error in SPARK mode if a package specification contains
-- more than one tagged type or type extension.
Check_One_Tagged_Type_Or_Extension_At_Most;
-- Issue an error if a package that is a library unit does not require a
-- body, and we have a non-null abstract state (SPARK LRM 7.1.5(4)).
if not Unit_Requires_Body (Id, Ignore_Abstract_State => True)
and then Present (Abstract_States (Id))
-- We use Scope_Depth of 1 to identify library units, which seems a
-- bit ugly, but there doesn't seem to be an easier way.
and then Scope_Depth (Id) = 1
-- A null abstract state always appears as the sole element of the
-- state list.
and then not Is_Null_State (Node (First_Elmt (Abstract_States (Id))))
then
declare
P : constant Node_Id := Get_Pragma (Id, Pragma_Abstract_State);
begin
Error_Msg_NE
("package & specifies a non-null abstract state", P, Id);
Error_Msg_N
("\but package does not otherwise require a body", P);
Error_Msg_N
("\pragma Elaborate_Body is required in this case", P);
end;
end if;
end Analyze_Package_Specification;
--------------------------------------
@ -2588,7 +2619,10 @@ package body Sem_Ch7 is
-- Unit_Requires_Body --
------------------------
function Unit_Requires_Body (P : Entity_Id) return Boolean is
function Unit_Requires_Body
(P : Entity_Id;
Ignore_Abstract_State : Boolean := False) return Boolean
is
E : Entity_Id;
begin
@ -2627,12 +2661,17 @@ package body Sem_Ch7 is
end;
-- A [generic] package that introduces at least one non-null abstract
-- state requires completion. A null abstract state always appears as
-- the sole element of the state list.
-- state requires completion. However, there is a separate rule that
-- requires that such a package have a reason other than this for a
-- body being required (if necessary a pragma Elaborate_Body must be
-- provided). If Ignore_Abstract_State is True, we don't do this check
-- (so we can use Unit_Requires_Body to check for some other reason).
elsif Ekind_In (P, E_Generic_Package, E_Package)
and then not Ignore_Abstract_State
and then Present (Abstract_States (P))
and then not Is_Null_State (Node (First_Elmt (Abstract_States (P))))
and then
not Is_Null_State (Node (First_Elmt (Abstract_States (P))))
then
return True;
end if;

14
gcc/ada/sem_ch7.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
@ -52,9 +52,15 @@ package Sem_Ch7 is
-- but is deferred until the compilation of the private part of the
-- child for public child packages.
function Unit_Requires_Body (P : Entity_Id) return Boolean;
-- Check if a unit requires a body. A specification requires a body
-- if it contains declarations that require completion in a body.
function Unit_Requires_Body
(P : Entity_Id;
Ignore_Abstract_State : Boolean := False) return Boolean;
-- Check if a unit requires a body. A specification requires a body if it
-- contains declarations that require completion in a body. If the flag
-- Ignore_Abstract_State is set True, then the test for a non-null abstract
-- state (which normally requires a body) is not carried out. This allows
-- the use of this routine to tell if there is some other reason that a
-- body is required (as is required for analyzing Abstract_State).
procedure May_Need_Implicit_Body (E : Entity_Id);
-- If a package declaration contains tasks or RACWs and does not require

2
gcc/ada/sem_prag.adb
View File

@ -4960,7 +4960,7 @@ package body Sem_Prag is
Pragma_Misplaced;
elsif (Nkind (Parent_Node) = N_Generic_Package_Declaration
or else Nkind (Parent_Node) =
or else Nkind (Parent_Node) =
N_Generic_Subprogram_Declaration)
and then Plist = Generic_Formal_Declarations (Parent_Node)
then