2014-06-11 Sergey Rybin <rybin@adacore.com frybin>

	* gnat_ugn.texi, vms_data.ads: add description of gnatstub -W<par>
	option to specify the result file encoding.

2014-06-11  Robert Dewar  <dewar@adacore.com>

	* errout.ads, sem_ch12.adb: Minor reformatting.
	* debug.adb, erroutc.adb: Remove -gnatd.q debug switch.
	* lib-xref.adb: Minor reformatting.
	* restrict.adb: Minor code reorganization (put routines in
	alpha order).

From-SVN: r211455

9 files changed, 161 insertions, 94 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c45ca09..6575396 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2014-06-11  Sergey Rybin  <rybin@adacore.com frybin>
+
+	* gnat_ugn.texi, vms_data.ads: add description of gnatstub -W<par>
+	option to specify the result file encoding.
+
+2014-06-11  Robert Dewar  <dewar@adacore.com>
+
+	* errout.ads, sem_ch12.adb: Minor reformatting.
+	* debug.adb, erroutc.adb: Remove -gnatd.q debug switch.
+	* lib-xref.adb: Minor reformatting.
+	* restrict.adb: Minor code reorganization (put routines in
+	alpha order).
+
 2014-06-11  Yannick Moy  <moy@adacore.com>
 
 	* einfo.ads: Minor typo in comment
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 49fae93..8399a2c 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -107,7 +107,7 @@ package body Debug is
    --  d.n  Print source file names
    --  d.o  Generate .NET listing of CIL code
    --  d.p  Enable the .NET CIL verifier
-   --  d.q  Quit on badly tagged warning message
+   --  d.q
    --  d.r  Enable OK_To_Reorder_Components in non-variant records
    --  d.s  Disable expansion of slice move, use memmove
    --  d.t  Disable static allocation of library level dispatch tables
@@ -561,12 +561,6 @@ package body Debug is
    --       disabled by default and this flag is used to enable it. In the
    --       future we will reverse this functionality.
 
-   --  d.q  All warning and info messages are supposed to be tagged with one
-   --       of the extended warning sequences such as ?? or <x<. The use of a
-   --       single ? or < is allowed for transitional purposes, but these are
-   --       intended to disappear. This debug switch makes it fatal to have a
-   --       warning presented which is not tagged (Program Error is raised).
-
    --  d.r  Forces the flag OK_To_Reorder_Components to be set in all record
    --       base types that have no discriminants.
 
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 45234a4..d7bc700 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -282,7 +282,8 @@ package Errout is
    --      status of continuations is determined only by the parent message
    --      which is being continued. It is allowable to put ? in continuation
    --      messages, and the usual style is to include it, since it makes it
-   --      clear that the continuation is part of a warning message.
+   --      clear that the continuation is part of a warning message, but it is
+   --      not necessary to go through any computational effort to include it.
    --
    --      Note: this usage is obsolete, use ?? ?*? ?$? ?x? ?X? to specify
    --      the string to be added when Warn_Doc_Switch is set to True. If this
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 8df7d90..eb54a02 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -756,14 +756,12 @@ package body Erroutc is
                end;
             end if;
 
-            --  Bomb if untagged warning message and -gnatd.q set
+            --  Bomb if untagged warning message. This code can be uncommented
+            --  for debugging when looking for untagged warning messages.
 
-            if Debug_Flag_Dot_Q
-              and then Is_Warning_Msg
-              and then Warning_Msg_Char = ' '
-            then
-               raise Program_Error;
-            end if;
+            --  if Is_Warning_Msg and then Warning_Msg_Char = ' ' then
+            --     raise Program_Error;
+            --  end if;
 
          --  Unconditional message (! insertion)
 
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index c926eb8..d199b6c 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -14539,7 +14539,7 @@ is made; this is the default.
 @cindex @option{^--par_threshold^/MAX_PAR^} (@command{gnatpp})
 If the number of parameter specifications is greater than @var{nnn}
 (or equal to @var{nnn} in case of a function), start each specification from
-a new line. The default for @var{nnn} is 3.
+a new line. This feature is disabled by default.
 @end table
 
 @node Setting the Source Search Path
@@ -19520,6 +19520,32 @@ conventions. If this switch is omitted the default name for the body will be
 obtained
 from the argument file name according to the GNAT file naming conventions.
 
+@item ^-W^/RESULT_ENCODING=^@var{e}
+@cindex @option{^-W^/RESULT_ENCODING=^} (@command{gnatstub})
+Specify the wide character encoding method for the output body file.
+@var{e} is one of the following:
+
+@itemize @bullet
+
+@item ^h^HEX^
+Hex encoding
+
+@item ^u^UPPER^
+Upper half encoding
+
+@item ^s^SHIFT_JIS^
+Shift/JIS encoding
+
+@item ^e^EUC^
+EUC encoding
+
+@item ^8^UTF8^
+UTF-8 encoding
+
+@item ^b^BRACKETS^
+Brackets encoding (default value)
+@end itemize
+
 @item ^-q^/QUIET^
 @cindex @option{^-q^/QUIET^} (@command{gnatstub})
 Quiet mode: do not generate a confirmation when a body is
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index cc9ac4c..283c029 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -660,7 +660,6 @@ package body Lib.Xref is
              (GNATprove_Mode
                and then In_Extended_Main_Code_Unit (N)
                and then (Typ = 'm' or else Typ = 'r' or else Typ = 's'))
