Skip to content

R
riscv-gcc-1
Commit b87971f3 by Arnaud Charlet
Options

[multiple changes] 

2009-10-28  Robert Dewar  <dewar@adacore.com>

	* a-ztexio.adb, a-ztexio.ads, a-witeio.ads, a-witeio.adb,
	a-textio.ads, a-textio.adb: Reorganize (moving specs from private part
	to body).
	(Initialize_Standard_Files): New procedure.
	* a-tienau.adb: Minor change to make EOF directly visible
	* a-tirsfi.ads, a-wrstfi.adb, a-wrstfi.ads, a-zrstfi.adb,
	a-zrstfi.ads, a-tirsfi.adb: New unit, initial version.
	* gnat_rm.texi: Add documentation for
	Ada.[Wide_[Wide_]]Text_IO.Reset_Standard_Files.
	* Makefile.rtl: Add entries for
	Ada.[Wide_[Wide_]]Text_IO.Reset_Standard_Files

2009-10-28  Thomas Quinot  <quinot@adacore.com>

	* exp_ch9.ads: Minor reformatting
	* sem_ch3.adb: Minor reformatting
	* sem_aggr.adb: Minor reformatting.
	* sem_attr.adb: Minor reformatting
	* tbuild.adb, tbuild.ads, par-ch4.adb, exp_ch4.adb (Tbuild.New_Op_Node):
	New subprogram.
	Minor code reorganization/factoring.

