sem_ch4.adb (Try_Primitive_Operations, [...]): argument is valid if it is a derived...

2017-01-23  Ed Schonberg  <schonberg@adacore.com>

	* 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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index df86a3a6717e9d74e5c316166ee7aa1f2bae2f5c..e05fcaa9c3588ed2548a41e0a97ad1cfd55cfb2d 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2017-01-23  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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  <moy@adacore.com>
 
        * frontend.adb (Frontend): Do not load runtime

diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 38f36f9de6b1a759ca1e29de19174465ecc9f78f..b38aed3eaff71a887a00b2d8e5f93fb427c447f0 100644 (file)
--- 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 f181bede2f941c7961cfb481fcef3673532a1339..e828a1e0978d65aedc6c24bc205c30b205e3020c 100644 (file)
--- 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 c54e2ca180aba62ad56ffc29a31f4b28fbbe7956..a6cfd5dff7f1a5a7580b9b36af15a6bcf3242519 100644 (file)
--- 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 26d78b6370b6e79fc571b2afcb6ac819fcb10480..7a2666144b932f50bb99b8ceb308f39f68c2359c 100644 (file)
--- 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