-
          then
             null;
 
diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index 78591c1..a376efe 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -274,72 +274,6 @@ package body Restrict is
       Check_Restriction (No_Implicit_Heap_Allocations, N);
    end Check_No_Implicit_Heap_Alloc;
 
-   -------------------------------------------
-   -- Check_Restriction_No_Use_Of_Attribute --
-   --------------------------------------------
-
-   procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id) is
-      Id   : constant Name_Id      := Chars (N);
-      A_Id : constant Attribute_Id := Get_Attribute_Id (Id);
-
-   begin
-      --  Ignore call if node N is not in the main source unit, since we only
-      --  give messages for the main unit. This avoids giving messages for
-      --  aspects that are specified in withed units.
-
-      if not In_Extended_Main_Source_Unit (N) then
-         return;
-      end if;
-
-      --  If nothing set, nothing to check
-
-      if not No_Use_Of_Attribute_Set then
-         return;
-      end if;
-
-      Error_Msg_Sloc := No_Use_Of_Attribute (A_Id);
-
-      if Error_Msg_Sloc /= No_Location then
-         Error_Msg_Node_1 := N;
-         Error_Msg_Warn := No_Use_Of_Attribute_Warning (A_Id);
-         Error_Msg_N
-           ("<*<violation of restriction `No_Use_Of_Attribute '='> &`#", N);
-      end if;
-   end Check_Restriction_No_Use_Of_Attribute;
-
-   ----------------------------------------
-   -- Check_Restriction_No_Use_Of_Pragma --
-   ----------------------------------------
-
-   procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id) is
-      Id   : constant Node_Id   := Pragma_Identifier (N);
-      P_Id : constant Pragma_Id := Get_Pragma_Id (Chars (Id));
-
-   begin
-      --  Ignore call if node N is not in the main source unit, since we only
-      --  give messages for the main unit. This avoids giving messages for
-      --  aspects that are specified in withed units.
-
-      if not In_Extended_Main_Source_Unit (N) then
-         return;
-      end if;
-
-      --  If nothing set, nothing to check
-
-      if not No_Use_Of_Pragma_Set then
-         return;
-      end if;
-
-      Error_Msg_Sloc := No_Use_Of_Pragma (P_Id);
-
-      if Error_Msg_Sloc /= No_Location then
-         Error_Msg_Node_1 := Id;
-         Error_Msg_Warn := No_Use_Of_Pragma_Warning (P_Id);
-         Error_Msg_N
-           ("<*<violation of restriction `No_Use_Of_Pragma '='> &`#", Id);
-      end if;
-   end Check_Restriction_No_Use_Of_Pragma;
-
    -----------------------------------
    -- Check_Obsolescent_2005_Entity --
    -----------------------------------
@@ -696,6 +630,72 @@ package body Restrict is
       end if;
    end Check_Restriction_No_Specification_Of_Aspect;
 
+   -------------------------------------------
+   -- Check_Restriction_No_Use_Of_Attribute --
+   --------------------------------------------
+
+   procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id) is
+      Id   : constant Name_Id      := Chars (N);
+      A_Id : constant Attribute_Id := Get_Attribute_Id (Id);
+
+   begin
+      --  Ignore call if node N is not in the main source unit, since we only
+      --  give messages for the main unit. This avoids giving messages for
+      --  aspects that are specified in withed units.
+
+      if not In_Extended_Main_Source_Unit (N) then
+         return;
+      end if;
+
+      --  If nothing set, nothing to check
+
+      if not No_Use_Of_Attribute_Set then
+         return;
+      end if;
+
+      Error_Msg_Sloc := No_Use_Of_Attribute (A_Id);
+
+      if Error_Msg_Sloc /= No_Location then
+         Error_Msg_Node_1 := N;
+         Error_Msg_Warn := No_Use_Of_Attribute_Warning (A_Id);
+         Error_Msg_N
+           ("<*<violation of restriction `No_Use_Of_Attribute '='> &`#", N);
+      end if;
+   end Check_Restriction_No_Use_Of_Attribute;
+
+   ----------------------------------------
+   -- Check_Restriction_No_Use_Of_Pragma --
+   ----------------------------------------
+
+   procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id) is
+      Id   : constant Node_Id   := Pragma_Identifier (N);
+      P_Id : constant Pragma_Id := Get_Pragma_Id (Chars (Id));
+
+   begin
+      --  Ignore call if node N is not in the main source unit, since we only
+      --  give messages for the main unit. This avoids giving messages for
+      --  aspects that are specified in withed units.
+
+      if not In_Extended_Main_Source_Unit (N) then
+         return;
+      end if;
+
+      --  If nothing set, nothing to check
+
+      if not No_Use_Of_Pragma_Set then
+         return;
+      end if;
+
+      Error_Msg_Sloc := No_Use_Of_Pragma (P_Id);
+
+      if Error_Msg_Sloc /= No_Location then
+         Error_Msg_Node_1 := Id;
+         Error_Msg_Warn := No_Use_Of_Pragma_Warning (P_Id);
+         Error_Msg_N
+           ("<*<violation of restriction `No_Use_Of_Pragma '='> &`#", Id);
+      end if;
+   end Check_Restriction_No_Use_Of_Pragma;
+
    --------------------------------------
    -- Check_Wide_Character_Restriction --
    --------------------------------------
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index acb267e..7456ac4 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -9965,11 +9965,11 @@ package body Sem_Ch12 is
                Uninit_Var := Uninitialized_Variable (Decl);
 
             elsif Nkind (Decl) = N_Formal_Type_Declaration
