[multiple changes]

2014-02-24  Thomas Quinot  <quinot@adacore.com>

	* s-os_lib.adb (Errno_Message): Do not depend on Integer'Image.
	* s-oscons-tmplt.c: On VxWorks, include adaint.h only after
	vxWorks.h has been included.  Also ensure that file attributes
	related definitions are output even in cases where socket support
	is not enabled.
	* a-tags.adb: Code clean up.
	* Make-generated.in (OSCONS_CPP, OSCONS_EXTRACT): Use -iquote
	instead of -I to add the main ada source directory to the header
	search path, in order to avoid conflict between our own "types.h"
	and VxWork's <types.h>.

2014-02-24  Robert Dewar  <dewar@adacore.com>

	* atree.ads, atree.adb (Copy_Separate_Tree): Add Syntax_Only parameter.
	* debug.adb: Remove documentation of -gnatd.X, no longer used.
	* freeze.adb (Wrap_Imported_Subprogram): Fixed and activated.

2014-02-24  Bob Duff  <duff@adacore.com>

	* gnat_ugn.texi: Improve documentation of gnatpp.

From-SVN: r208083

gcc/ada/ChangeLog

 2014-02-24  Thomas Quinot  <quinot@adacore.com>
 
+	* s-os_lib.adb (Errno_Message): Do not depend on Integer'Image.
+	* s-oscons-tmplt.c: On VxWorks, include adaint.h only after
+	vxWorks.h has been included.  Also ensure that file attributes
+	related definitions are output even in cases where socket support
+	is not enabled.
+	* a-tags.adb: Code clean up.
+	* Make-generated.in (OSCONS_CPP, OSCONS_EXTRACT): Use -iquote
+	instead of -I to add the main ada source directory to the header
+	search path, in order to avoid conflict between our own "types.h"
+	and VxWork's <types.h>.
+
+2014-02-24  Robert Dewar  <dewar@adacore.com>
+
+	* atree.ads, atree.adb (Copy_Separate_Tree): Add Syntax_Only parameter.
+	* debug.adb: Remove documentation of -gnatd.X, no longer used.
+	* freeze.adb (Wrap_Imported_Subprogram): Fixed and activated.
+
+2014-02-24  Bob Duff  <duff@adacore.com>
+
+	* gnat_ugn.texi: Improve documentation of gnatpp.
+
+2014-02-24  Thomas Quinot  <quinot@adacore.com>
+
 	* g-stheme.adb, g-socthi-vms.adb, g-socthi-vms.ads,
 	g-socthi-vxworks.adb, g-socthi-vxworks.ads, g-stseme.adb,
 	g-socthi-mingw.adb, g-socthi-mingw.ads, g-socthi.adb,

gcc/ada/Make-generated.in

@@ -67,12 +67,20 @@ $(ADA_GEN_SUBDIR)/stamp-nmake: $(ADA_GEN_SUBDIR)/sinfo.ads $(ADA_GEN_SUBDIR)/nma
 	touch $(ADA_GEN_SUBDIR)/stamp-nmake
 
 # GCC_FOR_TARGET has paths relative to the gcc directory, so we need to adjust
-# for running it from $(ADA_GEN_SUBDIR)/bldtools/oscons
+# for running it from $(ADA_GEN_SUBDIR)/bldtools/oscons.
+
 OSCONS_CC=$(subst ./xgcc,../../../xgcc,$(subst -B./, -B../../../,$(GCC_FOR_TARGET)))
+
+# The main ada source directory must be on the include path for #include "..."
+# because s-oscons-tmplt.c requires adaint.h, gsocket.h, and any file included
+# by these headers. However note that we must use -iquote, not -I, so that
+# ada/types.h does not conflict with a same-named system header (VxWorks
+# has a <types.h> header).
+
 OSCONS_SRCDIR=$${_oscons_srcdir}
 OSCONS_CPP=$(OSCONS_CC) $(GNATLIBCFLAGS) -E -C \
