+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.
procedure Error_Msg_SP (Msg : String);
- procedure Obsolescent_Check (S : Source_Ptr);
-
-- Instantiation of Styleg, needed to instantiate Scng
package Style is new Styleg
-- 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;
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 --
---------------
@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
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
Errutil.Error_Msg_S,
Errutil.Error_Msg_SC,
Errutil.Error_Msg_SP,
- Obsolescent_Check,
Errutil.Style);
-- The scanner for the preprocessor
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 --
---------------
-- --
-- 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- --
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 --
---------------
-- --
-- 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- --
-- 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;
-- --
-- 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- --
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);
-- --
-- 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- --
-- 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
-- --
-- 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- --
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
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 =>
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);
(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;
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;
-- --
-- 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- --
-- 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.
-- 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
Base := 10;
UI_Base := Uint_10;
UI_Int_Value := Uint_0;
+ Based_Literal_Uses_Colon := False;
Scale := 0;
Scan_Integer;
Point_Scanned := False;
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;
end if;
Accumulate_Token_Checksum;
-
return;
end Nlit;
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;
Style.Check_Vertical_Bar;
end if;
+ Post_Scan;
return;
end if;
end Vertical_Bar_Case;
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
else
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Vertical_Bar;
+ Post_Scan;
return;
end if;
end Exclamation_Case;
-- --
-- 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- --
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
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
-- --
-- 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- --
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.
projects / platform / upstream / linaro-gcc.git / commitdiff