diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-06-23 11:53:24 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-06-23 11:53:24 +0200 |
commit | 0eed45bbe286757689d39d5f345842b67c023ce4 (patch) | |
tree | 682a591ce203dec73771dbec80125a9be4066201 /gcc | |
parent | 6b8cdb0ac2a57a4d025254e4e7e9cbb54fc72862 (diff) | |
download | gcc-0eed45bbe286757689d39d5f345842b67c023ce4.zip gcc-0eed45bbe286757689d39d5f345842b67c023ce4.tar.gz gcc-0eed45bbe286757689d39d5f345842b67c023ce4.tar.bz2 |
[multiple changes]
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.
From-SVN: r161268
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 48 | ||||
-rw-r--r-- | gcc/ada/Makefile.rtl | 1 | ||||
-rw-r--r-- | gcc/ada/a-stuten.adb | 1032 | ||||
-rw-r--r-- | gcc/ada/a-stuten.ads | 117 | ||||
-rw-r--r-- | gcc/ada/errout.ads | 9 | ||||
-rw-r--r-- | gcc/ada/exp_ch11.adb | 10 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/Make-lang.in | 49 | ||||
-rw-r--r-- | gcc/ada/gnat_rm.texi | 74 | ||||
-rw-r--r-- | gcc/ada/gnat_ugn.texi | 77 | ||||
-rw-r--r-- | gcc/ada/impunit.adb | 5 | ||||
-rw-r--r-- | gcc/ada/inline.adb | 3 | ||||
-rw-r--r-- | gcc/ada/inline.ads | 7 | ||||
-rw-r--r-- | gcc/ada/opt.ads | 12 | ||||
-rw-r--r-- | gcc/ada/par-ch3.adb | 15 | ||||
-rw-r--r-- | gcc/ada/par-ch4.adb | 24 | ||||
-rw-r--r-- | gcc/ada/par-prag.adb | 16 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 20 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_ch4.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 41 | ||||
-rw-r--r-- | gcc/ada/snames.ads-tmpl | 6 | ||||
-rw-r--r-- | gcc/ada/switch-c.adb | 44 | ||||
-rw-r--r-- | gcc/ada/usage.adb | 14 | ||||
-rw-r--r-- | gcc/ada/vms_data.ads | 8 |
24 files changed, 1541 insertions, 95 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5af1505..6874fe5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,51 @@ +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 diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index c130ad3..236ddde 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -211,6 +211,7 @@ GNATRTL_NONTASKING_OBJS= \ a-ststio$(objext) \ a-stunau$(objext) \ a-stunha$(objext) \ + a-stuten$(objext) \ a-stwibo$(objext) \ a-stwifi$(objext) \ a-stwiha$(objext) \ diff --git a/gcc/ada/a-stuten.adb b/gcc/ada/a-stuten.adb new file mode 100644 index 0000000..7571bda --- /dev/null +++ b/gcc/ada/a-stuten.adb @@ -0,0 +1,1032 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/a-stuten.ads b/gcc/ada/a-stuten.ads new file mode 100644 index 0000000..33b5aec --- /dev/null +++ b/gcc/ada/a-stuten.ads @@ -0,0 +1,117 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index a6a72ae..8251126 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -376,6 +376,9 @@ package Errout is 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 := @@ -383,14 +386,16 @@ package Errout is 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 -- diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 20c9d47..111bc18 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -666,7 +666,8 @@ package body Exp_Ch11 is 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 @@ -741,13 +742,12 @@ package body Exp_Ch11 is 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 diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 8b92f1e..9bf7a47 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -4035,31 +4035,32 @@ ada/sem_util.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ 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 \ diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 76e2efc..e4a39e1 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -99,6 +99,8 @@ Implementation Defined Pragmas * Pragma Ada_95:: * Pragma Ada_05:: * Pragma Ada_2005:: +* Pragma Ada_12:: +* Pragma Ada_2012:: * Pragma Annotate:: * Pragma Assert:: * Pragma Assume_No_Invalid_Values:: @@ -132,6 +134,7 @@ Implementation Defined Pragmas * Pragma Export_Value:: * Pragma Export_Valued_Procedure:: * Pragma Extend_System:: +* Pragma Extensions_Allowed:: * Pragma External:: * Pragma External_Name_Casing:: * Pragma Fast_Math:: @@ -712,6 +715,8 @@ consideration, the use of these pragmas should be minimized. * Pragma Ada_95:: * Pragma Ada_05:: * Pragma Ada_2005:: +* Pragma Ada_12:: +* Pragma Ada_2012:: * Pragma Annotate:: * Pragma Assert:: * Pragma Assume_No_Invalid_Values:: @@ -745,6 +750,7 @@ consideration, the use of these pragmas should be minimized. * Pragma Export_Value:: * Pragma Export_Valued_Procedure:: * Pragma Extend_System:: +* Pragma Extensions_Allowed:: * Pragma External:: * Pragma External_Name_Casing:: * Pragma Fast_Math:: @@ -903,9 +909,7 @@ pragma Ada_05; @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. @@ -922,6 +926,37 @@ pragma Ada_2005; 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 @@ -2174,6 +2209,35 @@ it you will have to use the appropriate switch for compiling 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 @@ -8879,8 +8943,8 @@ The algorithm is the Mersenne Twister, as documented in the source file 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 diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index a786e2f..e18baef 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -4060,6 +4060,17 @@ Enforce Ada 95 restrictions. @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 @@ -4359,6 +4370,10 @@ Wide character encoding method @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}). @@ -6900,27 +6915,60 @@ uses of the new Ada 2005 features will cause error 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 @@ -11353,6 +11401,8 @@ recognized by GNAT: Ada_95 Ada_05 Ada_2005 + Ada_12 + Ada_2012 Assertion_Policy Assume_No_Invalid_Values C_Pass_By_Copy @@ -11396,6 +11446,7 @@ recognized by GNAT: Restrictions Restrictions_Warnings Reviewable + Short_Circuit_And_Or Source_File_Name Source_File_Name_Project Style_Checks @@ -20667,7 +20718,9 @@ Unlike HP Ada, the GNAT ``@code{EXPORT_}@i{subprogram}'' pragmas require 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} @@ -20677,6 +20730,12 @@ GNAT also supplies a number of implementation-defined pragmas as follows: @item @code{ADA_05} +@item @code{Ada_2005} + +@item @code{Ada_12} + +@item @code{Ada_2012} + @item @code{ANNOTATE} @item @code{ASSERT} @@ -20723,7 +20782,7 @@ GNAT also supplies a number of implementation-defined pragmas as follows: @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}. diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 47e5b16..cff6d67 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -459,6 +459,11 @@ package body Impunit is "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 -- --------------------------- diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index eeeb9da..1379a9e 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -34,7 +34,6 @@ with Fname.UF; use Fname.UF; 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; diff --git a/gcc/ada/inline.ads b/gcc/ada/inline.ads index fec948d..04cb323 100644 --- a/gcc/ada/inline.ads +++ b/gcc/ada/inline.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -36,6 +36,7 @@ -- Frontend, and thus are not mutually recursive. with Alloc; +with Opt; use Opt; with Sem; use Sem; with Table; with Types; use Types; @@ -84,6 +85,10 @@ package Inline is -- 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 ( diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 8758b30..54cec49 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -64,17 +64,15 @@ package Opt is -- 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 @@ -91,7 +89,7 @@ package Opt is -- 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. diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 5285e8f..d1bc039 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -124,9 +124,8 @@ package body Ch3 is 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; @@ -3663,10 +3662,10 @@ package body Ch3 is -- 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 => @@ -3679,12 +3678,12 @@ package body Ch3 is -- 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 diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 6f3a2f2..d90b413 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -2352,7 +2352,7 @@ package body Ch4 is -- 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; @@ -2378,7 +2378,7 @@ package body Ch4 is -- 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; @@ -2668,9 +2668,9 @@ package body Ch4 is 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 @@ -2759,9 +2759,9 @@ package body Ch4 is 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 @@ -2836,15 +2836,15 @@ package body Ch4 is 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)); diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 06c6974..a421592 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -306,7 +306,7 @@ begin -- 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. @@ -317,6 +317,18 @@ begin 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 -- ----------- @@ -374,8 +386,10 @@ begin 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; ---------------- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index ceb4dac..a2009c2 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3394,7 +3394,8 @@ package body Sem_Ch12 is 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; @@ -3701,7 +3702,8 @@ package body Sem_Ch12 is 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; @@ -3816,7 +3818,8 @@ package body Sem_Ch12 is 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; @@ -3855,7 +3858,8 @@ package body Sem_Ch12 is 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; @@ -8590,6 +8594,7 @@ package body Sem_Ch12 is 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 @@ -8853,6 +8858,7 @@ package body Sem_Ch12 is 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 @@ -10801,7 +10807,8 @@ package body Sem_Ch12 is 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 @@ -10841,7 +10848,8 @@ package body Sem_Ch12 is 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; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index cf151e9..8690807 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -315,7 +315,7 @@ package body Sem_Ch13 is -- 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 diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 5ba2595..743d128 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -2344,7 +2344,7 @@ package body Sem_Ch4 is Analyze_Expression (L); if No (R) - and then Extensions_Allowed + and then Ada_Version >= Ada_12 then Analyze_Set_Membership; return; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 0fb0ade..764d4f6 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5257,8 +5257,9 @@ package body Sem_Prag is -- 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; @@ -5347,6 +5348,33 @@ package body Sem_Prag is 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 -- ---------------------- @@ -7451,8 +7479,11 @@ package body Sem_Prag is 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; -------------- @@ -10080,7 +10111,7 @@ package body Sem_Prag is -- 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 @@ -10580,7 +10611,7 @@ package body Sem_Prag is -- 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 @@ -12647,6 +12678,8 @@ package body Sem_Prag is 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, diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 546e83c..7170038 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -34,7 +34,7 @@ with Namet; use Namet; 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. @@ -334,6 +334,8 @@ package Snames is 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 @@ -1416,6 +1418,8 @@ package Snames is 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, diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index ccc9986..ab213af 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -532,11 +532,11 @@ package body Switch.C is 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 @@ -903,6 +903,8 @@ package body Switch.C is 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 @@ -1048,6 +1050,42 @@ package body Switch.C is 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 diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 87d2735..2121b7f 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -595,7 +595,17 @@ begin 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 diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index 5e81a28..8454041 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -1227,7 +1227,13 @@ package VMS_Data is "-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=*" & |