[multiple changes]

2013-01-02  Robert Dewar  <dewar@adacore.com>

	* err_vars.ads (Warning_Doc_Switch): New flag.
	* errout.adb (Error_Msg_Internal): Implement new warning flag
	doc tag stuff (Set_Msg_Insertion_Warning): New procedure.
	* errout.ads: Document new insertion sequences ?? ?x? ?.x?
	* erroutc.adb (Output_Msg_Text): Handle ?? and ?x? warning doc
	tag stuff.
	* erroutc.ads (Warning_Msg_Char): New variable.
	(Warn_Chr): New field in error message object.
	* errutil.adb (Error_Msg): Set Warn_Chr in error message object.
	* sem_ch13.adb: Minor reformatting.
	* warnsw.adb: Add handling for -gnatw.d and -gnatw.D
	(Warning_Doc_Switch).
	* warnsw.ads: Add handling of -gnatw.d/.D switches (warning
	doc tag).

2013-01-02  Robert Dewar  <dewar@adacore.com>

	* opt.ads: Minor reformatting.

2013-01-02  Doug Rupp  <rupp@adacore.com>

	* init.c: Reorganize VMS section.
	(scan_condtions): New function for scanning condition tables.
	(__gnat_handle_vms_condtion): Use actual exception name for imported
	exceptions vice IMPORTED_EXCEPTION.
	Move condition table scanning into separate function. Move formerly
	special handled conditions to system condition table. Use SYS$PUTMSG
	output to fill exception message field for formally special handled
	condtions, in particular HPARITH to provide more clues about cause and
	location then raised from the translated image.

From-SVN: r194784

1 files changed, 99 insertions, 67 deletions

diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 56a4e35..35f71a4 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -442,13 +442,37 @@ package body Erroutc is
       Length : Nat;
       --  Maximum total length of lines
 
-      Txt   : constant String_Ptr := Errors.Table (E).Text;
-      Len   : constant Natural    := Txt'Length;
-      Ptr   : Natural;
-      Split : Natural;
-      Start : Natural;
+      Text     : constant String_Ptr := Errors.Table (E).Text;
+      Warn     : constant Boolean    := Errors.Table (E).Warn;
+      Warn_Chr : constant Character  := Errors.Table (E).Warn_Chr;
+      Warn_Tag : String_Ptr;
+      Ptr      : Natural;
+      Split    : Natural;
+      Start    : Natural;
 
    begin
+      --  Add warning doc tag if needed
+
+      if Warn and then Warn_Chr /= ' ' then
+         if Warn_Chr = '?' then
+            Warn_Tag := new String'(" [enabled by default]");
+
+         elsif Warn_Chr in 'a' .. 'z' then
+            Warn_Tag := new String'(" [-gnatw" & Warn_Chr & ']');
+
+         else pragma Assert (Warn_Chr in 'A' .. 'Z');
+            Warn_Tag :=
+              new String'(" [-gnatw."
+                          & Character'Val (Character'Pos (Warn_Chr) + 32)
+                          & ']');
+         end if;
+
+      else
+         Warn_Tag := new String'("");
+      end if;
+
+      --  Set error message line length
+
       if Error_Msg_Line_Length = 0 then
          Length := Nat'Last;
       else
@@ -457,87 +481,95 @@ package body Erroutc is
 
       Max := Integer (Length - Column + 1);
 
-      --  For warning message, add "warning: " unless msg starts with "info: "
+      declare
+         Txt : constant String := Text.all & Warn_Tag.all;
+         Len : constant Natural    := Txt'Length;
 
-      if Errors.Table (E).Warn then
-         if Len < 6 or else Txt (Txt'First .. Txt'First + 5) /= "info: " then
-            Write_Str ("warning: ");
-            Max := Max - 9;
-         end if;
+      begin
+         --  For warning, add "warning: " unless msg starts with "info: "
 
-      --  No prefix needed for style message, since "(style)" is there already
+         if Errors.Table (E).Warn then
+            if Len < 6
+              or else Txt (Txt'First .. Txt'First + 5) /= "info: "
+            then
+               Write_Str ("warning: ");
+               Max := Max - 9;
+            end if;
 
-      elsif Errors.Table (E).Style then
-         null;
+            --  No prefix needed for style message, "(style)" is there already
 
-      --  All other cases, add "error: "
+         elsif Errors.Table (E).Style then
+            null;
 
-      elsif Opt.Unique_Error_Tag then
-         Write_Str ("error: ");
-         Max := Max - 7;
-      end if;
+            --  All other cases, add "error: "
 
