[multiple changes]

2009-07-13  Emmanuel Briot  <briot@adacore.com>

	* prj-env.adb (Create_Config_Pragmas_File): Iterate on sources rather
	than units.

2009-07-13  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb (Process_Full_View): Propagate Has_Specified_Stream_{Read,
	Write,Input,Output} from private view to full view.

	* sem_type.adb, sem_type.ads: Minor reformatting

2009-07-13  Nicolas Setton  <setton@adacore.com>

	* exp_dbug.ads: Add documentation note on the utility of
	DW_AT_GNAT_encoding for IDEs.

2009-07-13  Robert Dewar  <dewar@adacore.com>

	* g-socthi-vxworks.adb: Minor reformatting

	* gnatcmd.adb: Minor reformatting

From-SVN: r149561

8 files changed, 111 insertions, 94 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0e8ea16..026acff 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,26 @@
+2009-07-13  Emmanuel Briot  <briot@adacore.com>
+
+	* prj-env.adb (Create_Config_Pragmas_File): Iterate on sources rather
+	than units.
+
+2009-07-13  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch3.adb (Process_Full_View): Propagate Has_Specified_Stream_{Read,
+	Write,Input,Output} from private view to full view.
+
+	* sem_type.adb, sem_type.ads: Minor reformatting
+
+2009-07-13  Nicolas Setton  <setton@adacore.com>
+
+	* exp_dbug.ads: Add documentation note on the utility of
+	DW_AT_GNAT_encoding for IDEs.
+
+2009-07-13  Robert Dewar  <dewar@adacore.com>
+
+	* g-socthi-vxworks.adb: Minor reformatting
+
+	* gnatcmd.adb: Minor reformatting
+
 2009-07-13  Thomas Quinot  <quinot@adacore.com>
 
 	* rtsfind.ads, exp_dist.adb (RE_Allocate_Buffer): Runtime entry
diff --git a/gcc/ada/exp_dbug.ads b/gcc/ada/exp_dbug.ads
index 3a6297c..15e83aa 100644
--- a/gcc/ada/exp_dbug.ads
+++ b/gcc/ada/exp_dbug.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1996-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2009, 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- --
@@ -1522,33 +1522,38 @@ package Exp_Dbug is
    --  to DWARF2/3 are generated, with the following variations from the above
    --  specification.
 
-   --   Change in the contents of the DW_AT_name attribute.
-   --    The operators are represented in their natural form. (Ie, the addition
-   --    operator is written as "+" instead of "Oadd").
-   --    The component separation string is "." instead of "__"
+   --   Change in the contents of the DW_AT_name attribute
 
-   --   Introduction of DW_AT_GNAT_encoding, encoded with value 0x2301.
-   --    Any debugging information entry representing a program entity, named
-   --    or implicit, may have a DW_AT_GNAT_encoding attribute. The value of
-   --    this attribute is a string representing the suffix internally added
-   --    by GNAT for various purposes, mainly for representing debug
-   --    information compatible with other formats.
+   --     The operators are represented in their natural form. (for example,
+   --     the addition operator is written as "+" instead of "Oadd"). The
+   --     component separator is "." instead of "__"
 
-   --    If a debugging information entry has multiple encodings, all of them
-   --    will be listed in DW_AT_GNAT_encoding. The separator for this list
-   --    is ':'.
+   --   Introduction of DW_AT_GNAT_encoding, encoded with value 0x2301
+
+   --     Any debugging information entry representing a program entity, named
+   --     or implicit, may have a DW_AT_GNAT_encoding attribute. The value of
+   --     this attribute is a string representing the suffix internally added
+   --     by GNAT for various purposes, mainly for representing debug
+   --     information compatible with other formats. In particular this is
+   --     useful for IDEs which need to filter out information internal to
+   --     GNAT from their graphical interfaces.
+
+   --     If a debugging information entry has multiple encodings, all of them
+   --     will be listed in DW_AT_GNAT_encoding using the list separator ':'.
 
    --   Introduction of DW_AT_GNAT_descriptive_type, encoded with value 0x2302
