Skip to content

R
riscv-gcc-1
Commit 357ac4df by Robert Dewar Committed by Arnaud Charlet
Options

scng.adb: Add call to new Check_EOF routine 

2005-06-14  Robert Dewar  <dewar@adacore.com>

	* scng.adb: Add call to new Check_EOF routine
	(Accumulate_Checksum): Properly handle wide wide char >= 2 ** 24
	Add some comments regarding wide character handling

	* style.ads, styleg.ads, styleg.adb: Implement new style switch -gnatyu

	* stylesw.ads, stylesw.adb: Implement new style switch -gnatyu

	* g-utf_32.ads, g-utf_32.adb (Is_UTF_32_Non_Graphic): Other_Format
	characters are now considered graphic characters and hence yield false
	in this call.

From-SVN: r101056
parent 38d7a13a
Showing with 128 additions and 29 deletions
gcc/ada/g-utf_32.ads
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . U T F _ 3 2 --
-- --
......@@ -38,15 +38,19 @@
-- 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
......@@ -77,7 +81,8 @@ package GNAT.UTF_32 is
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
......@@ -85,8 +90,8 @@ package GNAT.UTF_32 is
-- 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
......@@ -160,9 +165,9 @@ package GNAT.UTF_32 is
-- 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.
......@@ -171,6 +176,10 @@ package GNAT.UTF_32 is
-- 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
......
gcc/ada/scng.adb
......@@ -97,7 +97,8 @@ package body Scng is
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));
......@@ -1110,6 +1111,10 @@ package body Scng is
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
......@@ -1236,6 +1241,7 @@ package body Scng is
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
......@@ -1644,7 +1650,11 @@ package body Scng is
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))
......@@ -2257,6 +2267,10 @@ package body Scng is
-- 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;
......
gcc/ada/style.ads
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -111,6 +111,10 @@ package Style is
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
......
gcc/ada/styleg.adb
......@@ -40,6 +40,16 @@ package body Styleg is
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 --
-----------------------
......@@ -129,7 +139,6 @@ package body Styleg is
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
......@@ -399,6 +408,31 @@ package body Styleg is
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 --
-----------------------------------
......@@ -497,7 +531,16 @@ package body Styleg is
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
......@@ -522,30 +565,46 @@ package body Styleg is
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;
......
gcc/ada/styleg.ads
......@@ -92,6 +92,9 @@ package Styleg is
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
......
gcc/ada/stylesw.adb
......@@ -37,6 +37,7 @@ package body Stylesw is
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;
......@@ -121,6 +122,7 @@ package body Stylesw is
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
......@@ -300,6 +302,9 @@ package body Stylesw is
when 't' =>
Style_Check_Tokens := True;
when 'u' =>
Style_Check_Blank_Lines := True;
when 'x' =>
Style_Check_Xtra_Parens := True;
......
gcc/ada/stylesw.ads
......@@ -56,6 +56,11 @@ package Stylesw is
-- 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:
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment