errout.ads, errout.adb (Finalize): Implement switch -gnatd.m Avoid abbreviation Creat

2006-10-31  Robert Dewar  <dewar@adacore.com>

	* errout.ads, errout.adb (Finalize): Implement switch -gnatd.m
	Avoid abbreviation Creat
	(Finalize): List all sources in extended mail source if -gnatl
	switch is active.
	Suppress copyright notice to file in -gnatl=f mode if -gnatd7 set
	(Finalize): Implement new -gnatl=xxx switch to output listing to file
	(Set_Specific_Warning_On): New procedure
	(Set_Specific_Warning_Off): New procedure
	Add implementation of new insertion \\
	(Error_Msg_Internal): Add handling for Error_Msg_Line_Length
	(Unwind_Internal_Type): Improve report on anonymous access_to_subprogram
	types.
	(Error_Msg_Internal): Make sure that we set Last_Killed to
	True when a message from another package is suppressed.
	Implement insertion character ~ (insert string)
	(First_Node): Minor adjustments to get better placement.

	* frontend.adb: 
	Implement new -gnatl=xxx switch to output listing to file

	* gnat1drv.adb: 
	Implement new -gnatl=xxx switch to output listing to file

        * opt.ads: (Warn_On_Questionable_Missing_Paren): New switch
	(Commands_To_Stdout): New flag
	Implement new -gnatl=xxx switch to output listing to file
	New switch Dump_Source_Text
	(Warn_On_Deleted_Code): New warning flag for -gnatwt
	Define Error_Msg_Line_Length
	(Warn_On_Assumed_Low_Bound): New switch

	* osint.ads, osint.adb
	(Normalize_Directory_Name): Fix bug.
	Implement new -gnatl=xxx switch to output listing to file
	(Concat): Removed, replaced by real concatenation
	Make use of concatenation now allowed in compiler
	(Executable_Prefix.Get_Install_Dir): First get the full path, so that
	we find the 'lib' or 'bin' directory even when the tool has been
	invoked with a relative path.
	(Executable_Name): New function taking string parameters.

	* osint-c.ads, osint-c.adb: 
	Implement new -gnatl=xxx switch to output listing to file

	* sinput-d.adb: Change name Creat_Debug_File to Create_Debug_File

	* switch-c.adb: 
	Implement new -gnatl=xxx switch to output listing to file
	Recognize new -gnatL switch
	(no longer keep in old warning about old style usage)
	Use concatenation to simplify code
	Recognize -gnatjnn switch
	(Scan_Front_End_Switches): Clean up handling of -gnatW
	(Scan_Front_End_Switches): Include Warn_On_Assumed_Low_Bound for -gnatg

From-SVN: r118251

gcc/ada/errout.adb

@@ -37,6 +37,7 @@ with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Erroutc;  use Erroutc;
 with Fname;    use Fname;
+with Gnatvsn;  use Gnatvsn;
 with Hostparm; use Hostparm;
 with Lib;      use Lib;
 with Namet;    use Namet;
@@ -264,7 +265,7 @@ package body Errout is
          return;
       end if;
 
-      --  Start procesing of new message
+      --  Start processing of new message
 
       Sindex := Get_Source_File_Index (Flag_Location);
       Test_Style_Warning_Serious_Msg (Msg);
@@ -676,6 +677,7 @@ package body Errout is
       end if;
 
       Continuation := Msg_Cont;
+      Continuation_New_Line := False;
       Suppress_Message := False;
       Kill_Message := False;
       Set_Msg_Text (Msg, Sptr);
@@ -735,8 +737,9 @@ package body Errout is
          if In_Extended_Main_Source_Unit (Sptr) then
             null;
 
-         --  If the flag location is not in the main extended source
-         --  unit then we want to eliminate the warning.
+         --  If the flag location is not in the main extended source unit,
+         --  then we want to eliminate the warning, unless it is in the
+         --  extended main code unit and we want warnings on the instance.
 
          elsif In_Extended_Main_Code_Unit (Sptr)
            and then Warn_On_Instance
@@ -752,6 +755,11 @@ package body Errout is
 
          else
             Cur_Msg := No_Error_Msg;
+
+            if not Continuation then
+               Last_Killed := True;
+            end if;
+
             return;
          end if;
       end if;
@@ -767,6 +775,74 @@ package body Errout is
          return;
       end if;
 
