OSDN Git Service

2009-07-22 Robert Dewar <dewar@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / csets.adb
index 9bf755a..cd3e0b5 100644 (file)
@@ -6,30 +6,26 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision$
---                                                                          --
---          Copyright (C) 1992-2001, 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,  59 Temple Place - Suite 330,  Boston, --
--- MA 02111-1307, USA.                                                      --
+-- 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.               --
 --                                                                          --
--- 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.                                      --
+-- 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. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
 --                                                                          --
 ------------------------------------------------------------------------------
 
@@ -168,11 +164,11 @@ package body Csets is
    X_FE : constant Character := Character'Val (16#FE#);
    X_FF : constant Character := Character'Val (16#FF#);
 
-   -----------------------------
-   -- Definitions for Latin-1 --
-   -----------------------------
+   ------------------------------------------
+   -- Definitions for Latin-1 (ISO 8859-1) --
+   ------------------------------------------
 
-   Fold_Latin_1 : Translate_Table := Translate_Table'(
+   Fold_Latin_1 : constant Translate_Table := Translate_Table'(
 
       'a' => 'A',  X_E0 => X_C0,  X_F0 => X_D0,
       'b' => 'B',  X_E1 => X_C1,  X_F1 => X_D1,
@@ -243,11 +239,11 @@ package body Csets is
 
       others => ' ');
 
-   -----------------------------
-   -- Definitions for Latin-2 --
-   -----------------------------
+   ------------------------------------------
+   -- Definitions for Latin-2 (ISO 8859-2) --
+   ------------------------------------------
 
-   Fold_Latin_2 : Translate_Table := Translate_Table'(
+   Fold_Latin_2 : constant Translate_Table := Translate_Table'(
 
       'a' => 'A',  X_E0 => X_C0,  X_F0 => X_D0,
       'b' => 'B',  X_E1 => X_C1,  X_F1 => X_D1,  X_B1 => X_A1,
@@ -318,11 +314,11 @@ package body Csets is
 
       others => ' ');
 
-   -----------------------------
-   -- Definitions for Latin-3 --
-   -----------------------------
+   ------------------------------------------
+   -- Definitions for Latin-3 (ISO 8859-3) --
+   ------------------------------------------
 
-   Fold_Latin_3 : Translate_Table := Translate_Table'(
+   Fold_Latin_3 : constant Translate_Table := Translate_Table'(
 
       'a' => 'A',  X_E0 => X_C0,
       'b' => 'B',  X_E1 => X_C1,  X_F1 => X_D1,  X_B1 => X_A1,
@@ -393,11 +389,11 @@ package body Csets is
 
       others => ' ');
 
-   -----------------------------
-   -- Definitions for Latin-4 --
-   -----------------------------
+   ------------------------------------------
+   -- Definitions for Latin-4 (ISO 8859-4) --
+   ------------------------------------------
 
-   Fold_Latin_4 : Translate_Table := Translate_Table'(
+   Fold_Latin_4 : constant Translate_Table := Translate_Table'(
 
       'a' => 'A',  X_E0 => X_C0,  X_F0 => X_D0,
       'b' => 'B',  X_E1 => X_C1,  X_F1 => X_D1,  X_B1 => X_A1,
@@ -472,7 +468,7 @@ package body Csets is
    -- Definitions for Latin-5 (Cyrillic ISO-8859-5) --
    ---------------------------------------------------
 
-   Fold_Latin_5 : Translate_Table := Translate_Table'(
+   Fold_Latin_5 : constant Translate_Table := Translate_Table'(
 
       'a' => 'A',  X_D0 => X_B0,  X_E0 => X_C0,
       'b' => 'B',  X_D1 => X_B1,  X_E1 => X_C1,  X_F1 => X_A1,
@@ -543,6 +539,81 @@ package body Csets is
 
       others => ' ');
 
