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

[multiple changes]

Browse Source 
2012-03-09  Vasiliy Fofanov  <fofanov@adacore.com>

	* a-direct.adb: Do not strip the trailing directory separator
	from path, as this is already done inside Normalize_Pathname;
	doing it again produces the wrong result on Windows for the
	drive's root dir (i.e. "X:\" becomes "X:").

2012-03-09  Thomas Quinot  <quinot@adacore.com>

	* exp_attr.adb, freeze.adb, sem_attr.adb, aspects.adb, aspects.ads,
	sem_ch13.adb, snames.ads-tmpl (Exp_Attr.Expand_N_Attribute_Reference):
	Add Attribute_Scalar_Storage_Order.
	(Sem_Attr.Analyze_Attribute, Eval_Attribute): Ditto.
	(Aspects): Add Aspect_Scalar_Storage_Order (Snames): Add
	Name_Scalar_Storage_Order and Attribute_Scalar_Storage_Order.
	(Sem_Ch13.Analyze_Attribute_Definition_Clause): Add processing
	for Scalar_Storage_Order.
	(Freeze): If Scalar_Storage_Order is specified, check that it
	is compatible with Bit_Order.

From-SVN: r185142
This commit is contained in:
Arnaud Charlet 2012-03-09 15:54:58 +01:00
parent a1fc903a3f
commit f91510fca5
9 changed files with 140 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/ada/ChangeLog
View File

@ -1,3 +1,23 @@
2012-03-09 Vasiliy Fofanov <fofanov@adacore.com>
* a-direct.adb: Do not strip the trailing directory separator
from path, as this is already done inside Normalize_Pathname;
doing it again produces the wrong result on Windows for the
drive's root dir (i.e. "X:\" becomes "X:").
2012-03-09 Thomas Quinot <quinot@adacore.com>
* exp_attr.adb, freeze.adb, sem_attr.adb, aspects.adb, aspects.ads,
sem_ch13.adb, snames.ads-tmpl (Exp_Attr.Expand_N_Attribute_Reference):
Add Attribute_Scalar_Storage_Order.
(Sem_Attr.Analyze_Attribute, Eval_Attribute): Ditto.
(Aspects): Add Aspect_Scalar_Storage_Order (Snames): Add
Name_Scalar_Storage_Order and Attribute_Scalar_Storage_Order.
(Sem_Ch13.Analyze_Attribute_Definition_Clause): Add processing
for Scalar_Storage_Order.
(Freeze): If Scalar_Storage_Order is specified, check that it
is compatible with Bit_Order.
2012-03-09 Robert Dewar <dewar@adacore.com>
* s-osinte-linux.ads, sem_util.adb, s-taprop-linux.adb, exp_ch4.adb,

