[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
This commit is contained in:
Arnaud Charlet 2009-04-15 14:21:57 +02:00
parent bafc9e1d98
commit f66d46ecca
4 changed files with 49 additions and 36 deletions

View File

@ -1,3 +1,15 @@
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

View File

@ -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 :=

View File

@ -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

View File

@ -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;