[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:
parent
bafc9e1d98
commit
f66d46ecca
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue