gcc/ada/g-byorma.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                 G N A T . B Y T E _ O R D E R _ M A R K                  --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2006-2007, AdaCore                     --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 package body GNAT.Byte_Order_Mark is
  35
  36    --------------
  37    -- Read_BOM --
  38    --------------
  39
  40    procedure Read_BOM
  41      (Str         : String;
  42       Len         : out Natural;
  43       BOM         : out BOM_Kind;
  44       XML_Support : Boolean := False)
  45    is
  46    begin
  47       --  Note: the order of these tests is important, because in some cases
  48       --  one sequence is a prefix of a longer sequence, and we must test for
  49       --  the longer sequence first
  50
  51       --  UTF-32 (big-endian)
  52
  53       if Str'Length >= 4
  54         and then Str (Str'First)     = Character'Val (16#00#)
  55         and then Str (Str'First + 1) = Character'Val (16#00#)
  56         and then Str (Str'First + 2) = Character'Val (16#FE#)
  57         and then Str (Str'First + 3) = Character'Val (16#FF#)
  58       then
  59          Len := 4;
  60          BOM := UTF32_BE;
  61
  62       --  UTF-32 (little-endian)
  63
  64       elsif Str'Length >= 4
  65         and then Str (Str'First)     = Character'Val (16#FF#)
  66         and then Str (Str'First + 1) = Character'Val (16#FE#)
  67         and then Str (Str'First + 2) = Character'Val (16#00#)
  68         and then Str (Str'First + 3) = Character'Val (16#00#)
  69       then
  70          Len := 4;
  71          BOM := UTF32_LE;
  72
  73       --  UTF-16 (big-endian)
  74
  75       elsif Str'Length >= 2
  76         and then Str (Str'First) = Character'Val (16#FE#)
  77         and then Str (Str'First + 1) = Character'Val (16#FF#)
  78       then
  79          Len := 2;
  80          BOM := UTF16_BE;
  81
  82       --  UTF-16 (little-endian)
  83
  84       elsif Str'Length >= 2
  85         and then Str (Str'First) = Character'Val (16#FF#)
  86         and then Str (Str'First + 1) = Character'Val (16#FE#)
  87       then
  88          Len := 2;
  89          BOM := UTF16_LE;
  90       --  UTF-8 (endian-independent)
  91
  92       elsif Str'Length >= 3
  93         and then Str (Str'First)     = Character'Val (16#EF#)
  94         and then Str (Str'First + 1) = Character'Val (16#BB#)
  95         and then Str (Str'First + 2) = Character'Val (16#BF#)
  96       then
  97          Len := 3;
  98          BOM := UTF8_All;
  99
 100       --  UCS-4 (big-endian) XML only
 101
 102       elsif XML_Support
 103         and then Str'Length >= 4
 104         and then Str (Str'First)     = Character'Val (16#00#)
 105         and then Str (Str'First + 1) = Character'Val (16#00#)
 106         and then Str (Str'First + 2) = Character'Val (16#00#)
 107         and then Str (Str'First + 3) = Character'Val (16#3C#)
 108       then
 109          Len := 0;
 110          BOM := UCS4_BE;
 111
 112       --  UCS-4 (little-endian) XML case
 113
 114       elsif XML_Support
 115         and then Str'Length >= 4
 116         and then Str (Str'First)     = Character'Val (16#3C#)
 117         and then Str (Str'First + 1) = Character'Val (16#00#)
 118         and then Str (Str'First + 2) = Character'Val (16#00#)
 119         and then Str (Str'First + 3) = Character'Val (16#00#)
 120       then
 121          Len := 0;
 122          BOM := UCS4_LE;
 123
 124       --  UCS-4 (unusual byte order 2143) XML case
 125
 126       elsif XML_Support
 127         and then Str'Length >= 4
 128         and then Str (Str'First)     = Character'Val (16#00#)
 129         and then Str (Str'First + 1) = Character'Val (16#00#)
 130         and then Str (Str'First + 2) = Character'Val (16#3C#)
 131         and then Str (Str'First + 3) = Character'Val (16#00#)
 132       then
 133          Len := 0;
 134          BOM := UCS4_2143;
 135
 136       --  UCS-4 (unusual byte order 3412) XML case
 137
 138       elsif XML_Support
 139         and then Str'Length >= 4
 140         and then Str (Str'First)     = Character'Val (16#00#)
 141         and then Str (Str'First + 1) = Character'Val (16#3C#)
 142         and then Str (Str'First + 2) = Character'Val (16#00#)
 143         and then Str (Str'First + 3) = Character'Val (16#00#)
 144       then
 145          Len := 0;
 146          BOM := UCS4_3412;
 147
 148       --  UTF-16 (big-endian) XML case
 149
 150       elsif XML_Support
 151         and then Str'Length >= 4
 152         and then Str (Str'First)     = Character'Val (16#00#)
 153         and then Str (Str'First + 1) = Character'Val (16#3C#)
 154         and then Str (Str'First + 2) = Character'Val (16#00#)
 155         and then Str (Str'First + 3) = Character'Val (16#3F#)
 156       then
 157          Len := 0;
 158          BOM := UTF16_BE;
 159
 160       --  UTF-32 (little-endian) XML case
 161
 162       elsif XML_Support
 163         and then Str'Length >= 4
 164         and then Str (Str'First)     = Character'Val (16#3C#)
 165         and then Str (Str'First + 1) = Character'Val (16#00#)
 166         and then Str (Str'First + 2) = Character'Val (16#3F#)
 167         and then Str (Str'First + 3) = Character'Val (16#00#)
 168       then
 169          Len := 0;
 170          BOM := UTF16_LE;
 171
 172       --  Unrecognized special encodings XML only
 173
 174       elsif XML_Support
 175         and then Str'Length >= 4
 176         and then Str (Str'First)     = Character'Val (16#3C#)
 177         and then Str (Str'First + 1) = Character'Val (16#3F#)
 178         and then Str (Str'First + 2) = Character'Val (16#78#)
 179         and then Str (Str'First + 3) = Character'Val (16#6D#)
 180       then
 181          --  Utf8, ASCII, some part of ISO8859, Shift-JIS, EUC,...
 182
 183          Len := 0;
 184          BOM := Unknown;
 185
 186       --  No BOM recognized
 187
 188       else
 189          Len := 0;
 190          BOM := Unknown;
 191       end if;
 192    end Read_BOM;
 193
 194 end GNAT.Byte_Order_Mark;