+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,
-- --
-- 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- --
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;
----------------------
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,
Aspect_Predicate, -- GNAT
Aspect_Priority,
Aspect_Read,
+ Aspect_Scalar_Storage_Order, -- GNAT
Aspect_Simple_Storage_Pool, -- GNAT
Aspect_Size,
Aspect_Small,
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,
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,
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,
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
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
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 --
-----------
Attribute_Priority |
Attribute_Read |
Attribute_Result |
+ Attribute_Scalar_Storage_Order |
Attribute_Simple_Storage_Pool |
Attribute_Storage_Pool |
Attribute_Storage_Size |
-- 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
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 --
----------
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 =>
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;
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 + $;
Attribute_Safe_Last,
Attribute_Safe_Small,
Attribute_Same_Storage,
+ Attribute_Scalar_Storage_Order,
Attribute_Scale,
Attribute_Scaling,
Attribute_Signed_Zeros,
projects / thirdparty / gcc.git / commitdiff
