diff options
Diffstat (limited to 'gcc/ada/sem_aggr.adb')
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 35 |
1 files changed, 31 insertions, 4 deletions
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 491d3487b0c..6c52b9f763b 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -10,14 +10,13 @@ -- -- -- 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- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, USA. -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- @@ -3039,6 +3038,8 @@ package body Sem_Aggr is declare Loc : constant Source_Ptr := Sloc (N); + Assoc : Node_Id; + Discr : Entity_Id; Discr_Elmt : Elmt_Id; Discr_Val : Node_Id; Expr : Node_Id; @@ -3050,6 +3051,32 @@ package body Sem_Aggr is First_Elmt (Discriminant_Constraint (Ctyp)); while Present (Discr_Elmt) loop Discr_Val := Node (Discr_Elmt); + + -- The constraint may be given by a discriminant + -- of the enclosing type, in which case we have + -- to retrieve its value, which is part of the + -- current aggregate. + + if Is_Entity_Name (Discr_Val) + and then + Ekind (Entity (Discr_Val)) = E_Discriminant + then + Discr := Entity (Discr_Val); + + Assoc := First (New_Assoc_List); + while Present (Assoc) loop + if Present + (Entity (First (Choices (Assoc)))) + and then + Entity (First (Choices (Assoc))) = Discr + then + Discr_Val := Expression (Assoc); + exit; + end if; + Next (Assoc); + end loop; + end if; + Append (New_Copy_Tree (Discr_Val), Expressions (Expr)); |