-                    and then Nkind (Formal_Type_Definition (Decl))
-                      = N_Formal_Private_Type_Definition
+                    and then Nkind (Formal_Type_Definition (Decl)) =
+                                          N_Formal_Private_Type_Definition
             then
-               Uninit_Var := Uninitialized_Variable
-                                (Formal_Type_Definition (Decl));
+               Uninit_Var :=
+                 Uninitialized_Variable (Formal_Type_Definition (Decl));
             end if;
 
             if Present (Uninit_Var) then
@@ -9979,8 +9979,8 @@ package body Sem_Ch12 is
                --  For each formal there is a subtype declaration that renames
                --  the actual and has the same name as the formal. Locate the
                --  formal for warning message about uninitialized variables
-               --  in the generic, for which the actual type should be a
-               --  fully initialized type.
+               --  in the generic, for which the actual type should be a fully
+               --  initialized type.
 
                while Present (Actual) loop
                   exit when Ekind (Actual) = E_Package
@@ -9993,10 +9993,11 @@ package body Sem_Ch12 is
                   then
                      Error_Msg_Node_2 := Formal;
                      Error_Msg_NE
-                       ("generic unit has uninitialzed variable& of "
-                          & " formal private type &?v?", Actual, Uninit_Var);
-                     Error_Msg_NE ("actual type for& should be "
-                        & "fully initialized type?v?", Actual, Formal);
+                       ("generic unit has uninitialized variable& of "
+                        & "formal private type &?v?", Actual, Uninit_Var);
+                     Error_Msg_NE
+                       ("actual type for& should be fully initialized type?v?",
+                        Actual, Formal);
                      exit;
                   end if;
 
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index f28b9bf..ac07c62 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1996-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-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- --
@@ -7155,6 +7155,40 @@ package VMS_Data is
    --
    --   Look for source, library or object files in the default directory.
 
+   S_Stub_Encoding : aliased constant S := "/RESULT_ENCODING="             &
+                                            "BRACKETS "                    &
+                                               "-Wb "                      &
+                                            "HEX "                         &
+                                               "-Wh "                      &
+                                            "UPPER "                       &
+                                               "-Wu "                      &
+                                            "SHIFT_JIS "                   &
+                                               "-Ws "                      &
+                                            "EUC "                         &
+                                               "-We "                      &
+                                            "UTF8 "                        &
+                                               "-W8";
+   --        /RESULT_ENCODING[=encoding-type]
+   --
+   --   Specify the wide character encoding method used when writing the
+   --   generated body in the result file. 'encoding-type' is one of the
+   --   following:
+   --
+   --      BRACKETS (D)      Brackets encoding.
+   --
+   --      HEX               Hex ESC encoding.
+   --
+   --      UPPER             Upper half encoding.
+   --
+   --      SHIFT_JIS         Shift-JIS encoding.
+   --
+   --      EUC               EUC Encoding.
+   --
+   --      UTF8              UTF-8 encoding.
+   --
+   --   See 'HELP GNAT COMPILE /WIDE_CHARACTER_ENCODING' for an explanation
+   --   about the different character encoding methods.
+
    S_Stub_Ext     : aliased constant S := "/EXTERNAL_REFERENCE=" & '"'     &
                                             "-X" & '"';
    --        /EXTERNAL_REFERENCE="name=val"
@@ -7349,6 +7383,7 @@ package VMS_Data is
                      (S_Stub_Add        'Access,
                       S_Stub_Config     'Access,
                       S_Stub_Current    'Access,
+                      S_Stub_Encoding   'Access,
                       S_Stub_Ext        'Access,
                       S_Stub_Follow     'Access,
                       S_Stub_Full       'Access,