-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
procedure Close (File : in out File_Type) is
begin
- FIO.Close (AP (File));
+ FIO.Close (AP (File)'Unrestricted_Access);
end Close;
---------
Amethod => 'W',
Creat => True,
Text => True);
+
+ File.Self := File;
Set_WCEM (File);
end Create;
function Current_Error return File_Access is
begin
- return Current_Err'Access;
+ return Current_Err.Self'Access;
end Current_Error;
-------------------
function Current_Input return File_Access is
begin
- return Current_In'Access;
+ return Current_In.Self'Access;
end Current_Input;
--------------------
function Current_Output return File_Access is
begin
- return Current_Out'Access;
+ return Current_Out.Self'Access;
end Current_Output;
------------
procedure Delete (File : in out File_Type) is
begin
- FIO.Delete (AP (File));
+ FIO.Delete (AP (File)'Unrestricted_Access);
end Delete;
-----------------
-- Start of processing for Get_Wide_Char
begin
+ FIO.Check_Read_Status (AP (File));
return WC_In (C, File.WC_Method);
end Get_Wide_Char;
-- Start of processing for Get_Wide_Char_Immed
begin
+ FIO.Check_Read_Status (AP (File));
return WC_In (C, File.WC_Method);
end Get_Wide_Char_Immed;
Amethod => 'W',
Creat => False,
Text => True);
+
+ File.Self := File;
Set_WCEM (File);
end Open;
-- Start of processing for Put
begin
+ FIO.Check_Write_Status (AP (File));
WC_Out (Item, File.WC_Method);
File.Col := File.Col + 1;
end Put;
end if;
Terminate_Line (File);
- FIO.Reset (AP (File), To_FCB (Mode));
+ FIO.Reset (AP (File)'Unrestricted_Access, To_FCB (Mode));
File.Page := 1;
File.Line := 1;
File.Col := 1;
procedure Reset (File : in out File_Type) is
begin
Terminate_Line (File);
- FIO.Reset (AP (File));
+ FIO.Reset (AP (File)'Unrestricted_Access);
File.Page := 1;
File.Line := 1;
File.Col := 1;
if Start = 0 then
File.WC_Method := WCEM_Brackets;
- elsif Start /= 0 then
+ else
if Stop = Start then
for J in WC_Encoding_Letters'Range loop
if File.Form (Start) = WC_Encoding_Letters (J) then
-- up for such files, so we assume an implicit LM in this case.
loop
- exit when ch = LM or ch = EOF;
+ exit when ch = LM or else ch = EOF;
ch := Getc (File);
end loop;
end if;
-- a null character in the runtime, here the null characters are added
-- just to have a correct filename length.
- Err_Name : aliased String := "*stderr" & ASCII.Nul;
- In_Name : aliased String := "*stdin" & ASCII.Nul;
- Out_Name : aliased String := "*stdout" & ASCII.Nul;
+ Err_Name : aliased String := "*stderr" & ASCII.NUL;
+ In_Name : aliased String := "*stdin" & ASCII.NUL;
+ Out_Name : aliased String := "*stdout" & ASCII.NUL;
begin
-------------------------------
Standard_Err.Is_System_File := True;
Standard_Err.Is_Text_File := True;
Standard_Err.Access_Method := 'T';
+ Standard_Err.Self := Standard_Err;
Standard_Err.WC_Method := Default_WCEM;
- Standard_In.Stream := stdin;
- Standard_In.Name := In_Name'Access;
- Standard_In.Form := Null_Str'Unrestricted_Access;
- Standard_In.Mode := FCB.In_File;
- Standard_In.Is_Regular_File := is_regular_file (fileno (stdin)) /= 0;
- Standard_In.Is_Temporary_File := False;
- Standard_In.Is_System_File := True;
- Standard_In.Is_Text_File := True;
- Standard_In.Access_Method := 'T';
- Standard_In.WC_Method := Default_WCEM;
+ Standard_In.Stream := stdin;
+ Standard_In.Name := In_Name'Access;
+ Standard_In.Form := Null_Str'Unrestricted_Access;
+ Standard_In.Mode := FCB.In_File;
+ Standard_In.Is_Regular_File := is_regular_file (fileno (stdin)) /= 0;
+ Standard_In.Is_Temporary_File := False;
+ Standard_In.Is_System_File := True;
+ Standard_In.Is_Text_File := True;
+ Standard_In.Access_Method := 'T';
+ Standard_In.Self := Standard_In;
+ Standard_In.WC_Method := Default_WCEM;
Standard_Out.Stream := stdout;
Standard_Out.Name := Out_Name'Access;
Standard_Out.Is_System_File := True;
Standard_Out.Is_Text_File := True;
Standard_Out.Access_Method := 'T';
+ Standard_Out.Self := Standard_Out;
Standard_Out.WC_Method := Default_WCEM;
FIO.Chain_File (AP (Standard_In));
OSDN Git Service
