------------------------------------------------------------------------------
-- --
--- GNAT RUNTIME COMPONENTS --
+-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . U T F _ 3 2 --
-- --
-- itself, and we want to be able to compile the compiler with old versions
-- of GNAT that did not implement Wide_Wide_Character.
--- This package is not available directly for use in application programs,
--- but it serves as the basis for GNAT.Wide_Case_Utilities and
--- GNAT.Wide_Wide_Case_Utilities, which can be used directly.
+-- This package is available directly for use in application programs,
+-- and also serves as the basis for Ada.Wide_Wide_Characters.Unicode and
+-- Ada.Wide_Characters.Unicode, which can also be used directly.
package GNAT.UTF_32 is
type UTF_32 is range 0 .. 16#7FFF_FFFF#;
-- So far, the only defined character codes are in 0 .. 16#01_FFFF#
+ -- The following type defines the categories from the unicode definitions.
+ -- The one addition we make is Fe, which represents the characters FFFE
+ -- and FFFF in any of the planes.
+
type Category is (
Cc, -- Other, Control
Cf, -- Other, Format
So, -- Symbol, Other
Zl, -- Separator, Line
Zp, -- Separator, Paragraph
- Zs); -- Separator, Space
+ Zs, -- Separator, Space
+ Fe); -- relative position FFFE/FFFF in any plane
function Get_Category (U : UTF_32) return Category;
-- Given a UTF32 code, returns corresponding Category, or Cn if
-- The following functions perform category tests corresponding to lexical
-- classes defined in the Ada standard. There are two interfaces for each
- -- function. The first takes a Category (e.g. returned by Get_Category).
- -- The second takes a UTF_32 code. The form taking the UTF_32 code is
+ -- function. The second takes a Category (e.g. returned by Get_Category).
+ -- The first takes a UTF_32 code. The form taking the UTF_32 code is
-- typically more efficient than calling Get_Category, but if several
-- different tests are to be performed on the same code, it is more
-- efficient to use Get_Category to get the category, then test the
-- Other, Control (Cc)
-- Other, Private Use (Co)
-- Other, Surrogate (Cs)
- -- Other, Format (Cf)
-- Separator, Line (Zl)
-- Separator, Paragraph (Zp)
+ -- FFFE or FFFF positions in any plane (Fe)
--
-- Note that the Ada category format effector is subsumed by the above
-- list of Unicode categories.
-- in the list of categories above. This means that should any of these
-- code positions be defined in future with graphic characters they will
-- be allowed without a need to change implementations or the standard.
+ --
+ -- Note that Other, Format (Cf) is also quite deliberately not included
+ -- in the list of categories above. This means that these characters can
+ -- be included in character and string literals.
-- The following function is used to fold to upper case, as required by
-- the Ada 2005 standard rules for identifier case folding. Two
procedure Accumulate_Checksum (C : Char_Code) is
begin
if C > 16#FFFF# then
- Accumulate_Checksum (Character'Val (C / 2 ** 16));
+ Accumulate_Checksum (Character'Val (C / 2 ** 24));
+ Accumulate_Checksum (Character'Val ((C / 2 ** 16) mod 256));
Accumulate_Checksum (Character'Val ((C / 256) mod 256));
else
Accumulate_Checksum (Character'Val (C / 256));
Accumulate_Checksum (Code);
+ -- In Ada 95 mode we allow any wide characters in a string
+ -- but in Ada 2005, the set of characters allowed has been
+ -- restricted to graphic characters.
+
if Ada_Version >= Ada_05
and then Is_UTF_32_Non_Graphic (UTF_32 (Code))
then
when EOF =>
if Scan_Ptr = Source_Last (Current_Source_File) then
Check_End_Of_Line;
+ if Style_Check then Style.Check_EOF; end if;
Token := Tok_EOF;
return;
else
if Err then
Error_Illegal_Wide_Character;
- Code := Character'Pos (' ');
+ Code := Character'Pos (' ');
+
+ -- In Ada 95 mode we allow any wide character in a character
+ -- literal, but in Ada 2005, the set of characters allowed
+ -- is restricted to graphic characters.
elsif Ada_Version >= Ada_05
and then Is_UTF_32_Non_Graphic (UTF_32 (Code))
-- stored. It seems reasonable to exclude it from the
-- checksum.
+ -- Note that it is correct (see AI-395) to simply strip
+ -- other format characters, before testing for double
+ -- underlines, or for reserved words).
+
elsif Is_UTF_32_Other (Cat) then
null;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005 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- --
renames Style_Inst.Check_Dot_Dot;
-- Called after scanning out dot dot to check spacing
+ procedure Check_EOF
+ renames Style_Inst.Check_EOF;
+ -- Called after scanning out end of file mark
+
procedure Check_HT
renames Style_Inst.Check_HT;
-- Called with Scan_Ptr pointing to a horizontal tab character
use ASCII;
+ Blank_Lines : Nat := 0;
+ -- Counts number of empty lines seen. Reset to zero if a non-empty line
+ -- is encountered. Used to check for trailing blank lines in Check_EOF,
+ -- and for multiple blank lines.
+
+ Blank_Line_Location : Source_Ptr;
+ -- Remembers location of first blank line in a series. Used to issue an
+ -- appropriate diagnostic if subsequent blank lines or the end of file
+ -- is encountered.
+
-----------------------
-- Local Subprograms --
-----------------------
procedure Check_Attribute_Name (Reserved : Boolean) is
pragma Warnings (Off, Reserved);
-
begin
if Style_Check_Attribute_Casing then
if Determine_Token_Casing /= Mixed_Case then
end if;
end Check_Dot_Dot;
+ ---------------
+ -- Check_EOF --
+ ---------------
+
+ -- In check blanks at end mode, check no blank lines precede the EOF
+
+ procedure Check_EOF is
+ begin
+ if Style_Check_Blank_Lines then
+
+ -- We expect one blank line, from the EOF, but no more than one
+
+ if Blank_Lines = 2 then
+ Error_Msg
+ ("(style) blank line not allowed at end of file",
+ Blank_Line_Location);
+
+ elsif Blank_Lines >= 3 then
+ Error_Msg
+ ("(style) blank lines not allowed at end of file",
+ Blank_Line_Location);
+ end if;
+ end if;
+ end Check_EOF;
+
-----------------------------------
-- Check_Exponentiation_Operator --
-----------------------------------
procedure Check_Line_Terminator (Len : Int) is
S : Source_Ptr;
+ L : Int := Len;
+ -- Length of line (adjusted down for blanks at end of line)
+
begin
+ -- Reset count of blank lines if first line
+
+ if Get_Logical_Line_Number (Scan_Ptr) = 1 then
+ Blank_Lines := 0;
+ end if;
+
-- Check FF/VT terminators
if Style_Check_Form_Feeds then
end if;
end if;
- -- We are now possibly going to check for trailing spaces. There is no
- -- point in doing this if the current line is empty. It is actually
- -- wrong to do so, because we scan backwards for this purpose, so we
- -- would end up looking at different line, or even at invalid buffer
- -- locations if we have the first source line at hand.
+ -- Remove trailing spaces
- if Len = 0 then
- return;
+ S := Scan_Ptr;
+ while L > 0 and then Is_White_Space (Source (S - 1)) loop
+ S := S - 1;
+ L := L - 1;
+ end loop;
+
+ -- Issue message for blanks at end of line if option enabled
+
+ if Style_Check_Blanks_At_End and then L < Len then
+ Error_Msg
+ ("(style) trailing spaces not permitted", S);
end if;
- -- Check trailing space
+ -- Deal with empty (blank) line
- if Style_Check_Blanks_At_End then
- if Scan_Ptr >= First_Non_Blank_Location then
- if Is_White_Space (Source (Scan_Ptr - 1)) then
- S := Scan_Ptr - 1;
+ if L = 0 then
- while Is_White_Space (Source (S - 1)) loop
- S := S - 1;
- end loop;
+ -- Increment blank line count
- Error_Msg ("(style) trailing spaces not permitted", S);
- end if;
+ Blank_Lines := Blank_Lines + 1;
+
+ -- If first blank line, record location for later error message
+
+ if Blank_Lines = 1 then
+ Blank_Line_Location := Scan_Ptr;
+ end if;
+
+ -- Non-blank line, check for previous multiple blank lines
+
+ else
+ if Style_Check_Blank_Lines and then Blank_Lines > 1 then
+ Error_Msg
+ ("(style) multiple blank lines", Blank_Line_Location);
end if;
+
+ -- And reset blank line count
+
+ Blank_Lines := 0;
end if;
end Check_Line_Terminator;
procedure Check_Dot_Dot;
-- Called after scanning out dot dot to check spacing
+ procedure Check_EOF;
+ -- Called after scanning out EOF mark
+
procedure Check_HT;
-- Called with Scan_Ptr pointing to a horizontal tab character
Style_Check_Indentation := 0;
Style_Check_Attribute_Casing := False;
Style_Check_Blanks_At_End := False;
+ Style_Check_Blank_Lines := False;
Style_Check_Comments := False;
Style_Check_DOS_Line_Terminator := False;
Style_Check_End_Labels := False;
Add ('r', Style_Check_References);
Add ('s', Style_Check_Specs);
Add ('t', Style_Check_Tokens);
+ Add ('u', Style_Check_Blank_Lines);
Add ('x', Style_Check_Xtra_Parens);
if Style_Check_Max_Line_Length then
when 't' =>
Style_Check_Tokens := True;
+ when 'u' =>
+ Style_Check_Blank_Lines := True;
+
when 'x' =>
Style_Check_Xtra_Parens := True;
-- This can be set True by using the -gnatg or -gnatyb switches. If
-- it is True, then spaces at the end of lines are not permitted.
+ Style_Check_Blank_Lines : Boolean := False;
+ -- This can be set True by using the -gnatg or -gnatyu switches. If
+ -- it is True, then multiple blank lines are not permitted, and there
+ -- may not be a blank line at the end of the file.
+
Style_Check_Comments : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyc switches. If
-- it is True, then comments are style checked as follows:
OSDN Git Service
