1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S C N -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- 10-- -- 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. -- 21-- -- 22-- GNAT was originally developed by the GNAT team at New York University. -- 23-- Extensive contributions were provided by Ada Core Technologies Inc. -- 24-- -- 25------------------------------------------------------------------------------ 26 27with Atree; use Atree; 28with Csets; use Csets; 29with Hostparm; 30with Namet; use Namet; 31with Opt; use Opt; 32with Scans; use Scans; 33with Sinfo; use Sinfo; 34with Sinput; use Sinput; 35 36package body Scn is 37 38 use ASCII; 39 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). 44 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. 48 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. 53 54 procedure Error_Long_Line; 55 -- Signal error of excessively long line 56 57 --------------- 58 -- Post_Scan -- 59 --------------- 60 61 procedure Post_Scan is 62 begin 63 case Token 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); 68 69 when Tok_Identifier => 70 Token_Node := New_Node (N_Identifier, Token_Ptr); 71 Set_Chars (Token_Node, Token_Name); 72 73 when Tok_Real_Literal => 74 Token_Node := New_Node (N_Real_Literal, Token_Ptr); 75 Set_Realval (Token_Node, Real_Literal_Value); 76 77 when Tok_Integer_Literal => 78 Token_Node := New_Node (N_Integer_Literal, Token_Ptr); 79 Set_Intval (Token_Node, Int_Literal_Value); 80 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); 85 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); 90 91 when others => 92 null; 93 end case; 94 end Post_Scan; 95 96 ----------------------- 97 -- Check_End_Of_Line -- 98 ----------------------- 99 100 procedure Check_End_Of_Line is 101 Len : constant Int := Int (Scan_Ptr) - Int (Current_Line_Start); 102 103 begin 104 if Len > Hostparm.Max_Line_Length then 105 Error_Long_Line; 106 107 elsif Style_Check then 108 Style.Check_Line_Terminator (Len); 109 end if; 110 end Check_End_Of_Line; 111 112 ----------------------- 113 -- Determine_License -- 114 ----------------------- 115 116 function Determine_License return License_Type is 117 GPL_Found : Boolean := False; 118 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. 123 124 procedure Skip_EOL; 125 -- Skip to line terminator character 126 127 -------------- 128 -- Contains -- 129 -------------- 130 131 function Contains (S : String) return Boolean is 132 CP : Natural; 133 SP : Source_Ptr; 134 SS : Source_Ptr; 135 136 begin 137 SP := Scan_Ptr; 138 while Source (SP) /= CR and then Source (SP) /= LF loop 139 if Source (SP) = S (S'First) then 140 SS := SP; 141 CP := S'First; 142 143 loop 144 SS := SS + 1; 145 CP := CP + 1; 146 147 if CP > S'Last then 148 return True; 149 end if; 150 151 while Source (SS) = ' ' loop 152 SS := SS + 1; 153 end loop; 154 155 exit when Source (SS) /= S (CP); 156 end loop; 157 end if; 158 159 SP := SP + 1; 160 end loop; 161 162 return False; 163 end Contains; 164 165 -------------- 166 -- Skip_EOL -- 167 -------------- 168 169 procedure Skip_EOL is 170 begin 171 while Source (Scan_Ptr) /= CR 172 and then Source (Scan_Ptr) /= LF 173 loop 174 Scan_Ptr := Scan_Ptr + 1; 175 end loop; 176 end Skip_EOL; 177 178 -- Start of processing for Determine_License 179 180 begin 181 loop 182 if Source (Scan_Ptr) /= '-' 183 or else Source (Scan_Ptr + 1) /= '-' 184 then 185 if GPL_Found then 186 return GPL; 187 else 188 return Unknown; 189 end if; 190 191 elsif Contains ("Asaspecialexception") then 192 if GPL_Found then 193 return Modified_GPL; 194 end if; 195 196 elsif Contains ("GNUGeneralPublicLicense") then 197 GPL_Found := True; 198 199 elsif 200 Contains 201 ("ThisspecificationisadaptedfromtheAdaSemanticInterface") 202 or else 203 Contains 204 ("ThisspecificationisderivedfromtheAdaReferenceManual") 205 then 206 return Unrestricted; 207 end if; 208 209 Skip_EOL; 210 211 Check_End_Of_Line; 212 213 declare 214 Physical : Boolean; 215 216 begin 217 Skip_Line_Terminators (Scan_Ptr, Physical); 218 219 -- If we are at start of physical line, update scan pointers 220 -- to reflect the start of the new line. 221 222 if Physical then 223 Current_Line_Start := Scan_Ptr; 224 Start_Column := Scanner.Set_Start_Column; 225 First_Non_Blank_Location := Scan_Ptr; 226 end if; 227 end; 228 end loop; 229 end Determine_License; 230 231 ---------------------------- 232 -- Determine_Token_Casing -- 233 ---------------------------- 234 235 function Determine_Token_Casing return Casing_Type is 236 begin 237 return Scanner.Determine_Token_Casing; 238 end Determine_Token_Casing; 239 240 --------------------- 241 -- Error_Long_Line -- 242 --------------------- 243 244 procedure Error_Long_Line is 245 begin 246 Error_Msg 247 ("this line is too long", 248 Current_Line_Start + Hostparm.Max_Line_Length); 249 end Error_Long_Line; 250 251 ------------------------ 252 -- Initialize_Scanner -- 253 ------------------------ 254 255 procedure Initialize_Scanner 256 (Unit : Unit_Number_Type; 257 Index : Source_File_Index) 258 is 259 GNAT_Hedr : constant Text_Buffer (1 .. 78) := (others => '-'); 260 261 begin 262 Scanner.Initialize_Scanner (Unit, Index); 263 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 268 269 if Index /= Internal_Source_File then 270 Set_Comes_From_Source_Default (True); 271 end if; 272 273 -- Check license if GNAT type header possibly present 274 275 if Source_Last (Index) - Scan_Ptr > 80 276 and then Source (Scan_Ptr .. Scan_Ptr + 77) = GNAT_Hedr 277 then 278 Set_License (Current_Source_File, Determine_License); 279 end if; 280 281 -- Because of the License stuff above, Scng.Initialize_Scanner cannot 282 -- call Scan. Scan initial token (note this initializes Prev_Token, 283 -- Prev_Token_Ptr). 284 285 -- There are two reasons not to do the Scan step in case if we 286 -- initialize the scanner for the internal source buffer: 287 288 -- - The artificial string may not be created by the compiler in this 289 -- buffer when we call Initialize_Scanner 290 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. 294 295 if Index /= Internal_Source_File then 296 Scan; 297 end if; 298 299 -- Clear flags for reserved words used as indentifiers 300 301 for J in Token_Type loop 302 Used_As_Identifier (J) := False; 303 end loop; 304 end Initialize_Scanner; 305 306 ------------------------------ 307 -- Scan_Reserved_Identifier -- 308 ------------------------------ 309 310 procedure Scan_Reserved_Identifier (Force_Msg : Boolean) is 311 Token_Chars : constant String := Token_Type'Image (Token); 312 313 begin 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. 316 317 Name_Len := 0; 318 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)); 322 end loop; 323 324 Token_Name := Name_Find; 325 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; 330 end if; 331 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; 336 337end Scn; 338