-  -DTARGET=\"$(target)\" -I$(OSCONS_SRCDIR) s-oscons-tmplt.c > s-oscons-tmplt.i
-OSCONS_EXTRACT=$(OSCONS_CC) -I$(OSCONS_SRCDIR) -S s-oscons-tmplt.i
+  -DTARGET=\"$(target)\" -iquote $(OSCONS_SRCDIR) s-oscons-tmplt.c > s-oscons-tmplt.i
+OSCONS_EXTRACT=$(OSCONS_CC) -iquote $(OSCONS_SRCDIR) -S s-oscons-tmplt.i
 
 # Note: if you need to build with a non-GNU compiler, you could adapt the
 # following definitions (written for VMS DEC-C)

gcc/ada/a-tags.adb

@@ -31,7 +31,6 @@
 
 with Ada.Exceptions;
 with Ada.Unchecked_Conversion;
-with System.CRTL;             use System.CRTL;
 with System.HTable;
 with System.Storage_Elements; use System.Storage_Elements;
 with System.WCh_Con;          use System.WCh_Con;
@@ -57,6 +56,10 @@ package body Ada.Tags is
    --  table.  This is Inline_Always since it is called from other Inline_
    --  Always subprograms where we want no out of line code to be generated.
 
+   function Length (Str : Cstring_Ptr) return Natural;
+   --  Length of string represented by the given pointer (treating the string
+   --  as a C-style string, which is Nul terminated).
+
    function OSD (T : Tag) return Object_Specific_Data_Ptr;
    --  Ada 2005 (AI-251): Given a pointer T to a secondary dispatch table,
    --  retrieve the address of the record containing the Object Specific
@@ -270,11 +273,10 @@ package body Ada.Tags is
 
       function Hash (F : System.Address) return HTable_Headers is
          function H is new System.HTable.Hash (HTable_Headers);
-         Str : String (1 .. Integer (strlen (F)));
-         for Str'Address use F;
-         pragma Import (Ada, Str);
+         Str : constant Cstring_Ptr    := To_Cstring_Ptr (F);
+         Res : constant HTable_Headers := H (Str (1 .. Length (Str)));
       begin
-         return H (Str);
+         return Res;
       end Hash;
 
       -----------------
@@ -283,9 +285,9 @@ package body Ada.Tags is
 
       procedure Set_HT_Link (T : Tag; Next : Tag) is
          TSD_Ptr : constant Addr_Ptr :=
-                     To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+           To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
          TSD     : constant Type_Specific_Data_Ptr :=
-                     To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+           To_Type_Specific_Data_Ptr (TSD_Ptr.all);
       begin
          TSD.HT_Link.all := Next;
       end Set_HT_Link;
@@ -308,10 +310,8 @@ package body Ada.Tags is
    procedure Check_TSD (TSD : Type_Specific_Data_Ptr) is
       T : Tag;
 
