[multiple changes]

2010-09-09  Thomas Quinot  <quinot@adacore.com>

	* s-strxdr.adb, gnat_rm.texi, s-stratt-xdr.adb, s-stratt.ads: Rename
	s-strxdr.adb to s-stratt-xdr.adb

2010-09-09  Robert Dewar  <dewar@adacore.com>

	* ali-util.adb (Obsolescent_Check): Removed.
	* gprep.adb (Obsolescent_Check): Removed.
	Remove Obsolescent_Check parameter in Scng instantiation
	* prj-err.adb (Obsolescent_Check): Removed.
	* prj-err.ads (Obsolescent_Check): Removed.
	Remove Obsolescent_Check parameter in Scng instantiation
	* scans.ads (Based_Literal_Uses_Colon): New flag
	* scn.adb (Obsolscent_Check_Flag): Removed
	(Obsolscent_Check): Removed
	(Set_Obsolescent_Check): Removed
	(Post_Scan): Add handling for obsolescent features
	* scn.ads (Obsolscent_Check): Removed
	(Set_Obsolescent_Check): Removed
	(Post_Scan): Can no longer be inlined
	Remove Obsolescent_Check from instantiation of Scng
	* scng.adb (Nlit): Set Based_Literal_Uses_Colon
	(Nlit): Remove handling of obsolescent check
	(Scan, case '%'): Remove handling of obsolescent check
	(Scan, case '|'): Call Post_Scan
	(Scan, case '!'): Remove handling of obsolescent check, call Post_Scan
	* scng.ads Remove Obsolescent_Check argument from Scng generic
	(Post_Scan): Now called for Tok_Vertical_Bar
	* sinput-l.adb: Remove calls to Set_Obsolescent_Check

From-SVN: r164081
This commit is contained in:
Arnaud Charlet 2010-09-09 14:31:35 +02:00
parent 48a54da312
commit c90b20580d
14 changed files with 164 additions and 165 deletions

View File

@ -1,3 +1,34 @@
2010-09-09 Thomas Quinot <quinot@adacore.com>
* s-strxdr.adb, gnat_rm.texi, s-stratt-xdr.adb, s-stratt.ads: Rename
s-strxdr.adb to s-stratt-xdr.adb
2010-09-09 Robert Dewar <dewar@adacore.com>
* ali-util.adb (Obsolescent_Check): Removed.
* gprep.adb (Obsolescent_Check): Removed.
Remove Obsolescent_Check parameter in Scng instantiation
* prj-err.adb (Obsolescent_Check): Removed.
* prj-err.ads (Obsolescent_Check): Removed.
Remove Obsolescent_Check parameter in Scng instantiation
* scans.ads (Based_Literal_Uses_Colon): New flag
* scn.adb (Obsolscent_Check_Flag): Removed
(Obsolscent_Check): Removed
(Set_Obsolescent_Check): Removed
(Post_Scan): Add handling for obsolescent features
* scn.ads (Obsolscent_Check): Removed
(Set_Obsolescent_Check): Removed
(Post_Scan): Can no longer be inlined
Remove Obsolescent_Check from instantiation of Scng
* scng.adb (Nlit): Set Based_Literal_Uses_Colon
(Nlit): Remove handling of obsolescent check
(Scan, case '%'): Remove handling of obsolescent check
(Scan, case '|'): Call Post_Scan
(Scan, case '!'): Remove handling of obsolescent check, call Post_Scan
* scng.ads Remove Obsolescent_Check argument from Scng generic
(Post_Scan): Now called for Tok_Vertical_Bar
* sinput-l.adb: Remove calls to Set_Obsolescent_Check
2010-09-09 Doug Rupp <rupp@adacore.com>
* gnatlbr.adb: Removed.

View File

@ -50,8 +50,6 @@ package body ALI.Util is
procedure Error_Msg_SP (Msg : String);
procedure Obsolescent_Check (S : Source_Ptr);
-- Instantiation of Styleg, needed to instantiate Scng
package Style is new Styleg
@ -61,8 +59,7 @@ package body ALI.Util is
-- Get_File_Checksum).
package Scanner is new Scng
(Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP,
Obsolescent_Check, Style);
(Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP, Style);
type Header_Num is range 0 .. 1_000;
@ -201,16 +198,6 @@ package body ALI.Util is
Interfaces.Reset;
end Initialize_ALI_Source;
-----------------------
-- Obsolescent_Check --
-----------------------
procedure Obsolescent_Check (S : Source_Ptr) is
pragma Warnings (Off, S);
begin
null;
end Obsolescent_Check;
---------------
-- Post_Scan --
---------------