16
gcc/ada/a-direct.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2012, 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- --
@ -514,18 +514,10 @@ package body Ada.Directories is
begin
Local_Get_Current_Dir (Buffer'Address, Path_Len'Address);
declare
-- We need to resolve links because of A.16(47), since we must not
-- return alternative names for files
Cur : constant String := Normalize_Pathname (Buffer (1 .. Path_Len));
-- We need to resolve links because of A.16(47), since we must not
-- return alternative names for files
return Normalize_Pathname (Buffer (1 .. Path_Len));
begin
if Cur'Length > 1 and then Cur (Cur'Last) = Dir_Separator then
return Cur (1 .. Cur'Last - 1);
else
return Cur;
end if;
end;
end Current_Directory;
----------------------

1
gcc/ada/aspects.adb
View File

@ -278,6 +278,7 @@ package body Aspects is
Aspect_Pure_12 => Aspect_Pure_12,
Aspect_Remote_Call_Interface => Aspect_Remote_Call_Interface,
Aspect_Remote_Types => Aspect_Remote_Types,
Aspect_Scalar_Storage_Order => Aspect_Scalar_Storage_Order,
Aspect_Shared_Passive => Aspect_Shared_Passive,
Aspect_Universal_Data => Aspect_Universal_Data,
Aspect_Input => Aspect_Input,

4
gcc/ada/aspects.ads
View File

@ -74,6 +74,7 @@ package Aspects is
Aspect_Predicate, -- GNAT
Aspect_Priority,
Aspect_Read,
Aspect_Scalar_Storage_Order, -- GNAT
Aspect_Simple_Storage_Pool, -- GNAT
Aspect_Size,
Aspect_Small,
@ -188,6 +189,7 @@ package Aspects is
Aspect_Pure_Function => True,
Aspect_Remote_Access_Type => True,
Aspect_Shared => True,
Aspect_Scalar_Storage_Order => True,
Aspect_Simple_Storage_Pool => True,
Aspect_Simple_Storage_Pool_Type => True,
Aspect_Suppress_Debug_Info => True,
@ -281,6 +283,7 @@ package Aspects is
Aspect_Predicate => Expression,
Aspect_Priority => Expression,
Aspect_Read => Name,
Aspect_Scalar_Storage_Order => Expression,
Aspect_Simple_Storage_Pool => Name,
Aspect_Size => Expression,
Aspect_Small => Expression,
@ -367,6 +370,7 @@ package Aspects is
Aspect_Remote_Access_Type => Name_Remote_Access_Type,
Aspect_Remote_Call_Interface => Name_Remote_Call_Interface,
Aspect_Remote_Types => Name_Remote_Types,
Aspect_Scalar_Storage_Order => Name_Scalar_Storage_Order,
Aspect_Shared => Name_Shared,
Aspect_Shared_Passive => Name_Shared_Passive,
Aspect_Simple_Storage_Pool => Name_Simple_Storage_Pool,

3
gcc/ada/exp_attr.adb
View File

@ -5672,7 +5672,8 @@ package body Exp_Attr is
Attribute_Definite |
Attribute_Null_Parameter |
Attribute_Passed_By_Reference |
Attribute_Pool_Address =>
Attribute_Pool_Address |
Attribute_Scalar_Storage_Order =>
null;
-- The following attributes are also handled by the back end, but return

22
gcc/ada/freeze.adb
View File

@ -2129,6 +2129,28 @@ package body Freeze is
Next_Entity (Comp);
end loop;
-- Check compatibility of Scalar_Storage_Order with Bit_Order, if the
-- former is specified.
ADC := Get_Attribute_Definition_Clause
(Rec, Attribute_Scalar_Storage_Order);
if Present (ADC)
and then
Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec)
then
if Bytes_Big_Endian = not Reverse_Storage_Order (Rec) then
Error_Msg_N
("Scalar_Storage_Order High_Order_First is inconsistent with"
& " Bit_Order", ADC);
else
Error_Msg_N
("Scalar_Storage_Order Low_Order_First is inconsistent with"
& " Bit_Order", ADC);
end if;
end if;
-- Deal with Bit_Order aspect specifying a non-default bit order
if Reverse_Bit_Order (Rec) and then Base_Type (Rec) = Rec then

30
gcc/ada/sem_attr.adb
View File

@ -4442,6 +4442,35 @@ package body Sem_Attr is
Check_Object_Reference (E1);
Set_Etype (N, Standard_Boolean);
--------------------------
-- Scalar_Storage_Order --
--------------------------
when Attribute_Scalar_Storage_Order => Scalar_Storage_Order :
begin
Check_E0;
Check_Type;
if not Is_Record_Type (P_Type) then
Error_Attr_P ("prefix of % attribute must be record type");
end if;
if Bytes_Big_Endian xor Reverse_Storage_Order (P_Type) then
Rewrite (N,
New_Occurrence_Of (RTE (RE_High_Order_First), Loc));
else
Rewrite (N,
New_Occurrence_Of (RTE (RE_Low_Order_First), Loc));
end if;
Set_Etype (N, RTE (RE_Bit_Order));
Resolve (N);
-- Reset incorrect indication of staticness
Set_Is_Static_Expression (N, False);
end Scalar_Storage_Order;
-----------
-- Scale --
-----------
@ -7963,6 +7992,7 @@ package body Sem_Attr is
Attribute_Priority |
Attribute_Read |
Attribute_Result |
Attribute_Scalar_Storage_Order |
Attribute_Simple_Storage_Pool |
Attribute_Storage_Pool |
Attribute_Storage_Size |

