package body Scn is
- use ASCII;
-
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
-- keyword as an identifier once for a given keyword).
- function Determine_License return License_Type;
- -- Scan header of file and check that it has an appropriate GNAT-style
- -- header with a proper license statement. Returns GPL, Unrestricted,
- -- or Modified_GPL depending on header. If none of these, returns Unknown.
-
- -----------------------
- -- Determine_License --
- -----------------------
-
- function Determine_License return License_Type is
- GPL_Found : Boolean := False;
- Result : License_Type;
-
- function Contains (S : String) return Boolean;
- -- See if current comment contains successive non-blank characters
- -- matching the contents of S. If so leave Scan_Ptr unchanged and
- -- return True, otherwise leave Scan_Ptr unchanged and return False.
-
- procedure Skip_EOL;
- -- Skip to line terminator character
-
- --------------
- -- Contains --
- --------------
-
- function Contains (S : String) return Boolean is
- CP : Natural;
- SP : Source_Ptr;
- SS : Source_Ptr;
-
- begin
- -- Loop to check characters. This loop is terminated by end of
- -- line, and also we need to check for the EOF case, to take
- -- care of files containing only comments.
-
- 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;
-
- --------------
- -- Skip_EOL --
- --------------
-
- 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;
-
- -- Start of processing for Determine_License
-
- 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;
-
- Scanner.Check_End_Of_Line;
-
- if Source (Scan_Ptr) /= EOF then
-
- -- We have to take into account a degenerate case when the source
- -- file contains only comments and no Ada code.
-
- declare
- Physical : Boolean;
-
- begin
- Skip_Line_Terminators (Scan_Ptr, Physical);
-
- -- If we are at start of physical line, update scan pointers
- -- to reflect the start of the new line.
-
- 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;
-
----------------------------
-- Determine_Token_Casing --
----------------------------
procedure Initialize_Scanner
(Unit : Unit_Number_Type;
- Index : Source_File_Index)
- is
- GNAT_Hedr : constant Text_Buffer (1 .. 78) := (others => '-');
-
+ Index : Source_File_Index) is
begin
Scanner.Initialize_Scanner (Index);
Set_Unit (Index, Unit);
Set_Comes_From_Source_Default (True);
- -- Check license if GNAT type header possibly present
-
- 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;
-
Check_For_BOM;
-- Because of the License stuff above, Scng.Initialize_Scanner cannot