+      --  If error message line length set, and this is a continuation message
+      --  then all we do is to append the text to the text of the last message
+      --  with a comma space separator.
+
+      if Error_Msg_Line_Length /= 0
+        and then Continuation
+      then
+         Cur_Msg := Errors.Last;
+
+         declare
+            Oldm : String_Ptr := Errors.Table (Cur_Msg).Text;
+            Newm : String (1 .. Oldm'Last + 2 + Msglen);
+            Newl : Natural;
+
+         begin
+            --  First copy old message to new one and free it
+
+            Newm (Oldm'Range) := Oldm.all;
+            Newl := Oldm'Length;
+            Free (Oldm);
+
+            --  Now deal with separation between messages. Normally this
+            --  is simply comma space, but there are some special cases.
+
+            --  If continuation new line, then put actual NL character in msg
+
+            if Continuation_New_Line then
+               Newl := Newl + 1;
+               Newm (Newl) := ASCII.LF;
+
+            --  If continuation message is enclosed in parentheses, then
+            --  special treatment (don't need a comma, and we want to combine
+            --  successive parenthetical remarks into a single one with
+            --  separating commas).
+
+            elsif Msg_Buffer (1) = '(' and then Msg_Buffer (Msglen) = ')' then
+
+               --  Case where existing message ends in right paren, remove
+               --  and separate parenthetical remarks with a comma.
+
+               if Newm (Newl) = ')' then
+                  Newm (Newl) := ',';
+                  Msg_Buffer (1) := ' ';
+
+                  --  Case where we are adding new parenthetical comment
+
+               else
+                  Newl := Newl + 1;
+                  Newm (Newl) := ' ';
+               end if;
+
+            --  Case where continuation not in parens and no new line
+
+            else
+               Newm (Newl + 1 .. Newl + 2) := ", ";
+               Newl := Newl + 2;
+            end if;
+
+            --  Append new message
+
+            Newm (Newl + 1 .. Newl + Msglen) := Msg_Buffer (1 .. Msglen);
+            Newl := Newl + Msglen;
+            Errors.Table (Cur_Msg).Text := new String'(Newm (1 .. Newl));
+         end;
+
+         return;
+      end if;
+
       --  Otherwise build error message object for new message
 
       Errors.Increment_Last;
@@ -781,8 +857,8 @@ package body Errout is
       Errors.Table (Cur_Msg).Warn     := Is_Warning_Msg;
       Errors.Table (Cur_Msg).Style    := Is_Style_Msg;
       Errors.Table (Cur_Msg).Serious  := Is_Serious_Error;
-      Errors.Table (Cur_Msg).Uncond
-        := Is_Unconditional_Msg or Is_Warning_Msg;
+      Errors.Table (Cur_Msg).Uncond   := Is_Unconditional_Msg
+                                           or Is_Warning_Msg;
       Errors.Table (Cur_Msg).Msg_Cont := Continuation;
       Errors.Table (Cur_Msg).Deleted  := False;
 
@@ -792,8 +868,8 @@ package body Errout is
 
       if Debug_Flag_OO or else Debug_Flag_1 then
          Write_Eol;
-         Output_Source_Line (Errors.Table (Cur_Msg).Line,
-           Errors.Table (Cur_Msg).Sfile, True);
+         Output_Source_Line
+           (Errors.Table (Cur_Msg).Line, Errors.Table (Cur_Msg).Sfile, True);
          Temp_Msg := Cur_Msg;
          Output_Error_Msgs (Temp_Msg);
 
@@ -803,9 +879,9 @@ package body Errout is
       --  location (earlier flag location first in the chain).
 
       else
-         --  First a quick check, does this belong at the very end of the
-         --  chain of error messages. This saves a lot of time in the
-         --  normal case if there are lots of messages.
+         --  First a quick check, does this belong at the very end of the chain
+         --  of error messages. This saves a lot of time in the normal case if
+         --  there are lots of messages.
 
          if Last_Error_Msg /= No_Error_Msg
            and then Errors.Table (Cur_Msg).Sfile =
@@ -868,12 +944,12 @@ package body Errout is
             if not Errors.Table (Cur_Msg).Uncond
               and then not Continuation
             then
-               --  Don't delete if prev msg is warning and new msg is
-               --  an error. This is because we don't want a real error
-               --  masked by a warning. In all other cases (that is parse
-               --  errors for the same line that are not unconditional)
-               --  we do delete the message. This helps to avoid
-               --  junk extra messages from cascaded parsing errors
+               --  Don't delete if prev msg is warning and new msg is an error.
+               --  This is because we don't want a real error masked by a
+               --  warning. In all other cases (that is parse errors for the
+               --  same line that are not unconditional) we do delete the
+               --  message. This helps to avoid junk extra messages from
+               --  cascaded parsing errors
 
                if not (Errors.Table (Prev_Msg).Warn
                          or
@@ -883,8 +959,8 @@ package body Errout is
                          or
                         Errors.Table (Cur_Msg).Style)
                then
-                  --  All tests passed, delete the message by simply
-                  --  returning without any further processing.
+                  --  All tests passed, delete the message by simply returning
+                  --  without any further processing.
 
                   if not Continuation then
                      Last_Killed := True;
@@ -934,7 +1010,6 @@ package body Errout is
       if Total_Errors_Detected + Warnings_Detected = Maximum_Errors then
          raise Unrecoverable_Error;
       end if;
-
    end Error_Msg_Internal;
 
    -----------------
@@ -1093,6 +1168,137 @@ package body Errout is
       E, F     : Error_Msg_Id;
       Err_Flag : Boolean;
 
+      procedure Write_Error_Summary;
+      --  Write error summary
+
+      procedure Write_Header (Sfile : Source_File_Index);
+      --  Write header line (compiling or checking given file)
+
+      procedure Write_Max_Errors;
+      --  Write message if max errors reached
+
+      -------------------------
+      -- Write_Error_Summary --
+      -------------------------
+
+      procedure Write_Error_Summary is
+      begin
+         --  Extra blank line if error messages or source listing were output
+
+         if Total_Errors_Detected + Warnings_Detected > 0
+           or else Full_List
+         then
+            Write_Eol;
+         end if;
+
+         --  Message giving number of lines read and number of errors detected.
+         --  This normally goes to Standard_Output. The exception is when brief
+         --  mode is not set, verbose mode (or full list mode) is set, and
+         --  there are errors. In this case we send the message to standard
+         --  error to make sure that *something* appears on standard error in
+         --  an error situation.
+
+         --  Formerly, only the "# errors" suffix was sent to stderr, whereas
+         --  "# lines:" appeared on stdout. This caused problems on VMS when
+         --  the stdout buffer was flushed, giving an extra line feed after
+         --  the prefix.
+
+         if Total_Errors_Detected + Warnings_Detected /= 0
+           and then not Brief_Output
+           and then (Verbose_Mode or Full_List)
+         then
+            Set_Standard_Error;
+         end if;
+
+         --  Message giving total number of lines
+
+         Write_Str (" ");
+         Write_Int (Num_Source_Lines (Main_Source_File));
+
+         if Num_Source_Lines (Main_Source_File) = 1 then
+            Write_Str (" line: ");
+         else
+            Write_Str (" lines: ");
+         end if;
+
+         if Total_Errors_Detected = 0 then
+            Write_Str ("No errors");
+
+         elsif Total_Errors_Detected = 1 then
+            Write_Str ("1 error");
+
+         else
+            Write_Int (Total_Errors_Detected);
+            Write_Str (" errors");
+         end if;
+
+         if Warnings_Detected /= 0 then
+            Write_Str (", ");
+            Write_Int (Warnings_Detected);
+            Write_Str (" warning");
+
+            if Warnings_Detected /= 1 then
+               Write_Char ('s');
+            end if;
+
+            if Warning_Mode = Treat_As_Error then
+               Write_Str (" (treated as error");
+
+               if Warnings_Detected /= 1 then
+                  Write_Char ('s');
+               end if;
+
+               Write_Char (')');
+            end if;
+         end if;
+
+         Write_Eol;
+         Set_Standard_Output;
+      end Write_Error_Summary;
+
+      ------------------
+      -- Write_Header --
+      ------------------
+
+      procedure Write_Header (Sfile : Source_File_Index) is
+      begin
+         if Verbose_Mode or Full_List then
+            if Original_Operating_Mode = Generate_Code then
+               Write_Str ("Compiling: ");
+            else
+               Write_Str ("Checking: ");
+            end if;
+
+            Write_Name (Full_File_Name (Sfile));
+
+            if not Debug_Flag_7 then
+               Write_Str (" (source file time stamp: ");
+               Write_Time_Stamp (Sfile);
+               Write_Char (')');
+            end if;
+
+            Write_Eol;
+         end if;
+      end Write_Header;
+
+      ----------------------
+      -- Write_Max_Errors --
+      ----------------------
+
+      procedure Write_Max_Errors is
+      begin
+         if Maximum_Errors /= 0
+           and then Total_Errors_Detected + Warnings_Detected = Maximum_Errors
+         then
+            Set_Standard_Error;
+            Write_Str ("fatal error: maximum errors reached");
+            Write_Eol;
+            Set_Standard_Output;
+         end if;
+      end Write_Max_Errors;
+
+   --  Start of processing for Finalize
+
    begin
       --  Reset current error source file if the main unit has a pragma
       --  Source_Reference. This ensures outputting the proper name of
@@ -1122,6 +1328,25 @@ package body Errout is
          Cur := Nxt;
       end loop;
 
+      --  Mark any messages suppressed by specific warnings as Deleted
+
+      Cur := First_Error_Msg;
+      while Cur /= No_Error_Msg loop
+         if Warning_Specifically_Suppressed
+             (Errors.Table (Cur).Sptr,
+              Errors.Table (Cur).Text)
+         then
+            Errors.Table (Cur).Deleted := True;
+            Warnings_Detected := Warnings_Detected - 1;
+         end if;
+
+         Cur := Errors.Table (Cur).Next;
+      end loop;
+
+      --  Check consistency of specific warnings (may add warnings)
+
+      Validate_Specific_Warnings (Error_Msg'Access);
+
       --  Brief Error mode
 
       if Brief_Output or (not Full_List and not Verbose_Mode) then
@@ -1164,140 +1389,156 @@ package body Errout is
          List_Pragmas_Index := 1;
          List_Pragmas_Mode := True;
          E := First_Error_Msg;
-         Write_Eol;
-
-         --  First list initial main source file with its error messages
-
-         for N in 1 .. Last_Source_Line (Main_Source_File) loop
-            Err_Flag :=
-              E /= No_Error_Msg
-                and then Errors.Table (E).Line = N
-                and then Errors.Table (E).Sfile = Main_Source_File;
 
-            Output_Source_Line (N, Main_Source_File, Err_Flag);
-
-            if Err_Flag then
-               Output_Error_Msgs (E);
+         --  Normal case, to stdout (copyright notice already output)
 
-               if not Debug_Flag_2 then
-                  Write_Eol;
-               end if;
+         if Full_List_File_Name = null then
+            if not Debug_Flag_7 then
+               Write_Eol;
             end if;
 
-         end loop;
-
-         --  Then output errors, if any, for subsidiary units
+         --  Output to file
 
-         while E /= No_Error_Msg
-           and then Errors.Table (E).Sfile /= Main_Source_File
-         loop
-            Write_Eol;
-            Output_Source_Line
-              (Errors.Table (E).Line, Errors.Table (E).Sfile, True);
-            Output_Error_Msgs (E);
-         end loop;
-      end if;
+         else
+            Create_List_File_Access.all (Full_List_File_Name.all);
+            Set_Special_Output (Write_List_Info_Access.all'Access);
 
-      --  Verbose mode (error lines only with error flags)
+            --  Write copyright notice to file
 
-      if Verbose_Mode and not Full_List then
-         E := First_Error_Msg;
+            if not Debug_Flag_7 then
+               Write_Str ("GNAT ");
+               Write_Str (Gnat_Version_String);
+               Write_Eol;
+               Write_Str ("Copyright 1992-" &
+                          Current_Year &
+                          ", Free Software Foundation, Inc.");
+               Write_Eol;
+            end if;
+         end if;
 
-         --  Loop through error lines
+         --  First list extended main source file units with errors
 
-         while E /= No_Error_Msg loop
-            Write_Eol;
-            Output_Source_Line
-              (Errors.Table (E).Line, Errors.Table (E).Sfile, True);
-            Output_Error_Msgs (E);
-         end loop;
-      end if;
+         --  Note: if debug flag d.m is set, only the main source is listed
 
-      --  Output error summary if verbose or full list mode
+         for U in Main_Unit .. Last_Unit loop
+            if In_Extended_Main_Source_Unit (Cunit_Entity (U))
+              and then (U = Main_Unit or else not Debug_Flag_Dot_M)
+            then
+               declare
+                  Sfile : constant Source_File_Index := Source_Index (U);
 
-      if Verbose_Mode or else Full_List then
+               begin
+                  Write_Eol;
+                  Write_Header (Sfile);
+                  Write_Eol;
 
-         --  Extra blank line if error messages or source listing were output
+                  --  Normally, we don't want an "error messages from file"
+                  --  message when listing the entire file, so we set the
+                  --  current source file as the current error source file.
+                  --  However, the old style of doing things was to list this
+                  --  message if pragma Source_Reference is present, even for
+                  --  the main unit. Since the purpose of the -gnatd.m switch
+                  --  is to duplicate the old behavior, we skip the reset if
+                  --  this debug flag is set.
+
+                  if not Debug_Flag_Dot_M then
+                     Current_Error_Source_File := Sfile;
+                  end if;
 
-         if Total_Errors_Detected + Warnings_Detected > 0
-           or else Full_List
-         then
-            Write_Eol;
-         end if;
+                  for N in 1 .. Last_Source_Line (Sfile) loop
+                     while E /= No_Error_Msg
+                       and then Errors.Table (E).Deleted
+                     loop
+                        E := Errors.Table (E).Next;
+                     end loop;
+
+                     Err_Flag :=
+                       E /= No_Error_Msg
+                         and then Errors.Table (E).Line = N
+                         and then Errors.Table (E).Sfile = Sfile;
+
+                     Output_Source_Line (N, Sfile, Err_Flag);
+
+                     if Err_Flag then
+                        Output_Error_Msgs (E);
+
+                        if not Debug_Flag_2 then
+                           Write_Eol;
+                        end if;
+                     end if;
+                  end loop;
+               end;
+            end if;
+         end loop;
 
-         --  Message giving number of lines read and number of errors detected.
-         --  This normally goes to Standard_Output. The exception is when brief
-         --  mode is not set, verbose mode (or full list mode) is set, and
-         --  there are errors. In this case we send the message to standard
-         --  error to make sure that *something* appears on standard error in
-         --  an error situation.
+         --  Then output errors, if any, for subsidiary units not in the
+         --  main extended unit.
 
-         --  Formerly, only the "# errors" suffix was sent to stderr, whereas
-         --  "# lines:" appeared on stdout. This caused problems on VMS when
-         --  the stdout buffer was flushed, giving an extra line feed after
-         --  the prefix.
+         --  Note: if debug flag d.m set, include errors for any units other
+         --  than the main unit in the extended source unit (e.g. spec and
+         --  subunits for a body).
 
-         if Total_Errors_Detected + Warnings_Detected /= 0
-           and then not Brief_Output
-           and then (Verbose_Mode or Full_List)
-         then
-            Set_Standard_Error;
-         end if;
+         while E /= No_Error_Msg
+           and then (not In_Extended_Main_Source_Unit (Errors.Table (E).Sptr)
+                       or else
+                        (Debug_Flag_Dot_M
+                          and then Get_Source_Unit
+                                     (Errors.Table (E).Sptr) /= Main_Unit))
+         loop
+            if Errors.Table (E).Deleted then
+               E := Errors.Table (E).Next;
 
-         --  Message giving total number of lines
+            else
+               Write_Eol;
+               Output_Source_Line
+                 (Errors.Table (E).Line, Errors.Table (E).Sfile, True);
+               Output_Error_Msgs (E);
+            end if;
+         end loop;
 
-         Write_Str (" ");
-         Write_Int (Num_Source_Lines (Main_Source_File));
+         --  If output to file, write extra copy of error summary to the
+         --  output file, and then close it.
 
-         if Num_Source_Lines (Main_Source_File) = 1 then
-            Write_Str (" line: ");
-         else
-            Write_Str (" lines: ");
+         if Full_List_File_Name /= null then
+            Write_Error_Summary;
+            Write_Max_Errors;
+            Close_List_File_Access.all;
+            Cancel_Special_Output;
          end if;
+      end if;
 
-         if Total_Errors_Detected = 0 then
-            Write_Str ("No errors");
-
-         elsif Total_Errors_Detected = 1 then
-            Write_Str ("1 error");
+      --  Verbose mode (error lines only with error flags). Normally this is
+      --  ignored in full list mode, unless we are listing to a file, in which
+      --  case we still generate -gnatv output to standard output.
 
-         else
-            Write_Int (Total_Errors_Detected);
-            Write_Str (" errors");
-         end if;
+      if Verbose_Mode
+        and then (not Full_List or else Full_List_File_Name /= null)
+      then
+         Write_Eol;
+         Write_Header (Main_Source_File);
+         E := First_Error_Msg;
 
-         if Warnings_Detected /= 0 then
-            Write_Str (", ");
-            Write_Int (Warnings_Detected);
-            Write_Str (" warning");
+         --  Loop through error lines
 
-            if Warnings_Detected /= 1 then
-               Write_Char ('s');
+         while E /= No_Error_Msg loop
+            if Errors.Table (E).Deleted then
+               E := Errors.Table (E).Next;
+            else
+               Write_Eol;
+               Output_Source_Line
+                 (Errors.Table (E).Line, Errors.Table (E).Sfile, True);
+               Output_Error_Msgs (E);
             end if;
+         end loop;
+      end if;
 
-            if Warning_Mode = Treat_As_Error then
-               Write_Str (" (treated as error");
-
-               if Warnings_Detected /= 1 then
-                  Write_Char ('s');
-               end if;
-
-               Write_Char (')');
-            end if;
-         end if;
+      --  Output error summary if verbose or full list mode
 
-         Write_Eol;
-         Set_Standard_Output;
+      if Verbose_Mode or else Full_List then
+         Write_Error_Summary;
       end if;
 
-      if Maximum_Errors /= 0
-        and then Total_Errors_Detected + Warnings_Detected = Maximum_Errors
-      then
-         Set_Standard_Error;
-         Write_Str ("fatal error: maximum errors reached");
-         Write_Eol;
-         Set_Standard_Output;
-      end if;
+      Write_Max_Errors;
 
       if Warning_Mode = Treat_As_Error then
          Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected;
@@ -1310,7 +1551,7 @@ package body Errout is
    ----------------
 
    function First_Node (C : Node_Id) return Node_Id is
-      L        : constant Source_Ptr        := Sloc (C);
+      L        : constant Source_Ptr        := Sloc (Original_Node (C));
       Sfile    : constant Source_File_Index := Get_Source_File_Index (L);
       Earliest : Node_Id;
       Eloc     : Source_Ptr;
@@ -1329,7 +1570,7 @@ package body Errout is
       ------------------
 
       function Test_Earlier (N : Node_Id) return Traverse_Result is
-         Loc : constant Source_Ptr := Sloc (N);
+         Loc : constant Source_Ptr := Sloc (Original_Node (N));
 
       begin
          --  Check for earlier. The tests for being in the same file ensures
@@ -1340,7 +1581,7 @@ package body Errout is
          if Loc < Eloc
            and then Get_Source_File_Index (Loc) = Sfile
          then
-            Earliest := N;
+            Earliest := Original_Node (N);
             Eloc     := Loc;
          end if;
 
@@ -1428,6 +1669,7 @@ package body Errout is
       --  an initial dummy entry covering all possible source locations.
 
       Warnings.Init;
+      Specific_Warnings.Init;
 
       if Warning_Mode = Suppress then
          Warnings.Increment_Last;
@@ -1988,7 +2230,15 @@ package body Errout is
          Set_Qualification (Error_Msg_Qual_Level, Ent);
          Set_Msg_Node (Ent);
          Add_Class;
-         Set_Msg_Quote;
+
+         --  If Ent is an anonymous subprogram type, there is no name
+         --  to print, so remove enclosing quotes.
+
+         if Buffer_Ends_With ("""") then
+            Buffer_Remove ("""");
+         else
+            Set_Msg_Quote;
+         end if;
       end if;
 
       --  If the original type did not come from a predefined
@@ -2106,8 +2356,15 @@ package body Errout is
             Ent := Node;
          end if;
 
-         Unwind_Internal_Type (Ent);
-         Nam := Chars (Ent);
+         --  If the type is the designated type of an access_to_subprogram,
+         --  there is no name to provide in the call.
+
+         if Ekind (Ent) = E_Subprogram_Type then
+            return;
+         else
+            Unwind_Internal_Type (Ent);
+            Nam := Chars (Ent);
+         end if;
 
       else
          Nam := Chars (Node);
@@ -2241,6 +2498,11 @@ package body Errout is
             when '\' =>
                Continuation := True;
 
+               if Text (P) = '\' then
+                  Continuation_New_Line := True;
+                  P := P + 1;
+               end if;
+
             when '@' =>
                Set_Msg_Insertion_Column;
 
@@ -2270,6 +2532,9 @@ package body Errout is
                Set_Msg_Char (Text (P));
                P := P + 1;
 
+            when '~' =>
+               Set_Msg_Str (Error_Msg_String (1 .. Error_Msg_Strlen));
+
             --  Upper case letter
 
             when 'A' .. 'Z' =>
@@ -2435,10 +2700,36 @@ package body Errout is
          Old_Ent := Ent;
 
          --  Implicit access type, use directly designated type
+         --  In Ada 2005, the designated type may be an anonymous access to
+         --  subprogram, in which case we can only point to its definition.
 
          if Is_Access_Type (Ent) then
-            Set_Msg_Str ("access to ");
-            Ent := Directly_Designated_Type (Ent);
+            if Ekind (Ent) = E_Access_Subprogram_Type
+              or else Ekind (Ent) = E_Anonymous_Access_Subprogram_Type
+              or else Ekind (Ent) = E_Access_Protected_Subprogram_Type
+            then
+               Ent := Directly_Designated_Type (Ent);
+
+               if not Comes_From_Source (Ent) then
+                  if Buffer_Ends_With ("type ") then
+                     Buffer_Remove ("type ");
+                  end if;
+
+                  Set_Msg_Str ("access to subprogram with profile ");
+
+               elsif Ekind (Ent) = E_Function then
+                  Set_Msg_Str ("access to function ");
+               else
+                  Set_Msg_Str ("access to procedure ");
+               end if;
+               exit;
+
+            --  Type is access to object, named or anonymous
+
+            else
+               Set_Msg_Str ("access to ");
+               Ent := Directly_Designated_Type (Ent);
+            end if;
 
          --  Classwide type
 

gcc/ada/errout.ads

@@ -235,9 +235,18 @@ package Errout is
    --      of the cases in which messages are normally suppressed. Note that
    --      warnings are never suppressed, so the use of the ! character in a
    --      warning message is never useful.
+   --
+   --      Note: the presence of ! is ignored in continuation messages (i.e.
+   --      messages starting with the \ insertion character). The effect of the
+   --      use of ! in a parent message automatically applies to all of its
+   --      continuation messages (since we clearly don't want any case in which
+   --      continuations are separated from the parent message. 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 an
+   --      unconditional message.
 
    --    Insertion character ? (Question: warning message)
-   --      The character ? appearing anywhere in a message makes the message a
+   --      The character ? appearing anywhere in a message makes the message
    --      warning instead of a normal error message, and the text of the
    --      message will be preceded by "Warning:" instead of "Error:" in the
    --      normal case. The handling of warnings if further controlled by the
@@ -247,6 +256,13 @@ package Errout is
    --      the parser), but currently all relevant warnings are posted by the
    --      semantic phase anyway. Messages starting with (style) are also
    --      treated as warning messages.
+   --
+   --      Note: the presence of ? is ignored in continuation messages (i.e.
+   --      messages starting with the \ insertion character). The warning
+   --      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.
 
    --    Insertion character < (Less Than: conditional warning message)
    --      The character < appearing anywhere in a message is used for a
@@ -262,7 +278,7 @@ package Errout is
 
    --    Insertion character ` (Backquote: set manual quotation mode)
    --      The backquote character always appears in pairs. Each backquote of
-   --      the pair is replaced by a double quote character. In addition, Any
+   --      the pair is replaced by a double quote character. In addition, any
    --      reserved keywords, or name insertions between these backquotes are
    --      not surrounded by the usual automatic double quotes. See the
    --      section below on manual quotation mode for further details.
@@ -280,7 +296,12 @@ package Errout is
    --      messages are treated as a unit. The \ character must be the first
    --      character of the message text.
 
-   --    Insertion character | (vertical bar, non-serious error)
+   --    Insertion character \\ (Two backslashes, continuation with new line)
+   --      This differs from \ only in -gnatjnn mode (Error_Message_Line_Length
+   --      set non-zero). This sequence forces a new line to start even when
+   --      continuations are being gathered into a single message.
+
+   --    Insertion character | (Vertical bar: non-serious error)
    --      By default, error messages (other than warning messages) are
    --      considered to be fatal error messages which prevent expansion or
    --      generation of code in the presence of the -gnatQ switch. If the
@@ -288,6 +309,11 @@ package Errout is
    --      non-serious, and does not cause Serious_Errors_Detected to be
    --      incremented (so expansion is not prevented by such a msg).
 
+   --    Insertion character ~ (Tilde: insert string)
+   --      Indicates that Error_Msg_String (1 .. Error_Msg_Strlen) is to be
+   --      inserted to replace the ~ character. The string is inserted in the
+   --      literal form it appears, without any action on special characters.
+
    ----------------------------------------
    -- Specialization of Messages for VMS --
    ----------------------------------------
@@ -376,6 +402,11 @@ package Errout is
    --  Used if current message contains a < insertion character to indicate
    --  if the current message is a warning message.
 
+   Error_Msg_String : String  renames Err_Vars.Error_Msg_String;
+   Error_Msg_Strlen : Natural renames Err_Vars.Error_Msg_Strlen;
+   --  Used if current message contains a ~ insertion character to indicate
+   --  insertion of the string Error_Msg_String (1 .. Error_Msg_Strlen).
+
    -----------------------------------------------------
    -- Format of Messages and Manual Quotation Control --
    -----------------------------------------------------
@@ -636,6 +667,26 @@ package Errout is
    --  Called in response to a pragma Warnings (On) to record the source
    --  location from which warnings are to be turned back on.
 
+   procedure Set_Specific_Warning_Off (Loc : Source_Ptr; Msg : String)
+     renames Erroutc.Set_Specific_Warning_Off;
+   --  This is called in response to the two argument form of pragma Warnings
+   --  where the first argument is OFF, and the second argument is the prefix
+   --  of a specific warning to be suppressed. The first argument is the start
+   --  of the suppression range, and the second argument is the string from
+   --  the pragma.
+
+   procedure Set_Specific_Warning_On
+     (Loc : Source_Ptr;
+      Msg : String;
+      Err : out Boolean)
+     renames Erroutc.Set_Specific_Warning_On;
+   --  This is called in response to the two argument form of pragma Warnings
+   --  where the first argument is ON, and the second argument is the prefix
+   --  of a specific warning to be suppressed. The first argument is the end
+   --  of the suppression range, and the second argument is the string from
+   --  the pragma. Err is set to True on return to report the error of no
+   --  matching Warnings Off pragma preceding this one.
+
    function Compilation_Errors return Boolean
      renames Erroutc.Compilation_Errors;
    --  Returns true if errors have been detected, or warnings in -gnatwe

gcc/ada/frontend.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -43,7 +43,6 @@ with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Opt;      use Opt;
 with Osint;
-with Output;   use Output;
 with Par;
 with Prepcomp;
 with Rtsfind;
@@ -215,28 +214,6 @@ begin
 
    Initialize_Scanner (Main_Unit, Source_Index (Main_Unit));
 
-   --  Output header if in verbose mode or full list mode
-
-   if Verbose_Mode or Full_List then
-      Write_Eol;
-
-      if Operating_Mode = Generate_Code then
-         Write_Str ("Compiling: ");
-      else
-         Write_Str ("Checking: ");
-      end if;
-
-      Write_Name (Full_File_Name (Current_Source_File));
-
-      if not Debug_Flag_7 then
-         Write_Str (" (source file time stamp: ");
-         Write_Time_Stamp (Current_Source_File);
-         Write_Char (')');
-      end if;
-
-      Write_Eol;
-   end if;
-
    --  Here we call the parser to parse the compilation unit (or units in
    --  the check syntax mode, but in that case we won't go on to the
    --  semantics in any case).

gcc/ada/gnat1drv.adb

@@ -170,10 +170,11 @@ begin
          List_Representation_Info_Mechanisms := True;
       end if;
 
-      --  Output copyright notice if full list mode
+      --  Output copyright notice if full list mode unless we have a list
+      --  file, in which case we defer this so that it is output in the file
 
-      if (Verbose_Mode or Full_List)
-        and then (not Debug_Flag_7)
+      if (Verbose_Mode or else (Full_List and Full_List_File_Name = null))
+        and then not Debug_Flag_7
       then
          Write_Eol;
          Write_Str ("GNAT ");

gcc/ada/opt.ads

@@ -127,7 +127,7 @@ package Opt is
    --  GNAT
    --  Flag set to force display of multiple errors on a single line and
    --  also repeated error messages for references to undefined identifiers
-   --  and certain other repeated error messages.
+   --  and certain other repeated error messages. Set by use of -gnatf.
 
    All_Sources : Boolean := False;
    --  GNATBIND
@@ -239,6 +239,10 @@ package Opt is
    --  Set to True to enable checking for unused withs, and also the case
    --  of withing a package and using none of the entities in the package.
 
+   Commands_To_Stdout : Boolean := False;
+   --  GNATMAKE
+   --  True if echoed commands to be written to stdout instead of stderr
+
    Comment_Deleted_Lines : Boolean := False;
    --  GNATPREP
    --  True if source lines removed by the preprocessor should be commented
@@ -344,6 +348,11 @@ package Opt is
    --  GNATMAKE
    --  Set to True if no actual compilations should be undertaken.
 
+   Dump_Source_Text : Boolean := False;
+   --  GNAT
+   --  Set to True (by -gnatL) to dump source text intermingled with generated
+   --  code. Effective only if either of Debug/Print_Generated_Code is true.
+
    Dynamic_Elaboration_Checks : Boolean := False;
    --  GNAT
    --  Set True for dynamic elaboration checking mode, as set by the -gnatE
@@ -377,6 +386,15 @@ package Opt is
    --  Set to True if -gnato (enable overflow checks) switch is set,
    --  but not -gnatp.
 
+   Error_Msg_Line_Length : Nat := 0;
+   --  GNAT
+   --  Records the error message line length limit. If this is set to zero,
+   --  then we get the old style behavior, in which each call to the error
+   --  message routines generates one line of output as a separate message.
+   --  If it is set to a non-zero value, then continuation lines are folded
+   --  to make a single long message, and then this message is split up into
+   --  multiple lines not exceeding the specified length. Set by -gnatLnnn.
+
    Exception_Locations_Suppressed : Boolean := False;
    --  GNAT
    --  This flag is set True if a Suppress_Exception_Locations configuration
@@ -485,6 +503,12 @@ package Opt is
    --  GNAT
    --  Set True to generate full source listing with embedded errors
 
+   Full_List_File_Name : String_Ptr := null;
+   --  GNAT
+   --  Set to file name to generate full source listing to named file (or if
+   --  the name is of the form .xxx, then to name.xxx where name is the source
+   --  file name with extension stripped.
+
    function get_gcc_version return Int;
    pragma Import (C, get_gcc_version, "get_gcc_version");
 
@@ -643,22 +667,38 @@ package Opt is
    --  before preprocessing occurs. Set to True by switch -s of gnatprep
    --  or -s in preprocessing data file for the compiler.
 
-   type Creat_Repinfo_File_Proc is access procedure (Src : File_Name_Type);
-   type Write_Repinfo_Line_Proc is access procedure (Info : String);
-   type Close_Repinfo_File_Proc is access procedure;
+   type Create_Repinfo_File_Proc is access procedure (Src : File_Name_Type);
+   type Write_Repinfo_Line_Proc  is access procedure (Info : String);
+   type Close_Repinfo_File_Proc  is access procedure;
    --  Types used for procedure addresses below
 
-   Creat_Repinfo_File_Access : Creat_Repinfo_File_Proc := null;
-   Write_Repinfo_Line_Access : Write_Repinfo_Line_Proc := null;
-   Close_Repinfo_File_Access : Close_Repinfo_File_Proc := null;
+   Create_Repinfo_File_Access : Create_Repinfo_File_Proc := null;
+   Write_Repinfo_Line_Access  : Write_Repinfo_Line_Proc  := null;
+   Close_Repinfo_File_Access  : Close_Repinfo_File_Proc  := null;
    --  GNAT
    --  These three locations are left null when operating in non-compiler
    --  (e.g. ASIS mode), but when operating in compiler mode, they are
-   --  set to point to the three corresponding procedures in Osint. The
+   --  set to point to the three corresponding procedures in Osint-C. The
    --  reason for this slightly strange interface is to prevent Repinfo
    --  from dragging in Osint in ASIS mode, which would include a lot of
    --  unwanted units in the ASIS build.
 
+   type Create_List_File_Proc is access procedure (S : String);
+   type Write_List_Info_Proc  is access procedure (S : String);
+   type Close_List_File_Proc  is access procedure;
+   --  Types used for procedure addresses below
+
+   Create_List_File_Access : Create_List_File_Proc := null;
+   Write_List_Info_Access  : Write_List_Info_Proc  := null;
+   Close_List_File_Access  : Close_List_File_Proc  := null;
+   --  GNAT
+   --  These three locations are left null when operating in non-compiler
+   --  (e.g. from the binder), but when operating in compiler mode, they are
+   --  set to point to the three corresponding procedures in Osint-C. The
+   --  reason for this slightly strange interface is to prevent Repinfo
+   --  from dragging in Osint-C in the binder, which would include unwanted
+   --  units in the  binder.
+
    Locking_Policy : Character := ' ';
    --  GNAT, GNATBIND
    --  Set to ' ' for the default case (no locking policy specified).
@@ -1070,10 +1110,16 @@ package Opt is
 
    Warn_On_Ada_2005_Compatibility : Boolean := True;
    --  GNAT
-   --  Set to True to active all warnings on Ada 2005 compatibility issues,
+   --  Set to True to generate all warnings on Ada 2005 compatibility issues,
    --  including warnings on Ada 2005 obsolescent features used in Ada 2005
    --  mode. Set False by -gnatwY.
 
+   Warn_On_Assumed_Low_Bound : Boolean := True;
+   --  GNAT
+   --  Set to True to activate warnings for string parameters that are indexed
+   --  with literals or S'Length, presumably assuming a lower bound of one. Set
+   --  False by -gnatwW.
+
    Warn_On_Bad_Fixed_Value : Boolean := False;
    --  GNAT
    --  Set to True to generate warnings for static fixed-point expression
@@ -1084,6 +1130,12 @@ package Opt is
    --  Set to True to generate warnings for variables that could be declared
    --  as constants. Modified by use of -gnatwk/K.
 
+   Warn_On_Deleted_Code : Boolean := False;
+   --  GNAT
+   --  Set to True to generate warnings for code deleted by the front end
+   --  for conditional statements whose outcome is known at compile time.
+   --  Modified by use of -gnatwt/T.
+
    Warn_On_Dereference : Boolean := False;
    --  GNAT
    --  Set to True to generate warnings for implicit dereferences for array
@@ -1102,7 +1154,8 @@ package Opt is
    Warn_On_Modified_Unread : Boolean := False;
    --  GNAT
    --  Set to True to generate warnings if a variable is assigned but is never
-   --  read. The default is that this warning is suppressed.
+   --  read. The default is that this warning is suppressed. Also controls
+   --  warnings about assignments whose value is never read.
 
    Warn_On_No_Value_Assigned : Boolean := True;
    --  GNAT
@@ -1115,6 +1168,11 @@ package Opt is
    --  Set to True to generate warnings on use of any feature in Annex or if a
    --  subprogram is called for which a pragma Obsolescent applies.
 
+   Warn_On_Questionable_Missing_Parens : Boolean := False;
+   --  GNAT
+   --  Set to True to generate warnings for cases where parenthese are missing
+   --  and the usage is questionable, because the intent is unclear.
+
    Warn_On_Redundant_Constructs : Boolean := False;
    --  GNAT
    --  Set to True to generate warnings for redundant constructs (e.g. useless

gcc/ada/osint-c.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 2001-2005 Free Software Foundation, Inc.           --
+--          Copyright (C) 2001-2006, 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- --
@@ -43,9 +43,10 @@ package body Osint.C is
    function Create_Auxiliary_File
      (Src    : File_Name_Type;
       Suffix : String) return File_Name_Type;
-   --  Common processing for Creat_Repinfo_File and Create_Debug_File.
-   --  Src is the file name used to create the required output file and
-   --  Suffix is the desired suffic (dg/rep for debug/repinfo file).
+   --  Common processing for Create_List_File, Create_Repinfo_File and
+   --  Create_Debug_File. Src is the file name used to create the required
+   --  output file and Suffix is the desired suffic (dg/rep/xxx for debug/
+   --  repinfo/list file where xxx is specified extension.
 
    procedure Set_Library_Info_Name;
    --  Sets a default ali file name from the main compiler source name.
@@ -70,6 +71,23 @@ package body Osint.C is
       end if;
    end Close_Debug_File;
 
+   ---------------------
+   -- Close_List_File --
+   ---------------------
+
+   procedure Close_List_File is
+      Status : Boolean;
+
+   begin
+      Close (Output_FD, Status);
+
+      if not Status then
+         Fail
+           ("error while closing list file ",
+            Get_Name_String (Output_File_Name));
+      end if;
+   end Close_List_File;
+
    -------------------------------
    -- Close_Output_Library_Info --
    -------------------------------
@@ -110,7 +128,7 @@ package body Osint.C is
 
    function Create_Auxiliary_File
      (Src    : File_Name_Type;
-      Suffix : String) return   File_Name_Type
+      Suffix : String) return File_Name_Type
    is
       Result : File_Name_Type;
 
@@ -128,13 +146,10 @@ package body Osint.C is
       Name_Len := Name_Len + Suffix'Length;
 
       if Output_Object_File_Name /= null then
-
          for Index in reverse Output_Object_File_Name'Range loop
-
             if Output_Object_File_Name (Index) = Directory_Separator then
                declare
                   File_Name : constant String := Name_Buffer (1 .. Name_Len);
-
                begin
                   Name_Len := Index - Output_Object_File_Name'First + 1;
                   Name_Buffer (1 .. Name_Len) :=
@@ -165,6 +180,24 @@ package body Osint.C is
       return Create_Auxiliary_File (Src, "dg");
    end Create_Debug_File;
 
+   ----------------------
+   -- Create_List_File --
+   ----------------------
+
+   procedure Create_List_File (S : String) is
+      F : File_Name_Type;
+      pragma Warnings (Off, F);
+   begin
+      if S (S'First) = '.' then
+         F := Create_Auxiliary_File (Current_Main, S (S'First + 1 .. S'Last));
+      else
+         Name_Buffer (1 .. S'Length) := S;
+         Name_Len := S'Length + 1;
+         Name_Buffer (Name_Len) := ASCII.NUL;
+         Create_File_And_Check (Output_FD, Text);
+      end if;
+   end Create_List_File;
+
    --------------------------------
    -- Create_Output_Library_Info --
    --------------------------------
@@ -175,17 +208,16 @@ package body Osint.C is
       Create_File_And_Check (Output_FD, Text);
    end Create_Output_Library_Info;
 
-   --------------------------
-   -- Creat_Repinfo_File --
-   --------------------------
+   -------------------------
+   -- Create_Repinfo_File --
+   -------------------------
 
-   procedure Creat_Repinfo_File (Src : File_Name_Type) is
+   procedure Create_Repinfo_File (Src : File_Name_Type) is
       S : constant File_Name_Type := Create_Auxiliary_File (Src, "rep");
       pragma Warnings (Off, S);
-
    begin
       return;
-   end Creat_Repinfo_File;
+   end Create_Repinfo_File;
 
    ---------------------------
    -- Debug_File_Eol_Length --
@@ -412,6 +444,15 @@ package body Osint.C is
 
    procedure Write_Library_Info (Info : String) renames Write_Info;
 
+   ---------------------
+   -- Write_List_Info --
+   ---------------------
+
+   procedure Write_List_Info (S : String) is
+   begin
+      Write_With_Check (S'Address, S'Length);
+   end Write_List_Info;
+
    ------------------------
    -- Write_Repinfo_Line --
    ------------------------
@@ -419,11 +460,15 @@ package body Osint.C is
    procedure Write_Repinfo_Line (Info : String) renames Write_Info;
 
 begin
-
    Adjust_OS_Resource_Limits;
-   Opt.Creat_Repinfo_File_Access := Creat_Repinfo_File'Access;
-   Opt.Write_Repinfo_Line_Access := Write_Repinfo_Line'Access;
-   Opt.Close_Repinfo_File_Access := Close_Repinfo_File'Access;
+
+   Opt.Create_Repinfo_File_Access := Create_Repinfo_File'Access;
+   Opt.Write_Repinfo_Line_Access  := Write_Repinfo_Line'Access;
+   Opt.Close_Repinfo_File_Access  := Close_Repinfo_File'Access;
+
+   Opt.Create_List_File_Access := Create_List_File'Access;
+   Opt.Write_List_Info_Access  := Write_List_Info'Access;
+   Opt.Close_List_File_Access  := Close_List_File'Access;
 
    Set_Program (Compiler);
 

gcc/ada/osint-c.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001 Free Software Foundation, Inc.               --
+--          Copyright (C) 2001-2006, 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- --
@@ -91,7 +91,7 @@ package Osint.C is
    --  procedures in appropriate variables in Repinfo, so that they can
    --  be called indirectly without creating a dependence.
 
-   procedure Creat_Repinfo_File (Src : File_Name_Type);
+   procedure Create_Repinfo_File (Src : File_Name_Type);
    --  Given the simple name of a source file, this routine creates the
    --  corresponding file to hold representation information
 
@@ -139,6 +139,22 @@ package Osint.C is
    --  text is returned in Text. If the file does not exist, then Text is
    --  set to null.
 
+   ----------------------
+   -- List File Output --
+   ----------------------
+
+   procedure Create_List_File (S : String);
+   --  Creates the file whose name is given by S. If the name starts with a
+   --  period, then the name is xxx & S, where xxx is the name of the main
+   --  source file without the extension stripped. Information is written to
+   --  this file using Write_List_File.
+
+   procedure Write_List_Info (S : String);
+   --  Writes given string to the list file created by Create_List_File
+
+   procedure Close_List_File;
+   --  Close file previously opened by Create_List_File
+
    --------------------------------
    -- Semantic Tree Input-Output --
    --------------------------------

gcc/ada/osint.adb

@@ -82,9 +82,6 @@ package body Osint is
    function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type;
    --  Convert OS format time to GNAT format time stamp
 
-   function Concat (String_One : String; String_Two : String) return String;
-   --  Concatenates 2 strings and returns the result of the concatenation
-
    function Executable_Prefix return String_Ptr;
    --  Returns the name of the root directory where the executable is stored.
    --  The executable must be located in a directory called "bin", or
@@ -97,13 +94,6 @@ package body Osint is
    --  Update the specified path to replace the prefix with the location
    --  where GNAT is installed. See the file prefix.c in GCC for details.
 
-   procedure Write_With_Check (A : Address; N  : Integer);
-   --  Writes N bytes from buffer starting at address A to file whose FD is
-   --  stored in Output_FD, and whose file name is stored as a File_Name_Type
-   --  in Output_File_Name. A check is made for disk full, and if this is
-   --  detected, the file being written is deleted, and a fatal error is
-   --  signalled.
-
    function Locate_File
      (N    : File_Name_Type;
       T    : File_Type;
@@ -264,6 +254,7 @@ package body Osint is
       function Get_Libraries_From_Registry return String_Ptr;
       --  On Windows systems, get the list of installed standard libraries
       --  from the registry key:
+      --
       --  HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\
       --                             GNAT\Standard Libraries
       --  Return an empty string on other systems
@@ -302,7 +293,7 @@ package body Osint is
 
       procedure Get_Dirs_From_File (Additional_Source_Dir : Boolean) is
          File_FD    : File_Descriptor;
-         Buffer     : String (1 .. Path_File_Name'Length + 1);
+         Buffer     : constant String := Path_File_Name.all & ASCII.NUL;
          Len        : Natural;
          Actual_Len : Natural;
          S          : String_Access;
@@ -314,11 +305,6 @@ package body Osint is
          --  For the call to Close
 
       begin
-         --  Construct a C compatible character string buffer
-
-         Buffer (1 .. Buffer'Last - 1) := Path_File_Name.all;
-         Buffer (Buffer'Last) := ASCII.NUL;
-
          File_FD := Open_Read (Buffer'Address, Binary);
 
          --  If we cannot open the file, we ignore it, we don't fail
@@ -384,13 +370,16 @@ package body Osint is
          function C_Get_Libraries_From_Registry return Address;
          pragma Import (C, C_Get_Libraries_From_Registry,
                         "__gnat_get_libraries_from_registry");
+
          function Strlen (Str : Address) return Integer;
          pragma Import (C, Strlen, "strlen");
+
          procedure Strncpy (X : Address; Y : Address; Length : Integer);
          pragma Import (C, Strncpy, "strncpy");
-         Result_Ptr : Address;
+
+         Result_Ptr    : Address;
          Result_Length : Integer;
-         Out_String : String_Ptr;
+         Out_String    : String_Ptr;
 
       begin
          Result_Ptr := C_Get_Libraries_From_Registry;
@@ -428,9 +417,9 @@ package body Osint is
       --  will handle the expansion as part of the file processing.
 
       for Additional_Source_Dir in False .. True loop
-
          if Additional_Source_Dir then
             Search_Path := Getenv (Ada_Include_Path);
+
             if Search_Path'Length > 0 then
                if Hostparm.OpenVMS then
                   Search_Path := To_Canonical_Path_Spec ("ADA_INCLUDE_PATH:");
@@ -438,8 +427,10 @@ package body Osint is
                   Search_Path := To_Canonical_Path_Spec (Search_Path.all);
                end if;
             end if;
+
          else
             Search_Path := Getenv (Ada_Objects_Path);
+
             if Search_Path'Length > 0 then
                if Hostparm.OpenVMS then
                   Search_Path := To_Canonical_Path_Spec ("ADA_OBJECTS_PATH:");
@@ -644,18 +635,6 @@ package body Osint is
       end if;
    end Canonical_Case_File_Name;
 
-   ------------
-   -- Concat --
-   ------------
-
-   function Concat (String_One : String; String_Two : String) return String is
-      Buffer : String (1 .. String_One'Length + String_Two'Length);
-   begin
-      Buffer (1 .. String_One'Length) := String_One;
-      Buffer (String_One'Length + 1 .. Buffer'Last) := String_Two;
-      return Buffer;
-   end Concat;
-
    ---------------------------
    -- Create_File_And_Check --
    ---------------------------
@@ -743,23 +722,87 @@ package body Osint is
 
    function Executable_Name (Name : File_Name_Type) return File_Name_Type is
       Exec_Suffix : String_Access;
-
    begin
       if Name = No_File then
          return No_File;
       end if;
 
+      if Executable_Extension_On_Target = No_Name then
+         Exec_Suffix := Get_Target_Executable_Suffix;
+      else
+         Get_Name_String (Executable_Extension_On_Target);
+         Exec_Suffix := new String'(Name_Buffer (1 .. Name_Len));
+      end if;
+
       Get_Name_String (Name);
-      Exec_Suffix := Get_Executable_Suffix;
 
-      for J in Exec_Suffix'Range loop
-         Name_Len := Name_Len + 1;
-         Name_Buffer (Name_Len) := Exec_Suffix (J);
-      end loop;
+      if Exec_Suffix'Length /= 0 then
+         declare
+            Buffer : String := Name_Buffer (1 .. Name_Len);
+
+         begin
+            --  Get the file name in canonical case to accept as is
+            --  names ending with ".EXE" on VMS and Windows.
+
+            Canonical_Case_File_Name (Buffer);
+
+            --  If the Executable does not end with the executable
+            --  suffix, add it.
+
+            if Buffer'Length <= Exec_Suffix'Length
+              or else
+                Buffer (Buffer'Last - Exec_Suffix'Length + 1 .. Buffer'Last)
+                  /= Exec_Suffix.all
+            then
+               Name_Buffer (Name_Len + 1 .. Name_Len + Exec_Suffix'Length) :=
+                 Exec_Suffix.all;
+               Name_Len := Name_Len + Exec_Suffix'Length;
+               Free (Exec_Suffix);
+               return Name_Find;
+            end if;
+         end;
+      end if;
 
       Free (Exec_Suffix);
+      return Name;
+   end Executable_Name;
 
-      return Name_Enter;
+   function Executable_Name (Name : String) return String is
+      Exec_Suffix    : String_Access;
+      Canonical_Name : String := Name;
+
+   begin
+      if Executable_Extension_On_Target = No_Name then
+         Exec_Suffix := Get_Target_Executable_Suffix;
+      else
+         Get_Name_String (Executable_Extension_On_Target);
+         Exec_Suffix := new String'(Name_Buffer (1 .. Name_Len));
+      end if;
+
+      declare
+         Suffix : constant String := Exec_Suffix.all;
+
+      begin
+         Free (Exec_Suffix);
+         Canonical_Case_File_Name (Canonical_Name);
+
+         if Suffix'Length /= 0
+           and then
+             (Canonical_Name'Length <= Suffix'Length
+               or else Canonical_Name (Canonical_Name'Last - Suffix'Length + 1
+                                         .. Canonical_Name'Last) /= Suffix)
+         then
+            declare
+               Result : String (1 .. Name'Length + Suffix'Length);
+            begin
+               Result (1 .. Name'Length) := Name;
+               Result (Name'Length + 1 .. Result'Last) := Suffix;
+               return Result;
+            end;
+         else
+            return Name;
+         end if;
+      end;
    end Executable_Name;
 
    -----------------------
@@ -776,19 +819,24 @@ package body Osint is
       ---------------------
 
       function Get_Install_Dir (Exec : String) return String_Ptr is
+         Full_Path : constant String := Normalize_Pathname (Exec);
+         --  Use the full path, so that we find "lib" or "bin", even when
+         --  the tool has been invoked with a relative path, as in
+         --  "./gnatls -v" invoked in the GNAT bin directory.
+
       begin
-         for J in reverse Exec'Range loop
-            if Is_Directory_Separator (Exec (J)) then
-               if J < Exec'Last - 5 then
-                  if (To_Lower (Exec (J + 1)) = 'l'
-                      and then To_Lower (Exec (J + 2)) = 'i'
-                      and then To_Lower (Exec (J + 3)) = 'b')
+         for J in reverse Full_Path'Range loop
+            if Is_Directory_Separator (Full_Path (J)) then
+               if J < Full_Path'Last - 5 then
+                  if (To_Lower (Full_Path (J + 1)) = 'l'
+                      and then To_Lower (Full_Path (J + 2)) = 'i'
+                      and then To_Lower (Full_Path (J + 3)) = 'b')
                     or else
-                      (To_Lower (Exec (J + 1)) = 'b'
-                       and then To_Lower (Exec (J + 2)) = 'i'
-                       and then To_Lower (Exec (J + 3)) = 'n')
+                      (To_Lower (Full_Path (J + 1)) = 'b'
+                       and then To_Lower (Full_Path (J + 2)) = 'i'
+                       and then To_Lower (Full_Path (J + 3)) = 'n')
                   then
-                     return new String'(Exec (Exec'First .. J));
+                     return new String'(Full_Path (Full_Path'First .. J));
                   end if;
                end if;
             end if;
@@ -1207,8 +1255,8 @@ package body Osint is
       --  so that we can directly append a file to the directory
 
       if Search_Dir (Search_Dir'Last) /= Directory_Separator then
-         Local_Search_Dir := new String'
-           (Concat (Search_Dir, String'(1 => Directory_Separator)));
+         Local_Search_Dir :=
+           new String'(Search_Dir & String'(1 => Directory_Separator));
       else
          Local_Search_Dir := new String'(Search_Dir);
       end if;
@@ -1232,8 +1280,8 @@ package body Osint is
            := Read_Default_Search_Dirs (Norm_Search_Dir,
                                         Search_File,
                                         null);
-         Default_Search_Dir := new String'
-           (Concat (Norm_Search_Dir.all, Default_Suffix_Dir.all));
+         Default_Search_Dir :=
+           new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
          Free (Norm_Search_Dir);
 
          if Result_Search_Dir /= null then
@@ -1265,14 +1313,13 @@ package body Osint is
          end;
 
          Norm_Search_Dir :=
-           new String'(Concat (Current_Dir.all, Local_Search_Dir.all));
+           new String'(Current_Dir.all & Local_Search_Dir.all);
 
          Result_Search_Dir :=
            Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
 
          Default_Search_Dir :=
-           new String'
-             (Concat (Norm_Search_Dir.all, Default_Suffix_Dir.all));
+           new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
 
          Free (Norm_Search_Dir);
 
@@ -1287,15 +1334,13 @@ package body Osint is
 
             Norm_Search_Dir :=
               new String'
-              (Concat (Update_Path (Search_Dir_Prefix).all,
-                       Local_Search_Dir.all));
+               (Update_Path (Search_Dir_Prefix).all & Local_Search_Dir.all);
 
             Result_Search_Dir :=
               Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
 
             Default_Search_Dir :=
-              new String'
-                (Concat (Norm_Search_Dir.all, Default_Suffix_Dir.all));
+              new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
 
             Free (Norm_Search_Dir);
 
@@ -1309,18 +1354,16 @@ package body Osint is
                --  We finally search in Search_Dir_Prefix/rts-Search_Dir
 
                Temp_String :=
-                 new String'
-                 (Concat (Update_Path (Search_Dir_Prefix).all, "rts-"));
+                 new String'(Update_Path (Search_Dir_Prefix).all & "rts-");
 
                Norm_Search_Dir :=
-                 new String'(Concat (Temp_String.all, Local_Search_Dir.all));
+                 new String'(Temp_String.all & Local_Search_Dir.all);
 
                Result_Search_Dir :=
                  Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
 
                Default_Search_Dir :=
-                 new String'
-                   (Concat (Norm_Search_Dir.all, Default_Suffix_Dir.all));
+                 new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
                Free (Norm_Search_Dir);
 
                if Result_Search_Dir /= null then
@@ -1720,7 +1763,7 @@ package body Osint is
          --  spawn routines. This ensure that quotes will be added when needed.
 
          Result := new String (1 .. Directory'Length - 1);
-         Result (1 .. Directory'Length - 1) :=
+         Result (1 .. Directory'Length - 2) :=
            Directory (Directory'First + 1 .. Directory'Last - 1);
          Result (Result'Last) := Directory_Separator;
 

gcc/ada/osint.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2006 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- --
@@ -24,9 +24,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package contains the low level, operating system routines used in
---  the GNAT compiler and binder for command line processing and file input
---  output.
+--  This package contains the low level, operating system routines used in the
+--  compiler and binder for command line processing and file input output.
 
 with GNAT.OS_Lib; use GNAT.OS_Lib;
 with System;      use System;
@@ -37,9 +36,9 @@ pragma Elaborate (GNAT.OS_Lib);
 package Osint is
 
    Multi_Unit_Index_Character : Character := '~';
-   --  The character before the index of the unit in a multi-unit source,
-   --  in ALI and object file names. This is not a constant, because it is
-   --  changed to '$' on VMS.
+   --  The character before the index of the unit in a multi-unit source, in
+   --  ALI and object file names. This is not a constant, because it is changed
+   --  to '$' on VMS.
 
    Ada_Include_Path          : constant String := "ADA_INCLUDE_PATH";
    Ada_Objects_Path          : constant String := "ADA_OBJECTS_PATH";
@@ -59,18 +58,17 @@ package Osint is
    function Find_File
      (N : File_Name_Type;
       T : File_Type) return File_Name_Type;
-   --  Finds a source, library or config file depending on the value
-   --  of T following the directory search order rules unless N is the
-   --  name of the file just read with Next_Main_File and already
-   --  contains directiory information, in which case just look in the
-   --  Primary_Directory.  Returns File_Name_Type of the full file name
-   --  if found, No_File if file not found. Note that for the special
-   --  case of gnat.adc, only the compilation environment directory is
-   --  searched, i.e. the directory where the ali and object files are
-   --  written. Another special case is when Debug_Generated_Code is
-   --  set and the file name ends on ".dg", in which case we look for
-   --  the generated file only in the current directory, since that is
-   --  where it is always built.
+   --  Finds a source, library or config file depending on the value of T
+   --  following the directory search order rules unless N is the name of the
+   --  file just read with Next_Main_File and already contains directiory
+   --  information, in which case just look in the Primary_Directory. Returns
+   --  File_Name_Type of the full file name if found, No_File if file not
+   --  found. Note that for the special case of gnat.adc, only the compilation
+   --  environment directory is searched, i.e. the directory where the ali and
+   --  object files are written. Another special case is Debug_Generated_Code
+   --  set and the file name ends on ".dg", in which case we look for the
+   --  generated file only in the current directory, since that is where it is
+   --  always built.
 
    function Get_File_Names_Case_Sensitive return Int;
    pragma Import (C, Get_File_Names_Case_Sensitive,
@@ -147,6 +145,9 @@ package Osint is
    --  instance under DOS it adds the ".exe" suffix, whereas under UNIX no
    --  suffix is added.
 
+   function Executable_Name (Name : String) return String;
+   --  Same as above, with String parameters
+
    function File_Stamp (Name : File_Name_Type) return Time_Stamp_Type;
    --  Returns the time stamp of file Name. Name should include relative
    --  path information in order to locate it. If the source file cannot be
@@ -374,14 +375,14 @@ package Osint is
 
    function Full_Source_Name (N : File_Name_Type) return File_Name_Type;
    function Source_File_Stamp (N : File_Name_Type) return Time_Stamp_Type;
-   --  Returns the full name/time stamp of the source file whose simple name
-   --  is N which should not include path information. Note that if the file
-   --  cannot be located No_File is returned for the first routine and an
-   --  all blank time stamp is returned for the second (this is not an error
-   --  situation). The full name includes the appropriate directory
-   --  information. The source file directory lookup penalty is incurred
-   --  every single time the routines are called unless you have previously
-   --  called Source_File_Data (Cache => True). See below.
+   --  Returns the full name/time stamp of the source file whose simple name is
+   --  N which should not include path information. Note that if the file
+   --  cannot be located No_File is returned for the first routine and an all
+   --  blank time stamp is returned for the second (this is not an error
+   --  situation). The full name includes appropriate directory information.
+   --  The source file directory lookup penalty is incurred every single time
+   --  the routines are called unless you have previously called
+   --  Source_File_Data (Cache => True). See below.
 
    function Current_File_Index return Int;
    --  Return the index in its source file of the current main unit
@@ -389,9 +390,9 @@ package Osint is
    function Matching_Full_Source_Name
      (N : File_Name_Type;
       T : Time_Stamp_Type) return File_Name_Type;
-   --  Same semantics than Full_Source_Name but will search on the source
-   --  path until a source file with time stamp matching T is found. If
-   --  none is found returns No_File.
+   --  Same semantics than Full_Source_Name but will search on the source path
+   --  until a source file with time stamp matching T is found. If none is
+   --  found returns No_File.
 
    procedure Source_File_Data (Cache : Boolean);
    --  By default source file data (full source file name and time stamp)
@@ -433,7 +434,9 @@ package Osint is
 
    --  Which of these three methods is chosen depends on the constraints of the
    --  host operating system. The interface described here is independent of
-   --  which of these approaches is used.
+   --  which of these approaches is used. Currently all versions of GNAT use
+   --  the third approach with a file name of xxx.ali where xxx is the source
+   --  file name.
 
    -------------------------------
    -- Library Information Input --
@@ -523,9 +526,9 @@ package Osint is
 
    procedure Exit_Program (Exit_Code : Exit_Code_Type);
    pragma No_Return (Exit_Program);
-   --  A call to Exit_Program terminates execution with the given status.
-   --  A status of zero indicates normal completion, a non-zero status
-   --  indicates abnormal termination.
+   --  A call to Exit_Program terminates execution with the given status. A
+   --  status of zero indicates normal completion, a non-zero status indicates
+   --  abnormal termination.
 
    -------------------------
    -- Command Line Access --
@@ -562,7 +565,7 @@ private
    --  The suffix used for the target object files
 
    Output_FD : File_Descriptor;
-   --  The file descriptor for the current library info, tree or binder output
+   --  File descriptor for current library info, list, tree, or binder output
 
    Output_File_Name : File_Name_Type;
    --  File_Name_Type for name of open file whose FD is in Output_FD, the name
@@ -575,10 +578,10 @@ private
    type File_Name_Array_Ptr is access File_Name_Array;
    File_Names : File_Name_Array_Ptr :=
                   new File_Name_Array (1 .. Int (Argument_Count) + 2);
-   --  As arguments are scanned, file names are stored in this array
-   --  The strings do not have terminating NUL files. The array is
-   --  extensible, because when using project files, there may be
-   --  more files than arguments on the command line.
+   --  As arguments are scanned, file names are stored in this array The
+   --  strings do not have terminating NUL files. The array is extensible,
+   --  because when using project files, there may be more files than
+   --  arguments on the command line.
 
    type File_Index_Array is array (Int range <>) of Int;
    type File_Index_Array_Ptr is access File_Index_Array;
@@ -594,17 +597,17 @@ private
      (Fdesc : out File_Descriptor;
       Fmode : Mode);
    --  Create file whose name (NUL terminated) is in Name_Buffer (with the
-   --  length in Name_Len), and place the resulting descriptor in Fdesc.
-   --  Issue message and exit with fatal error if file cannot be created.
-   --  The Fmode parameter is set to either Text or Binary (see description
+   --  length in Name_Len), and place the resulting descriptor in Fdesc. Issue
+   --  message and exit with fatal error if file cannot be created. The Fmode
+   --  parameter is set to either Text or Binary (for details see description
    --  of GNAT.OS_Lib.Create_File).
 
    type Program_Type is (Compiler, Binder, Make, Gnatls, Unspecified);
    --  Program currently running
    procedure Set_Program (P : Program_Type);
-   --  Indicates to the body of Osint the program currently running.
-   --  This procedure is called by the child packages of Osint.
-   --  A check is made that this procedure is not called several times.
+   --  Indicates to the body of Osint the program currently running. This
+   --  procedure is called by the child packages of Osint. A check is made
+   --  that this procedure is not called more than once.
 
    function More_Files return Boolean;
    --  Implements More_Source_Files and More_Lib_Files
@@ -613,14 +616,20 @@ private
    --  Implements Next_Main_Source and Next_Main_Lib_File
 
    function Object_File_Name (N : File_Name_Type) return File_Name_Type;
-   --  Constructs the name of the object file corresponding to library
-   --  file N. If N is a full file name than the returned file name will
-   --  also be a full file name. Note that no lookup in the library file
-   --  directories is done for this file. This routine merely constructs
-   --  the name.
+   --  Constructs the name of the object file corresponding to library file N.
+   --  If N is a full file name than the returned file name will also be a full
+   --  file name. Note that no lookup in the library file directories is done
+   --  for this file. This routine merely constructs the name.
 
    procedure Write_Info (Info : String);
    --  Implementation of Write_Binder_Info, Write_Debug_Info and
    --  Write_Library_Info (identical)
 
+   procedure Write_With_Check (A : Address; N  : Integer);
+   --  Writes N bytes from buffer starting at address A to file whose FD is
+   --  stored in Output_FD, and whose file name is stored as a File_Name_Type
+   --  in Output_File_Name. A check is made for disk full, and if this is
+   --  detected, the file being written is deleted, and a fatal error is
+   --  signalled.
+
 end Osint;

gcc/ada/switch-c.adb

@@ -498,6 +498,7 @@ package body Switch.C is
                Constant_Condition_Warnings  := True;
                Implementation_Unit_Warnings := True;
                Ineffective_Inline_Warnings  := True;
+               Warn_On_Assumed_Low_Bound    := True;
                Warn_On_Bad_Fixed_Value      := True;
                Warn_On_Constant             := True;
                Warn_On_Export_Import        := True;
@@ -553,6 +554,19 @@ package body Switch.C is
                   Bad_Switch (C);
                end if;
 
+            --  Processing for j switch
+
+            when 'j' =>
+               Ptr := Ptr + 1;
+
+               --  There may be an equal sign between -gnatj and the value
+
+               if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
+                  Ptr := Ptr + 1;
+               end if;
+
+               Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C);
+
             --  Processing for k switch
 
             when 'k' =>
@@ -566,12 +580,23 @@ package body Switch.C is
                Ptr := Ptr + 1;
                Full_List := True;
 
+               --  There may be an equal sign between -gnatl and a file name
+
+               if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
+                  if Ptr = Max then
+                     Osint.Fail ("file name for -gnatl= is null");
+                  else
+                     Opt.Full_List_File_Name :=
+                       new String'(Switch_Chars (Ptr + 1 .. Max));
+                     Ptr := Max + 1;
+                  end if;
+               end if;
+
             --  Processing for L switch
 
             when 'L' =>
                Ptr := Ptr + 1;
-               Osint.Fail
-                 ("-gnatL is no longer supported: consider using --RTS=sjlj");
+               Dump_Source_Text := True;
 
             --  Processing for m switch
 
@@ -584,7 +609,7 @@ package body Switch.C is
                   Ptr := Ptr + 1;
                end if;
 
-               Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors, C);
+               Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Errors, C);
 
             --  Processing for n switch
 
@@ -805,15 +830,13 @@ package body Switch.C is
                   Bad_Switch (C);
                end if;
 
-               for J in WC_Encoding_Method loop
-                  if Switch_Chars (Ptr) = WC_Encoding_Letters (J) then
-                     Wide_Character_Encoding_Method := J;
-                     exit;
-
-                  elsif J = WC_Encoding_Method'Last then
+               begin
+                  Wide_Character_Encoding_Method :=
+                    Get_WC_Encoding_Method (Switch_Chars (Ptr));
+               exception
+                  when Constraint_Error =>
                      Bad_Switch (C);
-                  end if;
-               end loop;
+               end;
 
                Upper_Half_Encoding :=
                  Wide_Character_Encoding_Method in
@@ -856,15 +879,9 @@ package body Switch.C is
                        (Switch_Chars (Ptr .. Max), OK, Ptr);
 
                      if not OK then
-                        declare
-                           R : String (1 .. Style_Msg_Len + 20);
-                        begin
-                           R (1 .. 19) := "bad -gnaty switch (";
-                           R (20 .. R'Last - 1) :=
-                             Style_Msg_Buf (1 .. Style_Msg_Len);
-                           R (R'Last) := ')';
-                           Osint.Fail (R);
-                        end;
+                        Osint.Fail
+                          ("bad -gnaty switch (" &
+                           Style_Msg_Buf (1 .. Style_Msg_Len) & ')');
                      end if;
 
                      Ptr := First_Char + 1;