[multiple changes]
2014-07-29 Robert Dewar <dewar@adacore.com> * gnat_ugn.texi: Add section on Wide_Wide_Character encodings. * erroutc.adb (Output_Error_Msgs): Take wide characters into account in computing position of error flags. * sinput.adb (Get_Column_Number): Take wide characters into account. 2014-07-29 Ed Schonberg <schonberg@adacore.com> * par-ch3.adb (P_Access_Type_Definition): The subtype indication in an access type definition can carry a null_exclusion indicator. * sem_ch3.adb (Access_Type_Declaration): If the subtype indication carries a null_exclusion indicator, verify that the subtype indication denotes an access type, and create a null-excluding subtype for it. * sinfo.ads, sinfo.adb: New attribute Null_Excluding_Subtype, defined on N_Access_To_Object_Definition to indicate that the subtype indication carries a null_exclusion indicator. 2014-07-29 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch6.adb (Add_Extra_Actual): Do not construct the extra actual by name, generate a reference instead. 2014-07-29 Arnaud Charlet <charlet@adacore.com> * sem_prag.adb (Analyze_Pragma): Do not crash analyzing Allow_Integer_Address if already set. * a-except-2005.adb (Rcheck_PE_Stream_Operation_Not_Allowed): Fix order, for consistency with Rmsg_xx declarations. From-SVN: r213172
This commit is contained in:
Arnaud Charlet
parent
28e18b4f56
commit
7a2c227741
@ -1,3 +1,35 @@
|
||||
2014-07-29 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* gnat_ugn.texi: Add section on Wide_Wide_Character encodings.
|
||||
* erroutc.adb (Output_Error_Msgs): Take wide characters into
|
||||
account in computing position of error flags.
|
||||
* sinput.adb (Get_Column_Number): Take wide characters into
|
||||
account.
|
||||
|
||||
2014-07-29 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* par-ch3.adb (P_Access_Type_Definition): The subtype indication
|
||||
in an access type definition can carry a null_exclusion indicator.
|
||||
* sem_ch3.adb (Access_Type_Declaration): If the subtype indication
|
||||
carries a null_exclusion indicator, verify that the subtype
|
||||
indication denotes an access type, and create a null-excluding
|
||||
subtype for it.
|
||||
* sinfo.ads, sinfo.adb: New attribute Null_Excluding_Subtype,
|
||||
defined on N_Access_To_Object_Definition to indicate that the
|
||||
subtype indication carries a null_exclusion indicator.
|
||||
|
||||
2014-07-29 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_ch6.adb (Add_Extra_Actual): Do not construct
|
||||
the extra actual by name, generate a reference instead.
|
||||
|
||||
2014-07-29 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* sem_prag.adb (Analyze_Pragma): Do not crash analyzing
|
||||
Allow_Integer_Address if already set.
|
||||
* a-except-2005.adb (Rcheck_PE_Stream_Operation_Not_Allowed):
|
||||
Fix order, for consistency with Rmsg_xx declarations.
|
||||
|
||||
2014-07-29 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch4.adb (Complete_Object_Operation): If the type of the
|
||||
|
||||
@ -403,6 +403,9 @@ package body Ada.Exceptions is
|
||||
-- These routines raise a specific exception with a reason message
|
||||
-- attached. The parameters are the file name and line number in each
|
||||
-- case. The names are defined by Exp_Ch11.Get_RT_Exception_Name.
|
||||
-- Note that these routines should be declared in the same order as the
|
||||
-- corresponding Rmsg_xx constants below, this is needed by the
|
||||
-- .NET runtime (see exceptmsg.awk script).
|
||||
|
||||
procedure Rcheck_CE_Access_Check
|
||||
(File : System.Address; Line : Integer);
|
||||
@ -462,8 +465,6 @@ package body Ada.Exceptions is
|
||||
(File : System.Address; Line : Integer);
|
||||
procedure Rcheck_PE_Potentially_Blocking_Operation
|
||||
(File : System.Address; Line : Integer);
|
||||
procedure Rcheck_PE_Stream_Operation_Not_Allowed
|
||||
(File : System.Address; Line : Integer);
|
||||
procedure Rcheck_PE_Stubbed_Subprogram_Called
|
||||
(File : System.Address; Line : Integer);
|
||||
procedure Rcheck_PE_Unchecked_Union_Restriction
|
||||
@ -476,6 +477,8 @@ package body Ada.Exceptions is
|
||||
(File : System.Address; Line : Integer);
|
||||
procedure Rcheck_SE_Object_Too_Large
|
||||
(File : System.Address; Line : Integer);
|
||||
procedure Rcheck_PE_Stream_Operation_Not_Allowed
|
||||
(File : System.Address; Line : Integer);
|
||||
|
||||
procedure Rcheck_CE_Access_Check_Ext
|
||||
(File : System.Address; Line, Column : Integer);
|
||||
|
||||
@ -42,6 +42,7 @@ with Snames; use Snames;
|
||||
with Stringt; use Stringt;
|
||||
with Targparm; use Targparm;
|
||||
with Uintp; use Uintp;
|
||||
with Widechar; use Widechar;
|
||||
|
||||
package body Erroutc is
|
||||
|
||||
@ -445,32 +446,75 @@ package body Erroutc is
|
||||
and then Errors.Table (T).Line = Errors.Table (E).Line
|
||||
and then Errors.Table (T).Sfile = Errors.Table (E).Sfile
|
||||
loop
|
||||
-- Loop to output blanks till current flag position
|
||||
declare
|
||||
Src : Source_Buffer_Ptr
|
||||
renames Source_Text (Errors.Table (T).Sfile);
|
||||
|
||||
while P < Errors.Table (T).Sptr loop
|
||||
if Source_Text (Errors.Table (T).Sfile) (P) = ASCII.HT then
|
||||
Write_Char (ASCII.HT);
|
||||
else
|
||||
Write_Char (' ');
|
||||
begin
|
||||
-- Loop to output blanks till current flag position
|
||||
|
||||
while P < Errors.Table (T).Sptr loop
|
||||
|
||||
-- Horizontal tab case, just echo the tab
|
||||
|
||||
if Src (P) = ASCII.HT then
|
||||
Write_Char (ASCII.HT);
|
||||
P := P + 1;
|
||||
|
||||
-- Deal with wide character case, but don't include brackets
|
||||
-- notation in this circuit, since we know that this will
|
||||
-- display unencoded (no one encodes brackets notation).
|
||||
|
||||
elsif Src (P) /= '['
|
||||
and then Is_Start_Of_Wide_Char (Src, P)
|
||||
then
|
||||
Skip_Wide (Src, P);
|
||||
Write_Char (' ');
|
||||
|
||||
-- Normal non-wide character case (or bracket)
|
||||
|
||||
else
|
||||
P := P + 1;
|
||||
Write_Char (' ');
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
-- Output flag (unless already output, this happens if more
|
||||
-- than one error message occurs at the same flag position).
|
||||
|
||||
if P = Errors.Table (T).Sptr then
|
||||
if (Flag_Num = 1 and then not Mult_Flags)
|
||||
or else Flag_Num > 9
|
||||
then
|
||||
Write_Char ('|');
|
||||
else
|
||||
Write_Char
|
||||
(Character'Val (Character'Pos ('0') + Flag_Num));
|
||||
end if;
|
||||
|
||||
-- Skip past the corresponding source text character
|
||||
|
||||
-- Horizontal tab case, we output a flag at the tab position
|
||||
-- so now we output a tab to match up with the text.
|
||||
|
||||
if Src (P) = ASCII.HT then
|
||||
Write_Char (ASCII.HT);
|
||||
P := P + 1;
|
||||
|
||||
-- Skip wide character other than left bracket
|
||||
|
||||
elsif Src (P) /= '['
|
||||
and then Is_Start_Of_Wide_Char (Src, P)
|
||||
then
|
||||
Skip_Wide (Src, P);
|
||||
|
||||
-- Skip normal non-wide character case (or bracket)
|
||||
|
||||
else
|
||||
P := P + 1;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
P := P + 1;
|
||||
end loop;
|
||||
|
||||
-- Output flag (unless already output, this happens if more
|
||||
-- than one error message occurs at the same flag position).
|
||||
|
||||
if P = Errors.Table (T).Sptr then
|
||||
if (Flag_Num = 1 and then not Mult_Flags)
|
||||
or else Flag_Num > 9
|
||||
then
|
||||
Write_Char ('|');
|
||||
else
|
||||
Write_Char (Character'Val (Character'Pos ('0') + Flag_Num));
|
||||
end if;
|
||||
|
||||
P := P + 1;
|
||||
end if;
|
||||
end;
|
||||
|
||||
Set_Next_Non_Deleted_Msg (T);
|
||||
Flag_Num := Flag_Num + 1;
|
||||
|
||||
@ -2106,7 +2106,7 @@ package body Exp_Ch6 is
|
||||
|
||||
Append_To (Extra_Actuals,
|
||||
Make_Parameter_Association (Loc,
|
||||
Selector_Name => Make_Identifier (Loc, Chars (EF)),
|
||||
Selector_Name => New_Occurrence_Of (EF, Loc),
|
||||
Explicit_Actual_Parameter => Expr));
|
||||
|
||||
Analyze_And_Resolve (Expr, Etype (EF));
|
||||
|
||||
@ -1378,7 +1378,8 @@ of the compiler (@pxref{Character Set Control}).
|
||||
@menu
|
||||
* Latin-1::
|
||||
* Other 8-Bit Codes::
|
||||
* Wide Character Encodings::
|
||||
* Wide_Character Encodings::
|
||||
* Wide_Wide_Character Encodings::
|
||||
@end menu
|
||||
|
||||
@node Latin-1
|
||||
@ -1471,8 +1472,8 @@ equivalences that are recognized, see the file @file{csets.adb} in
|
||||
the GNAT compiler sources. You will need to obtain a full source release
|
||||
of GNAT to obtain this file.
|
||||
|
||||
@node Wide Character Encodings
|
||||
@subsection Wide Character Encodings
|
||||
@node Wide_Character Encodings
|
||||
@subsection Wide_Character Encodings
|
||||
|
||||
@noindent
|
||||
GNAT allows wide character codes to appear in character and string
|
||||
@ -1545,8 +1546,9 @@ where the @var{xxx} bits correspond to the left-padded bits of the
|
||||
are represented as ASCII bytes and all upper half characters and
|
||||
other wide characters are represented as sequences of upper-half
|
||||
(The full UTF-8 scheme allows for encoding 31-bit characters as
|
||||
6-byte sequences, but in this implementation, all UTF-8 sequences
|
||||
of four or more bytes length will be treated as illegal).
|
||||
6-byte sequences, and in the following section on wide wide
|
||||
characters, the use of these sequences is documented).
|
||||
|
||||
@item Brackets Coding
|
||||
In this encoding, a wide character is represented by the following eight
|
||||
character sequence:
|
||||
@ -1564,8 +1566,8 @@ Brackets coding for upper half characters. For example, the code
|
||||
@code{16#A3#} can be represented as @code{[``A3'']}.
|
||||
|
||||
This scheme is compatible with use of the full Wide_Character set,
|
||||
and is also the method used for wide character encoding in the standard
|
||||
ACVC (Ada Compiler Validation Capability) test suite distributions.
|
||||
and is also the method used for wide character encoding in some standard
|
||||
ACATS (Ada Conformity Assessment Test Suite) test suite distributions.
|
||||
|
||||
@end table
|
||||
|
||||
@ -1574,6 +1576,60 @@ Note: Some of these coding schemes do not permit the full use of the
|
||||
Ada character set. For example, neither Shift JIS, nor EUC allow the
|
||||
use of the upper half of the Latin-1 set.
|
||||
|
||||
@node Wide_Wide_Character Encodings
|
||||
@subsection Wide_Wide_Character Encodings
|
||||
|
||||
@noindent
|
||||
GNAT allows wide wide character codes to appear in character and string
|
||||
literals, and also optionally in identifiers, by means of the following
|
||||
possible encoding schemes:
|
||||
|
||||
@table @asis
|
||||
|
||||
@item UTF-8 Coding
|
||||
A wide character is represented using
|
||||
UCS Transformation Format 8 (UTF-8) as defined in Annex R of ISO
|
||||
10646-1/Am.2. Depending on the character value, the representation
|
||||
of character codes with values greater than 16#FFFF# is a
|
||||
is a four, five, or six byte sequence:
|
||||
|
||||
@smallexample
|
||||
@iftex
|
||||
@leftskip=.7cm
|
||||
@end iftex
|
||||
16#01_0000#-16#10_FFFF#: 11110xxx 10xxxxxx 10xxxxxx
|
||||
10xxxxxx
|
||||
16#0020_0000#-16#03FF_FFFF#: 111110xx 10xxxxxx 10xxxxxx
|
||||
10xxxxxx 10xxxxxx
|
||||
16#0400_0000#-16#7FFF_FFFF#: 1111110x 10xxxxxx 10xxxxxx
|
||||
10xxxxxx 10xxxxxx 10xxxxxx
|
||||
@end smallexample
|
||||
|
||||
@noindent
|
||||
where the @var{xxx} bits correspond to the left-padded bits of the
|
||||
32-bit character value.
|
||||
|
||||
@item Brackets Coding
|
||||
In this encoding, a wide wide character is represented by the following ten or
|
||||
twelve byte character sequence:
|
||||
|
||||
@smallexample
|
||||
[ " a b c d e f " ]
|
||||
[ " a b c d e f g h " ]
|
||||
@end smallexample
|
||||
|
||||
@noindent
|
||||
Where @code{a-h} are the six or eight hexadecimal
|
||||
characters (using uppercase letters) of the wide wide character code. For
|
||||
example, ["1F4567"] is used to represent the wide wide character with code
|
||||
@code{16#001F_4567#}.
|
||||
|
||||
This scheme is compatible with use of the full Wide_Wide_Character set,
|
||||
and is also the method used for wide wide character encoding in some standard
|
||||
ACATS (Ada Conformity Assessment Test Suite) test suite distributions.
|
||||
|
||||
@end table
|
||||
|
||||
@node File Naming Rules
|
||||
@section File Naming Rules
|
||||
|
||||
@ -7222,7 +7278,7 @@ UTF-8 encoding (brackets encoding also recognized)
|
||||
Brackets encoding only (default value)
|
||||
@end table
|
||||
For full details on these encoding
|
||||
methods see @ref{Wide Character Encodings}.
|
||||
methods see @ref{Wide_Character Encodings}.
|
||||
Note that brackets coding is always accepted, even if one of the other
|
||||
options is specified, so for example @option{-gnatW8} specifies that both
|
||||
brackets and UTF-8 encodings will be recognized. The units that are
|
||||
|
||||
@ -3930,6 +3930,7 @@ package body Ch3 is
|
||||
Access_Loc : constant Source_Ptr := Token_Ptr;
|
||||
Prot_Flag : Boolean;
|
||||
Not_Null_Present : Boolean := False;
|
||||
Not_Null_Subtype : Boolean := False;
|
||||
Type_Def_Node : Node_Id;
|
||||
Result_Not_Null : Boolean;
|
||||
Result_Node : Node_Id;
|
||||
@ -3964,8 +3965,16 @@ package body Ch3 is
|
||||
|
||||
begin
|
||||
if not Header_Already_Parsed then
|
||||
Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
|
||||
|
||||
-- not null access .. is a common form of access definition
|
||||
-- access non null .. is certainly rare, but syntactically legal.
|
||||
-- not null access not null .. is rarer yet, and also legal.
|
||||
-- The last two cases are only meaningful if the following subtype
|
||||
-- indication denotes an access type (semantic check).
|
||||
|
||||
Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
|
||||
Scan; -- past ACCESS
|
||||
Not_Null_Subtype := P_Null_Exclusion; -- Might also appear.
|
||||
end if;
|
||||
|
||||
if Token_Name = Name_Protected then
|
||||
@ -4040,6 +4049,7 @@ package body Ch3 is
|
||||
Type_Def_Node :=
|
||||
New_Node (N_Access_To_Object_Definition, Access_Loc);
|
||||
Set_Null_Exclusion_Present (Type_Def_Node, Not_Null_Present);
|
||||
Set_Null_Excluding_Subtype (Type_Def_Node, Not_Null_Subtype);
|
||||
|
||||
if Token = Tok_All or else Token = Tok_Constant then
|
||||
if Ada_Version = Ada_83 then
|
||||
|
||||
@ -1337,6 +1337,34 @@ package body Sem_Ch3 is
|
||||
Process_Subtype (S, P, T, 'P'));
|
||||
end if;
|
||||
|
||||
-- If the access definition is of the form : access not null ..
|
||||
-- the subtype indication must be of an access type. Create
|
||||
-- a null-excluding subtype of it.
|
||||
|
||||
if Null_Excluding_Subtype (Def) then
|
||||
if not Is_Access_Type (Entity (S)) then
|
||||
Error_Msg_N ("null exclusion must apply to access type", Def);
|
||||
|
||||
else
|
||||
declare
|
||||
Loc : constant Source_Ptr := Sloc (S);
|
||||
Decl : Node_Id;
|
||||
Nam : constant Entity_Id := Make_Temporary (Loc, 'S');
|
||||
|
||||
begin
|
||||
Decl :=
|
||||
Make_Subtype_Declaration (Loc,
|
||||
Defining_Identifier => Nam,
|
||||
Subtype_Indication =>
|
||||
New_Occurrence_Of (Entity (S), Loc));
|
||||
Set_Null_Exclusion_Present (Decl);
|
||||
Insert_Before (Parent (Def), Decl);
|
||||
Analyze (Decl);
|
||||
Set_Entity (S, Nam);
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
else
|
||||
Set_Directly_Designated_Type (T,
|
||||
Process_Subtype (S, P, T, 'P'));
|
||||
|
||||
@ -11019,8 +11019,13 @@ package body Sem_Prag is
|
||||
-- integer address values. If Address is not private (e.g. on
|
||||
-- VMS, where it is an integer type), then this pragma has no
|
||||
-- purpose, so it is simply ignored.
|
||||
-- If Allow_Integer_Address is already set do nothing, otherwise
|
||||
-- calling RTE on RE_Address would cause a crash when loading
|
||||
-- system.ads.
|
||||
|
||||
if Is_Private_Type (RTE (RE_Address)) then
|
||||
if not Opt.Allow_Integer_Address
|
||||
and then Is_Private_Type (RTE (RE_Address))
|
||||
then
|
||||
Opt.Allow_Integer_Address := True;
|
||||
end if;
|
||||
|
||||
|
||||
@ -2382,6 +2382,14 @@ package body Sinfo is
|
||||
return Flag13 (N);
|
||||
end Null_Present;
|
||||
|
||||
function Null_Excluding_Subtype
|
||||
(N : Node_Id) return Boolean is
|
||||
begin
|
||||
pragma Assert (False
|
||||
or else NT (N).Nkind = N_Access_To_Object_Definition);
|
||||
return Flag16 (N);
|
||||
end Null_Excluding_Subtype;
|
||||
|
||||
function Null_Exclusion_Present
|
||||
(N : Node_Id) return Boolean is
|
||||
begin
|
||||
@ -5565,6 +5573,14 @@ package body Sinfo is
|
||||
Set_Flag13 (N, Val);
|
||||
end Set_Null_Present;
|
||||
|
||||
procedure Set_Null_Excluding_Subtype
|
||||
(N : Node_Id; Val : Boolean := True) is
|
||||
begin
|
||||
pragma Assert (False
|
||||
or else NT (N).Nkind = N_Access_To_Object_Definition);
|
||||
Set_Flag16 (N, Val);
|
||||
end Set_Null_Excluding_Subtype;
|
||||
|
||||
procedure Set_Null_Exclusion_Present
|
||||
(N : Node_Id; Val : Boolean := True) is
|
||||
begin
|
||||
|
||||
@ -3369,6 +3369,7 @@ package Sinfo is
|
||||
-- Sloc points to ACCESS
|
||||
-- All_Present (Flag15)
|
||||
-- Null_Exclusion_Present (Flag11)
|
||||
-- Null_Excluding_Subtype (Flag16)
|
||||
-- Subtype_Indication (Node5)
|
||||
-- Constant_Present (Flag17)
|
||||
|
||||
@ -9363,6 +9364,9 @@ package Sinfo is
|
||||
function Null_Present
|
||||
(N : Node_Id) return Boolean; -- Flag13
|
||||
|
||||
function Null_Excluding_Subtype
|
||||
(N : Node_Id) return Boolean; -- Flag16
|
||||
|
||||
function Null_Exclusion_Present
|
||||
(N : Node_Id) return Boolean; -- Flag11
|
||||
|
||||
@ -10377,6 +10381,9 @@ package Sinfo is
|
||||
procedure Set_Null_Present
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag13
|
||||
|
||||
procedure Set_Null_Excluding_Subtype
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag16
|
||||
|
||||
procedure Set_Null_Exclusion_Present
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag11
|
||||
|
||||
@ -12652,6 +12659,7 @@ package Sinfo is
|
||||
pragma Inline (No_Truncation);
|
||||
pragma Inline (Non_Aliased_Prefix);
|
||||
pragma Inline (Null_Present);
|
||||
pragma Inline (Null_Excluding_Subtype);
|
||||
pragma Inline (Null_Exclusion_Present);
|
||||
pragma Inline (Null_Exclusion_In_Return_Present);
|
||||
pragma Inline (Null_Record_Present);
|
||||
@ -12985,6 +12993,7 @@ package Sinfo is
|
||||
pragma Inline (Set_No_Minimize_Eliminate);
|
||||
pragma Inline (Set_No_Truncation);
|
||||
pragma Inline (Set_Non_Aliased_Prefix);
|
||||
pragma Inline (Set_Null_Excluding_Subtype);
|
||||
pragma Inline (Set_Null_Exclusion_Present);
|
||||
pragma Inline (Set_Null_Exclusion_In_Return_Present);
|
||||
pragma Inline (Set_Null_Present);
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2014, 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- --
|
||||
@ -331,11 +331,22 @@ package body Sinput is
|
||||
while S < P loop
|
||||
if Src (S) = HT then
|
||||
C := (C - 1) / 8 * 8 + (8 + 1);
|
||||
S := S + 1;
|
||||
|
||||
-- Deal with wide character case, but don't include brackets
|
||||
-- notation in this circuit, since we know that this will
|
||||
-- display unencoded (no one encodes brackets notation).
|
||||
|
||||
elsif Src (S) /= '[' and then Is_Start_Of_Wide_Char (Src, S) then
|
||||
C := C + 1;
|
||||
Skip_Wide (Src, S);
|
||||
|
||||
-- Normal (non-wide) character case or brackets sequence
|
||||
|
||||
else
|
||||
C := C + 1;
|
||||
S := S + 1;
|
||||
end if;
|
||||
|
||||
S := S + 1;
|
||||
end loop;
|
||||
|
||||
return C;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user