[multiple changes]

2014-07-18  Robert Dewar  <dewar@adacore.com>

	* g-memdum.adb, g-memdum.ads, exp_strm.adb: Minor reformatting.

2014-07-18  Pascal Obry  <obry@adacore.com>

	* s-crtl.ads, i-cstrea.ads (fputwc): New routine.
	* a-witeio.adb (Put): On platforms where there is translation
	done by the OS output the raw text.
	(New_Line): Use Put above to properly handle the LM wide characters.

From-SVN: r212800

8 files changed, 75 insertions, 19 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 05d2da0..59ad09f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2014-07-18  Robert Dewar  <dewar@adacore.com>
+
+	* g-memdum.adb, g-memdum.ads, exp_strm.adb: Minor reformatting.
+
+2014-07-18  Pascal Obry  <obry@adacore.com>
+
+	* s-crtl.ads, i-cstrea.ads (fputwc): New routine.
+	* a-witeio.adb (Put): On platforms where there is translation
+	done by the OS output the raw text.
+	(New_Line): Use Put above to properly handle the LM wide characters.
+
 2014-07-18  Thomas Quinot  <quinot@adacore.com>
 
 	* g-memdum.adb, g-memdum.ads (Dump): New parameter Prefix, defaulted
diff --git a/gcc/ada/a-witeio.adb b/gcc/ada/a-witeio.adb
index 0457054..b1d2bef 100644
--- a/gcc/ada/a-witeio.adb
+++ b/gcc/ada/a-witeio.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -1082,13 +1082,13 @@ package body Ada.Wide_Text_IO is
       FIO.Check_Write_Status (AP (File));
 
       for K in 1 .. Spacing loop
