OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2013-04-11  Johannes Kanig  <kanig@adacore.com>

	* debug.adb: Remove comment for -gnatd.G.

2013-04-11  Thomas Quinot  <quinot@adacore.com>

	* exp_ch4.adb (Expand_Record_Equality.Suitable_Element):
	Remove recursive routine, replace with...
	(Expand_Record_Equality.Element_To_Compare): New subroutine,
	implement iterative search for next element to compare.
	Add explanatory comment in the tagged case.

From-SVN: r197747
This commit is contained in:
Arnaud Charlet 2013-04-11 11:38:07 +02:00
parent ac7d724dc0
commit 6b670dcfa7
3 changed files with 59 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/ada/ChangeLog
View File

@ -1,3 +1,15 @@
2013-04-11 Johannes Kanig <kanig@adacore.com>
* debug.adb: Remove comment for -gnatd.G.
2013-04-11 Thomas Quinot <quinot@adacore.com>
* exp_ch4.adb (Expand_Record_Equality.Suitable_Element):
Remove recursive routine, replace with...
(Expand_Record_Equality.Element_To_Compare): New subroutine,
implement iterative search for next element to compare.
Add explanatory comment in the tagged case.
2013-04-11 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb: remove spurious warning from non-empty loop.

4
gcc/ada/debug.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -124,7 +124,7 @@ package body Debug is
-- d.D Strict Alfa mode
-- d.E Force Alfa mode for gnat2why
-- d.F Alfa mode
-- d.G Precondition only mode for gnat2why
-- d.G
-- d.H Standard package only mode for gnat2why
-- d.I SCIL generation mode
-- d.J Disable parallel SCIL generation mode

83
gcc/ada/exp_ch4.adb
View File

@ -10889,53 +10889,60 @@ package body Exp_Ch4 is
First_Time : Boolean := True;
function Suitable_Element (C : Entity_Id) return Entity_Id;
-- Return the first field to compare beginning with C, skipping the
-- inherited components.
function Element_To_Compare (C : Entity_Id) return Entity_Id;
-- Return the next discriminant or component to compare, starting with
-- C, skipping inherited components.
----------------------
-- Suitable_Element --
----------------------
------------------------
-- Element_To_Compare --
------------------------
function Suitable_Element (C : Entity_Id) return Entity_Id is
function Element_To_Compare (C : Entity_Id) return Entity_Id is
Comp : Entity_Id;
begin
if No (C) then
return Empty;
Comp := C;
elsif Ekind (C) /= E_Discriminant
and then Ekind (C) /= E_Component
then
return Suitable_Element (Next_Entity (C));
loop
-- Exit loop when the next element to be compared is found, or
-- there is no more such element.
-- Below test for C /= Original_Record_Component (C) is dubious
-- if Typ is a constrained record subtype???
exit when No (Comp);
elsif Is_Tagged_Type (Typ)
and then C /= Original_Record_Component (C)
then
return Suitable_Element (Next_Entity (C));
exit when Ekind_In (Comp, E_Discriminant, E_Component)
and then not (
elsif Chars (C) = Name_uTag then
return Suitable_Element (Next_Entity (C));
-- Skip inherited components
-- The .NET/JVM version of type Root_Controlled contains two fields
-- which should not be considered part of the object. To achieve
-- proper equiality between two controlled objects on .NET/JVM, skip
-- field _parent whenever it is of type Root_Controlled.
-- Note: for a tagged type, we always generate the "=" primitive
-- for the base type (not on the first subtype), so the test for
-- Comp /= Original_Record_Component (Comp) is True for
-- inherited components only.
elsif Chars (C) = Name_uParent
and then VM_Target /= No_VM
and then Etype (C) = RTE (RE_Root_Controlled)
then
return Suitable_Element (Next_Entity (C));
(Is_Tagged_Type (Typ)
and then Comp /= Original_Record_Component (Comp))
elsif Is_Interface (Etype (C)) then
return Suitable_Element (Next_Entity (C));
-- Skip _Tag
else
return C;
end if;
end Suitable_Element;
or else Chars (Comp) = Name_uTag
-- The .NET/JVM version of type Root_Controlled contains two
-- fields which should not be considered part of the object. To
-- achieve proper equiality between two controlled objects on
-- .NET/JVM, skip _Parent whenever it has type Root_Controlled.
or else (Chars (Comp) = Name_uParent
and then VM_Target /= No_VM
and then Etype (Comp) = RTE (RE_Root_Controlled))
-- Skip interface elements (secondary tags???)
or else Is_Interface (Etype (Comp)));
Next_Entity (Comp);
end loop;
return Comp;
end Element_To_Compare;
-- Start of processing for Expand_Record_Equality
@ -10951,7 +10958,7 @@ package body Exp_Ch4 is
-- and then Lhs.Cmpn = Rhs.Cmpn
Result := New_Reference_To (Standard_True, Loc);
C := Suitable_Element (First_Entity (Typ));
C := Element_To_Compare (First_Entity (Typ));
while Present (C) loop
declare
New_Lhs : Node_Id;
@ -10995,7 +11002,7 @@ package body Exp_Ch4 is
end if;
end;
C := Suitable_Element (Next_Entity (C));
C := Element_To_Compare (Next_Entity (C));
end loop;
return Result;