mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-15 15:21:24 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2009-04-10  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb: Minor reformatting

	* exp_util.adb (Make_Non_Empty_Check): New function
	(Silly_Boolean_Array_Not_Test): Add call to Make_Non_Empty_Check
	(Silly_Boolean_Array_Xor_Test): Use Make_Non_Empty_Check

2009-04-10  Arnaud Charlet  <charlet@adacore.com>

	* make.adb, gnatlink.adb: Rename JGNAT toolchain.

2009-04-10  Jose Ruiz  <ruiz@adacore.com>

	* mlib-tgt-specific-xi.adb (Get_Target_Prefix): Insert the appropriate
	tool prefix for AVR and PowerPC 55xx targets.

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

	* sem_warn.adb (Within_Postcondition): New function
	(Check_Unset_Reference): Use Within_Postcondition to stop bad warning

From-SVN: r145889
This commit is contained in:
Arnaud Charlet 2009-04-10 13:07:42 +02:00
parent 2436ca9ee8
commit b3b9865d06
7 changed files with 486 additions and 391 deletions

26
gcc/ada/ChangeLog

@ -1,3 +1,29 @@
2009-04-10 Tristan Gingold <gingold@adacore.com>
* init.c: Install signal handler on Darwin.
2009-04-10 Robert Dewar <dewar@adacore.com>
* sem_prag.adb: Minor reformatting
* exp_util.adb (Make_Non_Empty_Check): New function
(Silly_Boolean_Array_Not_Test): Add call to Make_Non_Empty_Check
(Silly_Boolean_Array_Xor_Test): Use Make_Non_Empty_Check
2009-04-10 Arnaud Charlet <charlet@adacore.com>
* make.adb, gnatlink.adb: Rename JGNAT toolchain.
2009-04-10 Jose Ruiz <ruiz@adacore.com>
* mlib-tgt-specific-xi.adb (Get_Target_Prefix): Insert the appropriate
tool prefix for AVR and PowerPC 55xx targets.
2009-04-10 Robert Dewar <dewar@adacore.com>
* sem_warn.adb (Within_Postcondition): New function
(Check_Unset_Reference): Use Within_Postcondition to stop bad warning
2009-04-10 Robert Dewar <dewar@adacore.com>
* sem_warn.adb: Minor reformatting

73
gcc/ada/exp_util.adb

@ -135,6 +135,12 @@ package body Exp_Util is
-- (Literal_Type'Pos (Low_Bound (Literal_Type))
-- + (Length (Literal_Typ) -1))
function Make_Non_Empty_Check
(Loc : Source_Ptr;
N : Node_Id) return Node_Id;
-- Produce a boolean expression checking that the unidimensional array
-- node N is not empty.
function New_Class_Wide_Subtype
(CW_Typ : Entity_Id;
N : Node_Id) return Entity_Id;
@ -3742,6 +3748,25 @@ package body Exp_Util is
High_Bound => Hi);
end Make_Literal_Range;
--------------------------
-- Make_Non_Empty_Check --
--------------------------
function Make_Non_Empty_Check
(Loc : Source_Ptr;
N : Node_Id) return Node_Id
is
begin
return
Make_Op_Ne (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Length,
Prefix => Duplicate_Subexpr_No_Checks (N, Name_Req => True)),
Right_Opnd =>
Make_Integer_Literal (Loc, 0));
end Make_Non_Empty_Check;
----------------------------
-- Make_Subtype_From_Expr --
----------------------------
@ -5116,6 +5141,10 @@ package body Exp_Util is
-- that constraint error is raised. The reason is that the NOT is bound
-- to cause CE in this case, and we will not otherwise catch it.
-- No such check is required for AND and OR, since for both these cases
-- False op False = False, and True op True = True. For the XOR case,
-- see Silly_Boolean_Array_Xor_Test.
-- Believe it or not, this was reported as a bug. Note that nearly
-- always, the test will evaluate statically to False, so the code will
-- be statically removed, and no extra overhead caused.
@ -5125,19 +5154,34 @@ package body Exp_Util is
CT : constant Entity_Id := Component_Type (T);
begin
-- The check we install is
-- constraint_error when
-- component_type'first = component_type'last
-- and then array_type'Length /= 0)
-- We need the last guard because we don't want to raise CE for empty
-- arrays since no out of range values result. (Empty arrays with a
-- component type of True .. True -- very useful -- even the ACATS
-- does not test that marginal case!)
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
Condition =>
Make_Op_Eq (Loc,
Make_And_Then (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (CT, Loc),
Attribute_Name => Name_First),
Make_Op_Eq (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (CT, Loc),
Attribute_Name => Name_First),
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (CT, Loc),
Attribute_Name => Name_Last)),
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (CT, Loc),
Attribute_Name => Name_Last)),
Right_Opnd => Make_Non_Empty_Check (Loc, Right_Opnd (N))),
Reason => CE_Range_Check_Failed));
end Silly_Boolean_Array_Not_Test;
@ -5151,7 +5195,9 @@ package body Exp_Util is
-- will not be generated otherwise (cf Expand_Packed_Not).
-- No such check is required for AND and OR, since for both these cases
-- False op False = False, and True op True = True.
-- False op False = False, and True op True = True, and no check is
-- required for the case of False .. False, since False xor False = False.
-- See also Silly_Boolean_Array_Not_Test
procedure Silly_Boolean_Array_Xor_Test (N : Node_Id; T : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N);
@ -5188,14 +5234,7 @@ package body Exp_Util is
Prefix => New_Occurrence_Of (CT, Loc),
Attribute_Name => Name_Last))),
Right_Opnd =>
Make_Op_Ne (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (T, Loc),
Attribute_Name => Name_Length),
Right_Opnd => Make_Integer_Literal (Loc, 0))),
Right_Opnd => Make_Non_Empty_Check (Loc, Right_Opnd (N))),
Reason => CE_Range_Check_Failed));
end Silly_Boolean_Array_Xor_Test;