-   --    Any debugging information entry representing a type may have a
-   --    DW_AT_GNAT_descriptive_type attribute whose value is a reference,
-   --    pointing to a debugging information entry representing another type
-   --    associated to the type.
-
-   --   Modification of the contents of the DW_AT_producer string.
-   --    When emitting full GNAT Vendor extensions to DWARF2/3, "-gdwarf+"
-   --    is appended to the DW_AT_producer string.
+
+   --     Any debugging information entry representing a type may have a
+   --     DW_AT_GNAT_descriptive_type attribute whose value is a reference,
+   --     pointing to a debugging information entry representing another type
+   --     associated to the type.
+
+   --   Modification of the contents of the DW_AT_producer string
+
+   --     When emitting full GNAT Vendor extensions to DWARF2/3, "-gdwarf+"
+   --     is appended to the DW_AT_producer string.
    --
-   --    When emitting only DW_AT_GNAT_descriptive_type, "-gdwarf+-" is
-   --    appended to the DW_AT_producer string.
+   --     When emitting only DW_AT_GNAT_descriptive_type, "-gdwarf+-" is
+   --     appended to the DW_AT_producer string.
 
 end Exp_Dbug;
diff --git a/gcc/ada/g-socthi-vxworks.adb b/gcc/ada/g-socthi-vxworks.adb
index 8a90056..96d0cfc 100644
--- a/gcc/ada/g-socthi-vxworks.adb
+++ b/gcc/ada/g-socthi-vxworks.adb
@@ -369,12 +369,15 @@ package body GNAT.Sockets.Thin is
    begin
       loop
          if To = Null_Address then
+
             --  In violation of the standard sockets API, VxWorks does not
             --  support sendto(2) calls on connected sockets with a null
             --  destination address, so use send(2) instead in that case.
 
             Res := Syscall_Send (S, Msg, Len, Flags);
 