From-SVN: r153656
parent 1307c758
Showing with 718 additions and 416 deletions
gcc/ada/ChangeLog
2009-10-28 Robert Dewar <dewar@adacore.com>
* a-ztexio.adb, a-ztexio.ads, a-witeio.ads, a-witeio.adb,
a-textio.ads, a-textio.adb: Reorganize (moving specs from private part
to body).
(Initialize_Standard_Files): New procedure.
* a-tienau.adb: Minor change to make EOF directly visible
* a-tirsfi.ads, a-wrstfi.adb, a-wrstfi.ads, a-zrstfi.adb,
a-zrstfi.ads, a-tirsfi.adb: New unit, initial version.
* gnat_rm.texi: Add documentation for
Ada.[Wide_[Wide_]]Text_IO.Reset_Standard_Files.
* Makefile.rtl: Add entries for
Ada.[Wide_[Wide_]]Text_IO.Reset_Standard_Files
2009-10-28 Thomas Quinot <quinot@adacore.com>
* exp_ch9.ads: Minor reformatting
* sem_ch3.adb: Minor reformatting
* sem_aggr.adb: Minor reformatting.
* sem_attr.adb: Minor reformatting
* tbuild.adb, tbuild.ads, par-ch4.adb, exp_ch4.adb (Tbuild.New_Op_Node):
New subprogram.
Minor code reorganization/factoring.
2009-10-27 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (purpose_member_field): New static function.
......
gcc/ada/Makefile.rtl
......@@ -258,6 +258,7 @@ GNATRTL_NONTASKING_OBJS= \
a-timoau$(objext) \
a-timoio$(objext) \
a-tiocst$(objext) \
a-tirsfi$(objext) \
a-titest$(objext) \
a-tiunio$(objext) \
a-unccon$(objext) \
......@@ -265,6 +266,7 @@ GNATRTL_NONTASKING_OBJS= \
a-wichun$(objext) \
a-widcha$(objext) \
a-witeio$(objext) \
a-wrstfi$(objext) \
a-wtcoau$(objext) \
a-wtcoio$(objext) \
a-wtcstr$(objext) \
......@@ -286,6 +288,7 @@ GNATRTL_NONTASKING_OBJS= \
a-wwunio$(objext) \
a-zchara$(objext) \
a-zchuni$(objext) \
a-zrstfi$(objext) \
a-ztcoau$(objext) \
a-ztcoio$(objext) \
a-ztcstr$(objext) \
......
gcc/ada/a-textio.adb
......@@ -57,15 +57,30 @@ package body Ada.Text_IO is
WC_Encoding : Character;
pragma Import (C, WC_Encoding, "__gl_wc_encoding");
-- Default wide character encoding
Err_Name : aliased String := "*stderr" & ASCII.NUL;
In_Name : aliased String := "*stdin" & ASCII.NUL;
Out_Name : aliased String := "*stdout" & ASCII.NUL;
-- Names of standard files
--
-- Use "preallocated" strings to avoid calling "new" during the elaboration
-- of the run time. This is needed in the tasking case to avoid calling
-- Task_Lock too early. A filename is expected to end with a null character
-- in the runtime, here the null characters are added just to have a
-- correct filename length.
--
-- Note: the names for these files are bogus, and probably it would be
-- better for these files to have no names, but the ACVC tests insist!
-- We use names that are bound to fail in open etc.
Null_Str : aliased constant String := "";
-- Used as form string for standard files
-----------------------
-- Local Subprograms --
-----------------------
function Getc_Immed (File : File_Type) return int;
-- This routine is identical to Getc, except that the read is done in
-- Get_Immediate mode (i.e. without waiting for a line return).
function Get_Upper_Half_Char
(C : Character;
File : File_Type) return Character;
......@@ -82,18 +97,48 @@ package body Ada.Text_IO is
-- This routine is identical to Get_Upper_Half_Char, except that the reads
-- are done in Get_Immediate mode (i.e. without waiting for a line return).
function Getc (File : File_Type) return int;
-- Gets next character from file, which has already been checked for being
-- in read status, and returns the character read if no error occurs. The
-- result is EOF if the end of file was read.
function Getc_Immed (File : File_Type) return int;
-- This routine is identical to Getc, except that the read is done in
-- Get_Immediate mode (i.e. without waiting for a line return).
function Has_Upper_Half_Character (Item : String) return Boolean;
-- Returns True if any of the characters is in the range 16#80#-16#FF#
function Nextc (File : File_Type) return int;
-- Returns next character from file without skipping past it (i.e. it is a
-- combination of Getc followed by an Ungetc).
procedure Put_Encoded (File : File_Type; Char : Character);
-- Called to output a character Char to the given File, when the encoding
-- method for the file is other than brackets, and Char is upper half.
procedure Putc (ch : int; File : File_Type);
-- Outputs the given character to the file, which has already been checked
-- for being in output status. Device_Error is raised if the character
-- cannot be written.
procedure Set_WCEM (File : in out File_Type);
-- Called by Open and Create to set the wide character encoding method for
-- the file, processing a WCEM form parameter if one is present. File is
-- IN OUT because it may be closed in case of an error.
procedure Terminate_Line (File : File_Type);
-- If the file is in Write_File or Append_File mode, and the current line
-- is not terminated, then a line terminator is written using New_Line.
-- Note that there is no Terminate_Page routine, because the page mark at
-- the end of the file is implied if necessary.
procedure Ungetc (ch : int; File : File_Type);
-- Pushes back character into stream, using ungetc. The caller has checked
-- that the file is in read status. Device_Error is raised if the character
-- cannot be pushed back. An attempt to push back and end of file character
-- (EOF) is ignored.
-------------------
-- AFCB_Allocate --
-------------------
......@@ -392,15 +437,6 @@ 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 --
-----------
......@@ -965,6 +1001,52 @@ package body Ada.Text_IO is
return False;
end Has_Upper_Half_Character;
-------------------------------
-- Initialize_Standard_Files --
-------------------------------
procedure Initialize_Standard_Files is
begin
Standard_Err.Stream := stderr;
Standard_Err.Name := Err_Name'Access;
Standard_Err.Form := Null_Str'Unrestricted_Access;
Standard_Err.Mode := FCB.Out_File;
Standard_Err.Is_Regular_File := is_regular_file (fileno (stderr)) /= 0;
Standard_Err.Is_Temporary_File := False;
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.Self := Standard_In;
Standard_In.WC_Method := Default_WCEM;
Standard_Out.Stream := stdout;
Standard_Out.Name := Out_Name'Access;
Standard_Out.Form := Null_Str'Unrestricted_Access;
Standard_Out.Mode := FCB.Out_File;
Standard_Out.Is_Regular_File := is_regular_file (fileno (stdout)) /= 0;
Standard_Out.Is_Temporary_File := False;
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.Make_Unbuffered (AP (Standard_Out));
FIO.Make_Unbuffered (AP (Standard_Err));
end Initialize_Standard_Files;
-------------
-- Is_Open --
-------------
......@@ -2198,20 +2280,8 @@ package body Ada.Text_IO is
end if;
end Write;
-- Use "preallocated" strings to avoid calling "new" during the
-- elaboration of the run time. This is needed in the tasking case to
-- avoid calling Task_Lock too early. A filename is expected to end with 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;
begin
-------------------------------
-- Initialize Standard Files --
-------------------------------
-- Initialize Standard Files
for J in WC_Encoding_Method loop
if WC_Encoding = WC_Encoding_Letters (J) then
......@@ -2219,51 +2289,10 @@ begin
end if;
end loop;
-- Note: the names in these files are bogus, and probably it would be
-- better for these files to have no names, but the ACVC test insist!
-- We use names that are bound to fail in open etc.
Standard_Err.Stream := stderr;
Standard_Err.Name := Err_Name'Access;
Standard_Err.Form := Null_Str'Unrestricted_Access;
Standard_Err.Mode := FCB.Out_File;
Standard_Err.Is_Regular_File := is_regular_file (fileno (stderr)) /= 0;
Standard_Err.Is_Temporary_File := False;
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.Self := Standard_In;
Standard_In.WC_Method := Default_WCEM;
Standard_Out.Stream := stdout;
Standard_Out.Name := Out_Name'Access;
Standard_Out.Form := Null_Str'Unrestricted_Access;
Standard_Out.Mode := FCB.Out_File;
Standard_Out.Is_Regular_File := is_regular_file (fileno (stdout)) /= 0;
Standard_Out.Is_Temporary_File := False;
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;
Initialize_Standard_Files;
FIO.Chain_File (AP (Standard_In));
FIO.Chain_File (AP (Standard_Out));
FIO.Chain_File (AP (Standard_Err));
FIO.Make_Unbuffered (AP (Standard_Out));
FIO.Make_Unbuffered (AP (Standard_Err));
end Ada.Text_IO;
gcc/ada/a-textio.ads
......@@ -41,6 +41,7 @@
with Ada.IO_Exceptions;
with Ada.Streams;
with System;
with System.File_Control_Block;
with System.WCh_Con;
......@@ -443,9 +444,6 @@ private
-- The Standard Files --
------------------------
Null_Str : aliased constant String := "";
-- Used as name and form of standard files
Standard_In_AFCB : aliased Text_AFCB;
Standard_Out_AFCB : aliased Text_AFCB;
Standard_Err_AFCB : aliased Text_AFCB;
......@@ -460,47 +458,9 @@ private
Current_Err : aliased File_Type := Standard_Err;
-- Current files
-----------------------
-- Local Subprograms --
-----------------------
-- These subprograms are in the private part of the spec so that they can
-- be shared by the routines in the body of Ada.Text_IO.Wide_Text_IO.
-- Note: we use Integer in these declarations instead of the more accurate
-- Interfaces.C_Streams.int, because we do not want to drag in the spec of
-- this interfaces package with the spec of Ada.Text_IO, and we know that
-- in fact these types are identical
function EOF_Char return Integer;
-- Returns the system-specific character indicating the end of a text file.
-- This is exported for use by child packages such as Enumeration_Aux to
-- eliminate their needing to depend directly on Interfaces.C_Streams.
function Getc (File : File_Type) return Integer;
-- Gets next character from file, which has already been checked for
-- being in read status, and returns the character read if no error
-- occurs. The result is EOF if the end of file was read.
function Nextc (File : File_Type) return Integer;
-- Returns next character from file without skipping past it (i.e. it
-- is a combination of Getc followed by an Ungetc).
procedure Putc (ch : Integer; File : File_Type);
-- Outputs the given character to the file, which has already been
-- checked for being in output status. Device_Error is raised if the
-- character cannot be written.
procedure Terminate_Line (File : File_Type);
-- If the file is in Write_File or Append_File mode, and the current
-- line is not terminated, then a line terminator is written using
-- New_Line. Note that there is no Terminate_Page routine, because
-- the page mark at the end of the file is implied if necessary.
procedure Ungetc (ch : Integer; File : File_Type);
-- Pushes back character into stream, using ungetc. The caller has
-- checked that the file is in read status. Device_Error is raised
-- if the character cannot be pushed back. An attempt to push back
-- and end of file character (EOF) is ignored.
procedure Initialize_Standard_Files;
-- Initializes the file control blocks for the standard files. Called from
-- the elaboration routine for this package, and from Reset_Standard_Files
-- in package Ada.Text_IO.Reset_Standard_Files.
end Ada.Text_IO;
gcc/ada/a-tienau.adb
......@@ -32,6 +32,8 @@
with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Interfaces.C_Streams; use Interfaces.C_Streams;
-- Note: this package does not yet deal properly with wide characters ???
package body Ada.Text_IO.Enumeration_Aux is
......@@ -98,7 +100,7 @@ package body Ada.Text_IO.Enumeration_Aux is
Store_Char (File, Character'Pos (To_Upper (C)), Buf, Buflen);
ch := Getc (File);
exit when ch = EOF_Char;
exit when ch = EOF;
C := Character'Val (ch);
exit when not Is_Letter (C)
......
gcc/ada/a-tirsfi.adb 0 → 100755
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . T E X T _ I O . R E S E T _ S T A N D A R D _ F I L E S --
-- --
-- B o d y --
-- --
-- Copyright (C) 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 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. --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
--------------------------------------
-- Ada.Text_IO.Reset_Standard_Files --
--------------------------------------
procedure Ada.Text_IO.Reset_Standard_Files is
begin
Ada.Text_IO.Initialize_Standard_Files;
end Ada.Text_IO.Reset_Standard_Files;
gcc/ada/a-tirsfi.ads 0 → 100755
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . T E X T _ I O . R E S E T _ S T A N D A R D _ F I L E S --
-- --
-- S p e c --
-- --
-- Copyright (C) 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 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. --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- This package provides a reset routine that resets the standard files used
-- by Text_IO. This is useful in systems such as VxWorks where Ada.Text_IO is
-- elaborated at the program start, but a system restart may alter the status
-- of these files, resulting in incorrect operation of Text_IO (in particular
-- if the standard input file is changed to be interactive, then Get_Line may
-- hang looking for an extra character after the end of the line.
procedure Ada.Text_IO.Reset_Standard_Files;
-- Reset standard Text_IO files as described above
gcc/ada/a-witeio.adb
......@@ -57,26 +57,62 @@ package body Ada.Wide_Text_IO is
WC_Encoding : Character;
pragma Import (C, WC_Encoding, "__gl_wc_encoding");
-- Default wide character encoding
Err_Name : aliased String := "*stderr" & ASCII.NUL;
In_Name : aliased String := "*stdin" & ASCII.NUL;
Out_Name : aliased String := "*stdout" & ASCII.NUL;
-- Names of standard files
--
-- Use "preallocated" strings to avoid calling "new" during the elaboration
-- of the run time. This is needed in the tasking case to avoid calling
-- Task_Lock too early. A filename is expected to end with a null character
-- in the runtime, here the null characters are added just to have a
-- correct filename length.
--
-- Note: the names for these files are bogus, and probably it would be
-- better for these files to have no names, but the ACVC tests insist!
-- We use names that are bound to fail in open etc.
Null_Str : aliased constant String := "";
-- Used as form string for standard files
-----------------------
-- Local Subprograms --
-----------------------
function Getc_Immed (File : File_Type) return int;
-- This routine is identical to Getc, except that the read is done in
-- Get_Immediate mode (i.e. without waiting for a line return).
function Get_Wide_Char_Immed
(C : Character;
File : File_Type) return Wide_Character;
-- This routine is identical to Get_Wide_Char, except that the reads are
-- done in Get_Immediate mode (i.e. without waiting for a line return).
function Getc_Immed (File : File_Type) return int;
-- This routine is identical to Getc, except that the read is done in
-- Get_Immediate mode (i.e. without waiting for a line return).
procedure Putc (ch : int; File : File_Type);
-- Outputs the given character to the file, which has already been checked
-- for being in output status. Device_Error is raised if the character
-- cannot be written.
procedure Set_WCEM (File : in out File_Type);
-- Called by Open and Create to set the wide character encoding method for
-- the file, processing a WCEM form parameter if one is present. File is
-- IN OUT because it may be closed in case of an error.
procedure Terminate_Line (File : File_Type);
-- If the file is in Write_File or Append_File mode, and the current line
-- is not terminated, then a line terminator is written using New_Line.
-- Note that there is no Terminate_Page routine, because the page mark at
-- the end of the file is implied if necessary.
procedure Ungetc (ch : int; File : File_Type);
-- Pushes back character into stream, using ungetc. The caller has checked
-- that the file is in read status. Device_Error is raised if the character
-- cannot be pushed back. An attempt to push back and end of file character
-- (EOF) is ignored.
-------------------
-- AFCB_Allocate --
-------------------
......@@ -843,6 +879,52 @@ package body Ada.Wide_Text_IO is
return ch;
end Getc_Immed;
-------------------------------
-- Initialize_Standard_Files --
-------------------------------
procedure Initialize_Standard_Files is
begin
Standard_Err.Stream := stderr;
Standard_Err.Name := Err_Name'Access;
Standard_Err.Form := Null_Str'Unrestricted_Access;
Standard_Err.Mode := FCB.Out_File;
Standard_Err.Is_Regular_File := is_regular_file (fileno (stderr)) /= 0;
Standard_Err.Is_Temporary_File := False;
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.Self := Standard_In;
Standard_In.WC_Method := Default_WCEM;
Standard_Out.Stream := stdout;
Standard_Out.Name := Out_Name'Access;
Standard_Out.Form := Null_Str'Unrestricted_Access;
Standard_Out.Mode := FCB.Out_File;
Standard_Out.Is_Regular_File := is_regular_file (fileno (stdout)) /= 0;
Standard_Out.Is_Temporary_File := False;
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.Make_Unbuffered (AP (Standard_Out));
FIO.Make_Unbuffered (AP (Standard_Err));
end Initialize_Standard_Files;
-------------
-- Is_Open --
-------------
......@@ -856,9 +938,9 @@ package body Ada.Wide_Text_IO is
-- Line --
----------
-- Note: we assume that it is impossible in practice for the line
-- to exceed the value of Count'Last, i.e. no check is required for
-- overflow raising layout error.
-- Note: we assume that it is impossible in practice for the line to exceed
-- the value of Count'Last, i.e. no check is required for overflow raising
-- layout error.
function Line (File : File_Type) return Positive_Count is
begin
......@@ -1840,20 +1922,8 @@ package body Ada.Wide_Text_IO is
set_text_mode (fileno (File.Stream));
end Write;
-- Use "preallocated" strings to avoid calling "new" during the
-- elaboration of the run time. This is needed in the tasking case to
-- avoid calling Task_Lock too early. A filename is expected to end with
-- 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;
begin
-------------------------------
-- Initialize Standard Files --
-------------------------------
-- Initialize Standard Files
for J in WC_Encoding_Method loop
if WC_Encoding = WC_Encoding_Letters (J) then
......@@ -1861,51 +1931,10 @@ begin
end if;
end loop;
-- Note: the names in these files are bogus, and probably it would be
-- better for these files to have no names, but the ACVC test insist!
-- We use names that are bound to fail in open etc.
Standard_Err.Stream := stderr;
Standard_Err.Name := Err_Name'Access;
Standard_Err.Form := Null_Str'Unrestricted_Access;
Standard_Err.Mode := FCB.Out_File;
Standard_Err.Is_Regular_File := is_regular_file (fileno (stderr)) /= 0;
Standard_Err.Is_Temporary_File := False;
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.Self := Standard_In;
Standard_In.WC_Method := Default_WCEM;
Standard_Out.Stream := stdout;
Standard_Out.Name := Out_Name'Access;
Standard_Out.Form := Null_Str'Unrestricted_Access;
Standard_Out.Mode := FCB.Out_File;
Standard_Out.Is_Regular_File := is_regular_file (fileno (stdout)) /= 0;
Standard_Out.Is_Temporary_File := False;
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;
Initialize_Standard_Files;
FIO.Chain_File (AP (Standard_In));
FIO.Chain_File (AP (Standard_Out));
FIO.Chain_File (AP (Standard_Err));
FIO.Make_Unbuffered (AP (Standard_Out));
FIO.Make_Unbuffered (AP (Standard_Err));
end Ada.Wide_Text_IO;
gcc/ada/a-witeio.ads
......@@ -42,6 +42,9 @@
with Ada.IO_Exceptions;
with Ada.Streams;
with Interfaces.C_Streams;
with System;
with System.File_Control_Block;
with System.WCh_Con;
......@@ -441,9 +444,6 @@ private
-- The Standard Files --
------------------------
Null_Str : aliased constant String := "";
-- Used as name and form of standard files
Standard_Err_AFCB : aliased Wide_Text_AFCB;
Standard_In_AFCB : aliased Wide_Text_AFCB;
Standard_Out_AFCB : aliased Wide_Text_AFCB;
......@@ -458,26 +458,24 @@ private
Current_Err : aliased File_Type := Standard_Err;
-- Current files
procedure Initialize_Standard_Files;
-- Initializes the file control blocks for the standard files. Called from
-- the elaboration routine for this package, and from Reset_Standard_Files
-- in package Ada.Wide_Text_IO.Reset_Standard_Files.
-----------------------
-- Local Subprograms --
-----------------------
-- These subprograms are in the private part of the spec so that they can
-- be shared by the routines in the body of Ada.Text_IO.Wide_Text_IO.
-- Note: we use Integer in these declarations instead of the more accurate
-- Interfaces.C_Streams.int, because we do not want to drag in the spec of
-- this interfaces package with the spec of Ada.Text_IO, and we know that
-- in fact these types are identical
-- be shared by the children of Ada.Wide_Text_IO.
function Getc (File : File_Type) return Integer;
-- Gets next character from file, which has already been checked for
-- being in read status, and returns the character read if no error
-- occurs. The result is EOF if the end of file was read.
function Getc (File : File_Type) return Interfaces.C_Streams.int;
-- Gets next character from file, which has already been checked for being
-- in read status, and returns the character read if no error occurs. The
-- result is EOF if the end of file was read.
procedure Get_Character
(File : File_Type;
Item : out Character);
procedure Get_Character (File : File_Type; Item : out Character);
-- This is essentially a copy of the normal Get routine from Text_IO. It
-- obtains a single character from the input file File, and places it in
-- Item. This character may be the leading character of a Wide_Character
......@@ -491,25 +489,8 @@ private
-- read and is passed in C. The wide character value is returned as the
-- result, and the file pointer is bumped past the character.
function Nextc (File : File_Type) return Integer;
-- Returns next character from file without skipping past it (i.e. it
-- is a combination of Getc followed by an Ungetc).
procedure Putc (ch : Integer; File : File_Type);
-- Outputs the given character to the file, which has already been
-- checked for being in output status. Device_Error is raised if the
-- character cannot be written.
procedure Terminate_Line (File : File_Type);
-- If the file is in Write_File or Append_File mode, and the current
-- line is not terminated, then a line terminator is written using
-- New_Line. Note that there is no Terminate_Page routine, because
-- the page mark at the end of the file is implied if necessary.
procedure Ungetc (ch : Integer; File : File_Type);
-- Pushes back character into stream, using ungetc. The caller has
-- checked that the file is in read status. Device_Error is raised
-- if the character cannot be pushed back. An attempt to push back
-- and end of file character (EOF) is ignored.
function Nextc (File : File_Type) return Interfaces.C_Streams.int;
-- Returns next character from file without skipping past it (i.e. it is a
-- combination of Getc followed by an Ungetc).
end Ada.Wide_Text_IO;
gcc/ada/a-wrstfi.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- ADA.WIDE_TEXT_IO.RESET_STANDARD_FILES --
-- --
-- B o d y --
-- --
-- Copyright (C) 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 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. --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-------------------------------------------
-- Ada.Wide_Text_IO.Reset_Standard_Files --
-------------------------------------------
procedure Ada.Wide_Text_IO.Reset_Standard_Files is
begin
Ada.Wide_Text_IO.Initialize_Standard_Files;
end Ada.Wide_Text_IO.Reset_Standard_Files;
gcc/ada/a-wrstfi.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- ADA.WIDE_TEXT_IO.RESET_STANDARD_FILES --
-- --
-- S p e c --
-- --
-- Copyright (C) 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 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. --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- This package provides a reset routine that resets the standard files used
-- by Ada.Wide_Text_IO. This is useful in systems such as VxWorks where
-- Ada.Wide_Text_IO is elaborated at the program start, but a system restart
-- may alter the status of these files, resulting in incorrect operation of
-- Wide_Text_IO (in particular if the standard input file is changed to be
-- interactive, then Get_Line may hang looking for an extra character after
-- the end of the line.
procedure Ada.Wide_Text_IO.Reset_Standard_Files;
-- Reset standard Wide_Text_IO files as described above
gcc/ada/a-zrstfi.adb 0 → 100755
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- ADA.WIDE_WIDE_TEXT_IO.RESET_STANDARD_FILES --
-- --
-- B o d y --
-- --
-- Copyright (C) 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 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. --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
------------------------------------------------
-- Ada.Wide_Wide_Text_IO.Reset_Standard_Files --
------------------------------------------------
procedure Ada.Wide_Wide_Text_IO.Reset_Standard_Files is
begin
Ada.Wide_Wide_Text_IO.Initialize_Standard_Files;
end Ada.Wide_Wide_Text_IO.Reset_Standard_Files;
gcc/ada/a-zrstfi.ads 0 → 100755
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- ADA.WIDE_WIDE_TEXT_IO.RESET_STANDARD_FILES --
-- --
-- S p e c --
-- --
-- Copyright (C) 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 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. --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- This package provides a reset routine that resets the standard files used
-- by Ada.Wide_Wide_Text_IO. This is useful in systems such as VxWorks where
-- Ada.Wide_Wide_Text_IO is elaborated at the program start, but a system
-- restart may alter the status of these files, resulting in incorrect
-- operation of Wide_Wide_Text_IO (in particular if the standard input file
-- is changed to be interactive, then Get_Line may hang looking for an extra
-- character after the end of the line.
procedure Ada.Wide_Wide_Text_IO.Reset_Standard_Files;
-- Reset standard Wide_Wide_Text_IO files as described above
gcc/ada/a-ztexio.adb
......@@ -57,26 +57,62 @@ package body Ada.Wide_Wide_Text_IO is
WC_Encoding : Character;
pragma Import (C, WC_Encoding, "__gl_wc_encoding");
-- Default wide character encoding
Err_Name : aliased String := "*stderr" & ASCII.NUL;
In_Name : aliased String := "*stdin" & ASCII.NUL;
Out_Name : aliased String := "*stdout" & ASCII.NUL;
-- Names of standard files
--
-- Use "preallocated" strings to avoid calling "new" during the elaboration
-- of the run time. This is needed in the tasking case to avoid calling
-- Task_Lock too early. A filename is expected to end with a null character
-- in the runtime, here the null characters are added just to have a
-- correct filename length.
--
-- Note: the names for these files are bogus, and probably it would be
-- better for these files to have no names, but the ACVC tests insist!
-- We use names that are bound to fail in open etc.
Null_Str : aliased constant String := "";
-- Used as form string for standard files
-----------------------
-- Local Subprograms --
-----------------------
function Getc_Immed (File : File_Type) return int;
-- This routine is identical to Getc, except that the read is done in
-- Get_Immediate mode (i.e. without waiting for a line return).
function Get_Wide_Wide_Char_Immed
(C : Character;
File : File_Type) return Wide_Wide_Character;
-- This routine is identical to Get_Wide_Wide_Char, except that the reads
-- are done in Get_Immediate mode (i.e. without waiting for a line return).
function Getc_Immed (File : File_Type) return int;
-- This routine is identical to Getc, except that the read is done in
-- Get_Immediate mode (i.e. without waiting for a line return).
procedure Putc (ch : int; File : File_Type);
-- Outputs the given character to the file, which has already been checked
-- for being in output status. Device_Error is raised if the character
-- cannot be written.
procedure Set_WCEM (File : in out File_Type);
-- Called by Open and Create to set the wide character encoding method for
-- the file, processing a WCEM form parameter if one is present. File is
-- IN OUT because it may be closed in case of an error.
procedure Terminate_Line (File : File_Type);
-- If the file is in Write_File or Append_File mode, and the current line
-- is not terminated, then a line terminator is written using New_Line.
-- Note that there is no Terminate_Page routine, because the page mark at
-- the end of the file is implied if necessary.
procedure Ungetc (ch : int; File : File_Type);
-- Pushes back character into stream, using ungetc. The caller has checked
-- that the file is in read status. Device_Error is raised if the character
-- cannot be pushed back. An attempt to push back and end of file character
-- (EOF) is ignored.
-------------------
-- AFCB_Allocate --
-------------------
......@@ -843,6 +879,52 @@ package body Ada.Wide_Wide_Text_IO is
return ch;
end Getc_Immed;
-------------------------------
-- Initialize_Standard_Files --
-------------------------------
procedure Initialize_Standard_Files is
begin
Standard_Err.Stream := stderr;
Standard_Err.Name := Err_Name'Access;
Standard_Err.Form := Null_Str'Unrestricted_Access;
Standard_Err.Mode := FCB.Out_File;
Standard_Err.Is_Regular_File := is_regular_file (fileno (stderr)) /= 0;
Standard_Err.Is_Temporary_File := False;
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.Self := Standard_In;
Standard_In.WC_Method := Default_WCEM;
Standard_Out.Stream := stdout;
Standard_Out.Name := Out_Name'Access;
Standard_Out.Form := Null_Str'Unrestricted_Access;
Standard_Out.Mode := FCB.Out_File;
Standard_Out.Is_Regular_File := is_regular_file (fileno (stdout)) /= 0;
Standard_Out.Is_Temporary_File := False;
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.Make_Unbuffered (AP (Standard_Out));
FIO.Make_Unbuffered (AP (Standard_Err));
end Initialize_Standard_Files;
-------------
-- Is_Open --
-------------
......@@ -1840,20 +1922,8 @@ package body Ada.Wide_Wide_Text_IO is
set_text_mode (fileno (File.Stream));
end Write;
-- Use "preallocated" strings to avoid calling "new" during the
-- elaboration of the run time. This is needed in the tasking case to
-- avoid calling Task_Lock too early. A filename is expected to end with
-- 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;
begin
-------------------------------
-- Initialize Standard Files --
-------------------------------
-- Initialize Standard Files
for J in WC_Encoding_Method loop
if WC_Encoding = WC_Encoding_Letters (J) then
......@@ -1861,51 +1931,10 @@ begin
end if;
end loop;
-- Note: the names in these files are bogus, and probably it would be
-- better for these files to have no names, but the ACVC test insist!
-- We use names that are bound to fail in open etc.
Standard_Err.Stream := stderr;
Standard_Err.Name := Err_Name'Access;
Standard_Err.Form := Null_Str'Unrestricted_Access;
Standard_Err.Mode := FCB.Out_File;
Standard_Err.Is_Regular_File := is_regular_file (fileno (stderr)) /= 0;
Standard_Err.Is_Temporary_File := False;
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.Self := Standard_In;
Standard_In.WC_Method := Default_WCEM;
Standard_Out.Stream := stdout;
Standard_Out.Name := Out_Name'Access;
Standard_Out.Form := Null_Str'Unrestricted_Access;
Standard_Out.Mode := FCB.Out_File;
Standard_Out.Is_Regular_File := is_regular_file (fileno (stdout)) /= 0;
Standard_Out.Is_Temporary_File := False;
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;
Initialize_Standard_Files;
FIO.Chain_File (AP (Standard_In));
FIO.Chain_File (AP (Standard_Out));
FIO.Chain_File (AP (Standard_Err));
FIO.Make_Unbuffered (AP (Standard_Out));
FIO.Make_Unbuffered (AP (Standard_Err));
end Ada.Wide_Wide_Text_IO;
gcc/ada/a-ztexio.ads
......@@ -42,6 +42,9 @@
with Ada.IO_Exceptions;
with Ada.Streams;
with Interfaces.C_Streams;
with System;
with System.File_Control_Block;
with System.WCh_Con;
......@@ -357,13 +360,13 @@ private
PM : constant := Character'Pos (ASCII.FF);
-- Used as page mark, except at end of file where it is implied
-------------------------------------
------------------------------------------
-- Wide_Wide_Text_IO File Control Block --
-------------------------------------
------------------------------------------
Default_WCEM : WCh_Con.WC_Encoding_Method := WCh_Con.WCEM_UTF8;
-- This gets modified during initialization (see body) using
-- the default value established in the call to Set_Globals.
-- This gets modified during initialization (see body) using the default
-- value established in the call to Set_Globals.
package FCB renames System.File_Control_Block;
......@@ -443,9 +446,6 @@ private
-- The Standard Files --
------------------------
Null_Str : aliased constant String := "";
-- Used as name and form of standard files
Standard_Err_AFCB : aliased Wide_Wide_Text_AFCB;
Standard_In_AFCB : aliased Wide_Wide_Text_AFCB;
Standard_Out_AFCB : aliased Wide_Wide_Text_AFCB;
......@@ -460,31 +460,28 @@ private
Current_Err : aliased File_Type := Standard_Err;
-- Current files
procedure Initialize_Standard_Files;
-- Initializes the file control blocks for the standard files. Called from
-- the elaboration routine for this package, and from Reset_Standard_Files
-- in package Ada.Wide_Wide_Text_IO.Reset_Standard_Files.
-----------------------
-- Local Subprograms --
-----------------------
-- These subprograms are in the private part of the spec so that they can
-- be shared by the routines in the body of Ada.Text_IO.Wide_Wide_Text_IO.
-- Note: we use Integer in these declarations instead of the more accurate
-- Interfaces.C_Streams.int, because we do not want to drag in the spec of
-- this interfaces package with the spec of Ada.Text_IO, and we know that
-- in fact these types are identical
-- be shared by the children of Ada.Text_IO.Wide_Wide_Text_IO.
function Getc (File : File_Type) return Integer;
-- Gets next character from file, which has already been checked for
-- being in read status, and returns the character read if no error
-- occurs. The result is EOF if the end of file was read.
function Getc (File : File_Type) return Interfaces.C_Streams.int;
-- Gets next character from file, which has already been checked for being
-- in read status, and returns the character read if no error occurs. The
-- result is EOF if the end of file was read.
procedure Get_Character
(File : File_Type;
Item : out Character);
-- This is essentially a copy of the normal Get routine from Text_IO. It
procedure Get_Character (File : File_Type; Item : out Character);
-- This is essentially copy of Wide_Wide_Text_IO.Get. It obtains a single
-- obtains a single character from the input file File, and places it in
-- Item. This character may be the leading character of a
-- Wide_Wide_Character sequence, but that is up to the caller to deal
-- with.
-- Item. This result may be the leading character of a Wide_Wide_Character
-- sequence, but that is up to the caller to deal with.
function Get_Wide_Wide_Char
(C : Character;
......@@ -494,25 +491,8 @@ private
-- read and is passed in C. The wide character value is returned as the
-- result, and the file pointer is bumped past the character.
function Nextc (File : File_Type) return Integer;
-- Returns next character from file without skipping past it (i.e. it
-- is a combination of Getc followed by an Ungetc).
procedure Putc (ch : Integer; File : File_Type);
-- Outputs the given character to the file, which has already been
-- checked for being in output status. Device_Error is raised if the
-- character cannot be written.
procedure Terminate_Line (File : File_Type);
-- If the file is in Write_File or Append_File mode, and the current
-- line is not terminated, then a line terminator is written using
-- New_Line. Note that there is no Terminate_Page routine, because
-- the page mark at the end of the file is implied if necessary.
procedure Ungetc (ch : Integer; File : File_Type);
-- Pushes back character into stream, using ungetc. The caller has
-- checked that the file is in read status. Device_Error is raised
-- if the character cannot be pushed back. An attempt to push back
-- and end of file character (EOF) is ignored.
function Nextc (File : File_Type) return Interfaces.C_Streams.int;
-- Returns next character from file without skipping past it (i.e. it is a
-- combination of Getc followed by an Ungetc).
end Ada.Wide_Wide_Text_IO;
gcc/ada/exp_ch4.adb
......@@ -8065,20 +8065,9 @@ package body Exp_Ch4 is
Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
Expression => Relocate_Node (Left_Opnd (Operand)));
case Nkind (Operand) is
when N_Op_Add =>
Opnd := Make_Op_Add (Loc, L, R);
when N_Op_Divide =>
Opnd := Make_Op_Divide (Loc, L, R);
when N_Op_Expon =>
Opnd := Make_Op_Expon (Loc, L, R);
when N_Op_Multiply =>
Opnd := Make_Op_Multiply (Loc, L, R);
when N_Op_Subtract =>
Opnd := Make_Op_Subtract (Loc, L, R);
when others =>
raise Program_Error;
end case;
Opnd := New_Op_Node (Nkind (Operand), Loc);
Set_Left_Opnd (Opnd, L);
Set_Right_Opnd (Opnd, R);
Rewrite (N,
Make_Type_Conversion (Loc,
......
gcc/ada/exp_ch9.ads
......@@ -173,8 +173,8 @@ package Exp_Ch9 is
-- meaning is to get the Task_Id for the currently executing task.
function Convert_Concurrent
(N : Node_Id;
Typ : Entity_Id) return Node_Id;
(N : Node_Id;
Typ : Entity_Id) return Node_Id;
-- N is an expression of type Typ. If the type is not a concurrent type
-- then it is returned unchanged. If it is a task or protected reference,
-- Convert_Concurrent creates an unchecked conversion node from this
......
gcc/ada/gnat_rm.texi
......@@ -307,10 +307,13 @@ The GNAT Library
* Ada.Strings.Wide_Unbounded.Wide_Text_IO (a-swuwti.ads)::
* Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO (a-szuzti.ads)::
* Ada.Text_IO.C_Streams (a-tiocst.ads)::
* Ada.Text_IO.Reset_Standard_Files (a-tirsfi.ads)::
* Ada.Wide_Characters.Unicode (a-wichun.ads)::
* Ada.Wide_Text_IO.C_Streams (a-wtcstr.ads)::
* Ada.Wide_Text_IO.Reset_Standard_Files (a-wrstfi.ads)::
* Ada.Wide_Wide_Characters.Unicode (a-zchuni.ads)::
* Ada.Wide_Wide_Text_IO.C_Streams (a-ztcstr.ads)::
* Ada.Wide_Wide_Text_IO.Reset_Standard_Files (a-zrstfi.ads)::
* GNAT.Altivec (g-altive.ads)::
* GNAT.Altivec.Conversions (g-altcon.ads)::
* GNAT.Altivec.Vector_Operations (g-alveop.ads)::
......@@ -13496,10 +13499,13 @@ of GNAT, and will generate a warning message.
* Ada.Strings.Wide_Unbounded.Wide_Text_IO (a-swuwti.ads)::
* Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO (a-szuzti.ads)::
* Ada.Text_IO.C_Streams (a-tiocst.ads)::
* Ada.Text_IO.Reset_Standard_Files (a-tirsfi.ads)::
* Ada.Wide_Characters.Unicode (a-wichun.ads)::
* Ada.Wide_Text_IO.C_Streams (a-wtcstr.ads)::
* Ada.Wide_Text_IO.Reset_Standard_Files (a-wrstfi.ads)::
* Ada.Wide_Wide_Characters.Unicode (a-zchuni.ads)::
* Ada.Wide_Wide_Text_IO.C_Streams (a-ztcstr.ads)::
* Ada.Wide_Wide_Text_IO.Reset_Standard_Files (a-zrstfi.ads)::
* GNAT.Altivec (g-altive.ads)::
* GNAT.Altivec.Conversions (g-altcon.ads)::
* GNAT.Altivec.Vector_Operations (g-alveop.ads)::
......@@ -13819,6 +13825,18 @@ C streams and @code{Text_IO}. The stream identifier can be
extracted from a file opened on the Ada side, and an Ada file
can be constructed from a stream opened on the C side.
@node Ada.Text_IO.Reset_Standard_Files (a-tirsfi.ads)
@section @code{Ada.Text_IO.Reset_Standard_Files} (@file{a-tirsfi.ads})
@cindex @code{Ada.Text_IO.Reset_Standard_Files} (@file{a-tirsfi.ads})
@cindex @code{Text_IO} resetting standard files
@noindent
This procedure is used to reset the status of the standard files used
by Ada.Text_IO. This is useful in a situation (such as a restart in an
embedded application) where the status of the files may change during
execution (for example a standard input file may be redefined to be
interactive).
@node Ada.Wide_Characters.Unicode (a-wichun.ads)
@section @code{Ada.Wide_Characters.Unicode} (@file{a-wichun.ads})
@cindex @code{Ada.Wide_Characters.Unicode} (@file{a-wichun.ads})
......@@ -13839,6 +13857,18 @@ C streams and @code{Wide_Text_IO}. The stream identifier can be
extracted from a file opened on the Ada side, and an Ada file
can be constructed from a stream opened on the C side.
@node Ada.Wide_Text_IO.Reset_Standard_Files (a-wrstfi.ads)
@section @code{Ada.Wide_Text_IO.Reset_Standard_Files} (@file{a-wrstfi.ads})
@cindex @code{Ada.Wide_Text_IO.Reset_Standard_Files} (@file{a-wrstfi.ads})
@cindex @code{Wide_Text_IO} resetting standard files
@noindent
This procedure is used to reset the status of the standard files used
by Ada.Wide_Text_IO. This is useful in a situation (such as a restart in an
embedded application) where the status of the files may change during
execution (for example a standard input file may be redefined to be
interactive).
@node Ada.Wide_Wide_Characters.Unicode (a-zchuni.ads)
@section @code{Ada.Wide_Wide_Characters.Unicode} (@file{a-zchuni.ads})
@cindex @code{Ada.Wide_Wide_Characters.Unicode} (@file{a-zchuni.ads})
......@@ -13859,6 +13889,18 @@ C streams and @code{Wide_Wide_Text_IO}. The stream identifier can be
extracted from a file opened on the Ada side, and an Ada file
can be constructed from a stream opened on the C side.
@node Ada.Wide_Wide_Text_IO.Reset_Standard_Files (a-zrstfi.ads)
@section @code{Ada.Wide_Wide_Text_IO.Reset_Standard_Files} (@file{a-zrstfi.ads})
@cindex @code{Ada.Wide_Wide_Text_IO.Reset_Standard_Files} (@file{a-zrstfi.ads})
@cindex @code{Wide_Wide_Text_IO} resetting standard files
@noindent
This procedure is used to reset the status of the standard files used
by Ada.Wide_Wide_Text_IO. This is useful in a situation (such as a
restart in an embedded application) where the status of the files may
change during execution (for example a standard input file may be
redefined to be interactive).
@node GNAT.Altivec (g-altive.ads)
@section @code{GNAT.Altivec} (@file{g-altive.ads})
@cindex @code{GNAT.Altivec} (@file{g-altive.ads})
......
gcc/ada/par-ch4.adb
......@@ -89,9 +89,6 @@ package body Ch4 is
-- prefix. The current token is known to be an apostrophe and the
-- following token is known to be RANGE.
procedure Set_Op_Name (Node : Node_Id);
-- Procedure to set name field (Chars) in operator node
-------------------------
-- Bad_Range_Attribute --
-------------------------
......@@ -102,51 +99,6 @@ package body Ch4 is
Resync_Expression;
end Bad_Range_Attribute;
------------------
-- Set_Op_Name --
------------------
procedure Set_Op_Name (Node : Node_Id) is
type Name_Of_Type is array (N_Op) of Name_Id;
Name_Of : constant Name_Of_Type := Name_Of_Type'(
N_Op_And => Name_Op_And,
N_Op_Or => Name_Op_Or,
N_Op_Xor => Name_Op_Xor,
N_Op_Eq => Name_Op_Eq,
N_Op_Ne => Name_Op_Ne,
N_Op_Lt => Name_Op_Lt,
N_Op_Le => Name_Op_Le,
N_Op_Gt => Name_Op_Gt,
N_Op_Ge => Name_Op_Ge,
N_Op_Add => Name_Op_Add,
N_Op_Subtract => Name_Op_Subtract,
N_Op_Concat => Name_Op_Concat,
N_Op_Multiply => Name_Op_Multiply,
N_Op_Divide => Name_Op_Divide,
N_Op_Mod => Name_Op_Mod,
N_Op_Rem => Name_Op_Rem,
N_Op_Expon => Name_Op_Expon,
N_Op_Plus => Name_Op_Add,
N_Op_Minus => Name_Op_Subtract,
N_Op_Abs => Name_Op_Abs,
N_Op_Not => Name_Op_Not,
-- We don't really need these shift operators, since they never
-- appear as operators in the source, but the path of least
-- resistance is to put them in (the aggregate must be complete)
N_Op_Rotate_Left => Name_Rotate_Left,
N_Op_Rotate_Right => Name_Rotate_Right,
N_Op_Shift_Left => Name_Shift_Left,
N_Op_Shift_Right => Name_Shift_Right,
N_Op_Shift_Right_Arithmetic => Name_Shift_Right_Arithmetic);
begin
if Nkind (Node) in N_Op then
Set_Chars (Node, Name_Of (Nkind (Node)));
end if;
end Set_Op_Name;
--------------------------
-- 4.1 Name (also 6.4) --
--------------------------
......@@ -1600,10 +1552,9 @@ package body Ch4 is
end if;
Node2 := Node1;
Node1 := New_Node (Logical_Op, Op_Location);
Node1 := New_Op_Node (Logical_Op, Op_Location);
Set_Left_Opnd (Node1, Node2);
Set_Right_Opnd (Node1, P_Relation);
Set_Op_Name (Node1);
exit when Token not in Token_Class_Logop;
end loop;
......@@ -1704,10 +1655,9 @@ package body Ch4 is
end if;
Node2 := Node1;
Node1 := New_Node (Logical_Op, Op_Location);
Node1 := New_Op_Node (Logical_Op, Op_Location);
Set_Left_Opnd (Node1, Node2);
Set_Right_Opnd (Node1, P_Relation);
Set_Op_Name (Node1);
exit when Token not in Token_Class_Logop;
end loop;
......@@ -1768,9 +1718,8 @@ package body Ch4 is
-- P_Relational_Operator also parses the IN and NOT IN operations.
Optok := Token_Ptr;
Node2 := New_Node (P_Relational_Operator, Optok);
Node2 := New_Op_Node (P_Relational_Operator, Optok);
Set_Left_Opnd (Node2, Node1);
Set_Op_Name (Node2);
-- Case of IN or NOT IN
......@@ -1881,18 +1830,17 @@ package body Ch4 is
Style.Check_Exponentiation_Operator;
end if;
Node2 := New_Node (N_Op_Expon, Token_Ptr);
Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
Scan; -- past **
Set_Left_Opnd (Node2, Node1);
Set_Right_Opnd (Node2, P_Primary);
Set_Op_Name (Node2);
Node1 := Node2;
end if;
loop
exit when Token not in Token_Class_Mulop;
Tokptr := Token_Ptr;
Node2 := New_Node (P_Multiplying_Operator, Tokptr);
Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
if Style_Check then
Style.Check_Binary_Operator;
......@@ -1901,14 +1849,13 @@ package body Ch4 is
Scan; -- past operator
Set_Left_Opnd (Node2, Node1);
Set_Right_Opnd (Node2, P_Factor);
Set_Op_Name (Node2);
Node1 := Node2;
end loop;
loop
exit when Token not in Token_Class_Binary_Addop;
Tokptr := Token_Ptr;
Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
if Style_Check then
Style.Check_Binary_Operator;
......@@ -1917,7 +1864,6 @@ package body Ch4 is
Scan; -- past operator
Set_Left_Opnd (Node2, Node1);
Set_Right_Opnd (Node2, P_Term);
Set_Op_Name (Node2);
Node1 := Node2;
end loop;
......@@ -1931,7 +1877,7 @@ package body Ch4 is
if Token in Token_Class_Unary_Addop then
Tokptr := Token_Ptr;
Node1 := New_Node (P_Unary_Adding_Operator, Tokptr);
Node1 := New_Op_Node (P_Unary_Adding_Operator, Tokptr);
if Style_Check then
Style.Check_Unary_Plus_Or_Minus;
......@@ -1939,7 +1885,6 @@ package body Ch4 is
Scan; -- past operator
Set_Right_Opnd (Node1, P_Term);
Set_Op_Name (Node1);
else
Node1 := P_Term;
end if;
......@@ -1981,12 +1926,11 @@ package body Ch4 is
loop
exit when Token not in Token_Class_Binary_Addop;
Tokptr := Token_Ptr;
Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
Scan; -- past operator
Set_Left_Opnd (Node2, Node1);
Node1 := P_Term;
Set_Right_Opnd (Node2, Node1);
Set_Op_Name (Node2);
-- Check if we're still concatenating string literals
......@@ -2214,11 +2158,10 @@ package body Ch4 is
loop
exit when Token not in Token_Class_Mulop;
Tokptr := Token_Ptr;
Node2 := New_Node (P_Multiplying_Operator, Tokptr);
Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
Scan; -- past operator
Set_Left_Opnd (Node2, Node1);
Set_Right_Opnd (Node2, P_Factor);
Set_Op_Name (Node2);
Node1 := Node2;
end loop;
......@@ -2239,7 +2182,7 @@ package body Ch4 is
begin
if Token = Tok_Abs then
Node1 := New_Node (N_Op_Abs, Token_Ptr);
Node1 := New_Op_Node (N_Op_Abs, Token_Ptr);
if Style_Check then
Style.Check_Abs_Not;
......@@ -2247,11 +2190,10 @@ package body Ch4 is
Scan; -- past ABS
Set_Right_Opnd (Node1, P_Primary);
Set_Op_Name (Node1);
return Node1;
elsif Token = Tok_Not then
Node1 := New_Node (N_Op_Not, Token_Ptr);
Node1 := New_Op_Node (N_Op_Not, Token_Ptr);
if Style_Check then
Style.Check_Abs_Not;
......@@ -2259,18 +2201,16 @@ package body Ch4 is
Scan; -- past NOT
Set_Right_Opnd (Node1, P_Primary);
Set_Op_Name (Node1);
return Node1;
else
Node1 := P_Primary;
if Token = Tok_Double_Asterisk then
Node2 := New_Node (N_Op_Expon, Token_Ptr);
Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
Scan; -- past **
Set_Left_Opnd (Node2, Node1);
Set_Right_Opnd (Node2, P_Primary);
Set_Op_Name (Node2);
return Node2;
else
return Node1;
......
gcc/ada/sem_attr.adb
......@@ -667,8 +667,8 @@ package body Sem_Attr is
end loop;
if Present (Q) then
Set_Has_Per_Object_Constraint (
Defining_Identifier (Q), True);
Set_Has_Per_Object_Constraint
(Defining_Identifier (Q), True);
end if;
end;
......@@ -1991,9 +1991,10 @@ package body Sem_Attr is
-- entry wrappers, the attributes Count, Caller and AST_Entry require
-- a context check
if Aname = Name_Count
or else Aname = Name_Caller
or else Aname = Name_AST_Entry
if Ada_Version >= Ada_05
and then (Aname = Name_Count
or else Aname = Name_Caller
or else Aname = Name_AST_Entry)
then
declare
Count : Natural := 0;
......
gcc/ada/sem_ch3.adb
......@@ -784,7 +784,7 @@ package body Sem_Ch3 is
Anon_Type :=
Create_Itype
(E_Anonymous_Access_Type, Related_Nod, Scope_Id => Anon_Scope);
(E_Anonymous_Access_Type, Related_Nod, Scope_Id => Anon_Scope);
if All_Present (N)
and then Ada_Version >= Ada_05
......@@ -825,8 +825,7 @@ package body Sem_Ch3 is
Find_Type (Subtype_Mark (N));
Desig_Type := Entity (Subtype_Mark (N));
Set_Directly_Designated_Type
(Anon_Type, Desig_Type);
Set_Directly_Designated_Type (Anon_Type, Desig_Type);
Set_Etype (Anon_Type, Anon_Type);
-- Make sure the anonymous access type has size and alignment fields
......@@ -2883,12 +2882,11 @@ package body Sem_Ch3 is
Apply_Length_Check (E, T);
end if;
-- If the type is limited unconstrained with defaulted discriminants
-- and there is no expression, then the object is constrained by the
-- If the type is limited unconstrained with defaulted discriminants and
-- there is no expression, then the object is constrained by the
-- defaults, so it is worthwhile building the corresponding subtype.
elsif (Is_Limited_Record (T)
or else Is_Concurrent_Type (T))
elsif (Is_Limited_Record (T) or else Is_Concurrent_Type (T))
and then not Is_Constrained (T)
and then Has_Discriminants (T)
then
......
gcc/ada/tbuild.adb
......@@ -33,7 +33,6 @@ with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
with Sem_Aux; use Sem_Aux;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
......@@ -626,6 +625,56 @@ package body Tbuild is
return Occurrence;
end New_Occurrence_Of;
-----------------
-- New_Op_Node --
-----------------
function New_Op_Node
(New_Node_Kind : Node_Kind;
New_Sloc : Source_Ptr) return Node_Id
is
type Name_Of_Type is array (N_Op) of Name_Id;
Name_Of : constant Name_Of_Type := Name_Of_Type'(
N_Op_And => Name_Op_And,
N_Op_Or => Name_Op_Or,
N_Op_Xor => Name_Op_Xor,
N_Op_Eq => Name_Op_Eq,
N_Op_Ne => Name_Op_Ne,
N_Op_Lt => Name_Op_Lt,
N_Op_Le => Name_Op_Le,
N_Op_Gt => Name_Op_Gt,
N_Op_Ge => Name_Op_Ge,
N_Op_Add => Name_Op_Add,
N_Op_Subtract => Name_Op_Subtract,
N_Op_Concat => Name_Op_Concat,
N_Op_Multiply => Name_Op_Multiply,
N_Op_Divide => Name_Op_Divide,
N_Op_Mod => Name_Op_Mod,
N_Op_Rem => Name_Op_Rem,
N_Op_Expon => Name_Op_Expon,
N_Op_Plus => Name_Op_Add,
N_Op_Minus => Name_Op_Subtract,
N_Op_Abs => Name_Op_Abs,
N_Op_Not => Name_Op_Not,
-- We don't really need these shift operators, since they never
-- appear as operators in the source, but the path of least
-- resistance is to put them in (the aggregate must be complete)
N_Op_Rotate_Left => Name_Rotate_Left,
N_Op_Rotate_Right => Name_Rotate_Right,
N_Op_Shift_Left => Name_Shift_Left,
N_Op_Shift_Right => Name_Shift_Right,
N_Op_Shift_Right_Arithmetic => Name_Shift_Right_Arithmetic);
Nod : constant Node_Id := New_Node (New_Node_Kind, New_Sloc);
begin
if New_Node_Kind in Name_Of'Range then
Set_Chars (Nod, Name_Of (New_Node_Kind));
end if;
return Nod;
end New_Op_Node;
----------------------
-- New_Reference_To --
----------------------
......
gcc/ada/tbuild.ads
......@@ -27,6 +27,7 @@
-- building specific types of tree nodes.
with Namet; use Namet;
with Sinfo; use Sinfo;
with Types; use Types;
package Tbuild is
......@@ -196,6 +197,12 @@ package Tbuild is
-- "raise Constraint_Error" and returns the root of this tree,
-- the N_Raise_Statement node.
function New_Op_Node
(New_Node_Kind : Node_Kind;
New_Sloc : Source_Ptr) return Node_Id;
-- Create node using New_Node and, if its kind is in N_Op, set its Chars
-- field accordingly.
function New_External_Name
(Related_Id : Name_Id;
Suffix : Character := ' ';
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment