From 0145066d875a7e281d47f046655b16d0c9958c3a Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 11 Apr 2013 09:38:07 +0000 Subject: [PATCH] 2013-04-11 Johannes Kanig * debug.adb: Remove comment for -gnatd.G. 2013-04-11 Thomas Quinot * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@197747 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 12 ++++++++ gcc/ada/debug.adb | 4 +-- gcc/ada/exp_ch4.adb | 83 +++++++++++++++++++++++++++++------------------------ 3 files changed, 59 insertions(+), 40 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a9c5133..243c8db 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2013-04-11 Johannes Kanig + + * debug.adb: Remove comment for -gnatd.G. + +2013-04-11 Thomas Quinot + + * 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 * sem_ch5.adb: remove spurious warning from non-empty loop. diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index bcb6ee3..f6f69cb 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index c20c856..8083898 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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; -- 2.7.4