73
gcc/ada/sem_ch13.adb
View File

@ -1064,24 +1064,25 @@ package body Sem_Ch13 is
-- Aspects corresponding to attribute definition clauses
when Aspect_Address |
Aspect_Alignment |
Aspect_Bit_Order |
Aspect_Component_Size |
Aspect_External_Tag |
Aspect_Input |
Aspect_Machine_Radix |
Aspect_Object_Size |
Aspect_Output |
Aspect_Read |
Aspect_Size |
Aspect_Small |
Aspect_Simple_Storage_Pool |
Aspect_Storage_Pool |
Aspect_Storage_Size |
Aspect_Stream_Size |
Aspect_Value_Size |
Aspect_Write =>
when Aspect_Address |
Aspect_Alignment |
Aspect_Bit_Order |
Aspect_Component_Size |
Aspect_External_Tag |
Aspect_Input |
Aspect_Machine_Radix |
Aspect_Object_Size |
Aspect_Output |
Aspect_Read |
Aspect_Scalar_Storage_Order |
Aspect_Size |
Aspect_Small |
Aspect_Simple_Storage_Pool |
Aspect_Storage_Pool |
Aspect_Storage_Size |
Aspect_Stream_Size |
Aspect_Value_Size |
Aspect_Write =>
-- Construct the attribute definition clause
@ -2989,6 +2990,40 @@ package body Sem_Ch13 is
Analyze_Stream_TSS_Definition (TSS_Stream_Read);
Set_Has_Specified_Stream_Read (Ent);
--------------------------
-- Scalar_Storage_Order --
--------------------------
-- Scalar_Storage_Order attribute definition clause
when Attribute_Scalar_Storage_Order => Scalar_Storage_Order : declare
begin
if not Is_Record_Type (U_Ent) then
Error_Msg_N
("Scalar_Storage_Order can only be defined for record type",
Nam);
elsif Duplicate_Clause then
null;
else
Analyze_And_Resolve (Expr, RTE (RE_Bit_Order));
if Etype (Expr) = Any_Type then
return;
elsif not Is_Static_Expression (Expr) then
Flag_Non_Static_Expr
("Scalar_Storage_Order requires static expression!", Expr);
else
if (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then
Set_Reverse_Storage_Order (U_Ent, True);
end if;
end if;
end if;
end Scalar_Storage_Order;
----------
-- Size --
----------
@ -6147,7 +6182,7 @@ package body Sem_Ch13 is
when Aspect_Address =>
T := RTE (RE_Address);
when Aspect_Bit_Order =>
when Aspect_Bit_Order | Aspect_Scalar_Storage_Order =>
T := RTE (RE_Bit_Order);
when Aspect_CPU =>

4
gcc/ada/snames.ads-tmpl
View File

@ -120,7 +120,7 @@ package Snames is
Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y');
Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z');
-- Note: the following table is read by the utility program XSNAMES and
-- Note: the following table is read by the utility program XSNAMES, and
-- its format should not be changed without coordinating with this program.
N : constant Name_Id := First_Name_Id + 256;
@ -826,6 +826,7 @@ package Snames is
Name_Safe_Last : constant Name_Id := N + $;
Name_Safe_Small : constant Name_Id := N + $; -- Ada 83
Name_Same_Storage : constant Name_Id := N + $; -- Ada 12
Name_Scalar_Storage_Order : constant Name_Id := N + $; -- GNAT
Name_Scale : constant Name_Id := N + $;
Name_Scaling : constant Name_Id := N + $;
Name_Signed_Zeros : constant Name_Id := N + $;
@ -1387,6 +1388,7 @@ package Snames is
Attribute_Safe_Last,
Attribute_Safe_Small,
Attribute_Same_Storage,
Attribute_Scalar_Storage_Order,
Attribute_Scale,
Attribute_Scaling,
Attribute_Signed_Zeros,