-         Putc (LM, File);
+         Put (File, Wide_Character'Val (LM));
          File.Line := File.Line + 1;
 
          if File.Page_Length /= 0
            and then File.Line > File.Page_Length
          then
-            Putc (PM, File);
+            Put (File, Wide_Character'Val (PM));
             File.Line := 1;
             File.Page := File.Page + 1;
          end if;
@@ -1220,6 +1220,14 @@ package body Ada.Wide_Text_IO is
      (File : File_Type;
       Item : Wide_Character)
    is
+      text_translation_required : Boolean;
+      for text_translation_required'Size use Character'Size;
+      pragma Import (C, text_translation_required,
+                       "__gnat_text_translation_required");
+      --  Text translation is required on Windows only. This means that the
+      --  console is doing translation and we do not want to do any encoding
+      --  here. If this boolean is set we just output the character as-is.
+
       procedure Out_Char (C : Character);
       --  Procedure to output one character of a wide character sequence
 
@@ -1234,11 +1242,21 @@ package body Ada.Wide_Text_IO is
          Putc (Character'Pos (C), File);
       end Out_Char;
 
+      R : int;
+      pragma Unreferenced (R);
+
    --  Start of processing for Put
 
    begin
       FIO.Check_Write_Status (AP (File));
-      WC_Out (Item, File.WC_Method);
+
+      if text_translation_required then
+         set_wide_text_mode (fileno (File.Stream));
+         R := fputwc (Wide_Character'Pos (Item), File.Stream);
+      else
+         WC_Out (Item, File.WC_Method);
+      end if;
+
       File.Col := File.Col + 1;
    end Put;
 
diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb
index 288b1bf..1ffe9a5 100644
--- a/gcc/ada/exp_strm.adb
+++ b/gcc/ada/exp_strm.adb
@@ -1254,9 +1254,9 @@ package body Exp_Strm is
       Stms := New_List;
 
       --  Note that of course there will be no discriminants for the elementary
-      --  type case, so Has_Discriminants will be False. Note that the
-      --  language rules do not require writing the discriminants in the
-      --  defaulted case, because those are written by 'Write.
+      --  type case, so Has_Discriminants will be False. Note that the language
+      --  rules do not allow writing the discriminants in the defaulted case,
+      --  because those are written by 'Write.
 
       if Has_Discriminants (Typ)
         and then
diff --git a/gcc/ada/g-memdum.adb b/gcc/ada/g-memdum.adb
index 31564c5..9d7b25c 100644
--- a/gcc/ada/g-memdum.adb
+++ b/gcc/ada/g-memdum.adb
@@ -81,17 +81,21 @@ package body GNAT.Memory_Dump is
       case Prefix is
          when Absolute_Address =>
             AIL := Address_Image_Length - 4 + 2;
+
          when Offset =>
             Offset_Last := Offset_Buf'First - 1;
             Set_Image_Based_Integer (Ctr, 16, 0, Offset_Buf, Offset_Last);
             AIL := Offset_Last - 4 + 2;
+
          when None =>
             AIL := 0;
       end case;
+
       Line_Len := AIL + 3 * 16 + 2 + 16;
 
       declare
          Line_Buf : String (1 .. Line_Len);
+
       begin
          while Ctr /= 0 loop
 
@@ -110,6 +114,7 @@ package body GNAT.Memory_Dump is
                      declare
                         Last : Natural := 0;
                         Len  : Natural;
+
                      begin
                         Set_Image_Based_Integer
                           (Count - Ctr, 16, 0, Offset_Buf, Last);
@@ -160,7 +165,6 @@ package body GNAT.Memory_Dump is
             GNAT.IO.Put_Line (Line_Buf (1 .. AIL + 3 * 16 + 2 + N));
          end if;
       end;
-
    end Dump;
 
 end GNAT.Memory_Dump;
diff --git a/gcc/ada/g-memdum.ads b/gcc/ada/g-memdum.ads
index 919663c..840fc92 100644
--- a/gcc/ada/g-memdum.ads
+++ b/gcc/ada/g-memdum.ads
@@ -45,15 +45,17 @@ package GNAT.Memory_Dump is
       Count  : Natural;
       Prefix : Prefix_Type := Absolute_Address);
    --  Dumps indicated number (Count) of bytes, starting at the address given
-   --  by Addr. The coding of this routine in its current form assumes the
-   --  case of a byte addressable machine (and is therefore inapplicable to
-   --  machines like the AAMP, where the storage unit is not 8 bits). The
-   --  output is one or more lines in the following format, which is for the
-   --  case of 32-bit addresses (64-bit addresses are handled appropriately):
+   --  by Addr. The coding of this routine in its current form assumes the case
+   --  of a byte addressable machine (and is therefore inapplicable to machines
+   --  like the AAMP, where the storage unit is not 8 bits). The output is one
+   --  or more lines in the following format, which is for the case of 32-bit
+   --  addresses (64-bit addresses are handled appropriately):
    --
    --    0234_3368: 66 67 68 . . .  73 74 75 "fghijklmnopqstuv"
    --
    --  All but the last line have 16 bytes. A question mark is used in the
    --  string data to indicate a non-printable character.
+   --
+   --  Please document Prefix ???
 
 end GNAT.Memory_Dump;
diff --git a/gcc/ada/i-cstrea.ads b/gcc/ada/i-cstrea.ads
index 95dae64..a2d6ab0 100644
--- a/gcc/ada/i-cstrea.ads
+++ b/gcc/ada/i-cstrea.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1995-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2014, 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- --
@@ -119,6 +119,9 @@ package Interfaces.C_Streams is
    function fputc (C : int; stream : FILEs) return int
      renames System.CRTL.fputc;
 
+   function fputwc (C : int; stream : FILEs) return int
+     renames System.CRTL.fputwc;
+
    function fputs (Strng : chars; Stream : FILEs) return int
      renames System.CRTL.fputs;
 
@@ -223,8 +226,9 @@ package Interfaces.C_Streams is
    --  versa. These functions have no effect if text_translation_required is
    --  false (i.e. in normal unix mode). Use fileno to get a stream handle.
 
-   procedure set_binary_mode (handle : int);
-   procedure set_text_mode   (handle : int);
+   procedure set_binary_mode    (handle : int);
+   procedure set_text_mode      (handle : int);
+   procedure set_wide_text_mode (handle : int);
 
    ----------------------------
    -- Full Path Name support --
@@ -256,6 +260,7 @@ private
 
    pragma Import (C, set_binary_mode, "__gnat_set_binary_mode");
    pragma Import (C, set_text_mode, "__gnat_set_text_mode");
+   pragma Import (C, set_wide_text_mode, "__gnat_set_wide_text_mode");
 
    pragma Import (C, max_path_len, "__gnat_max_path_len");
    pragma Import (C, full_name, "__gnat_full_name");
diff --git a/gcc/ada/s-crtl.ads b/gcc/ada/s-crtl.ads
index e2fe289..0e809ab 100644
--- a/gcc/ada/s-crtl.ads
+++ b/gcc/ada/s-crtl.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2003-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2003-2014, 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- --
@@ -122,6 +122,9 @@ package System.CRTL is
    function fputc (C : int; stream : FILEs) return int;
    pragma Import (C, fputc, "fputc");
 
+   function fputwc (C : int; stream : FILEs) return int;
+   pragma Import (C, fputwc, "fputwc");
+
    function fputs (Strng : chars; Stream : FILEs) return int;
    pragma Import (C, fputs, "fputs");
 
diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c
index 43550cd..9e12946 100644
--- a/gcc/ada/sysdep.c
+++ b/gcc/ada/sysdep.c
@@ -104,11 +104,12 @@ extern struct tm *localtime_r(const time_t *, struct tm *);
    file positioning function, unless the input operation encounters
    end-of-file.
 
-   The other target dependent declarations here are for the two functions
-   __gnat_set_binary_mode and __gnat_set_text_mode:
+   The other target dependent declarations here are for the three functions
+   __gnat_set_binary_mode, __gnat_set_text_mode and __gnat_set_wide_text_mode:
 
       void __gnat_set_binary_mode (int handle);
       void __gnat_set_text_mode   (int handle);
+      void __gnat_set_wide_text_mode   (int handle);
 
    These functions have no effect in Unix (or similar systems where there is
    no distinction between binary and text files), but in DOS (and similar
@@ -150,6 +151,12 @@ __gnat_set_text_mode (int handle)
   WIN_SETMODE (handle, O_TEXT);
 }
 
+void
+__gnat_set_wide_text_mode (int handle)
+{
+  WIN_SETMODE (handle, _O_U16TEXT);
+}
+
 #ifdef __CYGWIN__
 
 char *
@@ -245,6 +252,12 @@ void
 __gnat_set_text_mode (int handle ATTRIBUTE_UNUSED)
 {
 }
+
+void
+__gnat_set_wide_text_mode (int handle ATTRIBUTE_UNUSED)
+{
+}
+
 char *
 __gnat_ttyname (int filedes)
 {