+2010-06-23 Eric Botcazou <ebotcazou@adacore.com>
+
+ * exp_ch11.adb (Expand_Local_Exception_Handlers): Propagate the end
+ label to the new sequence of statements. Set the sloc of the raise
+ statement onto the new goto statements.
+
+2010-06-23 Robert Dewar <dewar@adacore.com>
+
+ * a-stuten.ads, a-stuten.adb: New files.
+ * impunit.adb: Add engtry for Ada.Strings.UTF_Encoding (a-stuten.ads)
+ * Makefile.rtl: Add entry for a-stuten (Ada.Strings.UTF_Encoding)
+
+2010-06-23 Robert Dewar <dewar@adacore.com>
+
+ * gnat_ugn.texi: Add documentation of -gnat12 switch
+ Add documentation of -gnatX switch.
+
+2010-06-23 Ed Schonberg <schonberg@adacore.com>
+
+ * inline.ads: Include the current Ada_Version in the info for pending
+ instance bodies, so that declaration and body are compiled with the
+ same Ada_Version.
+ * inline.adb: Move with_clause for Opt to spec.
+ * sem_ch12.adb (Analyze_Package_Instantiation,
+ Analyze_Subprogram_Instantiation): Save current Ada_Version in
+ Pending_Instantiation information.
+ (Instantiate_Package_Body, Instantiate_Subprogram_Body,
+ Inline_Package_Body): Use the Ada_Version present in the body
+ information.
+
+2010-06-23 Robert Dewar <dewar@adacore.com>
+
+ * usage.adb: Add documentation for -gnat12 switch.
+ * errout.ads: Add VMS alias entry for -gnat12 switch
+ * gnat_rm.texi: Add documentation for pragma Ada_12 and Ada_2012
+ Add documentation for pragma Extensions_Allowed.
+ * opt.ads: Add entry for Ada 2012 mode.
+ * sem_ch4.adb, par-ch3.adb, par-ch4.adb: Use new Ada 2012 mode for 2012
+ features.
+ * sem_prag.adb, par-prag.adb: Add processing for pragma Ada_12 and
+ Ada_2012.
+ * sem_ch13.adb: Add handling for Ada 2012 mode.
+ * snames.ads-tmpl: Add entries for pragma Ada_2012 and Ada_12.
+ * switch-c.adb: Add handling for -gnat12 switch.
+ Implement -gnat2005 and -gnat2012.
+ * usage.adb: Add documentation for -gnat12 switch.
+ * vms_data.ads: Add /12 switch for Ada 2012 mode.
+
2010-06-23 Arnaud Charlet <charlet@adacore.com>
* exp_ch4.adb (Expand_N_Allocator): Fix potential crash when using
a-ststio$(objext) \
a-stunau$(objext) \
a-stunha$(objext) \
+ a-stuten$(objext) \
a-stwibo$(objext) \
a-stwifi$(objext) \
a-stwiha$(objext) \
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . S T R I N G S . U T F _ E N C O D I N G --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2010, 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. --
+-- --
+-------------------------------------------------------------------------------
+with Interfaces; use Interfaces;
+with Unchecked_Conversion;
+
+package body Ada.Strings.UTF_Encoding is
+
+ function To_Unsigned_8 is new
+ Unchecked_Conversion (Character, Unsigned_8);
+
+ function To_Unsigned_16 is new
+ Unchecked_Conversion (Wide_Character, Unsigned_16);
+
+ function To_Unsigned_32 is new
+ Unchecked_Conversion (Wide_Wide_Character, Unsigned_32);
+
+ -- Local subprograms
+
+ procedure Raise_Encoding_Error;
+ -- Called if an invalid input encoding sequence is found by Decode
+
+ function Decode_UTF_8 (Item : String) return Wide_String;
+ -- Equivalent to Decode (Item, UTF_8), but smaller and faster
+
+ function Decode_UTF_8 (Item : String) return Wide_Wide_String;
+ -- Equivalent to Decode (Item, UTF_8), but smaller and faster
+
+ function Encode_UTF_8 (Item : Wide_String) return String;
+ -- Equivalent to Encode (Item, UTF_8) but smaller and faster
+
+ function Encode_UTF_8 (Item : Wide_Wide_String) return String;
+ -- Equivalent to Encode (Item, UTF_8) but smaller and faster
+
+ function Decode_UTF_16 (Item : Wide_String) return Wide_String;
+ -- Equivalent to Decode (Item, UTF_16)
+
+ function Decode_UTF_16 (Item : Wide_String) return Wide_Wide_String;
+ -- Equivalent to Decode (Item, UTF_16)
+
+ function Encode_UTF_16 (Item : Wide_String) return Wide_String;
+ -- Equivalent to Encode (Item, UTF_16)
+
+ function Encode_UTF_16 (Item : Wide_Wide_String) return Wide_String;
+ -- Equivalent to Encode (Item, UTF_16)
+
+ ------------
+ -- Decode --
+ ------------
+
+ -- String input with Wide_String output (short encodings)
+
+ function Decode
+ (Item : String;
+ Scheme : Short_Encoding := UTF_8) return Wide_String
+ is
+ begin
+ -- UTF-8 encoding case
+
+ if Scheme = UTF_8 then
+ return Decode_UTF_8 (Item);
+
+ -- Case of UTF_16LE or UTF_16BE
+
+ else
+ UTF16_XE : declare
+ Input_UTF16 : Wide_String (1 .. Item'Length / 2);
+ -- UTF_16 input string
+
+ Iptr : Natural;
+ -- Pointer to next location to store in Input_UTF16
+
+ Ptr : Natural;
+ -- Input string pointer
+
+ H, L : Natural range 0 .. 1;
+ -- Offset for high and low order bytes
+
+ begin
+ -- In both cases, the input string must be even in length, since
+ -- we have two input characters for each input code in UTF_16.
+
+ if Item'Length mod 2 /= 0 then
+ Raise_Encoding_Error;
+ end if;
+
+ -- We first assemble the UTF_16 string from the input. Set offsets
+ -- for the two bytes. For UTF_16LE we have low order/high order.
+ -- For UTF_16BE we have high order/low order.
+
+ if Scheme = UTF_16LE then
+ L := 0;
+ H := 1;
+ else
+ L := 1;
+ H := 0;
+ end if;
+
+ -- Loop to convert input to UTF_16 form
+
+ Iptr := 1;
+ Ptr := Item'First;
+ while Ptr < Item'Last loop
+ Input_UTF16 (Iptr) :=
+ Wide_Character'Val
+ (Unsigned_16 (To_Unsigned_8 (Item (Ptr + L)))
+ or
+ Shift_Left
+ (Unsigned_16 (To_Unsigned_8 (Item (Ptr + H))), 8));
+ Iptr := Iptr + 1;
+ Ptr := Ptr + 2;
+ end loop;
+
+ -- Result is obtained by converting this UTF_16 input. Note that
+ -- we rely on this nested call to Decode to skip any BOM present.
+
+ return Decode (Input_UTF16);
+ end UTF16_XE;
+ end if;
+ end Decode;
+
+ -- String input with Wide_Wide_String output (short encodings)
+
+ function Decode
+ (Item : String;
+ Scheme : Short_Encoding := UTF_8) return Wide_Wide_String
+ is
+ begin
+ -- UTF-8 encoding case
+
+ if Scheme = UTF_8 then
+ return Decode_UTF_8 (Item);
+
+ -- Case of UTF_16LE or UTF_16BE
+
+ else
+ UTF16_XE : declare
+ Input_UTF16 : Wide_String (1 .. Item'Length / 2);
+ -- UTF_16 input string
+
+ Iptr : Natural;
+ -- Pointer to next location to store in Input_UTF16
+
+ Ptr : Natural;
+ -- Input string pointer
+
+ H, L : Integer range 0 .. 1;
+ -- Offset for high and low order bytes
+
+ begin
+ -- In both cases, the input string must be even in length, since
+ -- we have two input characters for each input code in UTF_16.
+
+ if Item'Length mod 2 /= 0 then
+ Raise_Encoding_Error;
+ end if;
+
+ -- We first assemble the UTF_16 string from the input. Set offsets
+ -- for the two bytes. For UTF_16LE we have low order/high order.
+ -- For UTF_16BE we have high order/low order.
+
+ if Scheme = UTF_16LE then
+ L := 0;
+ H := 1;
+ else
+ L := 1;
+ H := 0;
+ end if;
+
+ -- Loop to convert input to UTF_16 form
+
+ Ptr := Item'First;
+ Iptr := 1;
+ while Ptr < Item'Last loop
+ Input_UTF16 (Iptr) :=
+ Wide_Character'Val
+ (Unsigned_16 (To_Unsigned_8 (Item (Ptr + L)))
+ or
+ Shift_Left
+ (Unsigned_16 (To_Unsigned_8 (Item (Ptr + H))), 8));
+ Iptr := Iptr + 1;
+ Ptr := Ptr + 2;
+ end loop;
+
+ -- Result is obtained by converting this UTF_16 input. Note that
+ -- we rely on this nested call to Decode to skip any BOM present.
+
+ return Decode_UTF_16 (Input_UTF16);
+ end UTF16_XE;
+ end if;
+ end Decode;
+
+ -- Wide_String input with Wide_Wide_String output (long encodings)
+
+ function Decode
+ (Item : Wide_String;
+ Scheme : Long_Encoding := UTF_16) return Wide_String
+ is
+ pragma Unreferenced (Scheme);
+ begin
+ return Decode_UTF_16 (Item);
+ end Decode;
+
+ -- Wide_String input with Wide_Wide_String output (long encodings)
+
+ function Decode
+ (Item : Wide_String;
+ Scheme : Long_Encoding := UTF_16) return Wide_Wide_String
+ is
+ pragma Unreferenced (Scheme);
+ begin
+ return Decode_UTF_16 (Item);
+ end Decode;
+
+ -------------------
+ -- Decode_UTF_16 --
+ -------------------
+
+ -- Version returning Wide_String result
+
+ function Decode_UTF_16 (Item : Wide_String) return Wide_String is
+ Result : Wide_String (1 .. Item'Length);
+ -- Result is same length as input (possibly minus 1 if BOM present)
+
+ Len : Natural := 0;
+ -- Length of result
+
+ Cod : Unsigned_16;
+ J : Positive;
+
+ begin
+ -- Skip UTF-16 BOM at start
+
+ J := Item'First;
+
+ if J <= Item'Last and then Item (J) = BOM_16 (1) then
+ J := J + 1;
+ end if;
+
+ -- Loop through input characters
+
+ while J <= Item'Last loop
+ Cod := To_Unsigned_16 (Item (J));
+
+ -- Codes in the range 16#0000#..16#D7FF# or 16#E000#..16#FFFF#
+ -- represent their own value.
+
+ if Cod <= 16#D7FF# or else Cod >= 16#E000# then
+ Len := Len + 1;
+ Result (Len) := Wide_Character'Val (Cod);
+
+ -- Codes in the range 16#D800#..16#DBFF# represent the first of the
+ -- two surrogates used to encode the range 16#01_000#..16#10_FFFF".
+ -- Such codes are out of range for 16-bit output.
+
+ -- The remaining case of input in the range 16#DC00#..16#DFFF# must
+ -- never occur, since it means we have a second surrogate character
+ -- with no corresponding first surrogate.
+
+ -- Thus all remaining codes are invalid
+
+ else
+ Raise_Encoding_Error;
+ end if;
+
+ J := J + 1;
+ end loop;
+
+ return Result (1 .. Len);
+ end Decode_UTF_16;
+
+ -- Version returning Wide_Wide_String result
+
+ function Decode_UTF_16 (Item : Wide_String) return Wide_Wide_String is
+ Result : Wide_Wide_String (1 .. Item'Length);
+ -- Result cannot be longer than the input string
+
+ Len : Natural := 0;
+ -- Length of result
+
+ Cod : Unsigned_16;
+ J : Positive;
+ Rcod : Unsigned_32;
+
+ begin
+ -- Skip UTF-16 BOM at start
+
+ J := Item'First;
+
+ if J <= Item'Last and then Item (J) = BOM_16 (1) then
+ J := J + 1;
+ end if;
+
+ -- Loop through input characters
+
+ while J <= Item'Last loop
+ Cod := To_Unsigned_16 (Item (J));
+
+ -- Codes in the range 16#0000#..16#D7FF# or 16#E000#..16#FFFF#
+ -- represent their own value.
+
+ if Cod <= 16#D7FF# or else Cod >= 16#E000# then
+ Len := Len + 1;
+ Result (Len) := Wide_Wide_Character'Val (Cod);
+
+ -- Codes in the range 16#D800#..16#DBFF# represent the first of the
+ -- two surrogates used to encode the range 16#01_000#..16#10_FFFF".
+
+ elsif Cod <= 16#DBFF# then
+ Rcod := (Unsigned_32 (Cod) - 16#D800#) * 2 ** 10;
+
+ -- Error if at end of string
+
+ if J = Item'Last then
+ Raise_Encoding_Error;
+
+ -- Otherwise next character must be valid low order surrogate
+
+ else
+ J := J + 1;
+ Cod := To_Unsigned_16 (Item (J));
+
+ if Cod < 16#DC00# or else Cod > 16#DFFF# then
+ Raise_Encoding_Error;
+
+ else
+ Rcod := Rcod + (Unsigned_32 (Cod) mod 2 ** 10) + 16#01_0000#;
+ Len := Len + 1;
+ Result (Len) := Wide_Wide_Character'Val (Rcod);
+ end if;
+ end if;
+
+ -- If input is in the range 16#DC00#..16#DFFF#, we have a second
+ -- surrogate character with no corresponding first surrogate.
+
+ else
+ Raise_Encoding_Error;
+ end if;
+
+ J := J + 1;
+ end loop;
+
+ return Result (1 .. Len);
+ end Decode_UTF_16;
+
+ ------------------
+ -- Decode_UTF_8 --
+ ------------------
+
+ -- Version returning Wide_String result
+
+ function Decode_UTF_8 (Item : String) return Wide_String is
+ Result : Wide_String (1 .. Item'Length);
+ -- Result string (worst case is same length as input)
+
+ Len : Natural := 0;
+ -- Length of result stored so far
+
+ Ptr : Natural;
+ -- Input string pointer
+
+ C : Unsigned_8;
+ R : Unsigned_16;
+
+ procedure Get_Continuation;
+ -- Reads a continuation byte of the form 10xxxxxx, shifts R left
+ -- by 6 bits, and or's in the xxxxxx to the low order 6 bits. On
+ -- return Ptr is incremented. Raises exceptioon if continuation
+ -- byte does not exist or is invalid.
+
+ ----------------------
+ -- Get_Continuation --
+ ----------------------
+
+ procedure Get_Continuation is
+ begin
+ if Ptr > Item'Last then
+ Raise_Encoding_Error;
+
+ else
+ C := To_Unsigned_8 (Item (Ptr));
+ Ptr := Ptr + 1;
+
+ if C < 2#10_000000# or else C > 2#10_111111# then
+ Raise_Encoding_Error;
+
+ else
+ R := Shift_Left (R, 6) or
+ Unsigned_16 (C and 2#00_111111#);
+ end if;
+ end if;
+ end Get_Continuation;
+
+ -- Start of processing for Decode_UTF_8
+
+ begin
+ Ptr := Item'First;
+
+ -- Skip BOM at start
+
+ if Ptr + 2 <= Item'Last
+ and then Item (Ptr .. Ptr + 2) = BOM_8
+ then
+ Ptr := Ptr + 3;
+ end if;
+
+ -- Loop through input characters
+
+ while Ptr <= Item'Last loop
+ C := To_Unsigned_8 (Item (Ptr));
+ Ptr := Ptr + 1;
+
+ -- Codes in the range 16#00# - 16#7F# are represented as
+ -- 0xxxxxxx
+
+ if C <= 16#7F# then
+ R := Unsigned_16 (C);
+
+ -- No initial code can be of the form 10xxxxxx. Such codes are used
+ -- only for continuations.
+
+ elsif C <= 2#10_111111# then
+ Raise_Encoding_Error;
+
+ -- Codes in the range 16#80# - 16#7FF# are represented as
+ -- 110yyyxx 10xxxxxx
+
+ elsif C <= 2#110_11111# then
+ R := Unsigned_16 (C and 2#000_11111#);
+ Get_Continuation;
+
+ -- Codes in the range 16#800# - 16#FFFF# are represented as
+ -- 1110yyyy 10yyyyxx 10xxxxxx
+
+ elsif C <= 2#1110_1111# then
+ R := Unsigned_16 (C and 2#0000_1111#);
+ Get_Continuation;
+ Get_Continuation;
+
+ -- Codes in the range 16#10000# - 16#10FFFF# are represented as
+ -- 11110zzz 10zzyyyy 10yyyyxx 10xxxxxx
+
+ -- Such codes are out of range for Wide_String output
+
+ else
+ Raise_Encoding_Error;
+ end if;
+
+ Len := Len + 1;
+ Result (Len) := Wide_Character'Val (R);
+ end loop;
+
+ return Result (1 .. Len);
+ end Decode_UTF_8;
+
+ -- Version returning Wide_Wide_String result
+
+ function Decode_UTF_8 (Item : String) return Wide_Wide_String is
+ Result : Wide_Wide_String (1 .. Item'Length);
+ -- Result string (worst case is same length as input)
+
+ Len : Natural := 0;
+ -- Length of result stored so far
+
+ Ptr : Natural;
+ -- Input string pointer
+
+ C : Unsigned_8;
+ R : Unsigned_32;
+
+ procedure Get_Continuation;
+ -- Reads a continuation byte of the form 10xxxxxx, shifts R left
+ -- by 6 bits, and or's in the xxxxxx to the low order 6 bits. On
+ -- return Ptr is incremented. Raises exceptioon if continuation
+ -- byte does not exist or is invalid.
+
+ ----------------------
+ -- Get_Continuation --
+ ----------------------
+
+ procedure Get_Continuation is
+ begin
+ if Ptr > Item'Last then
+ raise Encoding_Error with
+ "incomplete UTF-8 encoding sequence";
+
+ else
+ C := To_Unsigned_8 (Item (Ptr));
+ Ptr := Ptr + 1;
+
+ if C < 2#10_000000# or else C > 2#10_111111# then
+ Raise_Encoding_Error;
+
+ else
+ R := Shift_Left (R, 6) or
+ Unsigned_32 (C and 2#00_111111#);
+ end if;
+ end if;
+ end Get_Continuation;
+
+ -- Start of processing for UTF8_Decode
+
+ begin
+ Ptr := Item'First;
+
+ -- Skip BOM at start
+
+ if Ptr + 2 <= Item'Last
+ and then Item (Ptr .. Ptr + 2) = BOM_8
+ then
+ Ptr := Ptr + 3;
+ end if;
+
+ -- Loop through input characters
+
+ while Ptr <= Item'Last loop
+ C := To_Unsigned_8 (Item (Ptr));
+ Ptr := Ptr + 1;
+
+ -- Codes in the range 16#00# - 16#7F# are represented as
+ -- 0xxxxxxx
+
+ if C <= 16#7F# then
+ R := Unsigned_32 (C);
+
+ -- No initial code can be of the form 10xxxxxx. Such codes are used
+ -- only for continuations.
+
+ elsif C <= 2#10_111111# then
+ Raise_Encoding_Error;
+
+ -- Codes in the range 16#80# - 16#7FF# are represented as
+ -- 110yyyxx 10xxxxxx
+
+ elsif C <= 2#110_11111# then
+ R := Unsigned_32 (C and 2#000_11111#);
+ Get_Continuation;
+
+ -- Codes in the range 16#800# - 16#FFFF# are represented as
+ -- 1110yyyy 10yyyyxx 10xxxxxx
+
+ elsif C <= 2#1110_1111# then
+ R := Unsigned_32 (C and 2#0000_1111#);
+ Get_Continuation;
+ Get_Continuation;
+
+ -- Codes in the range 16#10000# - 16#10FFFF# are represented as
+ -- 11110zzz 10zzyyyy 10yyyyxx 10xxxxxx
+
+ elsif C <= 2#11110_111# then
+ R := Unsigned_32 (C and 2#00000_111#);
+ Get_Continuation;
+ Get_Continuation;
+ Get_Continuation;
+
+ -- Any other code is an error
+
+ else
+ Raise_Encoding_Error;
+ end if;
+
+ Len := Len + 1;
+ Result (Len) := Wide_Wide_Character'Val (R);
+ end loop;
+
+ return Result (1 .. Len);
+ end Decode_UTF_8;
+
+ ------------
+ -- Encode --
+ ------------
+
+ -- Version with Wide_String input returning encoded String
+
+ function Encode
+ (Item : Wide_String;
+ Scheme : Short_Encoding := UTF_8) return String
+ is
+ begin
+ -- Case of UTF_8
+
+ if Scheme = UTF_8 then
+ return Encode_UTF_8 (Item);
+
+ -- Case of UTF_16LE or UTF_16BE
+
+ else
+ UTF16XE_Encode : declare
+ UTF16_Str : constant Wide_String := Encode_UTF_16 (Item);
+ Result : String (1 .. 2 * UTF16_Str'Last);
+
+ H, L : Integer range -1 .. 0;
+ -- Offset for high and low order bytes
+
+ C : Unsigned_16;
+ -- One UTF_16 output value
+
+ begin
+ -- Set proper byte offsets
+
+ -- Set the byte order for the two bytes of each UTF_16 input code.
+ -- For UTF_16LE we have low order/high order. For UTF_16BE we have
+ -- high order/low order.
+
+ if Scheme = UTF_16LE then
+ L := -1;
+ H := 0;
+ else
+ L := 0;
+ H := -1;
+ end if;
+
+ -- Now copy the UTF_16 string to the result string
+
+ pragma Warnings (Off);
+ for J in 1 .. UTF16_Str'Last loop
+ C := To_Unsigned_16 (UTF16_Str (J));
+ Result (2 * J + L) := Character'Val (C and 16#FF#);
+ Result (2 * J + H) := Character'Val (Shift_Right (C, 8));
+ end loop;
+
+ return Result;
+ end UTF16XE_Encode;
+ end if;
+ end Encode;
+
+ -- Version with Wide_Wide_String input returning String
+
+ function Encode
+ (Item : Wide_Wide_String;
+ Scheme : Short_Encoding := UTF_8) return String
+ is
+ begin
+ -- Case of UTF_8
+
+ if Scheme = UTF_8 then
+ return Encode_UTF_8 (Item);
+
+ -- Case of UTF_16LE or UTF_16BE
+
+ else
+ UTF16XE_Encode : declare
+ UTF16_Str : constant Wide_String := Encode (Item, UTF_16);
+ Result : String (1 .. 2 * UTF16_Str'Last);
+
+ H, L : Integer range -1 .. 0;
+ -- Offset for high and low order bytes
+
+ C : Unsigned_16;
+ -- One UTF_16 output value
+
+ begin
+ -- Set proper byte offsets
+
+ -- Set the byte order for the two bytes of each UTF_16 input code.
+ -- For UTF_16LE we have low order/high order. For UTF_16BE we have
+ -- high order/low order.
+
+ if Scheme = UTF_16LE then
+ L := -1;
+ H := 0;
+ else
+ L := 0;
+ H := -1;
+ end if;
+
+ -- Now copy the UTF_16 string to the result string
+
+ for J in 1 .. UTF16_Str'Last loop
+ C := To_Unsigned_16 (UTF16_Str (J));
+ Result (2 * J + L) := Character'Val (C and 16#FF#);
+ Result (2 * J + H) := Character'Val (Shift_Right (C, 8));
+ end loop;
+
+ return Result;
+ end UTF16XE_Encode;
+ end if;
+ end Encode;
+
+ -- Wide_String input returning encoded Wide_String (long encodings)
+
+ function Encode
+ (Item : Wide_String;
+ Scheme : Long_Encoding := UTF_16) return Wide_String
+ is
+ pragma Unreferenced (Scheme);
+ begin
+ return Encode_UTF_16 (Item);
+ end Encode;
+
+ -- Wide_Wide_String input returning Wide_String (long encodings)
+
+ function Encode
+ (Item : Wide_Wide_String;
+ Scheme : Long_Encoding := UTF_16) return Wide_String
+ is
+ pragma Unreferenced (Scheme);
+ begin
+ return Encode_UTF_16 (Item);
+ end Encode;
+
+ -------------------
+ -- Encode_UTF_16 --
+ -------------------
+
+ -- Wide_String input with UTF-16 encoded Wide_String output
+
+ function Encode_UTF_16 (Item : Wide_String) return Wide_String is
+ Result : Wide_String (1 .. Item'Length);
+ -- Output is same length as input (we do not add a BOM!)
+
+ Len : Integer := 0;
+ -- Length of output string
+
+ Cod : Unsigned_16;
+
+ begin
+ -- Loop through input characters encoding them
+
+ for J in Item'Range loop
+ Cod := To_Unsigned_16 (Item (J));
+
+ -- Codes in the range 16#0000#..16#D7FF# are output unchanged
+
+ if Cod <= 16#D7FF# then
+ Len := Len + 1;
+ Result (Len) := Wide_Character'Val (Cod);
+
+ -- Codes in tne range 16#D800#..16#DFFF# should never appear in the
+ -- input, since no valid Unicode characters are in this range (which
+ -- would conflict with the UTF-16 surrogate encodings).
+
+ elsif Cod <= 16#DFFF# then
+ raise Constraint_Error with
+ "Wide_Character in range 16#D800# .. 16#DFFF#";
+
+ -- Codes in the range 16#E000#..16#FFFF# are output unchanged
+
+ else
+ Len := Len + 1;
+ Result (Len) := Wide_Character'Val (Cod);
+ end if;
+ end loop;
+
+ return Result (1 .. Len);
+ end Encode_UTF_16;
+
+ -- Wide_Wide_String input with UTF-16 encoded Wide_String output
+
+ function Encode_UTF_16 (Item : Wide_Wide_String) return Wide_String is
+ Result : Wide_String (1 .. 2 * Item'Length);
+ -- Worst case is each input character generates two output characters
+
+ Len : Integer := 0;
+ -- Length of output string
+
+ Cod : Unsigned_32;
+
+ begin
+ -- Loop through input characters encoding them
+
+ for J in Item'Range loop
+ Cod := To_Unsigned_32 (Item (J));
+
+ -- Codes in the range 16#00_0000#..16#00_D7FF# are output unchanged
+
+ if Cod <= 16#00_D7FF# then
+ Len := Len + 1;
+ Result (Len) := Wide_Character'Val (Cod);
+
+ -- Codes in tne range 16#00_D800#..16#00_DFFF# should never appear
+ -- in the input, since no valid Unicode characters are in this range
+ -- (which would conflict with the UTF-16 surrogate encodings).
+
+ elsif Cod <= 16#00_DFFF# then
+ raise Constraint_Error with
+ "Wide_Wide_Character in range 16#00_D800# .. 16#00_DFFF#";
+
+ -- Codes in the range 16#00_E000#..16#00_FFFF# are output unchanged
+
+ elsif Cod <= 16#00_FFFF# then
+ Len := Len + 1;
+ Result (Len) := Wide_Character'Val (Cod);
+
+ -- Codes in the range 16#01_0000#..16#10_FFFF# are output using two
+ -- surrogate characters. First 16#1_0000# is subtracted from the code
+ -- point to give a 20-bit value. This is then split into two separate
+ -- 10-bit values each of which is represented as a surrogate with the
+ -- most significant half placed in the first surrogate. To allow safe
+ -- use of simple word-oriented string processing, separate ranges of
+ -- values are used for the two surrogates: 16#D800#-16#DBFF# for the
+ -- first, most significant surrogate and 16#DC00#-16#DFFF# for the
+ -- second, least significant surrogate.
+
+ elsif Cod <= 16#10_FFFF# then
+ Cod := Cod - 16#1_0000#;
+
+ Len := Len + 1;
+ Result (Len) := Wide_Character'Val (16#D800# + Cod / 2 ** 10);
+
+ Len := Len + 1;
+ Result (Len) := Wide_Character'Val (16#DC00# + Cod mod 2 ** 10);
+
+ -- Codes larger than 16#10_FFFF# are invalid
+
+ else
+ raise Constraint_Error with
+ "Wide_Wide_Character exceeds maximum value of 16#10_FFFF#";
+ end if;
+ end loop;
+
+ return Result (1 .. Len);
+ end Encode_UTF_16;
+
+ ------------------
+ -- Encode_UTF_8 --
+ ------------------
+
+ -- Wide_String input with UTF_8 encoded String output
+
+ function Encode_UTF_8 (Item : Wide_String) return String is
+ Result : String (1 .. 3 * Item'Length);
+ -- Worst case is three bytes per input byte
+
+ N : Natural := 0;
+ -- Number of output codes stored in Result
+
+ C : Unsigned_16;
+ -- Single input character
+
+ procedure Store (C : Unsigned_16);
+ pragma Inline (Store);
+ -- Store one output code, C is in the range 0 .. 255
+
+ -----------
+ -- Store --
+ -----------
+
+ procedure Store (C : Unsigned_16) is
+ begin
+ N := N + 1;
+ Result (N) := Character'Val (C);
+ end Store;
+
+ -- Start of processing for UTF8_Encode
+
+ begin
+ -- Loop through characters of input
+
+ for J in Item'Range loop
+ C := To_Unsigned_16 (Item (J));
+
+ -- Codes in the range 16#00# - 16#7F# are represented as
+ -- 0xxxxxxx
+
+ if C <= 16#7F# then
+ Store (C);
+
+ -- Codes in the range 16#80# - 16#7FF# are represented as
+ -- 110yyyxx 10xxxxxx
+
+ elsif C <= 16#7FF# then
+ Store (2#110_00000# or Shift_Right (C, 6));
+ Store (2#10_000000# or (C and 2#00_111111#));
+
+ -- Codes in the range 16#800# - 16#FFFF# are represented as
+ -- 1110yyyy 10yyyyxx 10xxxxxx
+
+ else
+ Store (2#1110_0000# or Shift_Right (C, 12));
+ Store (2#10_000000# or
+ Shift_Right (C and 2#111111_000000#, 6));
+ Store (2#10_000000# or (C and 2#00_111111#));
+ end if;
+ end loop;
+
+ return Result (1 .. N);
+ end Encode_UTF_8;
+
+ -- Wide_Wide_String input with UTF_8 encoded String output
+
+ function Encode_UTF_8 (Item : Wide_Wide_String) return String is
+ Result : String (1 .. 4 * Item'Length);
+ -- Worst case is four bytes per input byte
+
+ N : Natural := 0;
+ -- Number of output codes stored in Result
+
+ C : Unsigned_32;
+ -- Single input character
+
+ procedure Store (C : Unsigned_32);
+ pragma Inline (Store);
+ -- Store one output code (input is in range 0 .. 255)
+
+ -----------
+ -- Store --
+ -----------
+
+ procedure Store (C : Unsigned_32) is
+ begin
+ N := N + 1;
+ Result (N) := Character'Val (C);
+ end Store;
+
+ -- Start of processing for UTF8_Encode
+
+ begin
+ -- Loop through characters of input
+
+ for J in Item'Range loop
+ C := To_Unsigned_32 (Item (J));
+
+ -- Codes in the range 16#00# - 16#7F# are represented as
+ -- 0xxxxxxx
+
+ if C <= 16#7F# then
+ Store (C);
+
+ -- Codes in the range 16#80# - 16#7FF# are represented as
+ -- 110yyyxx 10xxxxxx
+
+ elsif C <= 16#7FF# then
+ Store (2#110_00000# or Shift_Right (C, 6));
+ Store (2#10_000000# or (C and 2#00_111111#));
+
+ -- Codes in the range 16#800# - 16#FFFF# are represented as
+ -- 1110yyyy 10yyyyxx 10xxxxxx
+
+ elsif C <= 16#FFFF# then
+ Store (2#1110_0000# or Shift_Right (C, 12));
+ Store (2#10_000000# or
+ Shift_Right (C and 2#111111_000000#, 6));
+ Store (2#10_000000# or (C and 2#00_111111#));
+
+ -- Codes in the range 16#10000# - 16#10FFFF# are represented as
+ -- 11110zzz 10zzyyyy 10yyyyxx 10xxxxxx
+
+ elsif C <= 16#10_FFFF# then
+ Store (2#11110_000# or Shift_Right (C, 18));
+ Store (2#10_000000# or
+ Shift_Right (C and 2#111111_000000_000000#, 12));
+ Store (2#10_000000#
+ or Shift_Right (C and 2#111111_000000#, 6));
+ Store (2#10_000000# or (C and 2#00_111111#));
+
+ -- Codes higher than 16#10_FFFF# should not appear
+
+ else
+ raise Constraint_Error with
+ "out of range invalid value in Encode input";
+ end if;
+ end loop;
+
+ return Result (1 .. N);
+ end Encode_UTF_8;
+
+ --------------
+ -- Encoding --
+ --------------
+
+ -- Version taking String input
+
+ function Encoding (Item : String) return Encoding_Scheme is
+ begin
+ if Item'Length >= 2 then
+ if Item (Item'First .. Item'First + 1) = BOM_16BE then
+ return UTF_16BE;
+
+ elsif Item (Item'First .. Item'First + 1) = BOM_16LE then
+ return UTF_16LE;
+
+ elsif Item'Length >= 3
+ and then Item (Item'First .. Item'First + 2) = BOM_8
+ then
+ return UTF_8;
+ end if;
+ end if;
+
+ return UTF_None;
+ end Encoding;
+
+ -- Version taking Wide_String input
+
+ function Encoding (Item : Wide_String) return Encoding_Scheme is
+ begin
+ if Item'Length >= 1
+ and then Item (Item'First .. Item'First) = BOM_16
+ then
+ return UTF_16;
+ else
+ return UTF_None;
+ end if;
+ end Encoding;
+
+ ------------------------
+ -- Raise_Encoding_Error --
+ ------------------------
+
+ procedure Raise_Encoding_Error is
+ begin
+ raise Encoding_Error with "invalid input encoding sequence";
+ end Raise_Encoding_Error;
+
+end Ada.Strings.UTF_Encoding;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . S T R I N G S . U T F _ E N C O D I N G --
+-- --
+-- S p e c --
+-- --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification, provided that if you redistribute a --
+-- modified version, any changes that you have made are clearly indicated. --
+-- --
+------------------------------------------------------------------------------
+
+-- This is the Ada 2012 package defined in AI05-0137-1. It is used for
+-- encoding strings using UTF encodings (UTF-8, UTF-16LE, UTF-16BE, UTF-16).
+
+-- Compared with version 05 of the AI, we have added routines for UTF-16
+-- encoding and decoding of wide strings, which seems missing from the AI,
+-- added comments, and reordered the declarations.
+
+-- Note: although this is an Ada 2012 package, the earlier versions of the
+-- language permit the addition of new grandchildren of Ada, so we are able
+-- to add this package unconditionally for use in Ada 2005 mode. We cannot
+-- allow it in earlier versions, since it requires Wide_Wide_Character/String.
+
+package Ada.Strings.UTF_Encoding is
+ pragma Pure (UTF_Encoding);
+
+ type Encoding_Scheme is (UTF_None, UTF_8, UTF_16BE, UTF_16LE, UTF_16);
+
+ subtype Short_Encoding is Encoding_Scheme range UTF_8 .. UTF_16LE;
+ subtype Long_Encoding is Encoding_Scheme range UTF_16 .. UTF_16;
+
+ -- The BOM (BYTE_ORDER_MARK) values defined here are used at the start of
+ -- a string to indicate the encoding. The convention in this package is
+ -- that decoding routines ignore a BOM, and output of encoding routines
+ -- does not include a BOM. If you want to include a BOM in the output,
+ -- you simply concatenate the appropriate value at the start of the string.
+
+ BOM_8 : constant String :=
+ Character'Val (16#EF#) &
+ Character'Val (16#BB#) &
+ Character'Val (16#BF#);
+
+ BOM_16BE : constant String :=
+ Character'Val (16#FE#) &
+ Character'Val (16#FF#);
+
+ BOM_16LE : constant String :=
+ Character'Val (16#FF#) &
+ Character'Val (16#FE#);
+
+ BOM_16 : constant Wide_String :=
+ (1 => Wide_Character'Val (16#FEFF#));
+
+ -- The encoding routines take a wide string or wide wide string as input
+ -- and encode the result using the specified UTF encoding method. For
+ -- UTF-16, the output is returned as a Wide_String, this is not a normal
+ -- Wide_String, since the codes in it may represent UTF-16 surrogate
+ -- characters used to encode large values. Similarly for UTF-8, UTF-16LE,
+ -- and UTF-16BE, the output is returned in a String, and again this String
+ -- is not a standard format string, since it may include UTF-8 surrogates.
+ -- As previously noted, the returned value does NOT start with a BOM.
+
+ -- Note: invalid codes in calls to one of the Encode routines represent
+ -- invalid values in the sense that they are not defined. For example, the
+ -- code 16#DC03# is not a valid wide character value. Such values result
+ -- in undefined behavior. For GNAT, Constraint_Error is raised with an
+ -- appropriate exception message.
+
+ function Encode
+ (Item : Wide_String;
+ Scheme : Short_Encoding := UTF_8) return String;
+ function Encode
+ (Item : Wide_Wide_String;
+ Scheme : Short_Encoding := UTF_8) return String;
+
+ function Encode
+ (Item : Wide_String;
+ Scheme : Long_Encoding := UTF_16) return Wide_String;
+ function Encode
+ (Item : Wide_Wide_String;
+ Scheme : Long_Encoding := UTF_16) return Wide_String;
+
+ -- The decoding routines take a String or Wide_String input which is an
+ -- encoded string using the specified encoding. The output is a normal
+ -- Ada Wide_String or Wide_Wide_String value representing the decoded
+ -- values. Note that a BOM in the input matching the encoding is skipped.
+
+ Encoding_Error : exception;
+ -- Exception raised if an invalid encoding sequence is encountered by
+ -- one of the Decode routines.
+
+ function Decode
+ (Item : String;
+ Scheme : Short_Encoding := UTF_8) return Wide_String;
+ function Decode
+ (Item : String;
+ Scheme : Short_Encoding := UTF_8) return Wide_Wide_String;
+
+ function Decode
+ (Item : Wide_String;
+ Scheme : Long_Encoding := UTF_16) return Wide_String;
+ function Decode
+ (Item : Wide_String;
+ Scheme : Long_Encoding := UTF_16) return Wide_Wide_String;
+
+ -- The Encoding functions inspect an encoded string or wide_string and
+ -- determine if a BOM is present. If so, the appropriate Encoding_Scheme
+ -- is returned. If not, then UTF_None is returned.
+
+ function Encoding (Item : String) return Encoding_Scheme;
+ function Encoding (Item : Wide_String) return Encoding_Scheme;
+
+end Ada.Strings.UTF_Encoding;
Gname5 : aliased constant String := "gnat05";
Vname5 : aliased constant String := "05";
+ Gname6 : aliased constant String := "gnat12";
+ Vname6 : aliased constant String := "12";
+
type Cstring_Ptr is access constant String;
Gnames : array (Nat range <>) of Cstring_Ptr :=
Gname2'Access,
Gname3'Access,
Gname4'Access,
- Gname5'Access);
+ Gname5'Access,
+ Gname6'Access);
Vnames : array (Nat range <>) of Cstring_Ptr :=
(Vname1'Access,
Vname2'Access,
Vname3'Access,
Vname4'Access,
- Vname5'Access);
+ Vname5'Access,
+ Vname6'Access);
-----------------------------------------------------
-- Global Values Used for Error Message Insertions --
Rewrite (HSS,
Make_Handled_Sequence_Of_Statements (Loc,
- Statements => New_List (Blk_Stm)));
+ Statements => New_List (Blk_Stm),
+ End_Label => Relocate_Node (End_Label (HSS))));
-- Set block statement as analyzed, we don't want to actually call
-- Analyze on this block, it would cause a recursion in exception
Relmt := First_Elmt (Local_Raise_Statements (Handler));
while Present (Relmt) loop
declare
- Raise_S : constant Node_Id := Node (Relmt);
-
+ Raise_S : constant Node_Id := Node (Relmt);
+ RLoc : constant Source_Ptr := Sloc (Raise_S);
Name_L1 : constant Node_Id :=
New_Occurrence_Of (L1_Dent, Loc);
-
Goto_L1 : constant Node_Id :=
- Make_Goto_Statement (Loc,
+ Make_Goto_Statement (RLoc,
Name => Name_L1);
begin
ada/casing.ads ada/casing.adb ada/checks.ads ada/csets.ads \
ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
- ada/exp_ch11.ads ada/exp_disp.ads ada/exp_tss.ads ada/exp_util.ads \
- ada/fname.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
- ada/g-hesorg.ads ada/g-htable.ads ada/hostparm.ads ada/interfac.ads \
- ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-sort.adb \
- ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
- ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
- ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
+ ada/exp_ch11.ads ada/exp_disp.ads ada/exp_dist.ads ada/exp_tss.ads \
+ ada/exp_util.ads ada/fname.ads ada/fname-uf.ads ada/freeze.ads \
+ ada/get_targ.ads ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads \
+ ada/hostparm.ads ada/interfac.ads ada/lib.ads ada/lib.adb \
+ ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-xref.ads \
+ ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
+ ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
+ ada/rident.ads ada/rtsfind.ads ada/rtsfind.adb ada/scans.ads \
ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_attr.ads \
- ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch6.ads ada/sem_ch8.ads \
- ada/sem_disp.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads \
- ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
- ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
- ada/snames.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
- ada/style.ads ada/styleg.ads ada/styleg.adb ada/stylesw.ads \
- ada/system.ads ada/s-carun8.ads ada/s-crc32.ads ada/s-crc32.adb \
- ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads \
- ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
- ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
- ada/s-stoele.ads ada/s-stoele.adb ada/s-strhas.ads ada/s-string.ads \
- ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads \
- ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
- ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
- ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \
- ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
- ada/widechar.ads
+ ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch6.ads ada/sem_ch7.ads \
+ ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_eval.ads \
+ ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
+ ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
+ ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \
+ ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
+ ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-carun8.ads \
+ ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads ada/s-htable.ads \
+ ada/s-htable.adb ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
+ ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
+ ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
+ ada/s-strhas.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
+ ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
+ ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
+ ada/ttypes.ads ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb \
+ ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
+ ada/urealp.adb ada/widechar.ads
ada/sem_vfpt.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
* Pragma Ada_95::
* Pragma Ada_05::
* Pragma Ada_2005::
+* Pragma Ada_12::
+* Pragma Ada_2012::
* Pragma Annotate::
* Pragma Assert::
* Pragma Assume_No_Invalid_Values::
* Pragma Export_Value::
* Pragma Export_Valued_Procedure::
* Pragma Extend_System::
+* Pragma Extensions_Allowed::
* Pragma External::
* Pragma External_Name_Casing::
* Pragma Fast_Math::
* Pragma Ada_95::
* Pragma Ada_05::
* Pragma Ada_2005::
+* Pragma Ada_12::
+* Pragma Ada_2012::
* Pragma Annotate::
* Pragma Assert::
* Pragma Assume_No_Invalid_Values::
* Pragma Export_Value::
* Pragma Export_Valued_Procedure::
* Pragma Extend_System::
+* Pragma Extensions_Allowed::
* Pragma External::
* Pragma External_Name_Casing::
* Pragma Fast_Math::
@noindent
A configuration pragma that establishes Ada 2005 mode for the unit to which
it applies, regardless of the mode set by the command line switches.
-This mode is set automatically for the @code{Ada} and @code{System}
-packages and their children, so you need not specify it in these
-contexts. This pragma is useful when writing a reusable component that
+This pragma is useful when writing a reusable component that
itself uses Ada 2005 features, but which is intended to be usable from
either Ada 83 or Ada 95 programs.
This configuration pragma is a synonym for pragma Ada_05 and has the
same syntax and effect.
+@node Pragma Ada_12
+@unnumberedsec Pragma Ada_12
+@findex Ada_12
+@noindent
+Syntax:
+@smallexample @c ada
+pragma Ada_12;
+@end smallexample
+
+@noindent
+A configuration pragma that establishes Ada 2012 mode for the unit to which
+it applies, regardless of the mode set by the command line switches.
+This mode is set automatically for the @code{Ada} and @code{System}
+packages and their children, so you need not specify it in these
+contexts. This pragma is useful when writing a reusable component that
+itself uses Ada 2012 features, but which is intended to be usable from
+Ada 83, Ada 95, or Ada 2005 programs.
+
+@node Pragma Ada_2012
+@unnumberedsec Pragma Ada_2012
+@findex Ada_2005
+@noindent
+Syntax:
+@smallexample @c ada
+pragma Ada_2012;
+@end smallexample
+
+@noindent
+This configuration pragma is a synonym for pragma Ada_12 and has the
+same syntax and effect.
+
@node Pragma Annotate
@unnumberedsec Pragma Annotate
@findex Annotate
system units. @xref{Top, @value{EDITION} User's Guide, About This
Guide,, gnat_ugn, @value{EDITION} User's Guide}, for details.
+@node Pragma Extensions_Allowed
+@unnumberedsec Pragma Extensions_Allowed
+@cindex Ada Extensions
+@cindex GNAT Extensions
+@findex Extensions_Allowed
+@noindent
+Syntax:
+
+@smallexample @c ada
+pragma Extensions_Allowed (On | Off);
+@end smallexample
+
+@noindent
+This configuration pragma enables or disables the implementation
+extension mode (the use of Off as a parameter cancels the effect
+of the @option{-gnatX} command switch).
+
+In extension mode, the latest version of the Ada language is
+implemented (currently Ada 2012), and in addition a small number
+of GNAT specific extensions are recognized as follows:
+
+@table @asis
+@item Constrained attribute for generic objects
+The @code{Constrained} attribute is permitted for objects of
+generic types. The result indicates if the corresponding actual
+is constrained.
+
+@end table
+
@node Pragma External
@unnumberedsec Pragma External
@findex External
state. See A.5.2(38).
@end cartouche
@noindent
-The value returned by the Image function is the concatenation of
-the fixed-width decimal representations of the 624 32-bit integers
+The value returned by the Image function is the concatenation of
+the fixed-width decimal representations of the 624 32-bit integers
of the state vector.
@sp 1
@cindex @option{-gnat05} (@command{gcc})
Allow full Ada 2005 features.
+@item -gnat2005
+@cindex @option{-gnat2005} (@command{gcc})
+Allow full Ada 2005 features (same as @option{-gnat05}
+
+@item -gnat12
+@cindex @option{-gnat12} (@command{gcc})
+
+@item -gnat2012
+@cindex @option{-gnat2012} (@command{gcc})
+Allow full Ada 2012 features (same as @option{-gnat12}
+
@item -gnata
@cindex @option{-gnata} (@command{gcc})
Assertions enabled. @code{Pragma Assert} and @code{pragma Debug} to be
@cindex @option{-gnatx} (@command{gcc})
Suppress generation of cross-reference information.
+@item -gnatX
+@cindex @option{-gnatX} (@command{gcc})
+Enable GNAT implementation extensions and latest Ada version.
+
@item ^-gnaty^/STYLE_CHECKS=(option,option@dots{})^
@cindex @option{^-gnaty^/STYLE_CHECKS^} (@command{gcc})
Enable built-in style checks (@pxref{Style Checking}).
messages or warnings.
This switch also can be used to cancel the effect of a previous
-@option{-gnat83} or @option{-gnat05} switch earlier in the command line.
+@option{-gnat83}, @option{-gnat05/2005}, or @option{-gnat12/2012}
+switch earlier in the command line.
-@item -gnat05 (Ada 2005 mode)
+@item -gnat05 or -gnat2005 (Ada 2005 mode)
@cindex @option{-gnat05} (@command{gcc})
+@cindex @option{-gnat2005} (@command{gcc})
@cindex Ada 2005 mode
@noindent
This switch directs the compiler to implement the Ada 2005 version of the
-language.
+language, as documented in the official Ada standards document.
Since Ada 2005 is almost completely upwards
compatible with Ada 95 (and thus also with Ada 83), Ada 83 and Ada 95 programs
may generally be compiled using this switch (see the description of the
@option{-gnat83} and @option{-gnat95} switches for further
information).
+Note that even though Ada 2005 is the current official version of the
+language, GNAT still compiles in Ada 95 mode by default, so if you are
+using Ada 2005 features in your program, you must use this switch (or
+the equivalent Ada_05 or Ada_2005 configuration pragmas).
+
+@item -gnat12 or -gnat2012 (Ada 2012 mode)
+@cindex @option{-gnat12} (@command{gcc})
+@cindex @option{-gnat2012} (@command{gcc})
+@cindex Ada 2012 mode
+
+@noindent
+This switch directs the compiler to implement the Ada 2012 version of the
+language.
+Since Ada 2012 is almost completely upwards
+compatible with Ada 2005 (and thus also with Ada 83, and Ada 95),
+Ada 83 and Ada 95 programs
+may generally be compiled using this switch (see the description of the
+@option{-gnat83}, @option{-gnat95}, and @option{-gnat05/2005} switches
+for further information).
+
For information about the approved ``Ada Issues'' that have been incorporated
-into Ada 2005, see @url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs}.
-Included with GNAT releases is a file @file{features-ada0y} that describes
-the set of implemented Ada 2005 features.
-@end table
+into Ada 2012, see @url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs}.
+Included with GNAT releases is a file @file{features-ada12} that describes
+the set of implemented Ada 2012 features.
+
+@item -gnatX (Enable GNAT Extensions)
+@cindex @option{-gnatX} (@command{gcc})
+@cindex Ada language extensions
+@cindex GNAT extensions
+
+@noindent
+This switch directs the compiler to implement the latest version of the
+language (currently Ada 2012) and also to enable certain GNAT implementation
+extensions that are not part of any Ada standard. For a full list of these
+extensions, see the GNAT reference manual.
+@end table
@node Character Set Control
@subsection Character Set Control
Ada_95
Ada_05
Ada_2005
+ Ada_12
+ Ada_2012
Assertion_Policy
Assume_No_Invalid_Values
C_Pass_By_Copy
Restrictions
Restrictions_Warnings
Reviewable
+ Short_Circuit_And_Or
Source_File_Name
Source_File_Name_Project
Style_Checks
a separate subprogram specification which must appear before the
subprogram body.
-GNAT also supplies a number of implementation-defined pragmas as follows:
+GNAT also supplies a number of implementation-defined pragmas including the
+following:
+
@itemize @bullet
@item @code{ABORT_DEFER}
@item @code{ADA_05}
+@item @code{Ada_2005}
+
+@item @code{Ada_12}
+
+@item @code{Ada_2012}
+
@item @code{ANNOTATE}
@item @code{ASSERT}
@end itemize
@noindent
-For full details on these GNAT implementation-defined pragmas,
+For full details on these and other GNAT implementation-defined pragmas,
see @ref{Implementation Defined Pragmas,,, gnat_rm, GNAT Reference
Manual}.
"a-szuzti", -- Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO
"a-zchuni", -- Ada.Wide_Wide_Characters.Unicode
+ -- Note: strictly the next one should be an Ada 2012 unit, but it seems
+ -- harmless (and useful) to make it available in Ada 2005 mode.
+
+ "a-stuten", -- Ada.Strings.UTF_Encoding
+
---------------------------
-- GNAT Special IO Units --
---------------------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
with Lib; use Lib;
with Namet; use Namet;
with Nlists; use Nlists;
-with Opt; use Opt;
with Sem_Aux; use Sem_Aux;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch10; use Sem_Ch10;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
-- Frontend, and thus are not mutually recursive.
with Alloc;
+with Opt; use Opt;
with Sem; use Sem;
with Table;
with Types; use Types;
-- This means we have to capture this information from the current scope
-- at the point of instantiation.
+ Version : Ada_Version_Type;
+ -- The body must be compiled with the same language version as the
+ -- spec. The version may be set by a configuration pragma in a separate
+ -- file or in the current file, and may differ from body to body.
end record;
package Pending_Instantiations is new Table.Table (
-- GNATBIND, GNATLINK
-- Set True if binder file to be generated in Ada rather than C
- type Ada_Version_Type is (Ada_83, Ada_95, Ada_05);
- pragma Warnings (Off, Ada_Version_Type);
+ type Ada_Version_Type is (Ada_83, Ada_95, Ada_05, Ada_12);
-- Versions of Ada for Ada_Version below. Note that these are ordered,
-- so that tests like Ada_Version >= Ada_95 are legitimate and useful.
- -- The Warnings_Off pragma stops warnings for Ada_Version >= Ada_05,
- -- which we want to allow, so that things work OK when Ada_15 is added!
- -- This warning is now removed, so this pragma can be removed some time???
Ada_Version_Default : constant Ada_Version_Type := Ada_05;
+ pragma Warnings (Off, Ada_Version_Default);
-- GNAT
- -- Default Ada version if no switch given
+ -- Default Ada version if no switch given. The Warnings off is to kill
+ -- constant condition warnings.
Ada_Version : Ada_Version_Type := Ada_Version_Default;
-- GNAT
-- the rare cases (notably for pragmas Preelaborate_05 and Pure_05)
-- where in the run-time we want the explicit version set.
- Ada_Version_Runtime : Ada_Version_Type := Ada_05;
+ Ada_Version_Runtime : Ada_Version_Type := Ada_12;
-- GNAT
-- Ada version used to compile the runtime. Used to set Ada_Version (but
-- not Ada_Version_Explicit) when compiling predefined or internal units.
elsif Nkind_In (N, N_In, N_Not_In)
and then Paren_Count (N) = 0
then
- Error_Msg_N ("|this expression must be parenthesized!", N);
Error_Msg_N
- ("\|since extensions (and set notation) are allowed", N);
+ ("|this expression must be parenthesized in Ada 2012 mode!", N);
end if;
end Check_Restricted_Expression;
-- Expression
else
- -- If extensions are permitted then the expression must be a
- -- simple expression. The resaon for this restriction (i.e.
- -- going back to the Ada 83 rule) is to avoid ambiguities
- -- when set membership operations are allowed, consider the
+ -- In Ada 2012 mode, the expression must be a simple
+ -- expression. The resaon for this restriction (i.e. going
+ -- back to the Ada 83 rule) is to avoid ambiguities when set
+ -- membership operations are allowed, consider the
-- following:
-- when A in 1 .. 10 | 12 =>
-- when (A in 1 .. 10 | 12) =>
-- when (A in 1 .. 10) | 12 =>
- -- To solve this, if extensins are enabled, we disallow
+ -- To solve this, in Ada 2012 mode, we disallow
-- the use of membership operations in expressions in
-- choices. Technically in the grammar, the expression
-- must match the grammar for restricted expression.
- if Extensions_Allowed then
+ if Ada_Version >= Ada_12 then
Check_Restricted_Expression (Expr_Node);
-- In Ada 83 mode, the syntax required a simple expression
-- If this looks like a conditional expression, then treat it
-- that way with an error message.
- elsif Extensions_Allowed then
+ elsif Ada_Version >= Ada_12 then
Error_Msg_SC
("conditional expression must be parenthesized");
return P_Conditional_Expression;
-- If this looks like a case expression, then treat it that way
-- with an error message.
- elsif Extensions_Allowed then
+ elsif Ada_Version >= Ada_12 then
Error_Msg_SC ("case expression must be parenthesized");
return P_Case_Expression;
Save_State : Saved_Scan_State;
begin
- if not Extensions_Allowed then
- Error_Msg_SC ("|case expression is an Ada extension");
- Error_Msg_SC ("\|use -gnatX switch to compile this unit");
+ if Ada_Version < Ada_12 then
+ Error_Msg_SC ("|case expression is an Ada 2012 feature");
+ Error_Msg_SC ("\|use -gnat12 switch to compile this unit");
end if;
Scan; -- past CASE
begin
Inside_Conditional_Expression := Inside_Conditional_Expression + 1;
- if Token = Tok_If and then not Extensions_Allowed then
- Error_Msg_SC ("|conditional expression is an Ada extension");
- Error_Msg_SC ("\|use -gnatX switch to compile this unit");
+ if Token = Tok_If and then Ada_Version < Ada_12 then
+ Error_Msg_SC ("|conditional expression is an Ada 2012 feature");
+ Error_Msg_SC ("\|use -gnat12 switch to compile this unit");
end if;
Scan; -- past IF or ELSIF
procedure P_Membership_Test (N : Node_Id) is
Alt : constant Node_Id :=
P_Range_Or_Subtype_Mark
- (Allow_Simple_Expression => Extensions_Allowed);
+ (Allow_Simple_Expression => (Ada_Version >= Ada_12));
begin
-- Set case
if Token = Tok_Vertical_Bar then
- if not Extensions_Allowed then
- Error_Msg_SC ("set notation is a language extension");
- Error_Msg_SC ("\|use -gnatX switch to compile this unit");
+ if Ada_Version < Ada_12 then
+ Error_Msg_SC ("set notation is an Ada 2012 feature");
+ Error_Msg_SC ("\|use -gnat12 switch to compile this unit");
end if;
Set_Alternatives (N, New_List (Alt));
-- Ada_05/Ada_2005 --
---------------------
- -- This pragma must be processed at parse time, since we want to set
+ -- These pragmas must be processed at parse time, since we want to set
-- the Ada version properly at parse time to recognize the appropriate
-- Ada version syntax. However, it is only the zero argument form that
-- must be processed at parse time.
Ada_Version_Explicit := Ada_05;
end if;
+ ---------------------
+ -- Ada_12/Ada_2012 --
+ ---------------------
+
+ -- These pragmas must be processed at parse time, since we want to set
+ -- the Ada version properly at parse time to recognize the appropriate
+ -- Ada version syntax.
+
+ when Pragma_Ada_12 | Pragma_Ada_2012 =>
+ Ada_Version := Ada_12;
+ Ada_Version_Explicit := Ada_12;
+
-----------
-- Debug --
-----------
if Chars (Expression (Arg1)) = Name_On then
Extensions_Allowed := True;
+ Ada_Version := Ada_12;
else
Extensions_Allowed := False;
+ Ada_Version := Ada_Version_Explicit;
end if;
----------------
Expander_Status => Expander_Active,
Current_Sem_Unit => Current_Sem_Unit,
Scope_Suppress => Scope_Suppress,
- Local_Suppress_Stack_Top => Local_Suppress_Stack_Top));
+ Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
+ Version => Ada_Version));
end if;
end if;
Expander_Status => Expander_Active,
Current_Sem_Unit => Current_Sem_Unit,
Scope_Suppress => Scope_Suppress,
- Local_Suppress_Stack_Top => Local_Suppress_Stack_Top)),
+ Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
+ Version => Ada_Version)),
Inlined_Body => True);
Pop_Scope;
Expander_Status => Expander_Active,
Current_Sem_Unit => Current_Sem_Unit,
Scope_Suppress => Scope_Suppress,
- Local_Suppress_Stack_Top => Local_Suppress_Stack_Top)),
+ Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
+ Version => Ada_Version)),
Inlined_Body => True);
end if;
end Inline_Instance_Body;
Expander_Status => Expander_Active,
Current_Sem_Unit => Current_Sem_Unit,
Scope_Suppress => Scope_Suppress,
- Local_Suppress_Stack_Top => Local_Suppress_Stack_Top));
+ Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
+ Version => Ada_Version));
return True;
else
return False;
Local_Suppress_Stack_Top := Body_Info.Local_Suppress_Stack_Top;
Scope_Suppress := Body_Info.Scope_Suppress;
+ Opt.Ada_Version := Body_Info.Version;
if No (Gen_Body_Id) then
Load_Parent_Of_Generic
Local_Suppress_Stack_Top := Body_Info.Local_Suppress_Stack_Top;
Scope_Suppress := Body_Info.Scope_Suppress;
+ Opt.Ada_Version := Body_Info.Version;
if No (Gen_Body_Id) then
Get_Code_Unit (Sloc (Node (Decl))),
Scope_Suppress => Scope_Suppress,
Local_Suppress_Stack_Top =>
- Local_Suppress_Stack_Top);
+ Local_Suppress_Stack_Top,
+ Version => Ada_Version);
-- Package instance
Get_Code_Unit (Sloc (Inst_Node)),
Scope_Suppress => Scope_Suppress,
Local_Suppress_Stack_Top =>
- Local_Suppress_Stack_Top)),
+ Local_Suppress_Stack_Top,
+ Version => Ada_Version)),
Body_Optional => Body_Optional);
end;
end if;
-- In AI-133. This involves gathering all components which start at
-- the same byte offset and processing them together
- when Ada_05 =>
+ when Ada_05 .. Ada_Version_Type'Last =>
declare
Max_Machine_Scalar_Size : constant Uint :=
UI_From_Int
Analyze_Expression (L);
if No (R)
- and then Extensions_Allowed
+ and then Ada_Version >= Ada_12
then
Analyze_Set_Membership;
return;
-- said this was a configuration pragma, but we did not check and
-- are hesitant to add the check now.
- -- However, we really cannot tolerate mixing Ada 2005 with Ada 83
- -- or Ada 95, so we must check if we are in Ada 2005 mode.
+ -- However, we really cannot tolerate mixing Ada 2005 or Ada 2012
+ -- with Ada 83 or Ada 95, so we must check if we are in Ada 2005
+ -- or Ada 2012 mode.
if Ada_Version >= Ada_05 then
Check_Valid_Configuration_Pragma;
end if;
end;
+ ---------------------
+ -- Ada_12/Ada_2012 --
+ ---------------------
+
+ -- pragma Ada_12;
+ -- pragma Ada_2012;
+
+ -- Note: these pragma also have some specific processing in Par.Prag
+ -- because we want to set the Ada 2012 version mode during parsing.
+
+ when Pragma_Ada_12 | Pragma_Ada_2012 =>
+ GNAT_Pragma;
+ Check_Arg_Count (0);
+
+ -- For Ada_2012 we unconditionally enforce the documented
+ -- configuration pragma placement, since we do not want to
+ -- tolerate mixed modes in a unit involving Ada 2012. That would
+ -- cause real difficulties for those cases where there are
+ -- incompatibilities between Ada 95 and Ada 2005/Ada 2012.
+
+ Check_Valid_Configuration_Pragma;
+
+ -- Now set Ada 2012 mode
+
+ Ada_Version := Ada_12;
+ Ada_Version_Explicit := Ada_12;
+
----------------------
-- All_Calls_Remote --
----------------------
if Chars (Expression (Arg1)) = Name_On then
Extensions_Allowed := True;
+ Ada_Version := Ada_Version_Type'Last;
+
else
Extensions_Allowed := False;
+ Ada_Version := Ada_Version_Explicit;
end if;
--------------
-- This is one of the few cases where we need to test the value of
-- Ada_Version_Explicit rather than Ada_Version (which is always
- -- set to Ada_05 in a predefined unit), we need to know the
+ -- set to Ada_12 in a predefined unit), we need to know the
-- explicit version set to know if this pragma is active.
if Ada_Version_Explicit >= Ada_05 then
-- This is one of the few cases where we need to test the value of
-- Ada_Version_Explicit rather than Ada_Version (which is always
- -- set to Ada_05 in a predefined unit), we need to know the
+ -- set to Ada_12 in a predefined unit), we need to know the
-- explicit version set to know if this pragma is active.
if Ada_Version_Explicit >= Ada_05 then
Pragma_Ada_95 => -1,
Pragma_Ada_05 => -1,
Pragma_Ada_2005 => -1,
+ Pragma_Ada_12 => -1,
+ Pragma_Ada_2012 => -1,
Pragma_All_Calls_Remote => -1,
Pragma_Annotate => -1,
Pragma_Assert => -1,
package Snames is
-- This package contains definitions of standard names (i.e. entries in the
--- Names table) that are used throughout the GNAT compiler). It also contains
+-- Names table) that are used throughout the GNAT compiler. It also contains
-- the definitions of some enumeration types whose definitions are tied to
-- the order of these preset names.
Name_Ada_95 : constant Name_Id := N + $; -- GNAT
Name_Ada_05 : constant Name_Id := N + $; -- GNAT
Name_Ada_2005 : constant Name_Id := N + $; -- GNAT
+ Name_Ada_12 : constant Name_Id := N + $; -- GNAT
+ Name_Ada_2012 : constant Name_Id := N + $; -- GNAT
Name_Assertion_Policy : constant Name_Id := N + $; -- Ada 05
Name_Assume_No_Invalid_Values : constant Name_Id := N + $; -- GNAT
Name_C_Pass_By_Copy : constant Name_Id := N + $; -- GNAT
Pragma_Ada_95,
Pragma_Ada_05,
Pragma_Ada_2005,
+ Pragma_Ada_12,
+ Pragma_Ada_2012,
Pragma_Assertion_Policy,
Pragma_Assume_No_Invalid_Values,
Pragma_C_Pass_By_Copy,
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2010, 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- --
System_Extend_Unit := Empty;
Warning_Mode := Treat_As_Error;
- -- Set Ada 2005 mode explicitly. We don't want to rely on the
+ -- Set Ada 2012 mode explicitly. We don't want to rely on the
-- implicit setting here, since for example, we want
-- Preelaborate_05 treated as Preelaborate
- Ada_Version := Ada_05;
+ Ada_Version := Ada_12;
Ada_Version_Explicit := Ada_Version;
-- Set default warnings and style checks for -gnatg
when 'X' =>
Ptr := Ptr + 1;
Extensions_Allowed := True;
+ Ada_Version := Ada_Version_Type'Last;
+ Ada_Version_Explicit := Ada_Version_Type'Last;
-- Processing for y switch
Ada_Version_Explicit := Ada_Version;
end if;
+ -- Processing for 12 switch
+
+ when '1' =>
+ if Ptr = Max then
+ Bad_Switch ("-gnat1");
+ end if;
+
+ Ptr := Ptr + 1;
+
+ if Switch_Chars (Ptr) /= '2' then
+ Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max));
+ else
+ Ptr := Ptr + 1;
+ Ada_Version := Ada_12;
+ Ada_Version_Explicit := Ada_Version;
+ end if;
+
+ -- Processing for 2005 and 2012 switches
+
+ when '2' =>
+ if Ptr > Max - 3 then
+ Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
+
+ elsif Switch_Chars (Ptr .. Ptr + 3) = "2005" then
+ Ada_Version := Ada_05;
+
+ elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
+ Ada_Version := Ada_12;
+
+ else
+ Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3));
+ end if;
+
+ Ada_Version_Explicit := Ada_Version;
+ Ptr := Ptr + 4;
+
-- Switch cancellation, currently only -gnat-p is allowed.
-- All we do here is the error checking, since the actual
-- processing for switch cancellation is done by calls to
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
if Ada_Version_Default = Ada_05 then
Write_Line ("Ada 2005 mode (default)");
else
- Write_Line ("Allow Ada 2005 extensions");
+ Write_Line ("Enforce Ada 2005 restrictions");
+ end if;
+
+ -- Line for -gnat12 switch
+
+ Write_Switch_Char ("12");
+
+ if Ada_Version_Default = Ada_12 then
+ Write_Line ("Ada 2012 mode (default)");
+ else
+ Write_Line ("Allow Ada 2012 extensions");
end if;
-- Line for -gnat-p switch
"-gnat05";
-- /05 (D)
--
- -- Allows GNAT to recognize all implemented proposed Ada 2005
+ -- Allows GNAT to recognize the full range of Ada 2005 constructs.
+
+ S_GCC_Ada_12 : aliased constant S := "/12 " &
+ "-gnat12";
+ -- /05 (D)
+ --
+ -- Allows GNAT to recognize all implemented proposed Ada 2012
-- extensions. See features file for list of implemented features.
S_GCC_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" &
OSDN Git Service