-      --  Here we have to split the message up into multiple lines
+         elsif Opt.Unique_Error_Tag then
+            Write_Str ("error: ");
+            Max := Max - 7;
+         end if;
 
-      Ptr := 1;
-      loop
-         --  Make sure we do not have ludicrously small line
+         --  Here we have to split the message up into multiple lines
 
-         Max := Integer'Max (Max, 20);
+         Ptr := 1;
+         loop
+            --  Make sure we do not have ludicrously small line
 
-         --  If remaining text fits, output it respecting LF and we are done
+            Max := Integer'Max (Max, 20);
 
-         if Len - Ptr < Max then
-            for J in Ptr .. Len loop
-               if Txt (J) = ASCII.LF then
-                  Write_Eol;
-                  Write_Spaces (Offs);
-               else
-                  Write_Char (Txt (J));
-               end if;
-            end loop;
+            --  If remaining text fits, output it respecting LF and we are done
 
-            return;
+            if Len - Ptr < Max then
+               for J in Ptr .. Len loop
+                  if Txt (J) = ASCII.LF then
+                     Write_Eol;
+                     Write_Spaces (Offs);
+                  else
+                     Write_Char (Txt (J));
+                  end if;
+               end loop;
+
+               return;
 
             --  Line does not fit
 
-         else
-            Start := Ptr;
+            else
+               Start := Ptr;
 
-            --  First scan forward looking for a hard end of line
+               --  First scan forward looking for a hard end of line
 
-            for Scan in Ptr .. Ptr + Max - 1 loop
-               if Txt (Scan) = ASCII.LF then
-                  Split := Scan - 1;
-                  Ptr := Scan + 1;
-                  goto Continue;
-               end if;
-            end loop;
+               for Scan in Ptr .. Ptr + Max - 1 loop
+                  if Txt (Scan) = ASCII.LF then
+                     Split := Scan - 1;
+                     Ptr := Scan + 1;
+                     goto Continue;
+                  end if;
+               end loop;
 
-            --  Otherwise scan backwards looking for a space
+               --  Otherwise scan backwards looking for a space
 
-            for Scan in reverse Ptr .. Ptr + Max - 1 loop
-               if Txt (Scan) = ' ' then
-                  Split := Scan - 1;
-                  Ptr := Scan + 1;
-                  goto Continue;
-               end if;
-            end loop;
+               for Scan in reverse Ptr .. Ptr + Max - 1 loop
+                  if Txt (Scan) = ' ' then
+                     Split := Scan - 1;
+                     Ptr := Scan + 1;
+                     goto Continue;
+                  end if;
+               end loop;
 
-            --  If we fall through, no space, so split line arbitrarily
+               --  If we fall through, no space, so split line arbitrarily
 
-            Split := Ptr + Max - 1;
-            Ptr := Split + 1;
-         end if;
+               Split := Ptr + Max - 1;
+               Ptr := Split + 1;
+            end if;
 
-         <<Continue>>
-         if Start <= Split then
-            Write_Line (Txt (Start .. Split));
-            Write_Spaces (Offs);
-         end if;
+            <<Continue>>
+            if Start <= Split then
+               Write_Line (Txt (Start .. Split));
+               Write_Spaces (Offs);
+            end if;
 
-         Max := Integer (Length - Column + 1);
-      end loop;
+            Max := Integer (Length - Column + 1);
+         end loop;
+      end;
    end Output_Msg_Text;
 
    --------------------
@@ -846,9 +878,7 @@ package body Erroutc is
          --  Remove upper case letter at end, again, we should not be getting
          --  such names, and what we hope is that the remainder makes sense.
 
-         if Name_Len > 1
-           and then Name_Buffer (Name_Len) in 'A' .. 'Z'
-         then
+         if Name_Len > 1 and then Name_Buffer (Name_Len) in 'A' .. 'Z' then
             Name_Len := Name_Len - 1;
          end if;
 
@@ -1217,11 +1247,13 @@ package body Erroutc is
            and then (J = Msg'First or else Msg (J - 1) /= ''')
          then
             Is_Warning_Msg := True;
+            Warning_Msg_Char := ' ';
 
          elsif Msg (J) = '<'
            and then (J = Msg'First or else Msg (J - 1) /= ''')
          then
             Is_Warning_Msg := Error_Msg_Warn;
+            Warning_Msg_Char := ' ';
 
          elsif Msg (J) = '|'
            and then (J = Msg'First or else Msg (J - 1) /= ''')