From 913e4b3617fe7f46fbdbb72b010cf6cf7201d329 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 23 Jan 2017 12:00:26 +0000 Subject: [PATCH] sem_ch4.adb (Try_Primitive_Operations, [...]): argument is valid if it is a derived type with unknown discriminants that... 2017-01-23 Ed Schonberg * sem_ch4.adb (Try_Primitive_Operations, Is_Valid_First_Argument_Of): argument is valid if it is a derived type with unknown discriminants that matches its underlying record view. * exp_util.adb (Expand_Subtype_From_Expr): Do not expand expression if its type is derived from a limited type with unknown discriminants, because the expansion (which is a call) must be expanded in the enclosing context to add the proper build- in-place parameters to the call. * lib.ads, exp_ch9.adb: Minor fixes in comments. From-SVN: r244790 --- gcc/ada/ChangeLog | 13 +++++++++++++ gcc/ada/exp_ch9.adb | 6 +++--- gcc/ada/exp_util.adb | 8 +++++++- gcc/ada/lib.ads | 2 +- gcc/ada/sem_ch4.adb | 7 +++++++ 5 files changed, 31 insertions(+), 5 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index df86a3a6717..e05fcaa9c35 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2017-01-23 Ed Schonberg + + * sem_ch4.adb (Try_Primitive_Operations, + Is_Valid_First_Argument_Of): argument is valid if it is a derived + type with unknown discriminants that matches its underlying + record view. + * exp_util.adb (Expand_Subtype_From_Expr): Do not expand + expression if its type is derived from a limited type with + unknown discriminants, because the expansion (which is a call) + must be expanded in the enclosing context to add the proper build- + in-place parameters to the call. + * lib.ads, exp_ch9.adb: Minor fixes in comments. + 2017-01-23 Yannick Moy * frontend.adb (Frontend): Do not load runtime diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 38f36f9de6b..b38aed3eaff 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -8469,9 +8469,9 @@ package body Exp_Ch9 is Op_Body := First (Declarations (N)); - -- The protected body is replaced with the bodies of its - -- protected operations, and the declarations for internal objects - -- that may have been created for entry family bounds. + -- The protected body is replaced with the bodies of its protected + -- operations, and the declarations for internal objects that may + -- have been created for entry family bounds. Rewrite (N, Make_Null_Statement (Sloc (N))); Analyze (N); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index f181bede2f9..e828a1e0978 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -3782,7 +3782,13 @@ package body Exp_Util is then -- Nothing to be done if no underlying record view available - if No (Underlying_Record_View (Unc_Type)) then + -- If this is a limited type derived from a type with unknown + -- discriminants, do not expand either, so that subsequent + -- expansion of the call can add build-in-place parameters to call. + + if No (Underlying_Record_View (Unc_Type)) + or else Is_Limited_Type (Unc_Type) + then null; -- Otherwise use the Underlying_Record_View to create the proper diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index c54e2ca180a..a6cfd5dff7f 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -302,7 +302,7 @@ package Lib is -- No_Name for the main unit. -- Fatal_Error - -- A flag that is initialized to None and gets set to Errorif a fatal + -- A flag that is initialized to None and gets set to Error if a fatal -- error occurs during the processing of a unit. A fatal error is one -- defined as serious enough to stop the next phase of the compiler -- from running (i.e. fatal error during parsing stops semantics, diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 26d78b6370b..7a2666144b9 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -9294,6 +9294,13 @@ package body Sem_Ch4 is or else Base_Type (Obj_Type) = Typ or else Corr_Type = Typ + -- Object may be of a derived type whose parent has unknown + -- discriminants, in which case the type matches the + -- underlying record view of its base. + + or else (Has_Unknown_Discriminants (Typ) + and then Typ = Underlying_Record_View (Base_Type (Obj_Type))) + -- Prefix can be dereferenced or else -- 2.30.2