Commit f66d46ec by Arnaud Charlet

[multiple changes]

2009-04-15  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb (Unchecked_Conversions): Store source location instead
	of node for location for warning messages.

	* gnatchop.adb: Minor reformatting

2009-04-15  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch6.adb: additional guard for renaming declarations for in
	parameters of an array type.

From-SVN: r146105
parent bafc9e1d
2009-04-15 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Unchecked_Conversions): Store source location instead
of node for location for warning messages.
* gnatchop.adb: Minor reformatting
2009-04-15 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb: additional guard for renaming declarations for in
parameters of an array type.
2009-04-15 Robert Dewar <dewar@adacore.com>
* sem_eval.adb (Get_Static_Length): Go to origin node for array bounds
in case they were rewritten by expander (Force_Evaluation).
......@@ -3806,6 +3806,7 @@ package body Exp_Ch6 is
and then not Is_Tagged_Type (Etype (A))
and then
(not Is_Array_Type (Etype (A))
or else not Is_Object_Reference (A)
or else Is_Bit_Packed_Array (Etype (A)))
then
Decl :=
......
......@@ -303,7 +303,7 @@ procedure Gnatchop is
function Get_Config_Pragmas
(Input : File_Num;
U : Unit_Num) return String_Access;
U : Unit_Num) return String_Access;
-- Call to read configuration pragmas from given unit entry, and
-- return a buffer containing the pragmas to be appended to
-- following units. Input is the file number for the chop file and
......@@ -419,8 +419,7 @@ procedure Gnatchop is
function Get_Config_Pragmas
(Input : File_Num;
U : Unit_Num)
return String_Access
U : Unit_Num) return String_Access
is
Info : Unit_Info renames Unit.Table (U);
FD : File_Descriptor;
......@@ -464,8 +463,7 @@ procedure Gnatchop is
function Get_EOL
(Source : not null access String;
Start : Positive)
return EOL_String
Start : Positive) return EOL_String
is
Ptr : Positive := Start;
First : Positive;
......@@ -1643,12 +1641,10 @@ procedure Gnatchop is
W_Name : aliased constant Wide_String := To_Wide_String (Name);
EOL : constant EOL_String :=
Get_EOL (Source, Source'First + Info.Offset);
OS_Name : aliased String (1 .. Name'Length * 2);
O_Length : aliased Natural := OS_Name'Length;
Encoding : aliased String (1 .. 64);
E_Length : aliased Natural := Encoding'Length;
Length : File_Offset;
begin
......
......@@ -121,10 +121,14 @@ package body Sem_Ch13 is
-- processing is to take advantage of back-annotations of size and
-- alignment values performed by the back end.
-- Note: the reason we store a Source_Ptr value instead of a Node_Id
-- is that by the time Validate_Unchecked_Conversions is called, Sprint
-- will already have modified all Sloc values if the -gnatD option is set.
type UC_Entry is record
Enode : Node_Id; -- node used for posting warnings
Source : Entity_Id; -- source type for unchecked conversion
Target : Entity_Id; -- target type for unchecked conversion
Eloc : Source_Ptr; -- node used for posting warnings
Source : Entity_Id; -- source type for unchecked conversion
Target : Entity_Id; -- target type for unchecked conversion
end record;
package Unchecked_Conversions is new Table.Table (
......@@ -4398,7 +4402,7 @@ package body Sem_Ch13 is
if Warn_On_Unchecked_Conversion then
Unchecked_Conversions.Append
(New_Val => UC_Entry'
(Enode => N,
(Eloc => Sloc (N),
Source => Source,
Target => Target));
......@@ -4455,9 +4459,9 @@ package body Sem_Ch13 is
declare
T : UC_Entry renames Unchecked_Conversions.Table (N);
Enode : constant Node_Id := T.Enode;
Source : constant Entity_Id := T.Source;
Target : constant Entity_Id := T.Target;
Eloc : constant Source_Ptr := T.Eloc;
Source : constant Entity_Id := T.Source;
Target : constant Entity_Id := T.Target;
Source_Siz : Uint;
Target_Siz : Uint;
......@@ -4477,17 +4481,16 @@ package body Sem_Ch13 is
Target_Siz := RM_Size (Target);
if Source_Siz /= Target_Siz then
Error_Msg_N
Error_Msg
("?types for unchecked conversion have different sizes!",
Enode);
Eloc);
if All_Errors_Mode then
Error_Msg_Name_1 := Chars (Source);
Error_Msg_Uint_1 := Source_Siz;
Error_Msg_Name_2 := Chars (Target);
Error_Msg_Uint_2 := Target_Siz;
Error_Msg_N
("\size of % is ^, size of % is ^?", Enode);
Error_Msg ("\size of % is ^, size of % is ^?", Eloc);
Error_Msg_Uint_1 := UI_Abs (Source_Siz - Target_Siz);
......@@ -4495,46 +4498,46 @@ package body Sem_Ch13 is
and then Is_Discrete_Type (Target)
then
if Source_Siz > Target_Siz then
Error_Msg_N
Error_Msg
("\?^ high order bits of source will be ignored!",
Enode);
Eloc);
elsif Is_Unsigned_Type (Source) then
Error_Msg_N
Error_Msg
("\?source will be extended with ^ high order " &
"zero bits?!", Enode);
"zero bits?!", Eloc);
else
Error_Msg_N
Error_Msg
("\?source will be extended with ^ high order " &
"sign bits!",
Enode);
Eloc);
end if;
elsif Source_Siz < Target_Siz then
if Is_Discrete_Type (Target) then
if Bytes_Big_Endian then
Error_Msg_N
Error_Msg
("\?target value will include ^ undefined " &
"low order bits!",
Enode);
Eloc);
else
Error_Msg_N
Error_Msg
("\?target value will include ^ undefined " &
"high order bits!",
Enode);
Eloc);
end if;
else
Error_Msg_N
Error_Msg
("\?^ trailing bits of target value will be " &
"undefined!", Enode);
"undefined!", Eloc);
end if;
else pragma Assert (Source_Siz > Target_Siz);
Error_Msg_N
Error_Msg
("\?^ trailing bits of source will be ignored!",
Enode);
Eloc);
end if;
end if;
end if;
......@@ -4568,15 +4571,16 @@ package body Sem_Ch13 is
then
Error_Msg_Uint_1 := Target_Align;
Error_Msg_Uint_2 := Source_Align;
Error_Msg_Node_1 := D_Target;
Error_Msg_Node_2 := D_Source;
Error_Msg_NE
Error_Msg
("?alignment of & (^) is stricter than " &
"alignment of & (^)!", Enode, D_Target);
"alignment of & (^)!", Eloc);
if All_Errors_Mode then
Error_Msg_N
Error_Msg
("\?resulting access value may have invalid " &
"alignment!", Enode);
"alignment!", Eloc);
end if;
end if;
end;
......
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