with Atree; use Atree;
with Csets; use Csets;
with Namet; use Namet;
with Opt; use Opt;
with Scans; use Scans;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
package body Scn is
use ASCII;
Used_As_Identifier : array (Token_Type) of Boolean;
procedure Check_End_Of_Line;
function Determine_License return License_Type;
procedure Error_Long_Line;
procedure Post_Scan is
begin
case Token is
when Tok_Char_Literal =>
Token_Node := New_Node (N_Character_Literal, Token_Ptr);
Set_Char_Literal_Value (Token_Node, Character_Code);
Set_Chars (Token_Node, Token_Name);
when Tok_Identifier =>
Token_Node := New_Node (N_Identifier, Token_Ptr);
Set_Chars (Token_Node, Token_Name);
when Tok_Real_Literal =>
Token_Node := New_Node (N_Real_Literal, Token_Ptr);
Set_Realval (Token_Node, Real_Literal_Value);
when Tok_Integer_Literal =>
Token_Node := New_Node (N_Integer_Literal, Token_Ptr);
Set_Intval (Token_Node, Int_Literal_Value);
when Tok_String_Literal =>
Token_Node := New_Node (N_String_Literal, Token_Ptr);
Set_Has_Wide_Character (Token_Node, Wide_Character_Found);
Set_Strval (Token_Node, String_Literal_Id);
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 others =>
null;
end case;
end Post_Scan;
procedure Check_End_Of_Line is
Len : constant Int := Int (Scan_Ptr) - Int (Current_Line_Start);
begin
if Style_Check then
Style.Check_Line_Terminator (Len);
elsif Len > Opt.Max_Line_Length then
Error_Long_Line;
end if;
end Check_End_Of_Line;
function Determine_License return License_Type is
GPL_Found : Boolean := False;
Result : License_Type;
function Contains (S : String) return Boolean;
procedure Skip_EOL;
function Contains (S : String) return Boolean is
CP : Natural;
SP : Source_Ptr;
SS : Source_Ptr;
begin
SP := Scan_Ptr;
while Source (SP) /= CR and then
Source (SP) /= LF and then
Source (SP) /= EOF
loop
if Source (SP) = S (S'First) then
SS := SP;
CP := S'First;
loop
SS := SS + 1;
CP := CP + 1;
if CP > S'Last then
return True;
end if;
while Source (SS) = ' ' loop
SS := SS + 1;
end loop;
exit when Source (SS) /= S (CP);
end loop;
end if;
SP := SP + 1;
end loop;
return False;
end Contains;
procedure Skip_EOL is
begin
while Source (Scan_Ptr) /= CR
and then Source (Scan_Ptr) /= LF
and then Source (Scan_Ptr) /= EOF
loop
Scan_Ptr := Scan_Ptr + 1;
end loop;
end Skip_EOL;
begin
loop
if Source (Scan_Ptr) /= '-'
or else Source (Scan_Ptr + 1) /= '-'
then
if GPL_Found then
Result := GPL;
exit;
else
Result := Unknown;
exit;
end if;
elsif Contains ("Asaspecialexception") then
if GPL_Found then
Result := Modified_GPL;
exit;
end if;
elsif Contains ("GNUGeneralPublicLicense") then
GPL_Found := True;
elsif
Contains
("ThisspecificationisadaptedfromtheAdaSemanticInterface")
or else
Contains
("ThisspecificationisderivedfromtheAdaReferenceManual")
then
Result := Unrestricted;
exit;
end if;
Skip_EOL;
Check_End_Of_Line;
if Source (Scan_Ptr) /= EOF then
declare
Physical : Boolean;
begin
Skip_Line_Terminators (Scan_Ptr, Physical);
if Physical then
Current_Line_Start := Scan_Ptr;
Start_Column := Scanner.Set_Start_Column;
First_Non_Blank_Location := Scan_Ptr;
end if;
end;
end if;
end loop;
return Result;
end Determine_License;
function Determine_Token_Casing return Casing_Type is
begin
return Scanner.Determine_Token_Casing;
end Determine_Token_Casing;
procedure Error_Long_Line is
begin
Error_Msg
("this line is too long",
Current_Line_Start + Source_Ptr (Opt.Max_Line_Length));
end Error_Long_Line;
procedure Initialize_Scanner
(Unit : Unit_Number_Type;
Index : Source_File_Index)
is
GNAT_Hedr : constant Text_Buffer (1 .. 78) := (others => '-');
begin
Scanner.Initialize_Scanner (Unit, Index);
if Index /= Internal_Source_File then
Set_Comes_From_Source_Default (True);
end if;
if Source_Last (Index) - Scan_Ptr > 80
and then Source (Scan_Ptr .. Scan_Ptr + 77) = GNAT_Hedr
then
Set_License (Current_Source_File, Determine_License);
end if;
if Index /= Internal_Source_File then
Scan;
end if;
for J in Token_Type loop
Used_As_Identifier (J) := False;
end loop;
end Initialize_Scanner;
procedure Scan_Reserved_Identifier (Force_Msg : Boolean) is
Token_Chars : constant String := Token_Type'Image (Token);
begin
Name_Len := 0;
for J in 5 .. Token_Chars'Length loop
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Fold_Lower (Token_Chars (J));
end loop;
Token_Name := Name_Find;
if not Used_As_Identifier (Token) or else Force_Msg then
Error_Msg_Name_1 := Token_Name;
Error_Msg_SC ("reserved word* cannot be used as identifier!");
Used_As_Identifier (Token) := True;
end if;
Token := Tok_Identifier;
Token_Node := New_Node (N_Identifier, Token_Ptr);
Set_Chars (Token_Node, Token_Name);
end Scan_Reserved_Identifier;
end Scn;