From: Bob Duff <duff@adacore.com>
Date: Mon, 7 Dec 2020 13:16:34 +0000 (-0500)
Subject: [Ada] Incorrect error with Default_Value on private/modular type
X-Git-Tag: basepoints/gcc-13~8127
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=cbd743fe0942e91eaa5e788ad21ac660f686a0de;p=thirdparty%2Fgcc.git

[Ada] Incorrect error with Default_Value on private/modular type

gcc/ada/

	* exp_ch3.adb (Simple_Init_Defaulted_Type): Simplify the code,
	and always use OK_Convert_To, rather than Unchecked_Convert_To
	and Convert_To.
---

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index e0040ede0936..b916aef2972d 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -8597,35 +8597,28 @@ package body Exp_Ch3 is
       --------------------------------
 
       function Simple_Init_Defaulted_Type return Node_Id is
-         Subtyp : constant Entity_Id := First_Subtype (Typ);
+         Subtyp : Entity_Id := First_Subtype (Typ);
 
       begin
-         --  Use the Sloc of the context node when constructing the initial
-         --  value because the expression of Default_Value may come from a
-         --  different unit. Updating the Sloc will result in accurate error
-         --  diagnostics.
-
          --  When the first subtype is private, retrieve the expression of the
          --  Default_Value from the underlying type.
 
          if Is_Private_Type (Subtyp) then
-            return
-              Unchecked_Convert_To
-                (Typ  => Typ,
-                 Expr =>
-                   New_Copy_Tree
-                     (Source   => Default_Aspect_Value (Full_View (Subtyp)),
-                      New_Sloc => Loc));
-
-         else
-            return
-              Convert_To
-                (Typ  => Typ,
-                 Expr =>
-                   New_Copy_Tree
-                     (Source   => Default_Aspect_Value (Subtyp),
-                      New_Sloc => Loc));
+            Subtyp := Full_View (Subtyp);
          end if;
+
+         --  Use the Sloc of the context node when constructing the initial
+         --  value because the expression of Default_Value may come from a
+         --  different unit. Updating the Sloc will result in accurate error
+         --  diagnostics.
+
+         return
+           OK_Convert_To
+             (Typ  => Typ,
+              Expr =>
+                New_Copy_Tree
+                  (Source   => Default_Aspect_Value (Subtyp),
+                   New_Sloc => Loc));
       end Simple_Init_Defaulted_Type;
 
       -----------------------------------------