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> 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 * sem_eval.adb (Get_Static_Length): Go to origin node for array bounds
in case they were rewritten by expander (Force_Evaluation). in case they were rewritten by expander (Force_Evaluation).
...@@ -3806,6 +3806,7 @@ package body Exp_Ch6 is ...@@ -3806,6 +3806,7 @@ package body Exp_Ch6 is
and then not Is_Tagged_Type (Etype (A)) and then not Is_Tagged_Type (Etype (A))
and then and then
(not Is_Array_Type (Etype (A)) (not Is_Array_Type (Etype (A))
or else not Is_Object_Reference (A)
or else Is_Bit_Packed_Array (Etype (A))) or else Is_Bit_Packed_Array (Etype (A)))
then then
Decl := Decl :=
......
...@@ -419,8 +419,7 @@ procedure Gnatchop is ...@@ -419,8 +419,7 @@ procedure Gnatchop is
function Get_Config_Pragmas function Get_Config_Pragmas
(Input : File_Num; (Input : File_Num;
U : Unit_Num) U : Unit_Num) return String_Access
return String_Access
is is
Info : Unit_Info renames Unit.Table (U); Info : Unit_Info renames Unit.Table (U);
FD : File_Descriptor; FD : File_Descriptor;
...@@ -464,8 +463,7 @@ procedure Gnatchop is ...@@ -464,8 +463,7 @@ procedure Gnatchop is
function Get_EOL function Get_EOL
(Source : not null access String; (Source : not null access String;
Start : Positive) Start : Positive) return EOL_String
return EOL_String
is is
Ptr : Positive := Start; Ptr : Positive := Start;
First : Positive; First : Positive;
...@@ -1643,12 +1641,10 @@ procedure Gnatchop is ...@@ -1643,12 +1641,10 @@ procedure Gnatchop is
W_Name : aliased constant Wide_String := To_Wide_String (Name); W_Name : aliased constant Wide_String := To_Wide_String (Name);
EOL : constant EOL_String := EOL : constant EOL_String :=
Get_EOL (Source, Source'First + Info.Offset); Get_EOL (Source, Source'First + Info.Offset);
OS_Name : aliased String (1 .. Name'Length * 2); OS_Name : aliased String (1 .. Name'Length * 2);
O_Length : aliased Natural := OS_Name'Length; O_Length : aliased Natural := OS_Name'Length;
Encoding : aliased String (1 .. 64); Encoding : aliased String (1 .. 64);
E_Length : aliased Natural := Encoding'Length; E_Length : aliased Natural := Encoding'Length;
Length : File_Offset; Length : File_Offset;
begin begin
......
...@@ -121,8 +121,12 @@ package body Sem_Ch13 is ...@@ -121,8 +121,12 @@ package body Sem_Ch13 is
-- processing is to take advantage of back-annotations of size and -- processing is to take advantage of back-annotations of size and
-- alignment values performed by the back end. -- 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 type UC_Entry is record
Enode : Node_Id; -- node used for posting warnings Eloc : Source_Ptr; -- node used for posting warnings
Source : Entity_Id; -- source type for unchecked conversion Source : Entity_Id; -- source type for unchecked conversion
Target : Entity_Id; -- target type for unchecked conversion Target : Entity_Id; -- target type for unchecked conversion
end record; end record;
...@@ -4398,7 +4402,7 @@ package body Sem_Ch13 is ...@@ -4398,7 +4402,7 @@ package body Sem_Ch13 is
if Warn_On_Unchecked_Conversion then if Warn_On_Unchecked_Conversion then
Unchecked_Conversions.Append Unchecked_Conversions.Append
(New_Val => UC_Entry' (New_Val => UC_Entry'
(Enode => N, (Eloc => Sloc (N),
Source => Source, Source => Source,
Target => Target)); Target => Target));
...@@ -4455,7 +4459,7 @@ package body Sem_Ch13 is ...@@ -4455,7 +4459,7 @@ package body Sem_Ch13 is
declare declare
T : UC_Entry renames Unchecked_Conversions.Table (N); T : UC_Entry renames Unchecked_Conversions.Table (N);
Enode : constant Node_Id := T.Enode; Eloc : constant Source_Ptr := T.Eloc;
Source : constant Entity_Id := T.Source; Source : constant Entity_Id := T.Source;
Target : constant Entity_Id := T.Target; Target : constant Entity_Id := T.Target;
...@@ -4477,17 +4481,16 @@ package body Sem_Ch13 is ...@@ -4477,17 +4481,16 @@ package body Sem_Ch13 is
Target_Siz := RM_Size (Target); Target_Siz := RM_Size (Target);
if Source_Siz /= Target_Siz then if Source_Siz /= Target_Siz then
Error_Msg_N Error_Msg
("?types for unchecked conversion have different sizes!", ("?types for unchecked conversion have different sizes!",
Enode); Eloc);
if All_Errors_Mode then if All_Errors_Mode then
Error_Msg_Name_1 := Chars (Source); Error_Msg_Name_1 := Chars (Source);
Error_Msg_Uint_1 := Source_Siz; Error_Msg_Uint_1 := Source_Siz;
Error_Msg_Name_2 := Chars (Target); Error_Msg_Name_2 := Chars (Target);
Error_Msg_Uint_2 := Target_Siz; Error_Msg_Uint_2 := Target_Siz;
Error_Msg_N Error_Msg ("\size of % is ^, size of % is ^?", Eloc);
("\size of % is ^, size of % is ^?", Enode);
Error_Msg_Uint_1 := UI_Abs (Source_Siz - Target_Siz); Error_Msg_Uint_1 := UI_Abs (Source_Siz - Target_Siz);
...@@ -4495,46 +4498,46 @@ package body Sem_Ch13 is ...@@ -4495,46 +4498,46 @@ package body Sem_Ch13 is
and then Is_Discrete_Type (Target) and then Is_Discrete_Type (Target)
then then
if Source_Siz > Target_Siz then if Source_Siz > Target_Siz then
Error_Msg_N Error_Msg
("\?^ high order bits of source will be ignored!", ("\?^ high order bits of source will be ignored!",
Enode); Eloc);
elsif Is_Unsigned_Type (Source) then elsif Is_Unsigned_Type (Source) then
Error_Msg_N Error_Msg
("\?source will be extended with ^ high order " & ("\?source will be extended with ^ high order " &
"zero bits?!", Enode); "zero bits?!", Eloc);
else else
Error_Msg_N Error_Msg
("\?source will be extended with ^ high order " & ("\?source will be extended with ^ high order " &
"sign bits!", "sign bits!",
Enode); Eloc);
end if; end if;
elsif Source_Siz < Target_Siz then elsif Source_Siz < Target_Siz then
if Is_Discrete_Type (Target) then if Is_Discrete_Type (Target) then
if Bytes_Big_Endian then if Bytes_Big_Endian then
Error_Msg_N Error_Msg
("\?target value will include ^ undefined " & ("\?target value will include ^ undefined " &
"low order bits!", "low order bits!",
Enode); Eloc);
else else
Error_Msg_N Error_Msg
("\?target value will include ^ undefined " & ("\?target value will include ^ undefined " &
"high order bits!", "high order bits!",
Enode); Eloc);
end if; end if;
else else
Error_Msg_N Error_Msg
("\?^ trailing bits of target value will be " & ("\?^ trailing bits of target value will be " &
"undefined!", Enode); "undefined!", Eloc);
end if; end if;
else pragma Assert (Source_Siz > Target_Siz); else pragma Assert (Source_Siz > Target_Siz);
Error_Msg_N Error_Msg
("\?^ trailing bits of source will be ignored!", ("\?^ trailing bits of source will be ignored!",
Enode); Eloc);
end if; end if;
end if; end if;
end if; end if;
...@@ -4568,15 +4571,16 @@ package body Sem_Ch13 is ...@@ -4568,15 +4571,16 @@ package body Sem_Ch13 is
then then
Error_Msg_Uint_1 := Target_Align; Error_Msg_Uint_1 := Target_Align;
Error_Msg_Uint_2 := Source_Align; Error_Msg_Uint_2 := Source_Align;
Error_Msg_Node_1 := D_Target;
Error_Msg_Node_2 := D_Source; Error_Msg_Node_2 := D_Source;
Error_Msg_NE Error_Msg
("?alignment of & (^) is stricter than " & ("?alignment of & (^) is stricter than " &
"alignment of & (^)!", Enode, D_Target); "alignment of & (^)!", Eloc);
if All_Errors_Mode then if All_Errors_Mode then
Error_Msg_N Error_Msg
("\?resulting access value may have invalid " & ("\?resulting access value may have invalid " &
"alignment!", Enode); "alignment!", Eloc);
end if; end if;
end if; end if;
end; 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