+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
-- 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);
(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
(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);
with Stringt; use Stringt;
with Targparm; use Targparm;
with Uintp; use Uintp;
+with Widechar; use Widechar;
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 (' ');
- end if;
+ begin
+ -- Loop to output blanks till current flag position
- P := P + 1;
- end loop;
+ while P < Errors.Table (T).Sptr loop
- -- Output flag (unless already output, this happens if more
- -- than one error message occurs at the same flag position).
+ -- Horizontal tab case, just echo the tab
- 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;
+ if Src (P) = ASCII.HT then
+ Write_Char (ASCII.HT);
+ P := P + 1;
- P := P + 1;
- end if;
+ -- 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;
+ end;
Set_Next_Non_Deleted_Msg (T);
Flag_Num := Flag_Num + 1;
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));
@menu
* Latin-1::
* Other 8-Bit Codes::
-* Wide Character Encodings::
+* Wide_Character Encodings::
+* Wide_Wide_Character Encodings::
@end menu
@node Latin-1
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
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:
@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
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
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
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;
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
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
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'));
-- 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;
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
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
-- Sloc points to ACCESS
-- All_Present (Flag15)
-- Null_Exclusion_Present (Flag11)
+ -- Null_Excluding_Subtype (Flag16)
-- Subtype_Indication (Node5)
-- Constant_Present (Flag17)
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
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
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);
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);
-- --
-- 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- --
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;
projects / thirdparty / gcc.git / commitdiff