2
gcc/ada/gnatlink.adb

@ -1619,7 +1619,7 @@ begin
if VM_Target /= No_VM then
case VM_Target is
when JVM_Target => Gcc := new String'("jgnat");
when JVM_Target => Gcc := new String'("jvm-gnatcompile");
when CLI_Target => Gcc := new String'("dotnet-gnatcompile");
when No_VM => raise Program_Error;
end case;

5
gcc/ada/make.adb

@ -5396,10 +5396,7 @@ package body Make is
-- JVM machine since ".class" files are generated instead.
Check_Object_Consistency := False;
Gcc := new String'("jgnat");
Gnatbind := new String'("jgnatbind");
Gnatlink := new String'("jgnatlink");
Gcc := new String'("jvm-gnatcompile");
when Targparm.CLI_Target =>
Gcc := new String'("dotnet-gnatcompile");

12
gcc/ada/mlib-tgt-specific-xi.adb

@ -148,12 +148,20 @@ package body MLib.Tgt.Specific is
Index := Index + 1;
end loop;
if Target_Name (Target_Name'First .. Index) = "erc32" then
if Target_Name (Target_Name'First .. Index) = "avr" then
return "avr-";
elsif Target_Name (Target_Name'First .. Index) = "erc32" then
return "erc32-elf-";
elsif Target_Name (Target_Name'First .. Index) = "leon" then
return "leon-elf-";
elsif Target_Name (Target_Name'First .. Index) = "powerpc" then
return "powerpc-elf-";
if Target_Name'Last - 6 >= Target_Name'First and then
Target_Name (Target_Name'Last - 6 .. Target_Name'Last) = "eabispe"
then
return "powerpc-eabispe-";
else
return "powerpc-elf-";
end if;
else
return "";
end if;

693
gcc/ada/sem_prag.adb

File diff suppressed because it is too large Load Diff

66
gcc/ada/sem_warn.adb

@ -1610,10 +1610,37 @@ package body Sem_Warn is
-- As always, it is possible to construct cases where the
-- warning is wrong, that is why it is a warning!
declare
Potential_Unset_Reference : declare
SR : Entity_Id;
SE : constant Entity_Id := Scope (E);
function Within_Postcondition return Boolean;
-- Returns True iff N is within a Precondition
--------------------------
-- Within_Postcondition --
--------------------------
function Within_Postcondition return Boolean is
Nod : Node_Id;
begin
Nod := Parent (N);
while Present (Nod) loop
if Nkind (Nod) = N_Pragma
and then Pragma_Name (Nod) = Name_Postcondition
then
return True;
end if;
Nod := Parent (Nod);
end loop;
return False;
end Within_Postcondition;
-- Start of processing for Potential_Unset_Reference
begin
SR := Current_Scope;
while SR /= SE loop
@ -1732,26 +1759,33 @@ package body Sem_Warn is
end Access_Type_Case;
end if;
-- Here we definitely have a case for giving a warning
-- for a reference to an unset value. But we don't give
-- the warning now. Instead we set the Unset_Reference
-- field of the identifier involved. The reason for this
-- is that if we find the variable is never ever assigned
-- a value then that warning is more important and there
-- is no point in giving the reference warning.
-- One more check, don't bother if we are within a
-- postcondition pragma, since the expression occurs
-- in a place unrelated to the actual test.
-- If this is an identifier, set the field directly
if not Within_Postcondition then
if Nkind (N) = N_Identifier then
Set_Unset_Reference (E, N);
-- Here we definitely have a case for giving a warning
-- for a reference to an unset value. But we don't
-- give the warning now. Instead set Unset_Reference
-- in the identifier involved. The reason for this is
-- that if we find the variable is never ever assigned
-- a value then that warning is more important and
-- there is no point in giving the reference warning.
-- Otherwise it is an expanded name, so set the field of
-- the actual identifier for the reference.
-- If this is an identifier, set the field directly
else
Set_Unset_Reference (E, Selector_Name (N));
if Nkind (N) = N_Identifier then
Set_Unset_Reference (E, N);
-- Otherwise it is an expanded name, so set the field
-- of the actual identifier for the reference.
else
Set_Unset_Reference (E, Selector_Name (N));
end if;
end if;
end;
end Potential_Unset_Reference;
end if;
end;