-      E_Tag_Len : constant Integer :=
-                    Integer (strlen (TSD.External_Tag.all'Address));
-
-      E_Tag : String (1 .. E_Tag_Len);
+      E_Tag_Len : constant Integer := Length (TSD.External_Tag);
+      E_Tag     : String (1 .. E_Tag_Len);
       for E_Tag'Address use TSD.External_Tag.all'Address;
       pragma Import (Ada, E_Tag);
 
@@ -486,7 +486,7 @@ package body Ada.Tags is
       TSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
       TSD     := To_Type_Specific_Data_Ptr (TSD_Ptr.all);
       Result  := TSD.Expanded_Name;
-      return Result (1 .. Integer (strlen  (Result.all'Address)));
+      return Result (1 .. Length (Result));
    end Expanded_Name;
 
    ------------------
@@ -506,7 +506,7 @@ package body Ada.Tags is
       TSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
       TSD     := To_Type_Specific_Data_Ptr (TSD_Ptr.all);
       Result  := TSD.External_Tag;
-      return Result (1 .. Integer (strlen (Result.all'Address)));
+      return Result (1 .. Length (Result));
    end External_Tag;
 
    ---------------------
@@ -730,6 +730,27 @@ package body Ada.Tags is
         and then D_TSD.Access_Level = A_TSD.Access_Level;
    end Is_Descendant_At_Same_Level;
 
+   ------------
+   -- Length --
+   ------------
+
+   --  Note: This unit is used in the Ravenscar runtime library, so it cannot
+   --  depend on System.CTRL. Furthermore, this happens on CPUs where the GCC
+   --  intrinsic strlen may not be available, so we need to recode our own Ada
+   --  version here.
+
+   function Length (Str : Cstring_Ptr) return Natural is
+      Len : Integer;
+
+   begin
+      Len := 1;
+      while Str (Len) /= ASCII.NUL loop
+         Len := Len + 1;
+      end loop;
+
+      return Len - 1;
+   end Length;
+
    -------------------
    -- Offset_To_Top --
    -------------------

gcc/ada/atree.adb

@@ -772,7 +772,10 @@ package body Atree is
    -- Copy_Separate_Tree --
    ------------------------
 
-   function Copy_Separate_Tree (Source : Node_Id) return Node_Id is
+   function Copy_Separate_Tree
+     (Source      : Node_Id;
+      Syntax_Only : Boolean := False) return Node_Id
+   is
       New_Id  : Node_Id;
 
       function Copy_Entity (E : Entity_Id) return Entity_Id;
@@ -793,6 +796,10 @@ package body Atree is
          New_Ent : Entity_Id;
 
       begin
+         --  Build appropriate node. Note that in this case, we do not need to
+         --  do any special casing for Syntax_Only, since the new node has no
+         --  Etype set, and is always unanalyzed.
+
          case N_Entity (Nkind (E)) is
             when N_Defining_Identifier =>
                New_Ent := New_Entity (N_Defining_Identifier, Sloc (E));
@@ -828,7 +835,7 @@ package body Atree is
                if Has_Extension (E) then
                   Append (Copy_Entity (E), NL);
                else
-                  Append (Copy_Separate_Tree (E), NL);
+                  Append (Copy_Separate_Tree (E, Syntax_Only), NL);
                end if;
 
                Next (E);
@@ -847,7 +854,8 @@ package body Atree is
 
       begin
          if Field in Node_Range then
-            New_N := Union_Id (Copy_Separate_Tree (Node_Id (Field)));
+            New_N :=
+              Union_Id (Copy_Separate_Tree (Node_Id (Field), Syntax_Only));
 
             if Parent (Node_Id (Field)) = Source then
                Set_Parent (Node_Id (New_N), New_Id);
@@ -898,6 +906,47 @@ package body Atree is
             Set_Entity (New_Id, Empty);
          end if;
 
+         --  This is the point at which we do the special processing for
+         --  the Syntax_Only flag being set:
+
+         if Syntax_Only then
+
+            --  Reset all Etype fields and Analyzed flags
+
+            if Nkind (New_Id) in N_Has_Etype then
+               Set_Etype (New_Id, Empty);
+            end if;
+
+            Set_Analyzed (New_Id, False);
+
+            --  Rather special case, if we have an expanded name, then change
+            --  it back into a selected component, so that the tree looks the
+            --  way it did coming out of the parser. This will change back
+            --  when we analyze the selected component node.
+
+            if Nkind (New_Id) = N_Expanded_Name then
+
+               --  The following code is a bit kludgy. It would be cleaner to
+               --  Add an entry Change_Expanded_Name_To_Selected_Component to
+               --  Sinfo.CN, but that's an earthquake, because it has the wrong
+               --  license, and Atree is used outside the compiler, e.g. in the
+               --  binder and in ASIS, so we don't want to add that dependency.
+
+               --  Consequently we have no choice but to hold our noses and do
+               --  the change manually. At least we are Atree, so this odd use
+               --  of Atree.Unchecked_Access is at least all in the family.
+
+               --  Change the node type
+
+               Atree.Unchecked_Access.Set_Nkind (New_Id, N_Selected_Component);
+
+               --  Clear the Chars field which is not present in a selected
+               --  component node, so we don't want a junk value around.
+
+               Set_Node1 (New_Id, Empty);
+            end if;
+         end if;
+
          --  All done, return copied node
 
          return New_Id;

gcc/ada/atree.ads

@@ -494,7 +494,9 @@ package Atree is
    --  is thus still attached to the tree. It is valid for Source to be Empty,
    --  in which case Relocate_Node simply returns Empty as the result.
 
-   function Copy_Separate_Tree (Source : Node_Id) return Node_Id;
+   function Copy_Separate_Tree
+     (Source      : Node_Id;
+      Syntax_Only : Boolean := False) return Node_Id;
    --  Given a node that is the root of a subtree, Copy_Separate_Tree copies
    --  the entire syntactic subtree, including recursively any descendants
    --  whose parent field references a copied node (descendants not linked to
@@ -505,6 +507,33 @@ package Atree is
    --  is called on an unanalyzed tree, and no semantic information is copied.
    --  However, to ensure that no entities are shared between the two when the
    --  source is already analyzed, entity fields in the copy are zeroed out.
+   --
+   --  In addition, if Syntax_Only is set True, then when Copy_Separate_Tree
+   --  is applied Identical to Copy_Separate_Tree except that in the case of
+   --  applying it to an already analyzed tree, all Etype fields are reset,
+   --  and all Analyzed flags are set False. In addition, Expanded_Name
+   --  nodes are converted back into the original parser form (where they are
+   --  Selected_Components), so that renalysis does the right thing.
+   --
+   --  Note: it really seems like Copy_Separate_Tree could do these identical
+   --  steps unconditionally, and that nearly works, except for this one known
+   --  test case that fails:
+   --
+   --    1. procedure III is
+   --    2.    procedure Proc2 is
+   --    3.       pragma Inline_Always (Proc2);
+   --                                   |
+   --       >>> argument of "INLINE_ALWAYS" must be entity in
+   --           current scope
+   --
+   --    4.    begin
+   --    5.       null;
+   --    6.    end Proc2;
+   --    7. begin
+   --    8.    null;
+   --    9. end III;
+   --
+   --  To be investigated ???
 
    function Copy_Separate_List (Source : List_Id) return List_Id;
    --  Applies Copy_Separate_Tree to each element of the Source list, returning

gcc/ada/debug.adb

@@ -141,7 +141,7 @@ package body Debug is
    --  d.U  Ignore indirect calls for static elaboration
    --  d.V
    --  d.W  Print out debugging information for Walk_Library_Items
-   --  d.X  Activate wrapping of imported subprograms with pre/post conditions
+   --  d.X
    --  d.Y
    --  d.Z
 
@@ -664,9 +664,6 @@ package body Debug is
    --       the order in which units are walked. This is primarily for use in
    --       debugging CodePeer mode.
 
-   --  d.X  Activates Wrap_Imported_Subprogram in Freeze (not yet working so
-   --       this allows checkin of partial implementation).
-
    --  d1   Error messages have node numbers where possible. Normally error
    --       messages have only source locations. This option is useful when
    --       debugging errors caused by expanded code, where the source location

gcc/ada/freeze.adb

@@ -3400,6 +3400,7 @@ package body Freeze is
 
       procedure Wrap_Imported_Subprogram (E : Entity_Id) is
          Loc   : constant Source_Ptr := Sloc (E);
+         CE    : constant Name_Id    := Chars (E);
          Spec  : Node_Id;
          Parms : List_Id;
          Stmt  : Node_Id;
@@ -3412,29 +3413,30 @@ package body Freeze is
 
          if not Is_Imported (E) then
             return;
-         end if;
 
          --  Test enabling conditions for wrapping
 
-         if Is_Subprogram (E)
+         elsif Is_Subprogram (E)
            and then Present (Contract (E))
            and then Present (Pre_Post_Conditions (Contract (E)))
            and then not GNATprove_Mode
          then
-            --  For now, activate this only if -gnatd.X is set, because there
-            --  are problems with this procedure, it is not working yet, but
-            --  we would like to be able to check it in ???
+            --  Here we do the wrap
 
-            if not Debug_Flag_Dot_XX then
-               Error_Msg_NE
-                 ("pre/post conditions on imported subprogram are not "
-                  & "enforced??", E, Pre_Post_Conditions (Contract (E)));
-               goto Not_Wrapped;
-            end if;
+            --  Note on calls to Copy_Separate_Tree. The trees we are copying
+            --  here are fully analyzed, but we definitely want fully syntactic
+            --  unanalyzed trees in the body we construct, so that the analysis
+            --  generates the right visibility. So this is a case in which we
+            --  set Syntax_Only. See spec of Copy_Separate_Tree for details on
+            --  the use of this flag.
+
+            --  Acquire copy of Inline pragma
+
+            Iprag :=
+              Copy_Separate_Tree (Import_Pragma (E), Syntax_Only => True);
 
             --  Fix up spec to be not imported any more
 
-            Iprag := Import_Pragma (E);
             Set_Is_Imported    (E, False);
             Set_Interface_Name (E, Empty);
             Set_Has_Completion (E, False);
@@ -3449,7 +3451,7 @@ package body Freeze is
             Parms := New_List;
             Forml := First_Formal (E);
             while Present (Forml) loop
-               Append_To (Parms, New_Occurrence_Of (Forml, Loc));
+               Append_To (Parms, Make_Identifier (Loc, Chars (Forml)));
                Next_Formal (Forml);
             end loop;
 
@@ -3460,13 +3462,13 @@ package body Freeze is
                  Make_Simple_Return_Statement (Loc,
                    Expression =>
                      Make_Function_Call (Loc,
-                       Name                   => New_Occurrence_Of (E, Loc),
+                       Name                   => Make_Identifier (Loc, CE),
                        Parameter_Associations => Parms));
 
             else
                Stmt :=
                  Make_Procedure_Call_Statement (Loc,
-                   Name                   => New_Occurrence_Of (E, Loc),
+                   Name                   => Make_Identifier (Loc, CE),
                    Parameter_Associations => Parms);
             end if;
 
@@ -3474,33 +3476,34 @@ package body Freeze is
 
             Bod :=
               Make_Subprogram_Body (Loc,
-                Specification              => Copy_Separate_Tree (Spec),
+                Specification              =>
+                  Copy_Separate_Tree (Spec, Syntax_Only => True),
                 Declarations               => New_List (
                   Make_Subprogram_Declaration (Loc,
-                    Specification => Copy_Separate_Tree (Spec)),
-                  Copy_Separate_Tree (Iprag)),
+                    Specification =>
+                      Copy_Separate_Tree (Spec, Syntax_Only => True)),
+                    Iprag),
                 Handled_Statement_Sequence =>
                   Make_Handled_Sequence_Of_Statements (Loc,
                     Statements             => New_List (Stmt),
-                    End_Label              => New_Occurrence_Of (E, Loc)));
+                    End_Label              => Make_Identifier (Loc, CE)));
 
             --  Append the body to freeze result
 
             Add_To_Result (Bod);
             return;
-         end if;
 
          --  Case of imported subprogram that does not get wrapped
 
-         <<Not_Wrapped>>
-
-         --  Set Is_Public. All imported entities need an external symbol
-         --  created for them since they are always referenced from another
-         --  object file. Note this used to be set when we set Is_Imported
-         --  back in Sem_Prag, but now we delay it to this point, since we
-         --  don't want to set this flag if we wrap an imported subprogram.
+         else
+            --  Set Is_Public. All imported entities need an external symbol
+            --  created for them since they are always referenced from another
+            --  object file. Note this used to be set when we set Is_Imported
+            --  back in Sem_Prag, but now we delay it to this point, since we
+            --  don't want to set this flag if we wrap an imported subprogram.
 
-         Set_Is_Public (E);
+            Set_Is_Public (E);
+         end if;
       end Wrap_Imported_Subprogram;
 
    --  Start of processing for Freeze_Entity

gcc/ada/s-os_lib.adb

@@ -924,8 +924,35 @@ package body System.OS_Lib is
       if C_Msg = Null_Address then
          if Default /= "" then
             return Default;
+
          else
-            return "errno =" & Err'Img;
+            --  Note: for bootstrap reasons, it is impractical
+            --  to use Integer'Image here.
+
+            declare
+               Val   : Integer;
+               First : Integer;
+               Buf   : String (1 .. 20);
+               --  Buffer large enough to hold image of largest Integer values
+
+            begin
+               Val   := abs Err;
+               First := Buf'Last;
+               loop
+                  Buf (First) :=
+                    Character'Val (Character'Pos ('0') + Val mod 10);
+                  Val := Val / 10;
+                  exit when Val = 0;
+                  First := First - 1;
+               end loop;
+
+               if Err < 0 then
+                  First := First - 1;
+                  Buf (First) := '-';
+               end if;
+
+               return "errno = " & Buf (First .. Buf'Last);
+            end;
          end if;
 
       else

gcc/ada/s-oscons-tmplt.c

@@ -89,7 +89,6 @@ pragma Style_Checks ("M32766");
 /* Include gsocket.h before any system header so it can redefine FD_SETSIZE */
 
 #include "gsocket.h"
-#include "adaint.h"
 
 #include <stdlib.h>
 #include <string.h>
@@ -114,12 +113,15 @@ pragma Style_Checks ("M32766");
 
 /**
  ** For VxWorks, always include vxWorks.h (gsocket.h provides it only for
- ** the case of runtime libraries that support sockets).
+ ** the case of runtime libraries that support sockets). Note: this must
+ ** be done before including adaint.h.
  **/
 
 # include <vxWorks.h>
 #endif
 
+#include "adaint.h"
+
 #ifdef DUMMY
 
 # if defined (TARGET)
@@ -1344,30 +1346,6 @@ CND(SIZEOF_struct_servent, "struct servent")
 CND(SIZEOF_sigset, "sigset")
 #endif
 
-/**
- ** Note: this constant can be used in the GNAT runtime library. In compiler
- ** units on the other hand, System.OS_Constants is not available, so we
- ** declare an Ada constant (Osint.File_Attributes_Size) independently, which
- ** is at least as large as sizeof (struct file_attributes), and we have an
- ** assertion at initialization of Osint checking that the size is indeed at
- ** least sufficient.
- **/
-#define SIZEOF_struct_file_attributes (sizeof (struct file_attributes))
-CND(SIZEOF_struct_file_attributes, "struct file_attributes")
-
-/**
- ** Maximal size of buffer for struct dirent. Note: Since POSIX.1 does not
- ** specify the size of the d_name field, and other nonstandard fields may
- ** precede that field within the dirent structure, we must make a conservative
- ** computation.
- **/
-{
-  struct dirent dent;
-#define SIZEOF_struct_dirent_alloc \
-  ((char*) &dent.d_name - (char*) &dent) + NAME_MAX + 1
-CND(SIZEOF_struct_dirent_alloc, "struct dirent allocation")
-}
-
 /*
 
    --  Fields of struct msghdr
@@ -1508,6 +1486,38 @@ CND(PTHREAD_ONCE_SIZE,       "pthread_once_t")
 
 #endif /* __APPLE__ || __linux__ */
 
+/*
+
+   --------------------------------
+   -- File and directory support --
+   --------------------------------
+
+*/
+
+/**
+ ** Note: this constant can be used in the GNAT runtime library. In compiler
+ ** units on the other hand, System.OS_Constants is not available, so we
+ ** declare an Ada constant (Osint.File_Attributes_Size) independently, which
+ ** is at least as large as sizeof (struct file_attributes), and we have an
+ ** assertion at initialization of Osint checking that the size is indeed at
+ ** least sufficient.
+ **/
+#define SIZEOF_struct_file_attributes (sizeof (struct file_attributes))
+CND(SIZEOF_struct_file_attributes, "struct file_attributes")
+
+/**
+ ** Maximal size of buffer for struct dirent. Note: Since POSIX.1 does not
+ ** specify the size of the d_name field, and other nonstandard fields may
+ ** precede that field within the dirent structure, we must make a conservative
+ ** computation.
+ **/
+{
+  struct dirent dent;
+#define SIZEOF_struct_dirent_alloc \
+  ((char*) &dent.d_name - (char*) &dent) + NAME_MAX + 1
+CND(SIZEOF_struct_dirent_alloc, "struct dirent allocation")
+}
+
 /**
  **  System-specific constants follow
  **  Each section should be activated if compiling for the corresponding