From: Arnaud Charlet Date: Fri, 9 Mar 2012 14:54:58 +0000 (+0100) Subject: [multiple changes] X-Git-Tag: misc/gccgo-go1_1_2~4099 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=f91510fca5547ad6e73ea9153ba1bac2fefcd915;p=thirdparty%2Fgcc.git [multiple changes] 2012-03-09 Vasiliy Fofanov * 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 * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fdb14ddcb9ce..90f87ddf670c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2012-03-09 Vasiliy Fofanov + + * 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 + + * 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 * s-osinte-linux.ads, sem_util.adb, s-taprop-linux.adb, exp_ch4.adb, diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb index e27bb3fdd6d8..88e1d72078f0 100644 --- a/gcc/ada/a-direct.adb +++ b/gcc/ada/a-direct.adb @@ -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; ---------------------- diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 89af1d975f3f..51f468c7889d 100755 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -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, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 3c28af83b8f1..84548a9d20d4 100755 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -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, diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 7621ff75e75f..4f67ef97dce5 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 15bd6e075e3a..51e87acfa251 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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 diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index a2b33d8bceb1..3df48228dead 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -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 | diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 9e552ec1118e..2a9255849680 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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 => diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index cce46080d0a7..26cb3d9b605b 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -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,