2004-05-17 Steve Kargl <kargls@comcast.net>

[pf3gnuchains/gcc-fork.git] / gcc / ada / a-textio.adb

diff --git a/gcc/ada/a-textio.adb b/gcc/ada/a-textio.adb
index 36a6a16..7afb804 100644 (file)
--- a/gcc/ada/a-textio.adb
+++ b/gcc/ada/a-textio.adb
@@ -6,9 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.81 $
---                                                                          --
---          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2004 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- --
@@ -29,7 +27,7 @@
 -- covered by the  GNU Public License.                                      --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
 --                                                                          --
 ------------------------------------------------------------------------------
 
@@ -37,6 +35,7 @@ with Ada.Streams;          use Ada.Streams;
 with Interfaces.C_Streams; use Interfaces.C_Streams;
 with System;
 with System.File_IO;
+with System.CRTL;
 with Unchecked_Conversion;
 with Unchecked_Deallocation;
 
@@ -53,11 +52,15 @@ package body Ada.Text_IO is
    function To_TIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
    use type FCB.File_Mode;
 
+   use type System.CRTL.size_t;
+
    -------------------
    -- AFCB_Allocate --
    -------------------
 
    function AFCB_Allocate (Control_Block : Text_AFCB) return FCB.AFCB_Ptr is
+      pragma Unreferenced (Control_Block);
+
    begin
       return new Text_AFCB;
    end AFCB_Allocate;
@@ -136,11 +139,14 @@ package body Ada.Text_IO is
       Name : in String := "";
       Form : in String := "")
    is
-      File_Control_Block : Text_AFCB;
+      Dummy_File_Control_Block : Text_AFCB;
+      pragma Warnings (Off, Dummy_File_Control_Block);
+      --  Yes, we know this is never assigned a value, only the tag
+      --  is used for dispatching purposes, so that's expected.
 
    begin
       FIO.Open (File_Ptr  => AP (File),
-                Dummy_FCB => File_Control_Block,
+                Dummy_FCB => Dummy_File_Control_Block,
                 Mode      => To_FCB (Mode),
                 Name      => Name,
                 Form      => Form,
@@ -338,6 +344,15 @@ package body Ada.Text_IO is
       return End_Of_Page (Current_In);
    end End_Of_Page;
 
+   --------------
+   -- EOF_Char --
+   --------------
+
+   function EOF_Char return Integer is
+   begin
+      return EOF;
+   end EOF_Char;
+
    -----------
    -- Flush --
    -----------
@@ -481,7 +496,9 @@ package body Ada.Text_IO is
       end_of_file : int;
 
       procedure getc_immediate
-        (stream : FILEs; ch : out int; end_of_file : out int);
+        (stream      : FILEs;
+         ch          : out int;
+         end_of_file : out int);
       pragma Import (C, getc_immediate, "getc_immediate");
 
    begin
@@ -503,7 +520,6 @@ package body Ada.Text_IO is
       end if;
 
       Item := Character'Val (ch);
-
    end Get_Immediate;
 
    procedure Get_Immediate
@@ -913,11 +929,14 @@ package body Ada.Text_IO is
       Name : in String;
       Form : in String := "")
    is
-      File_Control_Block : Text_AFCB;
+      Dummy_File_Control_Block : Text_AFCB;
+      pragma Warnings (Off, Dummy_File_Control_Block);
+      --  Yes, we know this is never assigned a value, only the tag
+      --  is used for dispatching purposes, so that's expected.
 
    begin
       FIO.Open (File_Ptr  => AP (File),
-                Dummy_FCB => File_Control_Block,
+                Dummy_FCB => Dummy_File_Control_Block,
                 Mode      => To_FCB (Mode),
                 Name      => Name,
                 Form      => Form,
@@ -1046,6 +1065,9 @@ package body Ada.Text_IO is
      (File : in File_Type;
       Item : in String)
    is
+      Ilen   : Natural := Item'Length;
+      Istart : Natural := Item'First;
+
    begin
       FIO.Check_Write_Status (AP (File));
 
@@ -1065,13 +1087,25 @@ package body Ada.Text_IO is
       --  tasking programs, since often the OS will treat the entire put
       --  operation as an atomic operation.
 
+      --  We only do this if the message is 512 characters or less in length,
+      --  since otherwise Put_Line would use an unbounded amount of stack
+      --  space and could cause undetected stack overflow. If we have a
+      --  longer string, then output the first part separately to avoid this.
+
+      if Ilen > 512 then
+         FIO.Write_Buf (AP (File), Item'Address, size_t (Ilen - 512));
+         Istart := Istart + Ilen - 512;
+         Ilen   := 512;
+      end if;
+
+      --  Now prepare the string with its terminator
+
       declare
-         Ilen   : constant Natural := Item'Length;
          Buffer : String (1 .. Ilen + 2);
          Plen   : size_t;
 
       begin
-         Buffer (1 .. Ilen) := Item;
+         Buffer (1 .. Ilen) := Item (Istart .. Item'Last);
          Buffer (Ilen + 1) := Character'Val (LM);
 
          if File.Page_Length /= 0
@@ -1121,7 +1155,8 @@ package body Ada.Text_IO is
       Item : out Stream_Element_Array;
       Last : out Stream_Element_Offset)
    is
-      ch : int;
+      Discard_ch : int;
+      pragma Warnings (Off, Discard_ch);
 
    begin
       if File.Mode /= FCB.In_File then
@@ -1143,7 +1178,7 @@ package body Ada.Text_IO is
          --  be expected if stream and text input are mixed this way?
 
          if File.Before_LM_PM then
-            ch := ungetc (PM, File.Stream);
+            Discard_ch := ungetc (PM, File.Stream);
             File.Before_LM_PM := False;
          end if;
 
@@ -1643,8 +1678,12 @@ package body Ada.Text_IO is
          --  because it is too much of a nuisance to have these odd line
          --  feeds when nothing has been written to the file.
 
+         --  We also avoid this for files opened in append mode, in
+         --  accordance with (RM A.8.2(10))
+
          elsif (File /= Standard_Err and then File /= Standard_Out)
            and then (File.Line = 1 and then File.Page = 1)
+           and then Mode (File) = Out_File
          then
             New_Line (File);
          end if;