OSDN Git Service

* gcc-interface/decl.c (gnat_to_gnu_entity): Create variables for size
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 8 May 2010 11:31:31 +0000 (11:31 +0000)
committerebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 8 May 2010 11:31:31 +0000 (11:31 +0000)
expressions of variant part of record types declared at library level.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159182 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/specs/lto3.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/lto3_pkg1.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/lto3_pkg1.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/lto3_pkg2.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/lto3_pkg2.ads [new file with mode: 0644]

index 6a78278..2a2805a 100644 (file)
@@ -1,5 +1,10 @@
 2010-05-08  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * gcc-interface/decl.c (gnat_to_gnu_entity): Create variables for size
+       expressions of variant part of record types declared at library level.
+
+2010-05-08  Eric Botcazou  <ebotcazou@adacore.com>
+
        * gcc-interface/gigi.h (create_field_decl): Move PACKED parameter.
        * gcc-interface/utils.c (create_field_decl): Move PACKED parameter.
        (rest_of_record_type_compilation): Adjust call to create_field_decl.
index 3050475..b0334f2 100644 (file)
@@ -4516,8 +4516,62 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
          if (TREE_CODE (gnu_type) == RECORD_TYPE)
            {
+             tree variant_part = get_variant_part (gnu_type);
              tree ada_size = TYPE_ADA_SIZE (gnu_type);
 
+             if (variant_part)
+               {
+                 tree union_type = TREE_TYPE (variant_part);
+                 tree offset = DECL_FIELD_OFFSET (variant_part);
+
+                 /* If the position of the variant part is constant, subtract
+                    it from the size of the type of the parent to get the new
+                    size.  This manual CSE reduces the data size.  */
+                 if (TREE_CODE (offset) == INTEGER_CST)
+                   {
+                     tree bitpos = DECL_FIELD_BIT_OFFSET (variant_part);
+                     TYPE_SIZE (union_type)
+                       = size_binop (MINUS_EXPR, TYPE_SIZE (gnu_type),
+                                     bit_from_pos (offset, bitpos));
+                     TYPE_SIZE_UNIT (union_type)
+                       = size_binop (MINUS_EXPR, TYPE_SIZE_UNIT (gnu_type),
+                                     byte_from_pos (offset, bitpos));
+                   }
+                 else
+                   {
+                     TYPE_SIZE (union_type)
+                       = elaborate_expression_1 (TYPE_SIZE (union_type),
+                                                 gnat_entity,
+                                                 get_identifier ("VSIZE"),
+                                                 definition, false);
+
+                     /* ??? For now, store the size as a multiple of the
+                        alignment in bytes so that we can see the alignment
+                        from the tree.  */
+                     TYPE_SIZE_UNIT (union_type)
+                       = elaborate_expression_2 (TYPE_SIZE_UNIT (union_type),
+                                                 gnat_entity,
+                                                 get_identifier
+                                                 ("VSIZE_A_UNIT"),
+                                                 definition, false,
+                                                 TYPE_ALIGN (union_type));
+
+                     /* ??? For now, store the offset as a multiple of the
+                        alignment in bytes so that we can see the alignment
+                        from the tree.  */
+                     DECL_FIELD_OFFSET (variant_part)
+                       = elaborate_expression_2 (offset,
+                                                 gnat_entity,
+                                                 get_identifier ("VOFFSET"),
+                                                 definition, false,
+                                                 DECL_OFFSET_ALIGN
+                                                 (variant_part));
+                   }
+
+                 DECL_SIZE (variant_part) = TYPE_SIZE (union_type);
+                 DECL_SIZE_UNIT (variant_part) = TYPE_SIZE_UNIT (union_type);
+               }
+
              if (operand_equal_p (ada_size, size, 0))
                ada_size = TYPE_SIZE (gnu_type);
              else
index 3435fdf..4a18a2b 100644 (file)
@@ -1,3 +1,9 @@
+2010-05-08  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/specs/lto3.ads: New test.
+       * gnat.dg/specs/lto3_pkg1.ad[sb]: New helper.
+       * gnat.dg/specs/lto3_pkg2.ad[sb]: Likewise.
+
 2010-05-08  Quentin Ochem  <ochem@adacore.com>
 
        * gnat.dg/sizetype3.ad[sb]: New test.
diff --git a/gcc/testsuite/gnat.dg/specs/lto3.ads b/gcc/testsuite/gnat.dg/specs/lto3.ads
new file mode 100644 (file)
index 0000000..815da5f
--- /dev/null
@@ -0,0 +1,10 @@
+-- { dg-do compile }
+-- { dg-options "-gnatws -flto" }
+
+with Lto3_Pkg1;
+
+package Lto3 is
+
+  package P is new Lto3_Pkg1 (Id_T => Natural);
+
+end Lto3;
diff --git a/gcc/testsuite/gnat.dg/specs/lto3_pkg1.adb b/gcc/testsuite/gnat.dg/specs/lto3_pkg1.adb
new file mode 100644 (file)
index 0000000..34caa3c
--- /dev/null
@@ -0,0 +1,24 @@
+package body Lto3_Pkg1 is
+
+  function Is_Fixed return Boolean is
+  begin
+    return True;
+  end Is_Fixed;
+
+  function Do_Item (I : Natural) return Variable_Data_Fixed_T is
+    It : Variable_Data_Fixed_T;
+  begin
+    return It;
+  end Do_Item;
+
+  My_Db : Db.T;
+
+  procedure Run is
+    Kitem : Variable_Data_Fixed_T;
+    I : Natural;
+  begin
+    Kitem := Db.Get (My_Db);
+    Kitem := Do_Item (I);
+  end Run;
+
+end Lto3_Pkg1;
diff --git a/gcc/testsuite/gnat.dg/specs/lto3_pkg1.ads b/gcc/testsuite/gnat.dg/specs/lto3_pkg1.ads
new file mode 100644 (file)
index 0000000..5619b60
--- /dev/null
@@ -0,0 +1,26 @@
+-- { dg-excess-errors "no code generated" }
+
+with Lto3_Pkg2;
+
+generic
+  type Id_T is range <>;
+package Lto3_Pkg1 is
+
+  type Variable_Data_T (Fixed : Boolean := False) is
+    record
+      case Fixed is
+        when True =>
+          Length : Natural;
+        when False =>
+          null;
+      end case;
+    end record;
+
+  function Is_Fixed return Boolean;
+
+  type Variable_Data_Fixed_T is new Variable_Data_T (Is_Fixed);
+
+  package Db is new Lto3_Pkg2 (Id_T => Id_T,
+                               Data_T => Variable_Data_Fixed_T);
+
+end Lto3_Pkg1;
diff --git a/gcc/testsuite/gnat.dg/specs/lto3_pkg2.adb b/gcc/testsuite/gnat.dg/specs/lto3_pkg2.adb
new file mode 100644 (file)
index 0000000..d95fe60
--- /dev/null
@@ -0,0 +1,7 @@
+package body Lto3_Pkg2 is
+  function Get (X : T) return Data_T is
+    Result : Data_T;
+  begin
+    return Result;
+  end;
+end Lto3_Pkg2;
diff --git a/gcc/testsuite/gnat.dg/specs/lto3_pkg2.ads b/gcc/testsuite/gnat.dg/specs/lto3_pkg2.ads
new file mode 100644 (file)
index 0000000..52fdccb
--- /dev/null
@@ -0,0 +1,11 @@
+-- { dg-excess-errors "no code generated" }
+
+generic
+  type Id_T is private;
+  type Data_T is private;
+package Lto3_Pkg2 is
+  type T is private;
+  function Get (X : T) return Data_T;
+private
+  type T is null record;
+end Lto3_Pkg2;