diff options
Diffstat (limited to 'gcc-4.2.1/gcc/ada/a-tienau.adb')
| -rw-r--r-- | gcc-4.2.1/gcc/ada/a-tienau.adb | 262 |
1 files changed, 0 insertions, 262 deletions
diff --git a/gcc-4.2.1/gcc/ada/a-tienau.adb b/gcc-4.2.1/gcc/ada/a-tienau.adb deleted file mode 100644 index aadb479ec..000000000 --- a/gcc-4.2.1/gcc/ada/a-tienau.adb +++ /dev/null @@ -1,262 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- A D A . T E X T _ I O . E N U M E R A T I O N _ A U X -- --- -- --- B o d y -- --- -- --- 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- -- --- ware Foundation; either version 2, 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. -- --- -- --- 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. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux; -with Ada.Characters.Handling; use Ada.Characters.Handling; - --- Note: this package does not yet deal properly with wide characters ??? - -package body Ada.Text_IO.Enumeration_Aux is - - ------------------ - -- Get_Enum_Lit -- - ------------------ - - procedure Get_Enum_Lit - (File : File_Type; - Buf : out String; - Buflen : out Natural) - is - ch : Integer; - C : Character; - - begin - Buflen := 0; - Load_Skip (File); - ch := Getc (File); - C := Character'Val (ch); - - -- Character literal case. If the initial character is a quote, then - -- we read as far as we can without backup (see ACVC test CE3905L) - - if C = ''' then - Store_Char (File, ch, Buf, Buflen); - - ch := Getc (File); - - if ch in 16#20# .. 16#7E# or else ch >= 16#80# then - Store_Char (File, ch, Buf, Buflen); - - ch := Getc (File); - - if ch = Character'Pos (''') then - Store_Char (File, ch, Buf, Buflen); - else - Ungetc (ch, File); - end if; - - else - Ungetc (ch, File); - end if; - - -- Similarly for identifiers, read as far as we can, in particular, - -- do read a trailing underscore (again see ACVC test CE3905L to - -- understand why we do this, although it seems somewhat peculiar). - - else - -- Identifier must start with a letter - - if not Is_Letter (C) then - Ungetc (ch, File); - return; - end if; - - -- If we do have a letter, loop through the characters quitting on - -- the first non-identifier character (note that this includes the - -- cases of hitting a line mark or page mark). - - loop - C := Character'Val (ch); - Store_Char (File, Character'Pos (To_Upper (C)), Buf, Buflen); - - ch := Getc (File); - exit when ch = EOF_Char; - C := Character'Val (ch); - - exit when not Is_Letter (C) - and then not Is_Digit (C) - and then C /= '_'; - - exit when C = '_' - and then Buf (Buflen) = '_'; - end loop; - - Ungetc (ch, File); - end if; - end Get_Enum_Lit; - - --------- - -- Put -- - --------- - - procedure Put - (File : File_Type; - Item : String; - Width : Field; - Set : Type_Set) - is - Actual_Width : constant Count := Count'Max (Count (Width), Item'Length); - - begin - if Set = Lower_Case and then Item (1) /= ''' then - declare - Iteml : String (Item'First .. Item'Last); - - begin - for J in Item'Range loop - Iteml (J) := To_Lower (Item (J)); - end loop; - - Put_Item (File, Iteml); - end; - - else - Put_Item (File, Item); - end if; - - for J in 1 .. Actual_Width - Item'Length loop - Put (File, ' '); - end loop; - end Put; - - ---------- - -- Puts -- - ---------- - - procedure Puts - (To : out String; - Item : String; - Set : Type_Set) - is - Ptr : Natural; - - begin - if Item'Length > To'Length then - raise Layout_Error; - - else - Ptr := To'First; - for J in Item'Range loop - if Set = Lower_Case and then Item (1) /= ''' then - To (Ptr) := To_Lower (Item (J)); - else - To (Ptr) := Item (J); - end if; - - Ptr := Ptr + 1; - end loop; - - while Ptr <= To'Last loop - To (Ptr) := ' '; - Ptr := Ptr + 1; - end loop; - end if; - end Puts; - - ------------------- - -- Scan_Enum_Lit -- - ------------------- - - procedure Scan_Enum_Lit - (From : String; - Start : out Natural; - Stop : out Natural) - is - C : Character; - - -- Processing for Scan_Enum_Lit - - begin - String_Skip (From, Start); - - -- Character literal case. If the initial character is a quote, then - -- we read as far as we can without backup (see ACVC test CE3905L - -- which is for the analogous case for reading from a file). - - if From (Start) = ''' then - Stop := Start; - - if Stop = From'Last then - raise Data_Error; - else - Stop := Stop + 1; - end if; - - if From (Stop) in ' ' .. '~' - or else From (Stop) >= Character'Val (16#80#) - then - if Stop = From'Last then - raise Data_Error; - else - Stop := Stop + 1; - - if From (Stop) = ''' then - return; - end if; - end if; - end if; - - raise Data_Error; - - -- Similarly for identifiers, read as far as we can, in particular, - -- do read a trailing underscore (again see ACVC test CE3905L to - -- understand why we do this, although it seems somewhat peculiar). - - else - -- Identifier must start with a letter - - if not Is_Letter (From (Start)) then - raise Data_Error; - end if; - - -- If we do have a letter, loop through the characters quitting on - -- the first non-identifier character (note that this includes the - -- cases of hitting a line mark or page mark). - - Stop := Start; - while Stop < From'Last loop - C := From (Stop + 1); - - exit when not Is_Letter (C) - and then not Is_Digit (C) - and then C /= '_'; - - exit when C = '_' - and then From (Stop) = '_'; - - Stop := Stop + 1; - end loop; - end if; - end Scan_Enum_Lit; - -end Ada.Text_IO.Enumeration_Aux; |