+         --  Normal case where destination address is non-null
+
          else
             Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
          end if;
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index ef1cf3e7..8349d43 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -364,7 +364,7 @@ procedure GNATCmd is
                            File :=
                              new String'
                                (Get_Name_String
-                                    (Proj.Project.Object_Directory.Name)     &
+                                 (Proj.Project.Object_Directory.Name)        &
                                 B_Start.all                                  &
                                 MLib.Fil.Ext_To
                                   (Get_Name_String
@@ -390,7 +390,7 @@ procedure GNATCmd is
                            File :=
                              new String'
                                (Get_Name_String
-                                    (Proj.Project.Object_Directory.Name)     &
+                                 (Proj.Project.Object_Directory.Name)        &
                                 B_Start.all                                  &
                                 Get_Name_String (Proj.Project.Library_Name)  &
                                 ".ci");
@@ -1080,9 +1080,7 @@ procedure GNATCmd is
                               --  replace the file with the absolute path.
 
                               Last_Switches.Table (J) :=
-                                new String'
-                                  (Dir
-                                   & ALI_File (1 .. Last));
+                                new String'(Dir & ALI_File (1 .. Last));
 
                               --  And we are done
 
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index e3766b5..55f025d 100644
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -401,9 +401,9 @@ package body Prj.Env is
       File_Name : Path_Name_Type  := No_Path;
       File      : File_Descriptor := Invalid_FD;
 
-      Current_Unit : Unit_Index := Units_Htable.Get_First (In_Tree.Units_HT);
-
       Current_Naming  : Naming_Id;
+      Iter            : Source_Iterator;
+      Source          : Source_Id;
 
       Status : Boolean;
       --  For call to Close
@@ -418,11 +418,7 @@ package body Prj.Env is
       --  If not, create one, and put its name in the project data,
       --  with the indication that it is a temporary file.
 
-      procedure Put
-        (Unit_Name : Name_Id;
-         File_Name : File_Name_Type;
-         Unit_Kind : Spec_Or_Body;
-         Index     : Int);
+      procedure Put (Source : Source_Id);
       --  Put an SFN pragma in the temporary file
 
       procedure Put (File : File_Descriptor; S : String);
@@ -449,7 +445,7 @@ package body Prj.Env is
 
          if Lang = null then
             if Current_Verbosity = High then
-               Write_Str ("Languages does not contain Ada, nothing to do");
+               Write_Line ("   Languages does not contain Ada, nothing to do");
             end if;
 
             return;
@@ -559,12 +555,7 @@ package body Prj.Env is
       -- Put --
       ---------
 
-      procedure Put
-        (Unit_Name : Name_Id;
-         File_Name : File_Name_Type;
-         Unit_Kind : Spec_Or_Body;
-         Index     : Int)
-      is
+      procedure Put (Source : Source_Id) is
       begin
          --  A temporary file needs to be open
 
@@ -573,20 +564,20 @@ package body Prj.Env is
          --  Put the pragma SFN for the unit kind (spec or body)
 
          Put (File, "pragma Source_File_Name_Project (");
-         Put (File, Namet.Get_Name_String (Unit_Name));
+         Put (File, Namet.Get_Name_String (Source.Unit.Name));
 
-         if Unit_Kind = Spec then
+         if Source.Kind = Spec then
             Put (File, ", Spec_File_Name => """);
          else
             Put (File, ", Body_File_Name => """);
          end if;
 
-         Put (File, Namet.Get_Name_String (File_Name));
+         Put (File, Namet.Get_Name_String (Source.File));
          Put (File, """");
 
-         if Index /= 0 then
+         if Source.Index /= 0 then
             Put (File, ", Index =>");
-            Put (File, Index'Img);
+            Put (File, Source.Index'Img);
          end if;
 
          Put_Line (File, ");");
@@ -652,30 +643,21 @@ package body Prj.Env is
 
          Check_Imported_Projects (For_Project, Dummy, Imported_First => False);
 
-         --  Visit all the units and process those that need an SFN pragma
+         --  Visit all the files and process those that need an SFN pragma
 
-         while Current_Unit /= No_Unit_Index loop
-            if Current_Unit.File_Names (Spec) /= null
-              and then Current_Unit.File_Names (Spec).Naming_Exception
-              and then not Current_Unit.File_Names (Spec).Locally_Removed
-            then
-               Put (Current_Unit.Name,
-                    Current_Unit.File_Names (Spec).File,
-                    Spec,
-                    Current_Unit.File_Names (Spec).Index);
-            end if;
+         Iter := For_Each_Source (In_Tree, For_Project);
 
-            if Current_Unit.File_Names (Impl) /= null
-              and then Current_Unit.File_Names (Impl).Naming_Exception
-              and then not Current_Unit.File_Names (Impl).Locally_Removed
+         while Element (Iter) /= No_Source loop
+            Source := Element (Iter);
+
+            if Source.Index >= 1
+              and then not Source.Locally_Removed
+              and then Source.Unit /= null
             then
-               Put (Current_Unit.Name,
-                    Current_Unit.File_Names (Impl).File,
-                    Impl,
-                    Current_Unit.File_Names (Impl).Index);
+               Put (Source);
             end if;
 
-            Current_Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
+            Next (Iter);
          end loop;
 
          --  If there are no non standard naming scheme, issue the GNAT
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index c6a10e0..9c289e7 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -7905,7 +7905,7 @@ package body Sem_Ch3 is
       --  declaration, all clauses are inherited.
 
       if No (First_Rep_Item (Def_Id)) then
-         Set_First_Rep_Item    (Def_Id, First_Rep_Item (T));
+         Set_First_Rep_Item (Def_Id, First_Rep_Item (T));
       end if;
 
       if Is_Tagged_Type (T) then
@@ -16443,6 +16443,22 @@ package body Sem_Ch3 is
          Set_Is_CPP_Class (Full_T);
          Set_Convention   (Full_T, Convention_CPP);
       end if;
+
+      --  If the private view has user specified stream attributes, then so has
+      --  the full view.
+
+      if Has_Specified_Stream_Read (Priv_T) then
+         Set_Has_Specified_Stream_Read (Full_T);
+      end if;
+      if Has_Specified_Stream_Write (Priv_T) then
+         Set_Has_Specified_Stream_Write (Full_T);
+      end if;
+      if Has_Specified_Stream_Input (Priv_T) then
+         Set_Has_Specified_Stream_Input (Full_T);
+      end if;
+      if Has_Specified_Stream_Output (Priv_T) then
+         Set_Has_Specified_Stream_Output (Full_T);
+      end if;
    end Process_Full_View;
 
    -----------------------------------
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 5883e3f..fad78d4 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -1204,9 +1204,9 @@ package body Sem_Type is
       --  for special handling of expressions with universal operands, see
       --  comments to Has_Abstract_Interpretation below.
 
-      ------------------------
-      --  In_Generic_Actual --
-      ------------------------
+      -----------------------
+      -- In_Generic_Actual --
+      -----------------------
 
       function In_Generic_Actual (Exp : Node_Id) return Boolean is
          Par : constant Node_Id := Parent (Exp);
@@ -2147,9 +2147,8 @@ package body Sem_Type is
    -------------------------
 
    function Has_Compatible_Type
-     (N    : Node_Id;
-      Typ  : Entity_Id)
-      return Boolean
+     (N   : Node_Id;
+      Typ : Entity_Id) return Boolean
    is
       I  : Interp_Index;
       It : Interp;
@@ -2597,9 +2596,8 @@ package body Sem_Type is
    ---------------------------
 
    function Is_Invisible_Operator
-     (N    : Node_Id;
-      T    : Entity_Id)
-      return Boolean
+     (N : Node_Id;
+      T : Entity_Id) return Boolean
    is
       Orig_Node : constant Node_Id := Original_Node (N);
 
@@ -2809,9 +2807,8 @@ package body Sem_Type is
               and then Base_Type (T1) = Base_Type (T)
               and then Is_Numeric_Type (T);
 
-         --  for division and multiplication, a user-defined function does
-         --  not match the predefined universal_fixed operation, except in
-         --  Ada83 mode.
+         --  For division and multiplication, a user-defined function does not
+         --  match the predefined universal_fixed operation, except in Ada 83.
 
          elsif Op_Name = Name_Op_Divide then
             return (Base_Type (T1) = Base_Type (T2)
@@ -2892,7 +2889,7 @@ package body Sem_Type is
       II : Interp_Index;
 
    begin
-      --  Find end of Interp list and copy downward to erase the discarded one
+      --  Find end of interp list and copy downward to erase the discarded one
 
       II := I + 1;
       while Present (All_Interp.Table (II).Typ) loop
@@ -2903,7 +2900,7 @@ package body Sem_Type is
          All_Interp.Table (J - 1) := All_Interp.Table (J);
       end loop;
 
-      --  Back up interp. index to insure that iterator will pick up next
+      --  Back up interp index to insure that iterator will pick up next
       --  available interpretation.
 
       I := I - 1;
diff --git a/gcc/ada/sem_type.ads b/gcc/ada/sem_type.ads
index 8794324..cfbc579 100644
--- a/gcc/ada/sem_type.ads
+++ b/gcc/ada/sem_type.ads
@@ -103,10 +103,7 @@ package Sem_Type is
    --  in N. If the name is an expanded name, the homonyms are only those that
    --  belong to the same scope.
 
-   function Is_Invisible_Operator
-     (N    : Node_Id;
-      T    : Entity_Id)
-      return Boolean;
+   function Is_Invisible_Operator (N : Node_Id; T : Entity_Id) return Boolean;
    --  Check whether a predefined operation with universal operands appears in
    --  a context in which the operators of the expected type are not visible.
 
@@ -172,8 +169,7 @@ package Sem_Type is
    function Disambiguate
      (N      : Node_Id;
       I1, I2 : Interp_Index;
-      Typ    : Entity_Id)
-      return   Interp;
+      Typ    : Entity_Id) return Interp;
    --  If more than one interpretation of a name in a call is legal, apply
    --  preference rules (universal types first) and operator visibility in
    --  order to remove ambiguity. I1 and I2 are the first two interpretations
@@ -191,10 +187,7 @@ package Sem_Type is
    --  right operand, which has one interpretation compatible with that of L.
    --  Return the type intersection of the two.
 
-   function Has_Compatible_Type
-     (N    : Node_Id;
-      Typ  : Entity_Id)
-      return Boolean;
+   function Has_Compatible_Type (N : Node_Id; Typ : Entity_Id) return Boolean;
    --  Verify that some interpretation of the node N has a type compatible with
    --  Typ. If N is not overloaded, then its unique type must be compatible
    --  with Typ. Otherwise iterate through the interpretations of N looking for
@@ -220,11 +213,11 @@ package Sem_Type is
 
    function Is_Ancestor (T1, T2 : Entity_Id) return Boolean;
    --  T1 is a tagged type (not class-wide). Verify that it is one of the
-   --  ancestors of type T2 (which may or not be class-wide)
+   --  ancestors of type T2 (which may or not be class-wide).
 
    function Is_Subtype_Of (T1 : Entity_Id; T2 : Entity_Id) return Boolean;
    --  Checks whether T1 is any subtype of T2 directly or indirectly. Applies
-   --  only to scalar subtypes ???
+   --  only to scalar subtypes???
 
    function Operator_Matches_Spec (Op, New_S : Entity_Id) return Boolean;
    --  Used to resolve subprograms renaming operators, and calls to user