diff options
| author | Hristian Kirtchev <kirtchev@adacore.com> | 2018-07-16 14:11:09 +0000 |
|---|---|---|
| committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2018-07-16 14:11:09 +0000 |
| commit | f2f9cdad15a6eaadb93239092eb4441c535fa387 (patch) | |
| tree | 1a85715c539174c1bc90ded7ca4aa5838aec14b7 /gcc/ada | |
| parent | 721500abf2b9d41bea8d2c91277c4ad5ab834db7 (diff) | |
| download | gcc-f2f9cdad15a6eaadb93239092eb4441c535fa387.zip gcc-f2f9cdad15a6eaadb93239092eb4441c535fa387.tar.gz gcc-f2f9cdad15a6eaadb93239092eb4441c535fa387.tar.bz2 | |
[Ada] Crash on Indefinite_Hashed_Maps with -gnata -gnateV
This patch corrects the generation of helper functions which verify the
validity of record type scalar discriminants and scalar components when
switches -gnata (assertions enabled) and -gnateV (validity checks on
subprogram parameters) are in effect.
2018-07-16 Hristian Kirtchev <kirtchev@adacore.com>
gcc/ada/
* exp_attr.adb (Build_Record_VS_Func): Handle corner cases dealing with
class-wide types and record extensions.
gcc/testsuite/
* gnat.dg/validity_check3.adb, gnat.dg/validity_check3.ads: New
testcase.
From-SVN: r262715
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 39 |
2 files changed, 40 insertions, 4 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6d8572d..59597a3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2018-07-16 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_attr.adb (Build_Record_VS_Func): Handle corner cases dealing with + class-wide types and record extensions. + 2018-07-16 Justin Squirek <squirek@adacore.com> * sem_eval.adb (Eval_Integer_Literal): Add exception for avoiding diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 45c12bf..77e706a 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -724,13 +724,44 @@ package body Exp_Attr is Func_Id : constant Entity_Id := Make_Temporary (Loc, 'V'); Obj_Id : constant Entity_Id := Make_Temporary (Loc, 'R'); - Rec_Decl : constant Node_Id := Declaration_Node (Rec_Typ); - Rec_Def : constant Node_Id := Type_Definition (Rec_Decl); + Comps : Node_Id; Stmts : List_Id; + Typ : Entity_Id; + Typ_Decl : Node_Id; + Typ_Def : Node_Id; + Typ_Ext : Node_Id; -- Start of processing for Build_Record_VS_Func begin + Typ := Rec_Typ; + + -- Use the root type when dealing with a class-wide type + + if Is_Class_Wide_Type (Typ) then + Typ := Root_Type (Typ); + end if; + + Typ_Decl := Declaration_Node (Typ); + Typ_Def := Type_Definition (Typ_Decl); + + -- The components of a derived type are located in the extension part + + if Nkind (Typ_Def) = N_Derived_Type_Definition then + Typ_Ext := Record_Extension_Part (Typ_Def); + + if Present (Typ_Ext) then + Comps := Component_List (Typ_Ext); + else + Comps := Empty; + end if; + + -- Otherwise the components are available in the definition + + else + Comps := Component_List (Typ_Def); + end if; + -- The code generated by this routine is as follows: -- -- function Func_Id (Obj_Id : Formal_Typ) return Boolean is @@ -774,7 +805,7 @@ package body Exp_Attr is if not Is_Unchecked_Union (Rec_Typ) then Validate_Fields (Obj_Id => Obj_Id, - Fields => Discriminant_Specifications (Rec_Decl), + Fields => Discriminant_Specifications (Typ_Decl), Stmts => Stmts); end if; @@ -782,7 +813,7 @@ package body Exp_Attr is Validate_Component_List (Obj_Id => Obj_Id, - Comp_List => Component_List (Rec_Def), + Comp_List => Comps, Stmts => Stmts); -- Generate: |