View File

@ -7182,16 +7182,16 @@ for scalar types.
@cindex Stream oriented attributes
The XDR implementation is provided as an alternative body of the
@code{System.Stream_Attributes} package, in the file
@file{s-strxdr.adb} in the GNAT library.
There is no @file{s-strxdr.ads} file.
@file{s-stratt-xdr.adb} in the GNAT library.
There is no @file{s-stratt-xdr.ads} file.
In order to install the XDR implementation, do the following:
@enumerate
@item Replace the default implementation of the
@code{System.Stream_Attributes} package with the XDR implementation.
For example on a Unix platform issue the commands:
@smallexample
$ mv s-stratt.adb s-strold.adb
$ mv s-strxdr.adb s-stratt.adb
$ mv s-stratt.adb s-stratt-default.adb
$ mv s-stratt-xdr.adb s-stratt.adb
@end smallexample
@item

View File

@ -91,9 +91,6 @@ package body GPrep is
procedure Display_Copyright;
-- Display the copyright notice
procedure Obsolescent_Check (S : Source_Ptr);
-- Null procedure, needed by instantiation of Scng below
procedure Post_Scan;
-- Null procedure, needed by instantiation of Scng below
@ -103,7 +100,6 @@ package body GPrep is
Errutil.Error_Msg_S,
Errutil.Error_Msg_SC,
Errutil.Error_Msg_SP,
Obsolescent_Check,
Errutil.Style);
-- The scanner for the preprocessor
@ -311,16 +307,6 @@ package body GPrep is
New_Line (Outfile.all);
end New_EOL_To_Outfile;
-----------------------
-- Obsolescent_Check --
-----------------------
procedure Obsolescent_Check (S : Source_Ptr) is
pragma Warnings (Off, S);
begin
null;
end Obsolescent_Check;
---------------
-- Post_Scan --
---------------

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2002-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- --
@ -29,16 +29,6 @@ with Stringt; use Stringt;
package body Prj.Err is
-----------------------
-- Obsolescent_Check --
-----------------------
procedure Obsolescent_Check (S : Source_Ptr) is
pragma Warnings (Off, S);
begin
null;
end Obsolescent_Check;
---------------
-- Post_Scan --
---------------

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2002-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- --
@ -82,20 +82,16 @@ package Prj.Err is
-- Scanner --
-------------
procedure Obsolescent_Check (S : Source_Ptr);
-- Dummy null procedure for Scng instantiation
procedure Post_Scan;
-- Convert an Ada operator symbol into a standard string
package Scanner is new Scng
(Post_Scan => Post_Scan,
Error_Msg => Errutil.Error_Msg,
Error_Msg_S => Errutil.Error_Msg_S,
Error_Msg_SC => Errutil.Error_Msg_SC,
Error_Msg_SP => Errutil.Error_Msg_SP,
Obsolescent_Check => Obsolescent_Check,
Style => Errutil.Style);
(Post_Scan => Post_Scan,
Error_Msg => Errutil.Error_Msg,
Error_Msg_S => Errutil.Error_Msg_S,
Error_Msg_SC => Errutil.Error_Msg_SC,
Error_Msg_SP => Errutil.Error_Msg_SP,
Style => Errutil.Style);
-- Instantiation of the generic scanner
end Prj.Err;

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
@ -157,10 +157,10 @@ package System.Stream_Attributes is
function Block_IO_OK return Boolean;
-- Package System.Stream_Attributes has several bodies - the default one
-- distributed with GNAT, s-strxdr.adb which is based on the XDR standard
-- and s-stratt.adb for Garlic. All three bodies share the same spec. The
-- role of this function is to determine whether the current version of
-- System.Stream_Attributes is able to support block IO.
-- distributed with GNAT, and s-stratt-xdr.adb, which is based on the XDR
-- standard. Both bodies share the same spec. The role of this function is
-- to indicate whether the current version of System.Stream_Attributes
-- supports block IO.
private
pragma Inline (I_AD);

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
@ -415,27 +415,34 @@ package Scans is
-- We do things this way to minimize the impact on comment scanning.
Character_Code : Char_Code;
-- Valid only when Token is Tok_Char_Literal
-- Valid only when Token is Tok_Char_Literal. Contains the value of the
-- scanned literal.
Real_Literal_Value : Ureal;
-- Valid only when Token is Tok_Real_Literal
-- Valid only when Token is Tok_Real_Literal, contains the value of the
-- scanned literal.
Int_Literal_Value : Uint;
-- Valid only when Token = Tok_Integer_Literal;
-- Valid only when Token = Tok_Integer_Literal, contains the value of the
-- scanned literal.
Based_Literal_Uses_Colon : Boolean;
-- Valid only when Token = Tok_Integer_Literal or Tok_Real_Literal. Set
-- True only for the case of a based literal using ':' instead of '#'.
String_Literal_Id : String_Id;
-- Id for currently scanned string value.
-- Valid only when Token = Tok_String_Literal or Tok_Operator_Symbol.
-- Contains the Id for currently scanned string value.
Wide_Character_Found : Boolean := False;
-- Set True if wide character found (i.e. a character that does not fit
-- in Character, but fits in Wide_Wide_Character).
-- Valid only when Token = Tok_String_Literal.
-- Valid only when Token = Tok_String_Literal. Set True if wide character
-- found (i.e. a character that does not fit in Character, but fits in
-- Wide_Wide_Character).
Wide_Wide_Character_Found : Boolean := False;
-- Set True if wide wide character found (i.e. a character that does
-- not fit in Character or Wide_Character).
-- Valid only when Token = Tok_String_Literal.
-- Valid only when Token = Tok_String_Literal. Set True if wide wide
-- character found (i.e. a character that does not fit in Character or
-- Wide_Character).
Special_Character : Character;
-- Valid only when Token = Tok_Special. Returns one of the characters

