exp_strm.adb (Make_Field_Attributes): Avoid _Parent components that are interface type.

2007-04-20  Robert Dewar  <dewar@adacore.com>

	* exp_strm.adb (Make_Field_Attributes): Avoid _Parent components that
	are interface type.
	(Build_Elementary_Input_Call): For floating-point use right type in the
	absence of strange size or stream size clauses.
	(Build_Elementary_Write_Call): Same fix
	(Has_Stream_Standard_Rep): Returns False if Stream_Size attribute
	set to value that does not match base type size.

From-SVN: r125409

1 files changed, 80 insertions, 16 deletions

diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb
index 53f9c57..7c9812c 100644
--- a/gcc/ada/exp_strm.adb
+++ b/gcc/ada/exp_strm.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -80,11 +80,12 @@ package body Exp_Strm is
    --  The parameter Fnam is the name of the constructed function.
 
    function Has_Stream_Standard_Rep (U_Type : Entity_Id) return Boolean;
-   --  This function is used to test U_Type, which is a type
-   --  Returns True if U_Type has a standard representation for stream
-   --  purposes, i.e. there is no non-standard enumeration representation
-   --  clause, and the size of the first subtype is the same as the size
-   --  of the root type.
+   --  This function is used to test the type U_Type, to determine if it has
+   --  a standard representation from a streaming point of view. Standard means
+   --  that it has a standard representation (e.g. no enumeration rep clause),
+   --  and the size of the root type is the same as the streaming size (which
+   --  is defined as value specified by a Stream_Size clause if present, or
+   --  the Esize of U_Type if not).
 
    function Make_Stream_Subprogram_Name
      (Loc : Source_Ptr;
@@ -456,7 +457,7 @@ package body Exp_Strm is
       --  Compute the size of the stream element. This is either the size of
       --  the first subtype or if given the size of the Stream_Size attribute.
 
-      if Is_Elementary_Type (FST) and then Has_Stream_Size_Clause (FST) then
+      if Has_Stream_Size_Clause (FST) then
          P_Size := Static_Integer (Expression (Stream_Size_Clause (FST)));
       else
          P_Size := Esize (FST);
@@ -491,13 +492,37 @@ package body Exp_Strm is
       --  Floating point types
 
       elsif Is_Floating_Point_Type (U_Type) then
-         if P_Size <= Standard_Short_Float_Size then
+
+         --  Question: should we use P_Size or Rt_Type to distinguish between
+         --  possible floating point types? If a non-standard size or a stream
+         --  size is specified, then we should certainly use the size. But if
+         --  we have two types the same (notably Short_Float_Size = Float_Size
+         --  which is close to universally true, and Long_Long_Float_Size =
+         --  Long_Float_Size, true on most targets except the x86), then we
+         --  would really rather use the root type, so that if people want to
+         --  fiddle with System.Stream_Attributes to get inter-target portable
+         --  streams, they get the size they expect. Consider in particular the
+         --  case of a stream written on an x86, with 96-bit Long_Long_Float
+         --  being read into a non-x86 target with 64 bit Long_Long_Float. A
+         --  special version of System.Stream_Attributes can deal with this
+         --  provided the proper type is always used.
+
+         --  To deal with these two requirements we add the special checks
+         --  on equal sizes and use the root type to distinguish.
+
+         if P_Size <= Standard_Short_Float_Size
+           and then (Standard_Short_Float_Size /= Standard_Float_Size
+                     or else Rt_Type = Standard_Short_Float)
+         then
             Lib_RE := RE_I_SF;
 
          elsif P_Size <= Standard_Float_Size then
             Lib_RE := RE_I_F;
 
-         elsif P_Size <= Standard_Long_Float_Size then
+         elsif P_Size <= Standard_Long_Float_Size
+           and then (Standard_Long_Float_Size /= Standard_Long_Long_Float_Size
+                       or else Rt_Type = Standard_Float)
+         then
             Lib_RE := RE_I_LF;
 
          else
@@ -644,7 +669,7 @@ package body Exp_Strm is
       --  Compute the size of the stream element. This is either the size of
       --  the first subtype or if given the size of the Stream_Size attribute.
 
-      if Is_Elementary_Type (FST) and then Has_Stream_Size_Clause (FST) then
+      if Has_Stream_Size_Clause (FST) then
          P_Size := Static_Integer (Expression (Stream_Size_Clause (FST)));
       else
          P_Size := Esize (FST);
@@ -681,12 +706,39 @@ package body Exp_Strm is
       --  Floating point types
 
       elsif Is_Floating_Point_Type (U_Type) then
-         if P_Size <= Standard_Short_Float_Size then
+
+         --  Question: should we use P_Size or Rt_Type to distinguish between
+         --  possible floating point types? If a non-standard size or a stream
+         --  size is specified, then we should certainly use the size. But if
+         --  we have two types the same (notably Short_Float_Size = Float_Size
+         --  which is close to universally true, and Long_Long_Float_Size =
+         --  Long_Float_Size, true on most targets except the x86), then we
+         --  would really rather use the root type, so that if people want to
+         --  fiddle with System.Stream_Attributes to get inter-target portable
+         --  streams, they get the size they expect. Consider in particular the
+         --  case of a stream written on an x86, with 96-bit Long_Long_Float
+         --  being read into a non-x86 target with 64 bit Long_Long_Float. A
+         --  special version of System.Stream_Attributes can deal with this
+         --  provided the proper type is always used.
+
+         --  To deal with these two requirements we add the special checks
+         --  on equal sizes and use the root type to distinguish.
+
+         if P_Size <= Standard_Short_Float_Size
+           and then (Standard_Short_Float_Size /= Standard_Float_Size
+                      or else Rt_Type = Standard_Short_Float)
+         then
             Lib_RE := RE_W_SF;
+
          elsif P_Size <= Standard_Float_Size then
             Lib_RE := RE_W_F;
-         elsif P_Size <= Standard_Long_Float_Size then
+
+         elsif P_Size <= Standard_Long_Float_Size
+           and then (Standard_Long_Float_Size /= Standard_Long_Long_Float_Size
+                      or else Rt_Type = Standard_Float)
+         then
             Lib_RE := RE_W_LF;
+
          else
             Lib_RE := RE_W_LLF;
          end if;
@@ -713,6 +765,8 @@ package body Exp_Strm is
       --     type W is range -1 .. +254;
       --     for W'Size use 8;
 
+      --  forcing a biased and unsigned representation
+
       elsif not Is_Unsigned_Type (FST)
         and then
           (Is_Fixed_Point_Type (U_Type)
@@ -1378,12 +1432,15 @@ package body Exp_Strm is
             --  Loop through components, skipping all internal components,
             --  which are not part of the value (e.g. _Tag), except that we
             --  don't skip the _Parent, since we do want to process that
-            --  recursively.
+            --  recursively. If _Parent is an interface type, being abstract
+            --  with no components there is no need to handle it.
 
             while Present (Item) loop
                if Nkind (Item) = N_Component_Declaration
                  and then
-                   (Chars (Defining_Identifier (Item)) = Name_uParent
+                   ((Chars (Defining_Identifier (Item)) = Name_uParent
+                       and then not Is_Interface
+                                      (Etype (Defining_Identifier (Item))))
                      or else
                     not Is_Internal_Name (Chars (Defining_Identifier (Item))))
                then
@@ -1586,13 +1643,20 @@ package body Exp_Strm is
    -----------------------------
 
    function Has_Stream_Standard_Rep (U_Type : Entity_Id) return Boolean is
+      Siz : Uint;
+
    begin
       if Has_Non_Standard_Rep (U_Type) then
          return False;
+      end if;
+
+      if Has_Stream_Size_Clause (U_Type) then
+         Siz := Static_Integer (Expression (Stream_Size_Clause (U_Type)));
       else
-         return
-           Esize (First_Subtype (U_Type)) = Esize (Root_Type (U_Type));
+         Siz := Esize (First_Subtype (U_Type));
       end if;
+
+      return Siz = Esize (Root_Type (U_Type));
    end Has_Stream_Standard_Rep;
 
    ---------------------------------