trans.c (gnat_to_gnu): Remove obsolete case of non-conversion to the nominal result...
authorEric Botcazou <ebotcazou@adacore.com>
Thu, 24 Mar 2011 15:15:44 +0000 (15:15 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Thu, 24 Mar 2011 15:15:44 +0000 (15:15 +0000)
* gcc-interface/trans.c (gnat_to_gnu): Remove obsolete case of
non-conversion to the nominal result type at the end.

From-SVN: r171398

gcc/ada/ChangeLog
gcc/ada/gcc-interface/trans.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/derived_type2.adb [new file with mode: 0644]

index 2468644e7f4fc5fe08e146cf1869b5d03b5c8280..e586919fd0cd1f975e4494dc301b0999c17d5a9e 100644 (file)
@@ -1,3 +1,8 @@
+2011-03-24  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/trans.c (gnat_to_gnu): Remove obsolete case of
+       non-conversion to the nominal result type at the end.
+
 2011-03-23  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/trans.c (create_temporary): New function taken from...
index dc83f0a1c8b261002b97b812392b11ad3add7b9d..ab0725b75b55f2560ad0ba6569fb32ce32275610 100644 (file)
@@ -5879,15 +5879,11 @@ gnat_to_gnu (Node_Id gnat_node)
          since we need to ignore those conversions (for 'Valid).
 
        2. If we have a label (which doesn't have any well-defined type), a
-         field or an error, return the result almost unmodified.  Also don't
-         do the conversion if the result type involves a PLACEHOLDER_EXPR in
-         its size since those are the cases where the front end may have the
-         type wrong due to "instantiating" the unconstrained record with
-         discriminant values.  Similarly, if the two types are record types
-         with the same name don't convert.  This will be the case when we are
-         converting from a packable version of a type to its original type and
-         we need those conversions to be NOPs in order for assignments into
-         these types to work properly.
+         field or an error, return the result almost unmodified.  Similarly,
+         if the two types are record types with the same name, don't convert.
+         This will be the case when we are converting from a packable version
+         of a type to its original type and we need those conversions to be
+         NOPs in order for assignments into these types to work properly.
 
        3. If the type is void or if we have no result, return error_mark_node
          to show we have no result.
@@ -5933,12 +5929,8 @@ gnat_to_gnu (Node_Id gnat_node)
   else if (TREE_CODE (gnu_result) == LABEL_DECL
           || TREE_CODE (gnu_result) == FIELD_DECL
           || TREE_CODE (gnu_result) == ERROR_MARK
-          || (TYPE_SIZE (gnu_result_type)
-              && TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST
-              && TREE_CODE (gnu_result) != INDIRECT_REF
-              && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type)))
-          || ((TYPE_NAME (gnu_result_type)
-               == TYPE_NAME (TREE_TYPE (gnu_result)))
+          || (TYPE_NAME (gnu_result_type)
+              == TYPE_NAME (TREE_TYPE (gnu_result))
               && TREE_CODE (gnu_result_type) == RECORD_TYPE
               && TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE))
     {
index 1bed864420e409f238e156487472d99422d9f042..14efc3fa1dec8d95261ff2a88a86f33ad0366fb7 100644 (file)
@@ -1,3 +1,7 @@
+2011-03-24  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/derived_type2.adb: New test.
+
 2011-03-24  Richard Guenther  <rguenther@suse.de>
 
        PR tree-optimization/48271
diff --git a/gcc/testsuite/gnat.dg/derived_type2.adb b/gcc/testsuite/gnat.dg/derived_type2.adb
new file mode 100644 (file)
index 0000000..607eb0b
--- /dev/null
@@ -0,0 +1,40 @@
+-- { dg-do run }
+-- { dg-options "-gnatws" }
+
+procedure Derived_Type2 is
+
+   package Pkg is
+
+      type Parent (B : Boolean := True) is record
+         case B is
+            when True => S : String (1 .. 5);
+            when False => F : Float;
+         end case;
+      end record;
+
+      function Create (X : Parent) return Parent;
+
+   end Pkg;
+
+   package body Pkg is
+
+      function Create (X : Parent) return Parent is
+      begin
+         return (True, "12345");
+      end;
+
+   end Pkg;
+
+   use Pkg;
+
+   type T is new Parent (True);
+
+   X : T;
+
+begin
+
+   if Create (X).B /= True then
+      raise Program_Error;
+   end if;
+
+end;