View File

@ -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- --
@ -44,10 +44,6 @@ package body Scn is
use ASCII;
Obsolescent_Check_Flag : Boolean := True;
-- Obsolescent check activation. Set to False during integrated
-- preprocessing.
Used_As_Identifier : array (Token_Type) of Boolean;
-- Flags set True if a given keyword is used as an identifier (used to
-- make sure that we only post an error message for incorrect use of a
@ -340,28 +336,61 @@ package body Scn is
end loop;
end Initialize_Scanner;
-----------------------
-- Obsolescent_Check --
-----------------------
procedure Obsolescent_Check (S : Source_Ptr) is
begin
if Obsolescent_Check_Flag then
-- This is a pain in the neck case, since we normally need a node to
-- call Check_Restrictions, and all we have is a source pointer. The
-- easiest thing is to construct a dummy node. A bit kludgy, but this
-- is a marginal case. It's not worth trying to do things more
-- cleanly.
Check_Restriction (No_Obsolescent_Features, New_Node (N_Empty, S));
end if;
end Obsolescent_Check;
---------------
-- Post_Scan --
---------------
procedure Post_Scan is
procedure Check_Obsolescent_Features_Restriction (S : Source_Ptr);
-- This checks for Obsolescent_Features restriction being active, and
-- if so, flags the restriction as occurring at the given scan location.
procedure Check_Obsolete_Base_Char;
-- Check for numeric literal using ':' instead of '#' for based case
--------------------------------------------
-- Check_Obsolescent_Features_Restriction --
--------------------------------------------
procedure Check_Obsolescent_Features_Restriction (S : Source_Ptr) is
begin
-- Normally we have a node handy for posting restrictions. We don't
-- have such a node here, so construct a dummy one with the right
-- scan pointer. This is only used to get the Sloc value anyway.
Check_Restriction (No_Obsolescent_Features, New_Node (N_Empty, S));
end Check_Obsolescent_Features_Restriction;
------------------------------
-- Check_Obsolete_Base_Char --
------------------------------
procedure Check_Obsolete_Base_Char is
S : Source_Ptr;
begin
if Based_Literal_Uses_Colon then
-- Find the : for the restriction or warning message
S := Token_Ptr;
while Source (S) /= ':' loop
S := S + 1;
end loop;
Check_Obsolescent_Features_Restriction (S);
if Warn_On_Obsolescent_Feature then
Error_Msg
("use of "":"" is an obsolescent feature (RM J.2(3))?", S);
Error_Msg
("\use ""'#"" instead?", S);
end if;
end if;
end Check_Obsolete_Base_Char;
-- Start of processing for Post_Scan
begin
case Token is
when Tok_Char_Literal =>
@ -376,10 +405,12 @@ package body Scn is
when Tok_Real_Literal =>
Token_Node := New_Node (N_Real_Literal, Token_Ptr);
Set_Realval (Token_Node, Real_Literal_Value);
Check_Obsolete_Base_Char;
when Tok_Integer_Literal =>
Token_Node := New_Node (N_Integer_Literal, Token_Ptr);
Set_Intval (Token_Node, Int_Literal_Value);
Check_Obsolete_Base_Char;
when Tok_String_Literal =>
Token_Node := New_Node (N_String_Literal, Token_Ptr);
@ -389,11 +420,32 @@ package body Scn is
(Token_Node, Wide_Wide_Character_Found);
Set_Strval (Token_Node, String_Literal_Id);
if Source (Token_Ptr) = '%' then
Check_Obsolescent_Features_Restriction (Token_Ptr);
if Warn_On_Obsolescent_Feature then
Error_Msg_SC
("use of ""'%"" is an obsolescent feature (RM J.2(4))?");
Error_Msg_SC ("\use """""" instead?");
end if;
end if;
when Tok_Operator_Symbol =>
Token_Node := New_Node (N_Operator_Symbol, Token_Ptr);
Set_Chars (Token_Node, Token_Name);
Set_Strval (Token_Node, String_Literal_Id);
when Tok_Vertical_Bar =>
if Source (Token_Ptr) = '!' then
Check_Obsolescent_Features_Restriction (Token_Ptr);
if Warn_On_Obsolescent_Feature then
Error_Msg_SC
("use of ""'!"" is an obsolescent feature (RM J.2(2))?");
Error_Msg_SC ("\use ""'|"" instead?");
end if;
end if;
when others =>
null;
end case;
@ -430,13 +482,4 @@ package body Scn is
Set_Chars (Token_Node, Token_Name);
end Scan_Reserved_Identifier;
---------------------------
-- Set_Obsolescent_Check --
---------------------------
procedure Set_Obsolescent_Check (Value : Boolean) is
begin
Obsolescent_Check_Flag := Value;
end Set_Obsolescent_Check;
end Scn;

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2008, 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- --
@ -47,15 +47,7 @@ package Scn is
-- Determines the casing style of the current token, which is
-- either a keyword or an identifier. See also package Casing.
procedure Obsolescent_Check (S : Source_Ptr);
-- Called to handle pragma restrictions check for usage of obsolescent
-- character replacements during the scan.
procedure Set_Obsolescent_Check (Value : Boolean);
-- Activate or not obsolescent check
procedure Post_Scan;
pragma Inline (Post_Scan);
-- Create nodes for tokens: Char_Literal, Identifier, Real_Literal,
-- Integer_Literal, String_Literal and Operator_Symbol.
@ -75,13 +67,12 @@ package Scn is
-- generic package Scng with routines appropriate to the compiler
package Scanner is new Scng
(Post_Scan => Post_Scan,
Error_Msg => Error_Msg,
Error_Msg_S => Error_Msg_S,
Error_Msg_SC => Error_Msg_SC,
Error_Msg_SP => Error_Msg_SP,
Obsolescent_Check => Obsolescent_Check,
Style => Style.Style_Inst);
(Post_Scan => Post_Scan,
Error_Msg => Error_Msg,
Error_Msg_S => Error_Msg_S,
Error_Msg_SC => Error_Msg_SC,
Error_Msg_SP => Error_Msg_SP,
Style => Style.Style_Inst);
procedure Scan renames Scanner.Scan;
-- Scan scans out the next token, and advances the scan state accordingly

View File

@ -516,6 +516,7 @@ package body Scng is
Base := 10;
UI_Base := Uint_10;
UI_Int_Value := Uint_0;
Based_Literal_Uses_Colon := False;
Scale := 0;
Scan_Integer;
Point_Scanned := False;
@ -568,20 +569,14 @@ package body Scng is
or else
Source (Scan_Ptr + 1) in 'a' .. 'z'))
then
if C = ':' then
Obsolescent_Check (Scan_Ptr);
if Warn_On_Obsolescent_Feature then
Error_Msg_S
("use of "":"" is an obsolescent feature (RM J.2(3))?");
Error_Msg_S ("\use ""'#"" instead?");
end if;
end if;
Accumulate_Checksum (C);
Base_Char := C;
UI_Base := UI_Int_Value;
if Base_Char = ':' then
Based_Literal_Uses_Colon := True;
end if;
if UI_Base < 2 or else UI_Base > 16 then
Error_Msg_SC ("base not 2-16");
UI_Base := Uint_16;
@ -753,7 +748,6 @@ package body Scng is
end if;
Accumulate_Token_Checksum;
return;
end Nlit;
@ -1579,24 +1573,9 @@ package body Scng is
end if;
end Minus_Case;
-- Double quote starting a string literal
when '"' =>
Slit;
Post_Scan;
return;
-- Percent starting a string literal
when '%' =>
Obsolescent_Check (Token_Ptr);
if Warn_On_Obsolescent_Feature then
Error_Msg_S
("use of ""'%"" is an obsolescent feature (RM J.2(4))?");
Error_Msg_S ("\use """""" instead?");
end if;
-- Double quote or percent starting a string literal
when '"' | '%' =>
Slit;
Post_Scan;
return;
@ -1808,6 +1787,7 @@ package body Scng is
Style.Check_Vertical_Bar;
end if;
Post_Scan;
return;
end if;
end Vertical_Bar_Case;
@ -1816,13 +1796,6 @@ package body Scng is
when '!' => Exclamation_Case : begin
Accumulate_Checksum ('!');
Obsolescent_Check (Token_Ptr);
if Warn_On_Obsolescent_Feature then
Error_Msg_S
("use of ""'!"" is an obsolescent feature (RM J.2(2))?");
Error_Msg_S ("\use ""'|"" instead?");
end if;
if Source (Scan_Ptr + 1) = '=' then
Error_Msg_S -- CODEFIX
@ -1834,6 +1807,7 @@ package body Scng is
else
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Vertical_Bar;
Post_Scan;
return;
end if;
end Exclamation_Case;

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
@ -33,9 +33,10 @@ with Types; use Types;
generic
with procedure Post_Scan;
-- Procedure called by Scan for the following tokens:
-- Tok_Char_Literal, Tok_Identifier, Tok_Real_Literal, Tok_Real_Literal,
-- Tok_Integer_Literal, Tok_String_Literal, Tok_Operator_Symbol.
-- Procedure called by Scan for the following tokens: Tok_Char_Literal,
-- Tok_Identifier, Tok_Real_Literal, Tok_Real_Literal, Tok_Integer_Literal,
-- Tok_String_Literal, Tok_Operator_Symbol, and Tok_Vertical_Bar. Used to
-- build Token_Node and also check for obsolescent features.
with procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
-- Output a message at specified location
@ -49,10 +50,6 @@ generic
with procedure Error_Msg_SP (Msg : String);
-- Output a message at the start of the previous token
with procedure Obsolescent_Check (S : Source_Ptr);
-- Called when one of the obsolescent character replacements is
-- used with S pointing to the character in question.
with package Style is new Styleg
(Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP);
-- Instantiation of Styleg with the same error reporting routines

View File

@ -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- --
@ -530,12 +530,9 @@ package body Sinput.L is
Save_Style_Check := Opt.Style_Check;
Opt.Style_Check := False;
-- Make sure that there will be no check of pragma Restrictions
-- for obsolescent features while preprocessing the source.
-- The actual preprocessing step
Scn.Set_Obsolescent_Check (False);
Preprocess (Modified);
Scn.Set_Obsolescent_Check (True);
-- Reset the scanner to its standard behavior, and restore the
-- Style_Checks flag.