+   ------------------------------------------
+   -- Definitions for Latin-9 (ISO 8859-9) --
+   ------------------------------------------
+
+   Fold_Latin_9 : constant Translate_Table := Translate_Table'(
+
+      'a' => 'A',  X_E0 => X_C0,  X_F0 => X_D0,
+      'b' => 'B',  X_E1 => X_C1,  X_F1 => X_D1,
+      'c' => 'C',  X_E2 => X_C2,  X_F2 => X_D2,
+      'd' => 'D',  X_E3 => X_C3,  X_F3 => X_D3,
+      'e' => 'E',  X_E4 => X_C4,  X_F4 => X_D4,
+      'f' => 'F',  X_E5 => X_C5,  X_F5 => X_D5,
+      'g' => 'G',  X_E6 => X_C6,  X_F6 => X_D6,
+      'h' => 'H',  X_E7 => X_C7,
+      'i' => 'I',  X_E8 => X_C8,  X_F8 => X_D8,
+      'j' => 'J',  X_E9 => X_C9,  X_F9 => X_D9,
+      'k' => 'K',  X_EA => X_CA,  X_FA => X_DA,
+      'l' => 'L',  X_EB => X_CB,  X_FB => X_DB,
+      'm' => 'M',  X_EC => X_CC,  X_FC => X_DC,
+      'n' => 'N',  X_ED => X_CD,  X_FD => X_DD,
+      'o' => 'O',  X_EE => X_CE,  X_FE => X_DE,
+      'p' => 'P',  X_EF => X_CF,
+      'q' => 'Q',  X_A8 => X_A6,
+      'r' => 'R',  X_B8 => X_B4,
+      's' => 'S',  X_BD => X_BC,
+      't' => 'T',  X_BE => X_FF,
+      'u' => 'U',
+      'v' => 'V',
+      'w' => 'W',
+      'x' => 'X',
+      'y' => 'Y',
+      'z' => 'Z',
+
+      'A' => 'A',  X_C0 => X_C0,  X_D0 => X_D0,
+      'B' => 'B',  X_C1 => X_C1,  X_D1 => X_D1,
+      'C' => 'C',  X_C2 => X_C2,  X_D2 => X_D2,
+      'D' => 'D',  X_C3 => X_C3,  X_D3 => X_D3,
+      'E' => 'E',  X_C4 => X_C4,  X_D4 => X_D4,
+      'F' => 'F',  X_C5 => X_C5,  X_D5 => X_D5,
+      'G' => 'G',  X_C6 => X_C6,  X_D6 => X_D6,
+      'H' => 'H',  X_C7 => X_C7,
+      'I' => 'I',  X_C8 => X_C8,  X_D8 => X_D8,
+      'J' => 'J',  X_C9 => X_C9,  X_D9 => X_D9,
+      'K' => 'K',  X_CA => X_CA,  X_DA => X_DA,
+      'L' => 'L',  X_CB => X_CB,  X_DB => X_DB,
+      'M' => 'M',  X_CC => X_CC,  X_DC => X_DC,
+      'N' => 'N',  X_CD => X_CD,  X_DD => X_DD,
+      'O' => 'O',  X_CE => X_CE,  X_DE => X_DE,
+      'P' => 'P',  X_CF => X_CF,  X_DF => X_DF,  X_FF => X_FF,
+      'Q' => 'Q',  X_A6 => X_A6,
+      'R' => 'R',  X_B4 => X_B4,
+      'S' => 'S',  X_BC => X_BC,
+      'T' => 'T',
+      'U' => 'U',
+      'V' => 'V',
+      'W' => 'W',
+      'X' => 'X',
+      'Y' => 'Y',
+      'Z' => 'Z',
+
+      '0' => '0',
+      '1' => '1',
+      '2' => '2',
+      '3' => '3',
+      '4' => '4',
+      '5' => '5',
+      '6' => '6',
+      '7' => '7',
+      '8' => '8',
+      '9' => '9',
+
+      '_' => '_',
+
+      others => ' ');
+
    --------------------------------------------
    -- Definitions for IBM PC (Code Page 437) --
    --------------------------------------------
@@ -551,7 +622,7 @@ package body Csets is
    --  for PC's in the US, it corresponds to the original PC character set.
    --  See also the definitions for code page 850.
 
-   Fold_IBM_PC_437 : Translate_Table := Translate_Table'(
+   Fold_IBM_PC_437 : constant Translate_Table := Translate_Table'(
 
       'a' => 'A',
       'b' => 'B',
@@ -686,7 +757,7 @@ package body Csets is
    --  set to include the additional characters defined in ISO Latin-1.
    --  See also the definitions for code page 437.
 
-   Fold_IBM_PC_850 : Translate_Table := Translate_Table'(
+   Fold_IBM_PC_850 : constant Translate_Table := Translate_Table'(
 
       'a' => 'A',
       'b' => 'B',
@@ -834,7 +905,7 @@ package body Csets is
    --  The full upper half set allows all upper half characters as letters,
    --  and does not recognize any upper/lower case equivalences in this half.
 
-   Fold_Full_Upper_Half : Translate_Table := Translate_Table'(
+   Fold_Full_Upper_Half : constant Translate_Table := Translate_Table'(
 
       'a' => 'A',
       'b' => 'B',
@@ -947,7 +1018,7 @@ package body Csets is
    --  thus there are no upper/lower case equivalences in this half. This set
    --  corresponds to the Ada 83 rules.
 
-   Fold_No_Upper_Half : Translate_Table := Translate_Table'(
+   Fold_No_Upper_Half : constant Translate_Table := Translate_Table'(
 
       'a' => 'A',
       'b' => 'B',
@@ -1024,7 +1095,6 @@ package body Csets is
 
    procedure Initialize is
    begin
-
       --  Set Fold_Upper table from source code indication
 
       if Identifier_Character_Set = '1'
@@ -1050,6 +1120,9 @@ package body Csets is
       elsif Identifier_Character_Set = '8' then
          Fold_Upper := Fold_IBM_PC_850;
 
+      elsif Identifier_Character_Set = '9' then
+         Fold_Upper := Fold_Latin_9;
+
       elsif Identifier_Character_Set = 'f' then
          Fold_Upper := Fold_Full_Upper_Half;
 
@@ -1084,8 +1157,7 @@ package body Csets is
       Identifier_Char ('[') := True;
 
       --  Add entry for ESC if wide characters in use with a wide character
-      --  encoding method active that uses the ESC code for encoding. Also
-      --  add entry for left bracket to capture use of brackets notation.
+      --  encoding method active that uses the ESC code for encoding.
 
       if Identifier_Character_Set = 'w'
         and then Wide_Character_Encoding_Method in WC_ESC_Encoding_Method