1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Atree
; use Atree
;
28 with Csets
; use Csets
;
30 with Namet
; use Namet
;
32 with Scans
; use Scans
;
33 with Sinfo
; use Sinfo
;
34 with Sinput
; use Sinput
;
40 Used_As_Identifier
: array (Token_Type
) of Boolean;
41 -- Flags set True if a given keyword is used as an identifier (used to
42 -- make sure that we only post an error message for incorrect use of a
43 -- keyword as an identifier once for a given keyword).
45 procedure Check_End_Of_Line
;
46 -- Called when end of line encountered. Checks that line is not
47 -- too long, and that other style checks for the end of line are met.
49 function Determine_License
return License_Type
;
50 -- Scan header of file and check that it has an appropriate GNAT-style
51 -- header with a proper license statement. Returns GPL, Unrestricted,
52 -- or Modified_GPL depending on header. If none of these, returns Unknown.
54 procedure Error_Long_Line
;
55 -- Signal error of excessively long line
61 procedure Post_Scan
is
64 when Tok_Char_Literal
=>
65 Token_Node
:= New_Node
(N_Character_Literal
, Token_Ptr
);
66 Set_Char_Literal_Value
(Token_Node
, Character_Code
);
67 Set_Chars
(Token_Node
, Token_Name
);
69 when Tok_Identifier
=>
70 Token_Node
:= New_Node
(N_Identifier
, Token_Ptr
);
71 Set_Chars
(Token_Node
, Token_Name
);
73 when Tok_Real_Literal
=>
74 Token_Node
:= New_Node
(N_Real_Literal
, Token_Ptr
);
75 Set_Realval
(Token_Node
, Real_Literal_Value
);
77 when Tok_Integer_Literal
=>
78 Token_Node
:= New_Node
(N_Integer_Literal
, Token_Ptr
);
79 Set_Intval
(Token_Node
, Int_Literal_Value
);
81 when Tok_String_Literal
=>
82 Token_Node
:= New_Node
(N_String_Literal
, Token_Ptr
);
83 Set_Has_Wide_Character
(Token_Node
, Wide_Character_Found
);
84 Set_Strval
(Token_Node
, String_Literal_Id
);
86 when Tok_Operator_Symbol
=>
87 Token_Node
:= New_Node
(N_Operator_Symbol
, Token_Ptr
);
88 Set_Chars
(Token_Node
, Token_Name
);
89 Set_Strval
(Token_Node
, String_Literal_Id
);
96 -----------------------
97 -- Check_End_Of_Line --
98 -----------------------
100 procedure Check_End_Of_Line
is
101 Len
: constant Int
:= Int
(Scan_Ptr
) - Int
(Current_Line_Start
);
104 if Len
> Hostparm
.Max_Line_Length
then
107 elsif Style_Check
then
108 Style
.Check_Line_Terminator
(Len
);
110 end Check_End_Of_Line
;
112 -----------------------
113 -- Determine_License --
114 -----------------------
116 function Determine_License
return License_Type
is
117 GPL_Found
: Boolean := False;
119 function Contains
(S
: String) return Boolean;
120 -- See if current comment contains successive non-blank characters
121 -- matching the contents of S. If so leave Scan_Ptr unchanged and
122 -- return True, otherwise leave Scan_Ptr unchanged and return False.
125 -- Skip to line terminator character
131 function Contains
(S
: String) return Boolean is
138 while Source
(SP
) /= CR
and then Source
(SP
) /= LF
loop
139 if Source
(SP
) = S
(S
'First) then
151 while Source
(SS
) = ' ' loop
155 exit when Source
(SS
) /= S
(CP
);
169 procedure Skip_EOL
is
171 while Source
(Scan_Ptr
) /= CR
172 and then Source
(Scan_Ptr
) /= LF
174 Scan_Ptr
:= Scan_Ptr
+ 1;
178 -- Start of processing for Determine_License
182 if Source
(Scan_Ptr
) /= '-'
183 or else Source
(Scan_Ptr
+ 1) /= '-'
191 elsif Contains
("Asaspecialexception") then
196 elsif Contains
("GNUGeneralPublicLicense") then
201 ("ThisspecificationisadaptedfromtheAdaSemanticInterface")
204 ("ThisspecificationisderivedfromtheAdaReferenceManual")
217 Skip_Line_Terminators
(Scan_Ptr
, Physical
);
219 -- If we are at start of physical line, update scan pointers
220 -- to reflect the start of the new line.
223 Current_Line_Start
:= Scan_Ptr
;
224 Start_Column
:= Scanner
.Set_Start_Column
;
225 First_Non_Blank_Location
:= Scan_Ptr
;
229 end Determine_License
;
231 ----------------------------
232 -- Determine_Token_Casing --
233 ----------------------------
235 function Determine_Token_Casing
return Casing_Type
is
237 return Scanner
.Determine_Token_Casing
;
238 end Determine_Token_Casing
;
240 ---------------------
241 -- Error_Long_Line --
242 ---------------------
244 procedure Error_Long_Line
is
247 ("this line is too long",
248 Current_Line_Start
+ Hostparm
.Max_Line_Length
);
251 ------------------------
252 -- Initialize_Scanner --
253 ------------------------
255 procedure Initialize_Scanner
256 (Unit
: Unit_Number_Type
;
257 Index
: Source_File_Index
)
259 GNAT_Hedr
: constant Text_Buffer
(1 .. 78) := (others => '-');
262 Scanner
.Initialize_Scanner
(Unit
, Index
);
264 -- Set default for Comes_From_Source (except if we are going to process
265 -- an artificial string internally created within the compiler and
266 -- placed into internal source duffer). All nodes built now until we
267 -- reenter the analyzer will have Comes_From_Source set to True
269 if Index
/= Internal_Source_File
then
270 Set_Comes_From_Source_Default
(True);
273 -- Check license if GNAT type header possibly present
275 if Source_Last
(Index
) - Scan_Ptr
> 80
276 and then Source
(Scan_Ptr
.. Scan_Ptr
+ 77) = GNAT_Hedr
278 Set_License
(Current_Source_File
, Determine_License
);
281 -- Because of the License stuff above, Scng.Initialize_Scanner cannot
282 -- call Scan. Scan initial token (note this initializes Prev_Token,
285 -- There are two reasons not to do the Scan step in case if we
286 -- initialize the scanner for the internal source buffer:
288 -- - The artificial string may not be created by the compiler in this
289 -- buffer when we call Initialize_Scanner
291 -- - For these artificial strings a special way of scanning is used, so
292 -- the standard step of the scanner may just break the algorithm of
293 -- processing these strings.
295 if Index
/= Internal_Source_File
then
299 -- Clear flags for reserved words used as indentifiers
301 for J
in Token_Type
loop
302 Used_As_Identifier
(J
) := False;
304 end Initialize_Scanner
;
306 ------------------------------
307 -- Scan_Reserved_Identifier --
308 ------------------------------
310 procedure Scan_Reserved_Identifier
(Force_Msg
: Boolean) is
311 Token_Chars
: constant String := Token_Type
'Image (Token
);
314 -- We have in Token_Chars the image of the Token name, i.e. Tok_xxx.
315 -- This code extracts the xxx and makes an identifier out of it.
319 for J
in 5 .. Token_Chars
'Length loop
320 Name_Len
:= Name_Len
+ 1;
321 Name_Buffer
(Name_Len
) := Fold_Lower
(Token_Chars
(J
));
324 Token_Name
:= Name_Find
;
326 if not Used_As_Identifier
(Token
) or else Force_Msg
then
327 Error_Msg_Name_1
:= Token_Name
;
328 Error_Msg_SC
("reserved word* cannot be used as identifier!");
329 Used_As_Identifier
(Token
) := True;
332 Token
:= Tok_Identifier
;
333 Token_Node
:= New_Node
(N_Identifier
, Token_Ptr
);
334 Set_Chars
(Token_Node
, Token_Name
);
335 end Scan_Reserved_Identifier
;