Home Explore Help
Sign In
pascal
/
freepascal.compiler
mirror of https://gitlab.com/freepascal.org/fpc/source.git
2
0
Fork 0
Files Issues 0 Wiki
Browse Source

* Improvements so whole RTL can be parsed

Michaël Van Canneyt 2 years ago
parent
08f396f64e
commit
047e360538
5 changed files with 658 additions and 242 deletions
Unified View Show Diff Stats
  1. 318 99
      packages/fcl-passrc/src/pparser.pp
  2. 258 143
      packages/fcl-passrc/src/pscanner.pp
  3. 28 0
      packages/fcl-passrc/tests/tcclasstype.pas
  4. 39 0
      packages/fcl-passrc/tests/tcprocfunc.pas
  5. 15 0
      packages/fcl-passrc/tests/tcscanner.pas

+ 318 - 99
packages/fcl-passrc/src/pparser.pp
View File 

@@ -18,6 +18,19 @@ unit PParser;
 
 
 
 {$i fcl-passrc.inc}
 
 {$i fcl-passrc.inc}
 
 
 
+{
 
+  define this for additional debug messages on stdout.
 
+  the define name contains Writeln so when you do a grep, you can nicely spot the locations where it is OK to write.
 
+   Make sure you keep the name in both IFDEF and ENDIF directives
 
+}
 
+
 
+{ $DEFINE VerbosePasParserWriteln}
 
+
 
+// Transform to define using Writeln in the name. Same mechanism as above
 
+{$IFDEF VerbosePasResolver}
 
+{$DEFINE VerbosePasResolverWriteln}
 
+{$ENDIF}
 
+
 
 interface
 
 interface
 
 
 
 uses
 
 uses
 
@@ -252,10 +265,12 @@ type
 
         Comments: TStrings;
 
         Comments: TStrings;
 
         SourcePos: TPasSourcePos;
 
         SourcePos: TPasSourcePos;
 
         TokenPos: TPasSourcePos;
 
         TokenPos: TPasSourcePos;
 
+        IsEscaped : Boolean;
 
       end;
 
       end;
 
       PTokenRec = ^TTokenRec;
 
       PTokenRec = ^TTokenRec;
 
   private
 
   private
 
     FCurModule: TPasModule;
 
     FCurModule: TPasModule;
 
+    FCurTokenEscaped: Boolean;
 
     FFileResolver: TBaseFileResolver;
 
     FFileResolver: TBaseFileResolver;
 
     FIdentifierPos: TPasSourcePos;
 
     FIdentifierPos: TPasSourcePos;
 
     FImplicitUses: TStrings;
 
     FImplicitUses: TStrings;
 
@@ -277,10 +292,10 @@ type
 
     FTokenRingCur: Integer; // index of current token in FTokenBuffer
 
     FTokenRingCur: Integer; // index of current token in FTokenBuffer
 
     FTokenRingStart: Integer; // first valid ring index in FTokenBuffer, if FTokenRingStart=FTokenRingEnd the ring is empty
 
     FTokenRingStart: Integer; // first valid ring index in FTokenBuffer, if FTokenRingStart=FTokenRingEnd the ring is empty
 
     FTokenRingEnd: Integer; // first invalid ring index in FTokenBuffer
 
     FTokenRingEnd: Integer; // first invalid ring index in FTokenBuffer
 
-    {$ifdef VerbosePasParser}
 
+    {$ifdef VerbosePasParserWriteln}
 
     FDumpIndent : String;
 
     FDumpIndent : String;
 
     procedure DumpCurToken(Const Msg : String; IndentAction : TIndentAction = iaNone);
 
     procedure DumpCurToken(Const Msg : String; IndentAction : TIndentAction = iaNone);
 
-    {$endif}
 
+    {$endif VerbosePasParserWriteln}
 
     function CheckOverloadList(AList: TFPList; AName: String; out OldMember: TPasElement): TPasOverloadedProc;
 
     function CheckOverloadList(AList: TFPList; AName: String; out OldMember: TPasElement): TPasOverloadedProc;
 
     function DoCheckHint(Element: TPasElement): Boolean;
 
     function DoCheckHint(Element: TPasElement): Boolean;
 
     function GetCurrentModeSwitches: TModeSwitches;
 
     function GetCurrentModeSwitches: TModeSwitches;
 
@@ -289,7 +304,7 @@ type
 
       Out VarMods: TVariableModifiers; Out LibName, ExportName: TPasExpr;
 
       Out VarMods: TVariableModifiers; Out LibName, ExportName: TPasExpr;
 
       const AllowedMods: TVariableModifiers): string;
 
       const AllowedMods: TVariableModifiers): string;
 
     function GetVariableValueAndLocation(Parent : TPasElement; Out Value: TPasExpr; Out AbsoluteExpr: TPasExpr; Out Location: String): Boolean;
 
     function GetVariableValueAndLocation(Parent : TPasElement; Out Value: TPasExpr; Out AbsoluteExpr: TPasExpr; Out Location: String): Boolean;
 
-    procedure HandleProcedureModifier(Parent: TPasElement; pm : TProcedureModifier);
 
+    procedure HandleProcedureModifier(Parent: TPasElement; pm : TProcedureModifier; IsBracketed : Boolean = false);
 
     procedure HandleProcedureTypeModifier(ProcType: TPasProcedureType; ptm : TProcTypeModifier);
 
     procedure HandleProcedureTypeModifier(ProcType: TPasProcedureType; ptm : TProcTypeModifier);
 
     procedure ParseMembersLocalConsts(AType: TPasMembersType; AVisibility: TPasMemberVisibility);
 
     procedure ParseMembersLocalConsts(AType: TPasMembersType; AVisibility: TPasMemberVisibility);
 
     procedure ParseMembersLocalTypes(AType: TPasMembersType; AVisibility: TPasMemberVisibility);
 
     procedure ParseMembersLocalTypes(AType: TPasMembersType; AVisibility: TPasMemberVisibility);
 
@@ -298,6 +313,8 @@ type
 
     procedure OnScannerModeChanged(Sender: TObject; NewMode: TModeSwitch;
 
     procedure OnScannerModeChanged(Sender: TObject; NewMode: TModeSwitch;
 
       Before: boolean; var Handled: boolean);
 
       Before: boolean; var Handled: boolean);
 
   protected
 
   protected
 
+    function AllowFinal(aType: TPasType): Boolean;
 
+    function CheckCurtokenIsFinal(aType: TPasType): boolean;
 
     Function SaveComments : String;
 
     Function SaveComments : String;
 
     Function SaveComments(Const AValue : String) : String;
 
     Function SaveComments(Const AValue : String) : String;
 
     function LogEvent(E : TPParserLogEvent) : Boolean; inline;
 
     function LogEvent(E : TPParserLogEvent) : Boolean; inline;
 
@@ -314,6 +331,8 @@ type
 
     procedure ReadGenericArguments(List: TFPList; Parent: TPasElement);
 
     procedure ReadGenericArguments(List: TFPList; Parent: TPasElement);
 
     procedure ReadSpecializeArguments(Parent: TPasElement; Params: TFPList);
 
     procedure ReadSpecializeArguments(Parent: TPasElement; Params: TFPList);
 
     function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String;
 
     function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String;
 
+    procedure ParseProcedureModifiers(Parent: TPasElement;
 
+      Element: TPasProcedureType; IsProcType, IsAnonymous: Boolean);
 
     function CheckProcedureArgs(Parent: TPasElement;
 
     function CheckProcedureArgs(Parent: TPasElement;
 
       Args: TFPList; // list of TPasArgument
 
       Args: TFPList; // list of TPasArgument
 
       ProcType: TProcType): boolean;
 
       ProcType: TProcType): boolean;
 
@@ -337,9 +356,9 @@ type
 
     function CreateBinaryExpr(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos): TBinaryExpr; overload;
 
     function CreateBinaryExpr(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos): TBinaryExpr; overload;
 
     procedure AddToBinaryExprChain(var ChainFirst: TPasExpr;
 
     procedure AddToBinaryExprChain(var ChainFirst: TPasExpr;
 
       Element: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos);
 
       Element: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos);
 
-    {$IFDEF VerbosePasParser}
 
+    {$IFDEF VerbosePasParserWriteln}
 
     procedure WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr);
 
     procedure WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr);
 
-    {$ENDIF}
 
+    {$ENDIF VerbosePasParserWriteln}
 
     function CreateUnaryExpr(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode): TUnaryExpr; overload;
 
     function CreateUnaryExpr(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode): TUnaryExpr; overload;
 
     function CreateUnaryExpr(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos): TUnaryExpr; overload;
 
     function CreateUnaryExpr(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos): TUnaryExpr; overload;
 
     function CreateArrayValues(AParent : TPasElement): TArrayValues;
 
     function CreateArrayValues(AParent : TPasElement): TArrayValues;
 
@@ -394,7 +413,7 @@ type
 
     procedure ExpectToken(tk: TToken);
 
     procedure ExpectToken(tk: TToken);
 
     procedure ExpectTokens(tk:  TTokens);
 
     procedure ExpectTokens(tk:  TTokens);
 
     function GetPrevToken: TToken;
 
     function GetPrevToken: TToken;
 
-    function ExpectIdentifier: String;
 
+    function ExpectIdentifier(CountAsIdentifier : TTokens = []): String;
 
     Procedure SaveIdentifierPosition;
 
     Procedure SaveIdentifierPosition;
 
     Function CurTokenIsIdentifier(Const S : String) : Boolean;
 
     Function CurTokenIsIdentifier(Const S : String) : Boolean;
 
     // Expression parsing
 
     // Expression parsing
 
@@ -469,6 +488,7 @@ type
 
     property Engine: TPasTreeContainer read FEngine;
 
     property Engine: TPasTreeContainer read FEngine;
 
     property CurToken: TToken read FCurToken;
 
     property CurToken: TToken read FCurToken;
 
     property CurTokenString: String read FCurTokenString;
 
     property CurTokenString: String read FCurTokenString;
 
+    property CurTokenEscaped : Boolean Read FCurTokenEscaped;
 
     property Options : TPOptions Read FOptions Write SetOptions;
 
     property Options : TPOptions Read FOptions Write SetOptions;
 
     property CurrentModeswitches : TModeSwitches Read GetCurrentModeSwitches Write SetCurrentModeSwitches;
 
     property CurrentModeswitches : TModeSwitches Read GetCurrentModeSwitches Write SetCurrentModeSwitches;
 
     property CurModule : TPasModule Read FCurModule;
 
     property CurModule : TPasModule Read FCurModule;
 
@@ -1023,11 +1043,12 @@ procedure TPasParser.ParseExc(MsgNumber: integer; const Fmt: String;
 
   Args: array of const);
 
   Args: array of const);
 
 var
 
 var
 
   p: TPasSourcePos;
 
   p: TPasSourcePos;
 
+  msg : String;
 
 begin
 
 begin
 
-  {$IFDEF VerbosePasParser}
 
+  {$IFDEF VerbosePasParserWriteln}
 
   writeln('TPasParser.ParseExc Token="',CurTokenText,'"');
 
   writeln('TPasParser.ParseExc Token="',CurTokenText,'"');
 
   //writeln('TPasParser.ParseExc ',Scanner.CurColumn,' ',Scanner.CurSourcePos.Column,' ',Scanner.CurTokenPos.Column,' ',Scanner.CurSourceFile.Filename);
 
   //writeln('TPasParser.ParseExc ',Scanner.CurColumn,' ',Scanner.CurSourcePos.Column,' ',Scanner.CurTokenPos.Column,' ',Scanner.CurSourceFile.Filename);
 
-  {$ENDIF}
 
+  {$ENDIF VerbosePasParserWriteln}
 
   SetLastMsg(mtError,MsgNumber,Fmt,Args);
 
   SetLastMsg(mtError,MsgNumber,Fmt,Args);
 
   p:=Scanner.CurTokenPos;
 
   p:=Scanner.CurTokenPos;
 
   if p.FileName='' then
 
   if p.FileName='' then
 
@@ -1037,10 +1058,11 @@ begin
 
     p.Row:=1;
 
     p.Row:=1;
 
     p.Column:=1;
 
     p.Column:=1;
 
     end;
 
     end;
 
-  raise EParserError.Create(SafeFormat(SParserErrorAtToken,
 
-    [FLastMsg, CurTokenName, p.FileName, p.Row, p.Column])
 
-    {$ifdef addlocation}+' ('+IntToStr(p.Row)+' '+IntToStr(p.Column)+')'{$endif},
 
-    p.FileName, p.Row, p.Column);
 
+  Msg:=SafeFormat(SParserErrorAtToken, [FLastMsg, CurTokenName, p.FileName, p.Row, p.Column]);
 
+  {$ifdef addlocation}
 
+  Msg:=Msg+' ('+IntToStr(p.Row)+' '+IntToStr(p.Column)+')';
 
+  {$endif}
 
+  raise EParserError.Create(Msg,p.FileName, p.Row, p.Column);
 
 end;
 
 end;
 
 
 
 procedure TPasParser.ParseExcExpectedIdentifier;
 
 procedure TPasParser.ParseExcExpectedIdentifier;
 
@@ -1177,6 +1199,7 @@ begin
 
     //writeln('TPasParser.NextToken REUSE Start=',FTokenRingStart,' Cur=',FTokenRingCur,' End=',FTokenRingEnd,' Cur=',CurTokenString);
 
     //writeln('TPasParser.NextToken REUSE Start=',FTokenRingStart,' Cur=',FTokenRingCur,' End=',FTokenRingEnd,' Cur=',CurTokenString);
 
     FCurToken := Scanner.CheckToken(P^.Token,P^.AsString);
 
     FCurToken := Scanner.CheckToken(P^.Token,P^.AsString);
 
     FCurTokenString := P^.AsString;
 
     FCurTokenString := P^.AsString;
 
+    FCurTokenEscaped:= p^.IsEscaped;
 
     end
 
     end
 
   else
 
   else
 
     begin
 
     begin
 
@@ -1212,11 +1235,13 @@ begin
 
           end;
 
           end;
 
         end;
 
         end;
 
     end;
 
     end;
 
-    p^.Token:=FCurToken;
 
     FCurTokenString := Scanner.CurTokenString;
 
     FCurTokenString := Scanner.CurTokenString;
 
+    FCurTokenEscaped:=Scanner.CurTokenEscaped;
 
+    p^.Token:=FCurToken;
 
     p^.AsString:=FCurTokenString;
 
     p^.AsString:=FCurTokenString;
 
     p^.SourcePos:=Scanner.CurSourcePos;
 
     p^.SourcePos:=Scanner.CurSourcePos;
 
     p^.TokenPos:=Scanner.CurTokenPos;
 
     p^.TokenPos:=Scanner.CurTokenPos;
 
+    P^.IsEscaped:=Scanner.CurTokenEscaped;
 
     end;
 
     end;
 
   //writeln('TPasParser.NextToken END Start=',FTokenRingStart,' Cur=',FTokenRingCur,' End=',FTokenRingEnd,' Cur=',CurTokenString);
 
   //writeln('TPasParser.NextToken END Start=',FTokenRingStart,' Cur=',FTokenRingCur,' End=',FTokenRingEnd,' Cur=',CurTokenString);
 
 end;
 
 end;
 
@@ -1286,9 +1311,9 @@ procedure TPasParser.CheckToken(tk: TToken);
 
 begin
 
 begin
 
   if (CurToken<>tk) then
 
   if (CurToken<>tk) then
 
     begin
 
     begin
 
-    {$IFDEF VerbosePasParser}
 
+    {$IFDEF VerbosePasParserWriteln}
 
     writeln('TPasParser.ParseExcTokenError String="',CurTokenString,'" Text="',CurTokenText,'" CurToken=',CurToken,' tk=',tk);
 
     writeln('TPasParser.ParseExcTokenError String="',CurTokenString,'" Text="',CurTokenText,'" CurToken=',CurToken,' tk=',tk);
 
-    {$ENDIF}
 
+    {$ENDIF VerbosePasParserWriteln}
 
     ParseExcTokenError(TokenInfos[tk]);
 
     ParseExcTokenError(TokenInfos[tk]);
 
     end;
 
     end;
 
 end;
 
 end;
 
@@ -1301,9 +1326,9 @@ Var
 
 begin
 
 begin
 
   if not (CurToken in tk) then
 
   if not (CurToken in tk) then
 
     begin
 
     begin
 
-    {$IFDEF VerbosePasParser}
 
+    {$IFDEF VerbosePasParserWriteln}
 
     writeln('TPasParser.ParseExcTokenError String="',CurTokenString,'" Text="',CurTokenText,'" CurToken=',CurToken);
 
     writeln('TPasParser.ParseExcTokenError String="',CurTokenString,'" Text="',CurTokenText,'" CurToken=',CurToken);
 
-    {$ENDIF}
 
+    {$ENDIF VerbosePasParserWriteln}
 
     S:='';
 
     S:='';
 
     For T in TToken do
 
     For T in TToken do
 
       if t in tk then
 
       if t in tk then
 
@@ -1345,9 +1370,15 @@ begin
 
   Result := P^.Token;
 
   Result := P^.Token;
 
 end;
 
 end;
 
 
 
-function TPasParser.ExpectIdentifier: String;
 
+function TPasParser.ExpectIdentifier(CountAsIdentifier: TTokens): String;
 
 begin
 
 begin
 
-  ExpectToken(tkIdentifier);
 
+  if CountAsIdentifier=[] then
 
+    ExpectToken(tkIdentifier)
 
+  else
 
+    begin
 
+    Include(CountAsIdentifier,tkIdentifier);
 
+    ExpectTokens(CountAsIdentifier);
 
+    end;
 
   Result := CurTokenString;
 
   Result := CurTokenString;
 
 end;
 
 end;
 
 
 
@@ -1385,6 +1416,13 @@ end;
 
 
 
 function TPasParser.TokenIsProcedureModifier(Parent: TPasElement;
 
 function TPasParser.TokenIsProcedureModifier(Parent: TPasElement;
 
   const S: String; out PM: TProcedureModifier): Boolean;
 
   const S: String; out PM: TProcedureModifier): Boolean;
 
+
 
+Const
 
+   IntfAllowed = [pmOverload, pmMessage, pmDispId,pmNoReturn,pmFar,pmFinal];
 
+
 
+Var
 
+  Allowed : TProcedureModifiers;
 
+
 
 begin
 
 begin
 
   Result:=IsProcModifier(S,PM);
 
   Result:=IsProcModifier(S,PM);
 
   if not Result then exit;
 
   if not Result then exit;
 
@@ -1394,8 +1432,13 @@ begin
 
       begin
 
       begin
 
       if PM in [pmPublic,pmForward] then exit(false);
 
       if PM in [pmPublic,pmForward] then exit(false);
 
       if TPasClassType(Parent).ObjKind in [okInterface,okDispInterface] then
 
       if TPasClassType(Parent).ObjKind in [okInterface,okDispInterface] then
 
-        if not (PM in [pmOverload, pmMessage, pmDispId,pmNoReturn,pmFar,pmFinal]) then
 
+        begin
 
+        Allowed:=IntfAllowed;
 
+        if TPasClassType(Parent).IsExternal then
 
+          Include(Allowed,pmExternal);
 
+        if not (PM in Allowed) then
 
           exit(false);
 
           exit(false);
 
+        end;
 
       exit;
 
       exit;
 
       end
 
       end
 
     else if Parent is TPasRecordType then
 
     else if Parent is TPasRecordType then
 
@@ -1518,10 +1561,10 @@ Function IsSimpleTypeToken(Var AName : String) : Boolean;
 
 Const
 
 Const
 
    SimpleTypeCount = 15;
 
    SimpleTypeCount = 15;
 
    SimpleTypeNames : Array[1..SimpleTypeCount] of string =
 
    SimpleTypeNames : Array[1..SimpleTypeCount] of string =
 
-     ('byte','boolean','char','integer','int64','longint','longword','double',
 
+     ('byte','boolean','AnsiChar','integer','int64','longint','longword','double',
 
       'shortint','smallint','string','word','qword','cardinal','widechar');
 
       'shortint','smallint','string','word','qword','cardinal','widechar');
 
    SimpleTypeCaseNames : Array[1..SimpleTypeCount] of string =
 
    SimpleTypeCaseNames : Array[1..SimpleTypeCount] of string =
 
-     ('Byte','Boolean','Char','Integer','Int64','LongInt','LongWord','Double',
 
+     ('Byte','Boolean','AnsiChar','Integer','Int64','LongInt','LongWord','Double',
 
      'ShortInt','SmallInt','String','Word','QWord','Cardinal','WideChar');
 
      'ShortInt','SmallInt','String','Word','QWord','Cardinal','WideChar');
 
 
 
 Var
 
 Var
 
@@ -1827,7 +1870,20 @@ begin
 
     Until CurToken=tkGreaterThan;
 
     Until CurToken=tkGreaterThan;
 
     end
 
     end
 
   else
 
   else
 
+    begin
 
+    if Curtoken=tkSemicolon then
 
+      begin
 
+      NextToken;
 
+      if CurTokenIsIdentifier('far') or  CurTokenIsIdentifier('near') then
 
+        begin
 
+        NextToken;
 
+        CheckToken(tkSemicolon);
 
+        end
 
+      else
 
+        UnGetToken;
 
+      end;
 
     UngetToken;
 
     UngetToken;
 
+    end;
 
   Result.DestType:=ResolveTypeReference(Name,Result);
 
   Result.DestType:=ResolveTypeReference(Name,Result);
 
   Engine.FinishScope(stTypeDef,Result);
 
   Engine.FinishScope(stTypeDef,Result);
 
 end;
 
 end;
 
@@ -2172,15 +2228,13 @@ begin
 
     Ref:=Engine.FindElementFor(Name,Parent,ParamCnt);
 
     Ref:=Engine.FindElementFor(Name,Parent,ParamCnt);
 
     if Ref=nil then
 
     if Ref=nil then
 
       begin
 
       begin
 
-      {$IFDEF VerbosePasResolver}
 
-      {AllowWriteln}
 
+      {$IFDEF VerbosePasResolverWriteln}
 
       if po_resolvestandardtypes in FOptions then
 
       if po_resolvestandardtypes in FOptions then
 
         begin
 
         begin
 
         writeln('ERROR: TPasParser.ResolveTypeReference: resolver failed to raise an error');
 
         writeln('ERROR: TPasParser.ResolveTypeReference: resolver failed to raise an error');
 
         ParseExcExpectedIdentifier;
 
         ParseExcExpectedIdentifier;
 
         end;
 
         end;
 
-      {AllowWriteln-}
 
-      {$ENDIF}
 
+      {$ENDIF VerbosePasResolverWriteln}
 
       end
 
       end
 
     else if not (Ref is TPasType) then
 
     else if not (Ref is TPasType) then
 
       ParseExc(nParserExpectedTypeButGot,SParserExpectedTypeButGot,[Ref.ElementTypeName]);
 
       ParseExc(nParserExpectedTypeButGot,SParserExpectedTypeButGot,[Ref.ElementTypeName]);
 
@@ -2311,6 +2365,20 @@ type
 
       end;
 
       end;
 
   end;
 
   end;
 
 
 
+  Function IsMemAccess(P : TPasExpr) : boolean;
 
+
 
+  Var
 
+    N : String;
 
+  begin
 
+    Result:=(po_AllowMem in options) and (P is TPrimitiveExpr);
 
+    if Result then
 
+      begin
 
+      N:=LowerCase(TPrimitiveExpr(P).Value);
 
+      // We should actually resolve this to system.NNN
 
+      Result:=(N='mem') or (N='meml') or (N='memw');
 
+      end;
 
+  end;
 
+
 
   function IsSpecialize: boolean;
 
   function IsSpecialize: boolean;
 
   var
 
   var
 
     LookAhead, i: Integer;
 
     LookAhead, i: Integer;
 
@@ -2510,7 +2578,7 @@ begin
 
       if CurToken=tkBraceOpen then
 
       if CurToken=tkBraceOpen then
 
         Params:=ParseParams(AParent,pekFuncParams,IsWriteOrStr(Func))
 
         Params:=ParseParams(AParent,pekFuncParams,IsWriteOrStr(Func))
 
       else
 
       else
 
-        Params:=ParseParams(AParent,pekArrayParams);
 
+        Params:=ParseParams(AParent,pekArrayParams,IsMemAccess(Func));
 
       if not Assigned(Params) then Exit;
 
       if not Assigned(Params) then Exit;
 
       Params.Value:=Result;
 
       Params.Value:=Result;
 
       Result.Parent:=Params;
 
       Result.Parent:=Params;
 
@@ -2696,9 +2764,9 @@ begin
 
   AllowedBinaryOps:=BinaryOP;
 
   AllowedBinaryOps:=BinaryOP;
 
   if Not AllowEqual then
 
   if Not AllowEqual then
 
     Exclude(AllowedBinaryOps,tkEqual);
 
     Exclude(AllowedBinaryOps,tkEqual);
 
-  {$ifdef VerbosePasParser}
 
+  {$ifdef VerbosePasParserWriteln}
 
   //DumpCurToken('Entry',iaIndent);
 
   //DumpCurToken('Entry',iaIndent);
 
-  {$endif}
 
+  {$endif VerbosePasParserWriteln}
 
   Result:=nil;
 
   Result:=nil;
 
   ExpStack := TFPList.Create;
 
   ExpStack := TFPList.Create;
 
   SetLength(OpStack,4);
 
   SetLength(OpStack,4);
 
@@ -2780,12 +2848,12 @@ begin
 
     Result.Parent:=AParent;
 
     Result.Parent:=AParent;
 
 
 
   finally
 
   finally
 
-    {$ifdef VerbosePasParser}
 
+    {$ifdef VerbosePasParserWriteln}
 
     if Not Assigned(Result) then
 
     if Not Assigned(Result) then
 
       DumpCurToken('Exiting (no result)',iaUndent)
 
       DumpCurToken('Exiting (no result)',iaUndent)
 
     else
 
     else
 
       DumpCurtoken('Exiting (Result: "'+Result.GetDeclaration(true)+'") ',iaUndent);
 
       DumpCurtoken('Exiting (Result: "'+Result.GetDeclaration(true)+'") ',iaUndent);
 
-    {$endif}
 
+    {$endif VerbosePasParserWriteln}
 
     SetLength(OpStack,0);
 
     SetLength(OpStack,0);
 
     ExpStack.Free;
 
     ExpStack.Free;
 
   end;
 
   end;
 
@@ -3138,9 +3206,9 @@ var
 
 begin
 
 begin
 
   if CurModule=nil then
 
   if CurModule=nil then
 
     ParseExcTokenError('TPasParser.ParseContinue missing module');
 
     ParseExcTokenError('TPasParser.ParseContinue missing module');
 
-  {$IFDEF VerbosePasParser}
 
+  {$IFDEF VerbosePasParserWriteln}
 
   writeln('TPasParser.ParseContinue ',CurModule.Name);
 
   writeln('TPasParser.ParseContinue ',CurModule.Name);
 
-  {$ENDIF}
 
+  {$ENDIF VerbosePasParserWriteln}
 
   if not CanParseContinue(Section) then
 
   if not CanParseContinue(Section) then
 
     ParseExcTokenError('TPasParser.ParseContinue missing section');
 
     ParseExcTokenError('TPasParser.ParseContinue missing section');
 
   HasFinished:=true;
 
   HasFinished:=true;
 
@@ -3232,7 +3300,6 @@ begin
 
     if not HasFinished then
 
     if not HasFinished then
 
       begin
 
       begin
 
       {$IFDEF VerbosePasResolver}
 
       {$IFDEF VerbosePasResolver}
 
-      {AllowWriteln}
 
       writeln('TPasParser.ParseProgram pause parsing after uses list of "',CurModule.Name,'"');
 
       writeln('TPasParser.ParseProgram pause parsing after uses list of "',CurModule.Name,'"');
 
       if CanParseContinue(aSection) then
 
       if CanParseContinue(aSection) then
 
         begin
 
         begin
 
@@ -3241,7 +3308,6 @@ begin
 
           writeln('TPasParser.ParseProgram aSection=',aSection.ClassName,' ',Section=aSection);
 
           writeln('TPasParser.ParseProgram aSection=',aSection.ClassName,' ',Section=aSection);
 
         ParseExc(nErrNoSourceGiven,'[20180305172432] ');
 
         ParseExc(nErrNoSourceGiven,'[20180305172432] ');
 
         end;
 
         end;
 
-      {AllowWriteln-}
 
       {$ENDIF}
 
       {$ENDIF}
 
       exit;
 
       exit;
 
       end;
 
       end;
 
@@ -3547,9 +3613,9 @@ begin
 
         SetBlock(declResourcestring)
 
         SetBlock(declResourcestring)
 
       else
 
       else
 
         begin
 
         begin
 
-        {$IFDEF VerbosePasParser}
 
+        {$IFDEF VerbosePasParserWriteln}
 
         writeln('TPasParser.ParseDeclarations ',Declarations.Parent.ClassName);
 
         writeln('TPasParser.ParseDeclarations ',Declarations.Parent.ClassName);
 
-        {$ENDIF}
 
+        {$ENDIF VerbosePasParserWriteln}
 
         ParseExc(nParserResourcestringsMustBeGlobal,SParserResourcestringsMustBeGlobal);
 
         ParseExc(nParserResourcestringsMustBeGlobal,SParserResourcestringsMustBeGlobal);
 
         end;
 
         end;
 
     tkType:
 
     tkType:
 
@@ -3806,9 +3872,9 @@ begin
 
   Result:=nil;
 
   Result:=nil;
 
   UsesUnit:=nil;
 
   UsesUnit:=nil;
 
   UnitRef:=nil;
 
   UnitRef:=nil;
 
-  {$IFDEF VerbosePasParser}
 
+  {$IFDEF VerbosePasParserWriteln}
 
   writeln('TPasParser.AddUseUnit AUnitName=',AUnitName,' CurModule.Name=',CurModule.Name);
 
   writeln('TPasParser.AddUseUnit AUnitName=',AUnitName,' CurModule.Name=',CurModule.Name);
 
-  {$ENDIF}
 
+  {$ENDIF VerbosePasParserWriteln}
 
   if CompareText(AUnitName,CurModule.Name)=0 then
 
   if CompareText(AUnitName,CurModule.Name)=0 then
 
     begin
 
     begin
 
     if CompareText(AUnitName,'System')=0 then
 
     if CompareText(AUnitName,'System')=0 then
 
@@ -4452,14 +4518,16 @@ begin
 
     begin
 
     begin
 
     Result:=True;
 
     Result:=True;
 
     NextToken;
 
     NextToken;
 
-    if Curtoken=tkNumber then
 
+    if Curtoken in [tkNumber,tkBraceOpen] then
 
       begin
 
       begin
 
-      AbsoluteExpr:=CreatePrimitiveExpr(Parent,pekNumber,CurTokenString);
 
+      AbsoluteExpr:=DoParseExpression(Parent,Nil,False);
 
       Location:=CurTokenString
 
       Location:=CurTokenString
 
       end
 
       end
 
     else
 
     else
 
       begin
 
       begin
 
       Location:=ReadDottedIdentifier(Parent,AbsoluteExpr,true);
 
       Location:=ReadDottedIdentifier(Parent,AbsoluteExpr,true);
 
+      if CurToken<>tkSemicolon then
 
+        AbsoluteExpr:=DoParseExpression(Parent,AbsoluteExpr,false);
 
       UnGetToken;
 
       UnGetToken;
 
       end
 
       end
 
     end
 
     end
 
@@ -4494,6 +4562,8 @@ begin
 
     ExtMod:=vmPublic
 
     ExtMod:=vmPublic
 
   else if (vmExport in AllowedMods) and (s='export') then
 
   else if (vmExport in AllowedMods) and (s='export') then
 
     ExtMod:=vmExport
 
     ExtMod:=vmExport
 
+  else if (vmFar in AllowedMods) and (s='far') then
 
+    ExtMod:=vmFar
 
   else
 
   else
 
     begin
 
     begin
 
     UngetToken;
 
     UngetToken;
 
@@ -4571,7 +4641,6 @@ begin
 
         CheckToken(tkIdentifier);
 
         CheckToken(tkIdentifier);
 
       end;
 
       end;
 
     Repeat
 
     Repeat
 
-      // create the TPasVariable here, so that SourceLineNumber is correct
 
       VarEl:=TPasVariable(CreateElement(TPasVariable,CurTokenString,Parent,
 
       VarEl:=TPasVariable(CreateElement(TPasVariable,CurTokenString,Parent,
 
                                         AVisibility,CurTokenPos));
 
                                         AVisibility,CurTokenPos));
 
       VarList.Add(VarEl);
 
       VarList.Add(VarEl);
 
@@ -4628,7 +4697,7 @@ begin
 
       if ExternalStruct then
 
       if ExternalStruct then
 
         AllowedVarMods:=[vmExternal]
 
         AllowedVarMods:=[vmExternal]
 
       else
 
       else
 
-        AllowedVarMods:=[vmCVar,vmExternal,vmPublic,vmExport];
 
+        AllowedVarMods:=[vmCVar,vmExternal,vmPublic,vmExport, vmfar];
 
       Mods:=GetVariableModifiers(VarEl,VarMods,aLibName,aExpName,AllowedVarMods);
 
       Mods:=GetVariableModifiers(VarEl,VarMods,aLibName,aExpName,AllowedVarMods);
 
       if (Mods='') and (CurToken<>tkSemicolon) then
 
       if (Mods='') and (CurToken<>tkSemicolon) then
 
         NextToken;
 
         NextToken;
 
@@ -4970,7 +5039,8 @@ begin
 
     end;
 
     end;
 
 end;
 
 end;
 
 
 
-procedure TPasParser.HandleProcedureModifier(Parent: TPasElement; pm: TProcedureModifier);
 
+procedure TPasParser.HandleProcedureModifier(Parent: TPasElement;
 
+  pm: TProcedureModifier; IsBracketed: Boolean);
 
 // at end on last token of modifier, usually the semicolon
 
 // at end on last token of modifier, usually the semicolon
 
 Var
 
 Var
 
   P : TPasProcedure;
 
   P : TPasProcedure;
 
@@ -4991,11 +5061,13 @@ begin
 
   pmExternal:
 
   pmExternal:
 
     begin
 
     begin
 
     NextToken;
 
     NextToken;
 
-    if CurToken in [tkString,tkIdentifier] then
 
+    if CurToken in [tkChar,tkString,tkIdentifier] then
 
       begin
 
       begin
 
       // external libname
 
       // external libname
 
       // external libname name XYZ
 
       // external libname name XYZ
 
       // external name XYZ
 
       // external name XYZ
 
+      // external index XYZ
 
+
 
       if Not CurTokenIsIdentifier('NAME') then
 
       if Not CurTokenIsIdentifier('NAME') then
 
         begin
 
         begin
 
         E:=DoParseExpression(Parent);
 
         E:=DoParseExpression(Parent);
 
@@ -5011,17 +5083,42 @@ begin
 
         if Assigned(P) then
 
         if Assigned(P) then
 
           P.LibrarySymbolName:=E;
 
           P.LibrarySymbolName:=E;
 
         end;
 
         end;
 
+      if CurTokenIsIdentifier('INDEX') then
 
+        begin
 
+        NextToken;
 
+        if not (CurToken in [tkNumber,tkChar,tkString,tkIdentifier]) then
 
+          ParseExcTokenError(TokenInfos[tkNumber]);
 
+        E:=DoParseExpression(Parent);
 
+        if Assigned(P) then
 
+          P.LibrarySymbolIndex:=E;
 
+        end;
 
       if CurToken<>tkSemicolon then
 
       if CurToken<>tkSemicolon then
 
         UngetToken;
 
         UngetToken;
 
       end
 
       end
 
     else
 
     else
 
       UngetToken;
 
       UngetToken;
 
     end;
 
     end;
 
+  pmSection:
 
+    begin
 
+    NextToken;
 
+    If CurToken<>tkString then
 
+      ParseExcTokenError(TokenInfos[tkString]);
 
+    NextToken;
 
+    CheckToken(tkSemicolon);
 
+    end;
 
   pmPublic:
 
   pmPublic:
 
     begin
 
     begin
 
     NextToken;
 
     NextToken;
 
     If not CurTokenIsIdentifier('name') then
 
     If not CurTokenIsIdentifier('name') then
 
       begin
 
       begin
 
+      if IsBracketed then
 
+        begin
 
+        // [ public, alias];
 
+        if Not (CurToken in [tkComma,tkSquaredBraceClose]) then
 
+          ParseExcTokenError(TokenInfos[tkComma]);
 
+        AddModifier;
 
+        exit;
 
+        end;
 
       if P.Parent is TPasMembersType then
 
       if P.Parent is TPasMembersType then
 
         begin
 
         begin
 
         // public section starts
 
         // public section starts
 
@@ -5081,6 +5178,19 @@ begin
 
     if CurToken<>tkSemicolon then
 
     if CurToken<>tkSemicolon then
 
       UngetToken;
 
       UngetToken;
 
     end;
 
     end;
 
+  pmCompilerProc:
 
+    begin
 
+    NextToken;
 
+    if CurToken=tkColon then
 
+      begin
 
+      NextToken;
 
+      CheckToken(tkIdentifier);
 
+      TPasProcedure(Parent).CompProcID:=CurtokenString;
 
+      NextToken;
 
+      end;
 
+    if CurToken<>tkSemicolon then
 
+      UngetToken;
 
+    end;
 
   else
 
   else
 
     // Do nothing, satisfy compiler
 
     // Do nothing, satisfy compiler
 
   end; // Case
 
   end; // Case
 
@@ -5164,25 +5274,12 @@ procedure TPasParser.ParseProcedureOrFunction(Parent: TPasElement;
 
       end;
 
       end;
 
   end;
 
   end;
 
 
 
-  procedure ConsumeSemi;
 
-  begin
 
-    NextToken;
 
-    if (CurToken <> tkSemicolon) and IsCurTokenHint then
 
-      UngetToken;
 
-  end;
 
-
 
 Var
 
 Var
 
-  Tok : String;
 
-  CC : TCallingConvention;
 
-  PM : TProcedureModifier;
 
   ResultEl: TPasResultElement;
 
   ResultEl: TPasResultElement;
 
   OK: Boolean;
 
   OK: Boolean;
 
   IsProcType: Boolean; // false = procedure, true = procedure type
 
   IsProcType: Boolean; // false = procedure, true = procedure type
 
   IsAnonymous: Boolean;
 
   IsAnonymous: Boolean;
 
   OldForceCaret : Boolean;
 
   OldForceCaret : Boolean;
 
-  PTM: TProcTypeModifier;
 
-  ModTokenCount: Integer;
 
-  LastToken: TToken;
 
 
 
 begin
 
 begin
 
   // Element must be non-nil. Removed all checks for not-nil.
 
   // Element must be non-nil. Removed all checks for not-nil.
 
@@ -5273,6 +5370,48 @@ begin
 
     else
 
     else
 
       UnGetToken;
 
       UnGetToken;
 
     end;
 
     end;
 
+  ParseProcedureModifiers(Parent,Element,IsProcType,IsAnonymous);
 
+  if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
 
+    TPasOperator(Parent).CorrectName;
 
+  Engine.FinishScope(stProcedureHeader,Element);
 
+  if (not IsProcType) and (IsAnonymous or TPasProcedure(Parent).CanParseImplementation) then
 
+    ParseProcedureBody(Parent);
 
+end;
 
+
 
+procedure TPasParser.ParseProcedureModifiers(Parent : TPasElement; Element : TPasProcedureType; IsProcType,IsAnonymous : Boolean);
 
+
 
+  Function CurtokenisValidSyscall : Boolean;
 
+  var
 
+     CT : String;
 
+  begin
 
+    Result:=CurToken=tkIdentifier;
 
+    if Result then
 
+      begin
 
+      CT:=LowerCase(CurTokenText);
 
+      Result:=(CT='consoledevice')
 
+              or (CT='legacy')
 
+              or (Pos('base',CT)>0)
 
+              or (Pos('systrap',CT)>0)
 
+              or (Pos('sysv',CT)>0);
 
+      end;
 
+  end;
 
+
 
+  procedure ConsumeSemi;
 
+  begin
 
+    NextToken;
 
+    if (CurToken <> tkSemicolon) and IsCurTokenHint then
 
+      UngetToken;
 
+  end;
 
+
 
+Var
 
+  ModTokenCount: Integer;
 
+  PM : TProcedureModifier;
 
+  PTM: TProcTypeModifier;
 
+  LastToken: TToken;
 
+  Tok : String;
 
+  CC : TCallingConvention;
 
+
 
+begin
 
   ModTokenCount:=0;
 
   ModTokenCount:=0;
 
   //writeln('TPasParser.ParseProcedureOrFunction IsProcType=',IsProcType,' IsAnonymous=',IsAnonymous);
 
   //writeln('TPasParser.ParseProcedureOrFunction IsProcType=',IsProcType,' IsAnonymous=',IsAnonymous);
 
   Repeat
 
   Repeat
 
@@ -5305,15 +5444,18 @@ begin
 
         if CurToken=tkSemiColon then
 
         if CurToken=tkSemiColon then
 
           UngetToken
 
           UngetToken
 
         else
 
         else
 
-          // remove legacy or basesysv on MorphOS syscalls
 
           begin
 
           begin
 
-          if (Pos('sysv',LowerCase(CurtokenText))>0) or CurTokenIsIdentifier('legacy') then
 
-            NextToken; 
           // remove LibBase (Amiga, AROS, MorphOS)  or Interface (OS4)
 
           // remove LibBase (Amiga, AROS, MorphOS)  or Interface (OS4)
 
-          if CurTokenIsIdentifier('consoledevice') or
 
-              ((Curtoken=tkIdentifier) and (Pos('base',LowerCase(CurtokenText)) > 0)) or 
-              ((Curtoken=tkIdentifier) and (CurtokenText[1] = 'I')) then
 
+          // syscall 11 23 is also used
 
+          // syscall SysTrapNNN
 
+
 
+          if (curToken=tkNumber) or CurtokenIsValidSysCall then
 
+            begin
 
+            HandleProcedureModifier(Parent,pmExternal);
 
             NextToken;
 
             NextToken;
 
+            if Curtoken<>tkNumber then
 
+               Ungettoken;
 
+            end;
 
           end;
 
           end;
 
       end;
 
       end;
 
       if IsProcType then
 
       if IsProcType then
 
@@ -5323,6 +5465,7 @@ begin
 
           UngetToken;
 
           UngetToken;
 
         end
 
         end
 
       else if IsAnonymous then
 
       else if IsAnonymous then
 
+        // No semicolon
 
       else
 
       else
 
         ExpectTokens([tkSemicolon]);
 
         ExpectTokens([tkSemicolon]);
 
       end
 
       end
 
@@ -5380,6 +5523,8 @@ begin
 
         // ToDo: read FPC's [] modifiers, e.g. [public,alias:'']
 
         // ToDo: read FPC's [] modifiers, e.g. [public,alias:'']
 
         repeat
 
         repeat
 
           NextToken;
 
           NextToken;
 
+          if TokenIsProcedureModifier(Parent,CurtokenString,Pm) then
 
+            HandleProcedureModifier(Parent,Pm,True);
 
           if CurToken in [tkSquaredBraceOpen,tkSemicolon] then
 
           if CurToken in [tkSquaredBraceOpen,tkSemicolon] then
 
             CheckToken(tkSquaredBraceClose);
 
             CheckToken(tkSquaredBraceClose);
 
         until CurToken = tkSquaredBraceClose;
 
         until CurToken = tkSquaredBraceClose;
 
@@ -5409,17 +5554,6 @@ begin
 
       end;
 
       end;
 
     // Writeln('Done: ',TokenInfos[Curtoken],' ',CurtokenString);
 
     // Writeln('Done: ',TokenInfos[Curtoken],' ',CurtokenString);
 
   Until false;
 
   Until false;
 
-  if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
 
-    TPasOperator(Parent).CorrectName;
 
-  Engine.FinishScope(stProcedureHeader,Element);
 
-  if (not IsProcType)
 
-  and (not TPasProcedure(Parent).IsForward)
 
-  and (not TPasProcedure(Parent).IsExternal)
 
-  and ((Parent.Parent is TImplementationSection)
 
-     or (Parent.Parent is TProcedureBody)
 
-     or IsAnonymous)
 
-  then
 
-    ParseProcedureBody(Parent);
 
 end;
 
 end;
 
 
 
 // starts after the semicolon
 
 // starts after the semicolon
 
@@ -5704,7 +5838,7 @@ var
 
 begin
 
 begin
 
   AsmBlock:=TPasImplAsmStatement(CreateElement(TPasImplAsmStatement,'',Parent));
 
   AsmBlock:=TPasImplAsmStatement(CreateElement(TPasImplAsmStatement,'',Parent));
 
   Parent.Body:=AsmBlock;
 
   Parent.Body:=AsmBlock;
 
-  ParseAsmBlock(AsmBlock);
 
+  ParseAsmBlock(AsmBlock); // we're on end or ]
 
   NextToken;
 
   NextToken;
 
   if not (Parent.Parent is TPasAnonymousProcedure) then
 
   if not (Parent.Parent is TPasAnonymousProcedure) then
 
     CheckToken(tkSemicolon);
 
     CheckToken(tkSemicolon);
 
@@ -5733,7 +5867,7 @@ begin
 
     repeat
 
     repeat
 
       Scanner.ReadNonPascalTillEndToken(true);
 
       Scanner.ReadNonPascalTillEndToken(true);
 
       case Scanner.CurToken of
 
       case Scanner.CurToken of
 
-      tkLineEnding,tkWhitespace:
 
+      tkLineEnding,tkWhitespace,tkComment:
 
         AsmBlock.Tokens.Add(Scanner.CurTokenString);
 
         AsmBlock.Tokens.Add(Scanner.CurTokenString);
 
       tkend:
 
       tkend:
 
         begin
 
         begin
 
@@ -5765,7 +5899,20 @@ begin
 
       NextToken;
 
       NextToken;
 
       end;
 
       end;
 
     end;
 
     end;
 
-  // Do not consume end. Current token will normally be end;
 
+   NextToken;
 
+   if CurToken<>tkSquaredBraceOpen then
 
+     UngetToken
 
+   else
 
+    begin
 
+      NextToken;
 
+      While Not (Curtoken in [tkSquaredBraceClose,tkEOF]) do
 
+        begin
 
+        AsmBlock.ModifierTokens.Add(CurTokenString);
 
+        NextToken;
 
+        end;
 
+    end;
 
+
 
+  // Do not consume end. Current token will normally be end
 
 end;
 
 end;
 
 
 
 // Next token is start of (compound) statement
 
 // Next token is start of (compound) statement
 
@@ -5779,7 +5926,7 @@ procedure TPasParser.ParseStatement(Parent: TPasImplBlock;
 
 var
 
 var
 
   CurBlock: TPasImplBlock;
 
   CurBlock: TPasImplBlock;
 
 
 
-  {$IFDEF VerbosePasParser}
 
+  {$IFDEF VerbosePasParserWriteln}
 
   function i: string;
 
   function i: string;
 
   var
 
   var
 
     c: TPasElement;
 
     c: TPasElement;
 
@@ -5791,7 +5938,7 @@ var
 
       c:=c.Parent;
 
       c:=c.Parent;
 
     end;
 
     end;
 
   end;
 
   end;
 
-  {$ENDIF}
 
+  {$ENDIF VerbosePasParserWriteln}
 
 
 
   function CloseBlock: boolean; // true if parent reached
 
   function CloseBlock: boolean; // true if parent reached
 
   var C: TPasImplBlockClass;
 
   var C: TPasImplBlockClass;
 
@@ -5843,9 +5990,9 @@ var
 
     t:=GetPrevToken;
 
     t:=GetPrevToken;
 
     if t in [tkSemicolon,tkColon,tkElse,tkotherwise] then
 
     if t in [tkSemicolon,tkColon,tkElse,tkotherwise] then
 
       exit;
 
       exit;
 
-    {$IFDEF VerbosePasParser}
 
+    {$IFDEF VerbosePasParserWriteln}
 
     writeln('TPasParser.ParseStatement.CheckSemicolon Prev=',GetPrevToken,' Cur=',CurToken,' ',CurBlock.ClassName,' ',CurBlock.Elements.Count,' ',TObject(CurBlock.Elements[0]).ClassName);
 
     writeln('TPasParser.ParseStatement.CheckSemicolon Prev=',GetPrevToken,' Cur=',CurToken,' ',CurBlock.ClassName,' ',CurBlock.Elements.Count,' ',TObject(CurBlock.Elements[0]).ClassName);
 
-    {$ENDIF}
 
+    {$ENDIF VerbosePasParserWriteln}
 
     // last statement not complete -> semicolon is missing
 
     // last statement not complete -> semicolon is missing
 
     ParseExcTokenError('Semicolon');
 
     ParseExcTokenError('Semicolon');
 
   end;
 
   end;
 
@@ -5882,7 +6029,9 @@ begin
 
   while True do
 
   while True do
 
   begin
 
   begin
 
     NextToken;
 
     NextToken;
 
-    //WriteLn({$IFDEF VerbosePasParser}i,{$ENDIF}' Token=',CurTokenText,' CurBlock=',CurBlock.ClassName);
 
+    {$IFDEF VerbosePasParserWriteln}
 
+    WriteLn(' Token=',CurTokenText,' CurBlock=',CurBlock.ClassName);
 
+    {$ENDIF VerbosePasParserWriteln}
 
     case CurToken of
 
     case CurToken of
 
     tkasm:
 
     tkasm:
 
       begin
 
       begin
 
@@ -5928,7 +6077,7 @@ begin
 
     tkelse,tkotherwise:
 
     tkelse,tkotherwise:
 
       // ELSE can close multiple blocks, similar to semicolon
 
       // ELSE can close multiple blocks, similar to semicolon
 
       repeat
 
       repeat
 
-        {$IFDEF VerbosePasParser}
 
+        {$IFDEF VerbosePasParserWriteln}
 
         writeln('TPasParser.ParseStatement ELSE CurBlock=',CurBlock.ClassName);
 
         writeln('TPasParser.ParseStatement ELSE CurBlock=',CurBlock.ClassName);
 
         {$ENDIF}
 
         {$ENDIF}
 
         if CurBlock is TPasImplIfElse then
 
         if CurBlock is TPasImplIfElse then
 
@@ -6476,7 +6625,10 @@ var
 
     CurName: String;
 
     CurName: String;
 
     Part: TProcedureNamePart;
 
     Part: TProcedureNamePart;
 
   begin
 
   begin
 
-    Result:=ExpectIdentifier;
 
+    if  (Parent is TPasClassType) and TPasClassType(Parent).IsExternal then
 
+      Result:=ExpectIdentifier([tkAbsolute])
 
+    else
 
+      Result:=ExpectIdentifier;
 
     NamePos:=CurSourcePos;
 
     NamePos:=CurSourcePos;
 
     Cnt:=1;
 
     Cnt:=1;
 
     repeat
 
     repeat
 
@@ -6696,11 +6848,10 @@ begin
 
   Until Done;
 
   Until Done;
 
 end;
 
 end;
 
 
 
-{$ifdef VerbosePasParser}
 
+{$ifdef VerbosePasParserWriteln}
 
 procedure TPasParser.DumpCurToken(const Msg: String; IndentAction: TIndentAction
 
 procedure TPasParser.DumpCurToken(const Msg: String; IndentAction: TIndentAction
 
   );
 
   );
 
 begin
 
 begin
 
-  {AllowWriteln}
 
   if IndentAction=iaUndent then
 
   if IndentAction=iaUndent then
 
     FDumpIndent:=copy(FDumpIndent,1,Length(FDumpIndent)-2);
 
     FDumpIndent:=copy(FDumpIndent,1,Length(FDumpIndent)-2);
 
   Writeln(FDumpIndent,Msg,' : ',TokenInfos[CurToken],' "',CurTokenString,'", Position: ',Scanner.CurFilename,'(',Scanner.CurRow,',',SCanner.CurColumn,') : ',Scanner.CurLine);
 
   Writeln(FDumpIndent,Msg,' : ',TokenInfos[CurToken],' "',CurTokenString,'", Position: ',Scanner.CurFilename,'(',Scanner.CurRow,',',SCanner.CurColumn,') : ',Scanner.CurLine);
 
@@ -6711,9 +6862,8 @@ begin
 
   {$else}
 
   {$else}
 
   Flush(output);
 
   Flush(output);
 
   {$endif}
 
   {$endif}
 
-  {AllowWriteln-}
 
 end;
 
 end;
 
-{$endif}
 
+{$endif VerbosePasParserWriteln}
 
 
 
 function TPasParser.GetCurrentModeSwitches: TModeSwitches;
 
 function TPasParser.GetCurrentModeSwitches: TModeSwitches;
 
 begin
 
 begin
 
@@ -6878,6 +7028,7 @@ begin
 
         ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
 
         ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
 
       tkGeneric, // Can count as field name
 
       tkGeneric, // Can count as field name
 
       tkabsolute,
 
       tkabsolute,
 
+      tkis,
 
       tkSelf, // Count as field name
 
       tkSelf, // Count as field name
 
       tkIdentifier :
 
       tkIdentifier :
 
         begin
 
         begin
 
@@ -6996,6 +7147,8 @@ Var
 
   B : Boolean;
 
   B : Boolean;
 
 
 
 begin
 
 begin
 
+  if CurtokenEscaped then
 
+    exit(False);
 
   s := LowerCase(CurTokenString);
 
   s := LowerCase(CurTokenString);
 
   B:=(S='strict');
 
   B:=(S='strict');
 
   if B then
 
   if B then
 
@@ -7103,7 +7256,11 @@ begin
 
       UngetToken;
 
       UngetToken;
 
       end;
 
       end;
 
     tkIdentifier:
 
     tkIdentifier:
 
+      begin
 
       Done:=CheckVisibility(CurTokenString,AVisibility);
 
       Done:=CheckVisibility(CurTokenString,AVisibility);
 
+      if not done and CheckCurtokenIsFinal(aType) then
 
+        Done:=True;
 
+      end;
 
     tkSquaredBraceOpen:
 
     tkSquaredBraceOpen:
 
       if msPrefixedAttributes in CurrentModeswitches then
 
       if msPrefixedAttributes in CurrentModeswitches then
 
         repeat
 
         repeat
 
@@ -7122,6 +7279,12 @@ begin
 
   Engine.FinishScope(stTypeSection,AType);
 
   Engine.FinishScope(stTypeSection,AType);
 
 end;
 
 end;
 
 
 
+function TPasParser.CheckCurtokenIsFinal(aType : TPasType) : boolean;
 
+
 
+begin
 
+  Result:=(not CurTokenEscaped) and CurtokenIsIdentifier('final') and  AllowFinal(aType);
 
+end;
 
+
 
 procedure TPasParser.ParseMembersLocalConsts(AType: TPasMembersType;
 
 procedure TPasParser.ParseMembersLocalConsts(AType: TPasMembersType;
 
   AVisibility: TPasMemberVisibility);
 
   AVisibility: TPasMemberVisibility);
 
 
 
@@ -7148,8 +7311,9 @@ begin
 
       exit;
 
       exit;
 
     NextToken;
 
     NextToken;
 
     case CurToken of
 
     case CurToken of
 
+    tkAbsolute,
 
     tkIdentifier:
 
     tkIdentifier:
 
-      Done:=CheckVisibility(CurTokenString,AVisibility);
 
+      Done:=CheckVisibility(CurTokenString,AVisibility) or CheckCurtokenIsFinal(aType);
 
     tkSquaredBraceOpen:
 
     tkSquaredBraceOpen:
 
       if msPrefixedAttributes in CurrentModeswitches then
 
       if msPrefixedAttributes in CurrentModeswitches then
 
         repeat
 
         repeat
 
@@ -7167,7 +7331,30 @@ begin
 
   Until Done;
 
   Until Done;
 
 end;
 
 end;
 
 
 
+function TPasParser.AllowFinal(aType: TPasType): Boolean;
 
+
 
+var
 
+  CType : TPasClassType absolute aType;
 
+
 
+begin
 
+  Result:=False;
 
+  if Not (aType is TPasClassType) then
 
+    exit;
 
+  While (cType<>Nil) and not Result do
 
+    begin
 
+    Result:=cType.IsExternal;
 
+    if aType.Parent is TPasClassType then
 
+      cType:=TPasClassType(cType.Parent)
 
+    else
 
+      cType:=nil;
 
+    end;
 
+end;
 
+
 
+
 
 procedure TPasParser.ParseClassMembers(AType: TPasClassType);
 
 procedure TPasParser.ParseClassMembers(AType: TPasClassType);
 
+
 
+
 
+
 
 Type
 
 Type
 
   TSectionType = (stNone,stConst,stType,stVar,stClassVar);
 
   TSectionType = (stNone,stConst,stType,stVar,stClassVar);
 
 Var
 
 Var
 
@@ -7178,6 +7365,7 @@ Var
 
   LastToken: TToken;
 
   LastToken: TToken;
 
   PropEl: TPasProperty;
 
   PropEl: TPasProperty;
 
   MethodRes: TPasMethodResolution;
 
   MethodRes: TPasMethodResolution;
 
+
 
 begin
 
 begin
 
   CurSection:=stNone;
 
   CurSection:=stNone;
 
   haveClass:=false;
 
   haveClass:=false;
 
@@ -7198,6 +7386,9 @@ begin
 
       case AType.ObjKind of
 
       case AType.ObjKind of
 
       okClass,okObject,
 
       okClass,okObject,
 
       okClassHelper,okRecordHelper,okTypeHelper: ;
 
       okClassHelper,okRecordHelper,okTypeHelper: ;
 
+      okInterface :
 
+        if Not aType.IsExternal then
 
+          ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['TYPE',ObjKindNames[AType.ObjKind]]);
 
       else
 
       else
 
         ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['TYPE',ObjKindNames[AType.ObjKind]]);
 
         ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['TYPE',ObjKindNames[AType.ObjKind]]);
 
       end;
 
       end;
 
@@ -7213,6 +7404,9 @@ begin
 
       case AType.ObjKind of
 
       case AType.ObjKind of
 
       okClass,okObject,
 
       okClass,okObject,
 
       okClassHelper,okRecordHelper,okTypeHelper: ;
 
       okClassHelper,okRecordHelper,okTypeHelper: ;
 
+      okInterface:
 
+        if Not aType.IsExternal then
 
+          ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['CONST',ObjKindNames[AType.ObjKind]]);
 
       else
 
       else
 
         ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['CONST',ObjKindNames[AType.ObjKind]]);
 
         ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['CONST',ObjKindNames[AType.ObjKind]]);
 
       end;
 
       end;
 
@@ -7224,7 +7418,8 @@ begin
 
     tkVar:
 
     tkVar:
 
       begin
 
       begin
 
       if (AType.ObjKind in okWithFields)
 
       if (AType.ObjKind in okWithFields)
 
-      or (haveClass and (AType.ObjKind in okAllHelpers)) then
 
+        or (haveClass and (AType.ObjKind in okAllHelpers))
 
+        or ((aType.ObjKind=okInterface) and aType.IsExternal) then
 
         // ok
 
         // ok
 
       else
 
       else
 
         ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
 
         ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
 
@@ -7233,8 +7428,15 @@ begin
 
       else
 
       else
 
         CurSection:=stVar;
 
         CurSection:=stVar;
 
       end;
 
       end;
 
+    tkabsolute,
 
     tkIdentifier:
 
     tkIdentifier:
 
-      if CheckVisibility(CurTokenString,CurVisibility,(AType.ObjKind=okObjcProtocol)) then
 
+     // create the TPasVariable here, so that SourceLineNumber is correct
 
+      if CheckCurTokenIsFinal(aType) then
 
+        begin
 
+        NextToken;
 
+        Continue;
 
+        end
 
+      else if CheckVisibility(CurTokenString,CurVisibility,(AType.ObjKind=okObjcProtocol)) then
 
         CurSection:=stNone
 
         CurSection:=stNone
 
       else
 
       else
 
         begin
 
         begin
 
@@ -7257,7 +7459,9 @@ begin
 
           end;
 
           end;
 
         stClassVar:
 
         stClassVar:
 
           begin
 
           begin
 
-          if not (AType.ObjKind in okWithClassFields) then
 
+          if not
 
+            ((AType.ObjKind in okWithClassFields)
 
+            or ((aType.ObjKind=okInterface) and aType.IsExternal)) then
 
             ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
 
             ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
 
           ParseClassFields(AType,CurVisibility,true);
 
           ParseClassFields(AType,CurVisibility,true);
 
           end;
 
           end;
 
@@ -7344,6 +7548,9 @@ begin
 
       case AType.ObjKind of
 
       case AType.ObjKind of
 
       okClass,okObject,
 
       okClass,okObject,
 
       okClassHelper,okRecordHelper,okTypeHelper, okObjCClass, okObjcCategory, okObjcProtocol : ;
 
       okClassHelper,okRecordHelper,okTypeHelper, okObjCClass, okObjcCategory, okObjcProtocol : ;
 
+      okInterface:
 
+        if Not aType.IsExternal then
 
+          ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['CLASS',ObjKindNames[AType.ObjKind]]);
 
       else
 
       else
 
         ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['CLASS',ObjKindNames[AType.ObjKind]]);
 
         ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['CLASS',ObjKindNames[AType.ObjKind]]);
 
       end;
 
       end;
 
@@ -7399,7 +7606,8 @@ begin
 
       CheckToken(tkend);
 
       CheckToken(tkend);
 
     NextToken;
 
     NextToken;
 
     AType.AncestorType := ParseTypeReference(AType,false,Expr);
 
     AType.AncestorType := ParseTypeReference(AType,false,Expr);
 
-    if AType.ObjKind in [okClass,okObjCClass,okObjcProtocol] then
 
+    if (AType.ObjKind in [okClass,okObjCClass,okObjcProtocol])
 
+       or ((AType.ObjKind=okInterface) and aType.IsExternal) then
 
       while CurToken=tkComma do
 
       while CurToken=tkComma do
 
         begin
 
         begin
 
         NextToken;
 
         NextToken;
 
@@ -7533,7 +7741,7 @@ function TPasParser.ParseClassDecl(Parent: TPasElement;
 
   AObjKind: TPasObjKind; PackMode: TPackMode): TPasType;
 
   AObjKind: TPasObjKind; PackMode: TPackMode): TPasType;
 
 
 
 Var
 
 Var
 
-  isExternal, ok: Boolean;
 
+  isExternal, isSealed, isAbstract, ok: Boolean;
 
   AExternalNameSpace,AExternalName : String;
 
   AExternalNameSpace,AExternalName : String;
 
   PCT:TPasClassType;
 
   PCT:TPasClassType;
 
 
 
@@ -7549,6 +7757,15 @@ begin
 
     Engine.FinishScope(stTypeDef,Result);
 
     Engine.FinishScope(stTypeDef,Result);
 
     exit;
 
     exit;
 
     end;
 
     end;
 
+  isAbstract:=False;
 
+  isSealed:=False;
 
+  // Abstract can appear before 'external'
 
+  if (AObjKind = okClass) and (CurTokenIsIdentifier('abstract') or CurTokenIsIdentifier('sealed')) then
 
+    begin
 
+    isAbstract:=CurTokenIsIdentifier('abstract');
 
+    isSealed:=CurTokenIsIdentifier('sealed');
 
+    NextToken;
 
+    end;
 
   isExternal:=DoParseClassExternalHeader(AObjKind,AExternalNameSpace,AExternalName);
 
   isExternal:=DoParseClassExternalHeader(AObjKind,AExternalNameSpace,AExternalName);
 
   if AObjKind in okAllHelpers then
 
   if AObjKind in okAllHelpers then
 
     begin
 
     begin
 
@@ -7561,6 +7778,10 @@ begin
 
   Result:=PCT;
 
   Result:=PCT;
 
   ok:=false;
 
   ok:=false;
 
   try
 
   try
 
+    if IsAbstract then
 
+      PCT.Modifiers.Add('abstract');
 
+    if IsSealed then
 
+      PCT.Modifiers.Add('sealed');
 
     PCT.HelperForType:=nil;
 
     PCT.HelperForType:=nil;
 
     PCT.IsExternal:=IsExternal;
 
     PCT.IsExternal:=IsExternal;
 
     if AExternalName<>'' then
 
     if AExternalName<>'' then
 
@@ -7670,8 +7891,7 @@ begin
 
     end;
 
     end;
 
 end;
 
 end;
 
 
 
-{$IFDEF VerbosePasParser}
 
-{AllowWriteln}
 
+{$IFDEF VerbosePasParserWriteln}
 
 procedure TPasParser.WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr
 
 procedure TPasParser.WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr
 
   );
 
   );
 
 var
 
 var
 
@@ -7731,8 +7951,7 @@ begin
 
       writeln(' Last=nil');
 
       writeln(' Last=nil');
 
     end;
 
     end;
 
 end;
 
 end;
 
-{AllowWriteln-}
 
-{$ENDIF}
 
+{$ENDIF VerbosePasParserWriteln}
 
 
 
 function TPasParser.CreateUnaryExpr(AParent: TPasElement; AOperand: TPasExpr;
 
 function TPasParser.CreateUnaryExpr(AParent: TPasElement; AOperand: TPasExpr;
 
   AOpCode: TExprOpCode): TUnaryExpr;
 
   AOpCode: TExprOpCode): TUnaryExpr;

+ 258 - 143
packages/fcl-passrc/src/pscanner.pp
View File 

@@ -686,7 +686,9 @@ type
 
     po_StopOnUnitInterface,  // parse only a unit name and stop at interface keyword
 
     po_StopOnUnitInterface,  // parse only a unit name and stop at interface keyword
 
     po_IgnoreUnknownResource,// Ignore resources for which no handler is registered.
 
     po_IgnoreUnknownResource,// Ignore resources for which no handler is registered.
 
     po_AsyncProcs,            // allow async procedure modifier
 
     po_AsyncProcs,            // allow async procedure modifier
 
-    po_DisableResources      // Disable resources altogether
 
+    po_DisableResources,      // Disable resources altogether
 
+    po_AsmPascalComments,    // Allow pascal comments/directives in asm blocks
 
+    po_AllowMem              // Allow use of meml, mem, memw arrays
 
     );
 
     );
 
   TPOptions = set of TPOption;
 
   TPOptions = set of TPOption;
 
 
 
@@ -737,6 +739,7 @@ type
 
     FCurrentBoolSwitches: TBoolSwitches;
 
     FCurrentBoolSwitches: TBoolSwitches;
 
     FCurrentModeSwitches: TModeSwitches;
 
     FCurrentModeSwitches: TModeSwitches;
 
     FCurrentValueSwitches: TValueSwitchArray;
 
     FCurrentValueSwitches: TValueSwitchArray;
 
+    FCurtokenEscaped: Boolean;
 
     FCurTokenPos: TPasSourcePos;
 
     FCurTokenPos: TPasSourcePos;
 
     FLastMsg: string;
 
     FLastMsg: string;
 
     FLastMsgArgs: TMessageArgs;
 
     FLastMsgArgs: TMessageArgs;
 
@@ -833,6 +836,8 @@ type
 
       var Handled: boolean); virtual;
 
       var Handled: boolean); virtual;
 
     procedure HandleMultilineStringTrimLeft(const AParam : String);
 
     procedure HandleMultilineStringTrimLeft(const AParam : String);
 
     procedure HandleMultilineStringLineEnding(const AParam : string);
 
     procedure HandleMultilineStringLineEnding(const AParam : string);
 
+    Function HandleMultilineComment: TToken;
 
+    function HandleMultilineCommentOldStyle: TToken;
 
     procedure HandleIFDEF(const AParam: String);
 
     procedure HandleIFDEF(const AParam: String);
 
     procedure HandleIFNDEF(const AParam: String);
 
     procedure HandleIFNDEF(const AParam: String);
 
     procedure HandleIFOPT(const AParam: String);
 
     procedure HandleIFOPT(const AParam: String);
 
@@ -900,6 +905,7 @@ type
 
     function AddMacro(const aName, aValue: String; Quiet: boolean = false): boolean;
 
     function AddMacro(const aName, aValue: String; Quiet: boolean = false): boolean;
 
     function RemoveMacro(const aName: String; Quiet: boolean = false): boolean;
 
     function RemoveMacro(const aName: String; Quiet: boolean = false): boolean;
 
     procedure SetCompilerMode(S : String);
 
     procedure SetCompilerMode(S : String);
 
+    procedure SetModeSwitch(S : String);
 
     function CurSourcePos: TPasSourcePos;
 
     function CurSourcePos: TPasSourcePos;
 
     function SetForceCaret(AValue : Boolean) : Boolean; // returns old state
 
     function SetForceCaret(AValue : Boolean) : Boolean; // returns old state
 
     function IgnoreMsgType(MsgType: TMessageType): boolean; virtual;
 
     function IgnoreMsgType(MsgType: TMessageType): boolean; virtual;
 
@@ -913,6 +919,7 @@ type
 
     property CurColumn: Integer read GetCurColumn;
 
     property CurColumn: Integer read GetCurColumn;
 
     property CurToken: TToken read FCurToken;
 
     property CurToken: TToken read FCurToken;
 
     property CurTokenString: string read FCurTokenString;
 
     property CurTokenString: string read FCurTokenString;
 
+    property CurTokenEscaped : Boolean Read FCurTokenEscaped;
 
     property CurTokenPos: TPasSourcePos read FCurTokenPos;
 
     property CurTokenPos: TPasSourcePos read FCurTokenPos;
 
     property PreviousToken : TToken Read FPreviousToken;
 
     property PreviousToken : TToken Read FPreviousToken;
 
     property ModuleRow: Integer read FModuleRow;
 
     property ModuleRow: Integer read FModuleRow;
 
@@ -2129,6 +2136,7 @@ end;
 
 
 
 procedure TCondDirectiveEvaluator.LogXExpectedButTokenFound(const X: String;
 
 procedure TCondDirectiveEvaluator.LogXExpectedButTokenFound(const X: String;
 
   ErrorPos: integer);
 
   ErrorPos: integer);
 
+
 
 begin
 
 begin
 
   Log(mtError,nErrXExpectedButYFound,SErrXExpectedButYFound,
 
   Log(mtError,nErrXExpectedButYFound,SErrXExpectedButYFound,
 
       [X,TokenInfos[FToken]],ErrorPos);
 
       [X,TokenInfos[FToken]],ErrorPos);
 
@@ -3488,6 +3496,7 @@ end;
 
 
 
 function TPascalScanner.ReadNonPascalTillEndToken(StopAtLineEnd: boolean
 
 function TPascalScanner.ReadNonPascalTillEndToken(StopAtLineEnd: boolean
 
   ): TToken;
 
   ): TToken;
 
+
 
 var
 
 var
 
   StartPos: {$ifdef UsePChar}PChar{$else}integer{$endif};
 
   StartPos: {$ifdef UsePChar}PChar{$else}integer{$endif};
 
   {$ifndef UsePChar}
 
   {$ifndef UsePChar}
 
@@ -3561,6 +3570,16 @@ begin
 
       #0: // end of line
 
       #0: // end of line
 
         if DoEndOfLine then exit;
 
         if DoEndOfLine then exit;
 
       {$endif}
 
       {$endif}
 
+      '{': // Pascal comments are supported.
 
+        begin
 
+        If po_AsmPascalComments in Options then
 
+          begin
 
+          Result:=HandleMultilineComment;
 
+          Break;
 
+          end
 
+        else
 
+          Inc(FTokenPos);
 
+        end;
 
       '''':
 
       '''':
 
         begin
 
         begin
 
         // Notes:
 
         // Notes:
 
@@ -3592,6 +3611,33 @@ begin
 
           end;
 
           end;
 
         until false;
 
         until false;
 
         end;
 
         end;
 
+      '"': // string literals: labels, section names etc.
 
+        begin
 
+        inc(FTokenPos);
 
+        repeat
 
+          {$ifndef UsePChar}
 
+          if FTokenPos>l then
 
+            Error(nErrOpenString,SErrOpenString);
 
+          {$endif}
 
+          case {$ifdef UsePChar}FTokenPos^{$else}s[FTokenPos]{$endif} of
 
+          {$ifdef UsePChar}
 
+          #0: Error(nErrOpenString,SErrOpenString);
 
+          {$endif}
 
+          '"':
 
+            begin
 
+            inc(FTokenPos);
 
+            break;
 
+            end;
 
+          #10,#13:
 
+            begin
 
+            // String literal missing closing quote
 
+            break;
 
+            end
 
+          else
 
+            inc(FTokenPos);
 
+          end;
 
+        until false;
 
+        end;
 
       '/':
 
       '/':
 
         begin
 
         begin
 
         inc(FTokenPos);
 
         inc(FTokenPos);
 
@@ -3603,7 +3649,7 @@ begin
 
           until {$ifdef UsePChar}FTokenPos^ in [#0,#10,#13]{$else}(FTokenPos>l) or (s[FTokenPos] in [#10,#13]){$endif};
 
           until {$ifdef UsePChar}FTokenPos^ in [#0,#10,#13]{$else}(FTokenPos>l) or (s[FTokenPos] in [#10,#13]){$endif};
 
           end;
 
           end;
 
         end;
 
         end;
 
-      '0'..'9', 'A'..'Z', 'a'..'z','_':
 
+      '@','0'..'9', 'A'..'Z', 'a'..'z','_':
 
         begin
 
         begin
 
         // number or identifier
 
         // number or identifier
 
         if {$ifdef UsePChar}
 
         if {$ifdef UsePChar}
 
@@ -3627,7 +3673,10 @@ begin
 
             exit;
 
             exit;
 
             end;
 
             end;
 
           // return 'end'
 
           // return 'end'
 
-          Result := tkend;
 
+          if PPIsSkipping then
 
+            Result := tkWhitespace
 
+          else
 
+            Result := tkend;
 
           {$ifdef UsePChar}
 
           {$ifdef UsePChar}
 
           SetLength(FCurTokenString, 3);
 
           SetLength(FCurTokenString, 3);
 
           Move(FTokenPos^, FCurTokenString[1], 3);
 
           Move(FTokenPos^, FCurTokenString[1], 3);
 
@@ -3641,11 +3690,14 @@ begin
 
         else
 
         else
 
           begin
 
           begin
 
           // skip identifier
 
           // skip identifier
 
+          if FTokenPos[0]='@' then
 
+            inc(FTokenPos);
 
           while {$ifdef UsePChar}FTokenPos[0] in IdentChars{$else}(FTokenPos<=l) and (s[FTokenPos] in IdentChars){$endif} do
 
           while {$ifdef UsePChar}FTokenPos[0] in IdentChars{$else}(FTokenPos<=l) and (s[FTokenPos] in IdentChars){$endif} do
 
             inc(FTokenPos);
 
             inc(FTokenPos);
 
           end;
 
           end;
 
         end;
 
         end;
 
       else
 
       else
 
+        // Else case FTokenPos
 
         inc(FTokenPos);
 
         inc(FTokenPos);
 
     end;
 
     end;
 
   until false;
 
   until false;
 
@@ -4137,7 +4189,7 @@ begin
 
   end;
 
   end;
 
 end;
 
 end;
 
 
 
-Function TPascalScanner.MakeLibAlias(Const LibFileName : String): string;
 
+Function TPascalScanner.MakeLibAlias(const LibFileName : String): string;
 
 
 
 Var
 
 Var
 
   p,l,d : integer;
 
   p,l,d : integer;
 
@@ -5063,16 +5115,204 @@ begin
 
   MultilineStringsEOLStyle:=S;
 
   MultilineStringsEOLStyle:=S;
 
 end;
 
 end;
 
 
 
+function TPascalScanner.HandleMultilineCommentOldStyle: TToken;
 
+
 
+var
 
+  {$ifdef UsePChar}
 
+  TokenStart: PChar;
 
+  OldLength: integer;
 
+  Ch: AnsiChar;
 
+  LE: String[2];
 
+  {$else}
 
+  TokenStart: Integer;
 
+  s: String;
 
+  l: integer;
 
+  {$endif}
 
+  SectionLength, NestingLevel: Integer;
 
+
 
+  function FetchLocalLine: boolean; inline;
 
+  begin
 
+    Result:=FetchLine;
 
+    {$ifndef UsePChar}
 
+    if not Result then exit;
 
+    s:=FCurLine;
 
+    l:=length(s);
 
+    {$endif}
 
+  end;
 
+
 
+begin
 
+  {$ifdef UsePChar}
 
+  LE:=LineEnding;
 
+  {$endif}
 
+  // Old-style multi-line comment
 
+  Inc(FTokenPos);
 
+  TokenStart := FTokenPos;
 
+  FCurTokenString := '';
 
+  {$ifdef UsePChar}
 
+  OldLength := 0;
 
+  {$endif}
 
+  NestingLevel:=0;
 
+  repeat
 
+    if {$ifdef UsePChar}FTokenPos[0] = #0{$else}FTokenPos>l{$endif} then
 
+      begin
 
+      SectionLength:=FTokenPos - TokenStart;
 
+      {$ifdef UsePChar}
 
+      SetLength(FCurTokenString, OldLength + SectionLength + length(LineEnding)); // Corrected JC
 
+      if SectionLength > 0 then
 
+        Move(TokenStart^, FCurTokenString[OldLength + 1],SectionLength);
 
+      Inc(OldLength, SectionLength);
 
+      for Ch in LE do
 
+        begin
 
+        Inc(OldLength);
 
+        FCurTokenString[OldLength] := Ch;
 
+        end;
 
+      {$else}
 
+      FCurTokenString:=FCurTokenString+copy(FCurLine,TokenStart,SectionLength)+LineEnding; // Corrected JC
 
+      {$endif}
 
+      if not FetchLocalLine then
 
+        begin
 
+        Result := tkEOF;
 
+        FCurToken := Result;
 
+        exit;
 
+        end;
 
+      TokenStart:=FTokenPos;
 
+      end
 
+    else if {$ifdef UsePChar}(FTokenPos[0] = '*') and (FTokenPos[1] = ')')
 
+        {$else}(FTokenPos<l) and (s[FTokenPos]='*') and (s[FTokenPos+1]=')'){$endif}
 
+      then begin
 
+      dec(NestingLevel);
 
+      if NestingLevel<0 then
 
+        break;
 
+      inc(FTokenPos,2);
 
+      end
 
+    else if (msNestedComment in CurrentModeSwitches)
 
+        and {$ifdef UsePChar}(FTokenPos[0] = '(') and (FTokenPos[1] = '*')
 
+        {$else}(FTokenPos<l) and (s[FTokenPos]='(') and (s[FTokenPos+1]='*'){$endif}
 
+      then begin
 
+      inc(FTokenPos,2);
 
+      Inc(NestingLevel);
 
+      end
 
+    else
 
+      Inc(FTokenPos);
 
+  until false;
 
+  SectionLength := FTokenPos - TokenStart;
 
+  {$ifdef UsePChar}
 
+  SetLength(FCurTokenString, OldLength + SectionLength);
 
+  if SectionLength > 0 then
 
+    Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
 
+  {$else}
 
+  FCurTokenString:=FCurTokenString+copy(FCurLine,TokenStart,SectionLength);
 
+  {$endif}
 
+  Inc(FTokenPos, 2);
 
+  Result := tkComment;
 
+  if Copy(CurTokenString,1,1)='$' then
 
+    Result := HandleDirective(CurTokenString)
 
+  else
 
+    DoHandleComment(Self,CurTokenString);
 
+end;
 
+
 
+
 
+function TPascalScanner.HandleMultilineComment: TToken;
 
+
 
+var
 
+  {$ifdef UsePChar}
 
+  TokenStart: PChar;
 
+  OldLength: integer;
 
+  Ch: AnsiChar;
 
+  LE: String[2];
 
+  {$else}
 
+  TokenStart: Integer;
 
+  s: String;
 
+  l: integer;
 
+  {$endif}
 
+  SectionLength, NestingLevel: Integer;
 
+
 
+  function FetchLocalLine: boolean; inline;
 
+  begin
 
+    Result:=FetchLine;
 
+    {$ifndef UsePChar}
 
+    if not Result then exit;
 
+    s:=FCurLine;
 
+    l:=length(s);
 
+    {$endif}
 
+  end;
 
+
 
+begin
 
+  Inc(FTokenPos);
 
+  TokenStart := FTokenPos;
 
+  FCurTokenString := '';
 
+  {$ifdef UsePChar}
 
+  LE:=LineEnding;
 
+  OldLength := 0;
 
+  {$endif}
 
+  NestingLevel := 0;
 
+  repeat
 
+    if {$ifdef UsePChar}FTokenPos[0] = #0{$else}FTokenPos>l{$endif} then
 
+      begin
 
+      SectionLength := FTokenPos - TokenStart;
 
+      {$ifdef UsePChar}
 
+      SetLength(FCurTokenString, OldLength + SectionLength + length(LineEnding)); // Corrected JC
 
+      if SectionLength > 0 then
 
+        Move(TokenStart^, FCurTokenString[OldLength + 1],SectionLength);
 
+
 
+      // Corrected JC: Append the correct lineending
 
+      Inc(OldLength, SectionLength);
 
+      for Ch in LE do
 
+        begin
 
+          Inc(OldLength);
 
+          FCurTokenString[OldLength] := Ch;
 
+        end;
 
+      {$else}
 
+      FCurTokenString:=FCurTokenString+copy(FCurLine,TokenStart,SectionLength)+LineEnding; // Corrected JC
 
+      {$endif}
 
+      if not FetchLocalLine then
 
+      begin
 
+        Result := tkEOF;
 
+        FCurToken := Result;
 
+        exit;
 
+      end;
 
+      TokenStart := FTokenPos;
 
+      end
 
+    else if {$ifdef UsePChar}(FTokenPos[0] = '}'){$else}(s[FTokenPos]='}'){$endif} then
 
+      begin
 
+      Dec(NestingLevel);
 
+      if NestingLevel<0 then
 
+        break;
 
+      Inc(FTokenPos);
 
+      end
 
+    else if {$ifdef UsePChar}(FTokenPos[0] = '{'){$else}(s[FTokenPos]='{'){$endif}
 
+        and (msNestedComment in CurrentModeSwitches) then
 
+      begin
 
+      inc(FTokenPos);
 
+      Inc(NestingLevel);
 
+      end
 
+    else
 
+      Inc(FTokenPos);
 
+  until false;
 
+  SectionLength := FTokenPos - TokenStart;
 
+  {$ifdef UsePChar}
 
+  SetLength(FCurTokenString, OldLength + SectionLength);
 
+  if SectionLength > 0 then
 
+    Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
 
+  {$else}
 
+  FCurTokenString:=FCurTokenString+copy(s,TokenStart,SectionLength);
 
+  {$endif}
 
+  Inc(FTokenPos);
 
+  Result := tkComment;
 
+  if (Copy(CurTokenString,1,1)='$') then
 
+    Result:=HandleDirective(CurTokenString)
 
+  else
 
+    DoHandleComment(Self, CurTokenString)
 
+end;
 
+
 
 function TPascalScanner.DoFetchToken: TToken;
 
 function TPascalScanner.DoFetchToken: TToken;
 
 
 
 var
 
 var
 
   TokenStart: {$ifdef UsePChar}PChar{$else}integer{$endif};
 
   TokenStart: {$ifdef UsePChar}PChar{$else}integer{$endif};
 
   i: TToken;
 
   i: TToken;
 
-  SectionLength, NestingLevel, Index: Integer;
 
+  SectionLength,  Index: Integer;
 
   {$ifdef UsePChar}
 
   {$ifdef UsePChar}
 
-  OldLength: integer;
 
-  Ch: Char;
 
-  LE: string[2];
 
+  //
 
   {$else}
 
   {$else}
 
   s: string;
 
   s: string;
 
   l: integer;
 
   l: integer;
 
@@ -5100,6 +5340,7 @@ var
 
   end;
 
   end;
 
 
 
 begin
 
 begin
 
+  FCurtokenEscaped:=False;
 
   TokenStart:={$ifdef UsePChar}nil{$else}0{$endif};
 
   TokenStart:={$ifdef UsePChar}nil{$else}0{$endif};
 
   Result:=tkLineEnding;
 
   Result:=tkLineEnding;
 
   if FTokenPos {$ifdef UsePChar}= nil{$else}<1{$endif} then
 
   if FTokenPos {$ifdef UsePChar}= nil{$else}<1{$endif} then
 
@@ -5180,6 +5421,7 @@ begin
 
         // &Keyword
 
         // &Keyword
 
         DoFetchToken();
 
         DoFetchToken();
 
         Result:=tkIdentifier;
 
         Result:=tkIdentifier;
 
+        FCurtokenEscaped:=True;
 
         end
 
         end
 
       else
 
       else
 
         begin
 
         begin
 
@@ -5218,76 +5460,7 @@ begin
 
       else if {$ifdef UsePChar}FTokenPos[0] <> '*'{$else}(FTokenPos>l) or (s[FTokenPos]<>'*'){$endif} then
 
       else if {$ifdef UsePChar}FTokenPos[0] <> '*'{$else}(FTokenPos>l) or (s[FTokenPos]<>'*'){$endif} then
 
         Result := tkBraceOpen
 
         Result := tkBraceOpen
 
       else
 
       else
 
-        begin
 
-        {$ifdef UsePChar}
 
-        LE:=LineEnding;
 
-        {$endif}
 
-        // Old-style multi-line comment
 
-        Inc(FTokenPos);
 
-        TokenStart := FTokenPos;
 
-        FCurTokenString := '';
 
-        {$ifdef UsePChar}
 
-        OldLength := 0;
 
-        {$endif}
 
-        NestingLevel:=0;
 
-        repeat
 
-          if {$ifdef UsePChar}FTokenPos[0] = #0{$else}FTokenPos>l{$endif} then
 
-            begin
 
-            SectionLength:=FTokenPos - TokenStart;
 
-            {$ifdef UsePChar}
 
-            SetLength(FCurTokenString, OldLength + SectionLength + length(LineEnding)); // Corrected JC
 
-            if SectionLength > 0 then
 
-              Move(TokenStart^, FCurTokenString[OldLength + 1],SectionLength);
 
-            Inc(OldLength, SectionLength);
 
-            for Ch in LE do
 
-              begin
 
-              Inc(OldLength);
 
-              FCurTokenString[OldLength] := Ch;
 
-              end;
 
-            {$else}
 
-            FCurTokenString:=FCurTokenString+copy(FCurLine,TokenStart,SectionLength)+LineEnding; // Corrected JC
 
-            {$endif}
 
-            if not FetchLocalLine then
 
-              begin
 
-              Result := tkEOF;
 
-              FCurToken := Result;
 
-              exit;
 
-              end;
 
-            TokenStart:=FTokenPos;
 
-            end
 
-          else if {$ifdef UsePChar}(FTokenPos[0] = '*') and (FTokenPos[1] = ')')
 
-              {$else}(FTokenPos<l) and (s[FTokenPos]='*') and (s[FTokenPos+1]=')'){$endif}
 
-            then begin
 
-            dec(NestingLevel);
 
-            if NestingLevel<0 then
 
-              break;
 
-            inc(FTokenPos,2);
 
-            end
 
-          else if (msNestedComment in CurrentModeSwitches)
 
-              and {$ifdef UsePChar}(FTokenPos[0] = '(') and (FTokenPos[1] = '*')
 
-              {$else}(FTokenPos<l) and (s[FTokenPos]='(') and (s[FTokenPos+1]='*'){$endif}
 
-            then begin
 
-            inc(FTokenPos,2);
 
-            Inc(NestingLevel);
 
-            end
 
-          else
 
-            Inc(FTokenPos);
 
-        until false;
 
-        SectionLength := FTokenPos - TokenStart;
 
-        {$ifdef UsePChar}
 
-        SetLength(FCurTokenString, OldLength + SectionLength);
 
-        if SectionLength > 0 then
 
-          Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
 
-        {$else}
 
-        FCurTokenString:=FCurTokenString+copy(FCurLine,TokenStart,SectionLength);
 
-        {$endif}
 
-        Inc(FTokenPos, 2);
 
-        Result := tkComment;
 
-        if Copy(CurTokenString,1,1)='$' then
 
-          Result := HandleDirective(CurTokenString)
 
-        else
 
-          DoHandleComment(Self,CurTokenString);
 
-        end;
 
+        Result:=HandleMultilineCommentOldStyle;
 
       end;
 
       end;
 
     ')':
 
     ')':
 
       begin
 
       begin
 
@@ -5542,71 +5715,8 @@ begin
 
       end;
 
       end;
 
     '{':        // Multi-line comment
 
     '{':        // Multi-line comment
 
       begin
 
       begin
 
-      Inc(FTokenPos);
 
-      TokenStart := FTokenPos;
 
-      FCurTokenString := '';
 
-      {$ifdef UsePChar}
 
-      LE:=LineEnding;
 
-      OldLength := 0;
 
-      {$endif}
 
-      NestingLevel := 0;
 
-      repeat
 
-        if {$ifdef UsePChar}FTokenPos[0] = #0{$else}FTokenPos>l{$endif} then
 
-          begin
 
-          SectionLength := FTokenPos - TokenStart;
 
-          {$ifdef UsePChar}
 
-          SetLength(FCurTokenString, OldLength + SectionLength + length(LineEnding)); // Corrected JC
 
-          if SectionLength > 0 then
 
-            Move(TokenStart^, FCurTokenString[OldLength + 1],SectionLength);
 
-
 
-          // Corrected JC: Append the correct lineending
 
-          Inc(OldLength, SectionLength);
 
-          for Ch in LE do
 
-            begin
 
-              Inc(OldLength);
 
-              FCurTokenString[OldLength] := Ch;
 
-            end;
 
-          {$else}
 
-          FCurTokenString:=FCurTokenString+copy(FCurLine,TokenStart,SectionLength)+LineEnding; // Corrected JC
 
-          {$endif}
 
-          if not FetchLocalLine then
 
-          begin
 
-            Result := tkEOF;
 
-            FCurToken := Result;
 
-            exit;
 
-          end;
 
-          TokenStart := FTokenPos;
 
-          end
 
-        else if {$ifdef UsePChar}(FTokenPos[0] = '}'){$else}(s[FTokenPos]='}'){$endif} then
 
-          begin
 
-          Dec(NestingLevel);
 
-          if NestingLevel<0 then
 
-            break;
 
-          Inc(FTokenPos);
 
-          end
 
-        else if {$ifdef UsePChar}(FTokenPos[0] = '{'){$else}(s[FTokenPos]='{'){$endif}
 
-            and (msNestedComment in CurrentModeSwitches) then
 
-          begin
 
-          inc(FTokenPos);
 
-          Inc(NestingLevel);
 
-          end
 
-        else
 
-          Inc(FTokenPos);
 
-      until false;
 
-      SectionLength := FTokenPos - TokenStart;
 
-      {$ifdef UsePChar}
 
-      SetLength(FCurTokenString, OldLength + SectionLength);
 
-      if SectionLength > 0 then
 
-        Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
 
-      {$else}
 
-      FCurTokenString:=FCurTokenString+copy(s,TokenStart,SectionLength);
 
-      {$endif}
 
-      Inc(FTokenPos);
 
-      Result := tkComment;
 
-      if (Copy(CurTokenString,1,1)='$') then
 
-        Result:=HandleDirective(CurTokenString)
 
-      else
 
-        DoHandleComment(Self, CurTokenString)
 
+      // HandleMultilineComment calls Directive handling
 
+      Result:=HandleMultilineComment;
 
       end;
 
       end;
 
     'A'..'Z', 'a'..'z', '_':
 
     'A'..'Z', 'a'..'z', '_':
 
       begin
 
       begin
 
@@ -6222,6 +6332,11 @@ begin
 
   HandleMode(S);
 
   HandleMode(S);
 
 end;
 
 end;
 
 
 
+procedure TPascalScanner.SetModeSwitch(S: String);
 
+begin
 
+  HandleModeSwitch(S);
 
+end;
 
+
 
 function TPascalScanner.CurSourcePos: TPasSourcePos;
 
 function TPascalScanner.CurSourcePos: TPasSourcePos;
 
 begin
 
 begin
 
   Result.FileName:=CurFilename;
 
   Result.FileName:=CurFilename;

+ 28 - 0
packages/fcl-passrc/tests/tcclasstype.pas
View File 

@@ -197,6 +197,9 @@ type
 
     procedure TestRecordHelperEmpty;
 
     procedure TestRecordHelperEmpty;
 
     procedure TestRecordHelperParentedEmpty;
 
     procedure TestRecordHelperParentedEmpty;
 
     procedure TestRecordHelperOneMethod;
 
     procedure TestRecordHelperOneMethod;
 
+    procedure TestExternalClassFinalVar;
 
+    procedure TestEscapedVisibilityVar;
 
+    procedure TestEscapedAbsoluteVar;
 
   end;
 
   end;
 
 
 
 implementation
 
 implementation
 
@@ -2296,6 +2299,31 @@ begin
 
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
 
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
 
 end;
 
 end;
 
 
 
+
 
+procedure TestExternalClassFinalVar;
 
+
 
+begin
 
+  // final var Xyz : Integer;
 
+  Fail('To be implemented');
 
+end;
 
+
 
+
 
+procedure TestEscapedVisibilityVar;
 
+
 
+begin
 
+  //  &Public : Integer;
 
+  Fail('To be implemented');
 
+end;
 
+
 
+
 
+procedure TestEscapedAbsoluteVar;
 
+
 
+begin
 
+ 
+  // var absolute  : integer;
 
+  Fail('To be implemented.');
 
+end;
 
+
 
 initialization
 
 initialization
 
 
 
   RegisterTest(TTestClassType);
 
   RegisterTest(TTestClassType);

+ 39 - 0
packages/fcl-passrc/tests/tcprocfunc.pas
View File 

@@ -187,6 +187,10 @@ type
 
     procedure TestOperatorNames;
 
     procedure TestOperatorNames;
 
     Procedure TestAssignOperatorAfterObject;
 
     Procedure TestAssignOperatorAfterObject;
 
     Procedure TestFunctionNoResult;
 
     Procedure TestFunctionNoResult;
 
+    Procedure TestExternalFunctionFinal;
 
+    Procedure TestFunctionSyscallSingleNumber;
 
+    Procedure TestFunctionSyscallDoubleNumber;
 
+    Procedure TestFunctionSysCallSysTrapIdentifier;
 
   end;
 
   end;
 
 
 
 implementation
 
 implementation
 
@@ -1486,6 +1490,41 @@ begin
 
   AssertEquals('Correct comment',' A comment'+sLineBreak,FProc.DocComment);
 
   AssertEquals('Correct comment',' A comment'+sLineBreak,FProc.DocComment);
 
 end;
 
 end;
 
 
 
+
 
+Procedure TTestProcedureFunction.TestExternalFunctionFinal;
 
+
 
+begin
 
+  // class external 'XYZ' name 'ABC'
 
+  //  function Something : Someresult; final;
 
+  // end; 
+  Fail('To be implemented');
 
+end;
 
+
 
+
 
+Procedure TTestProcedureFunction.TestFunctionSyscallSingleNumber;
 
+begin
 
+  // function Something : Someresult; syscall 12
 
+  Fail('To be implemented');
 
+end;
 
+
 
+
 
+Procedure TTestProcedureFunction.TestFunctionSyscallDoubleNumber;
 
+
 
+begin
 
+  // function Something : Someresult; syscall 12 13
 
+  Fail('To be implemented');
 
+end;
 
+
 
+
 
+Procedure TTestProcedureFunction.TestFunctionSysCallSysTrapIdentifier;
 
+
 
+begin
 
+  // function Something : Someresult; syscall systrapNNN
 
+  Fail('To be implemented');
 
+end;
 
+
 
+
 
+
 
 initialization
 
 initialization
 
 
 
   RegisterTest(TTestProcedureFunction);
 
   RegisterTest(TTestProcedureFunction);

+ 15 - 0
packages/fcl-passrc/tests/tcscanner.pas
View File 

@@ -163,6 +163,8 @@ type
 
     procedure TestArray;
 
     procedure TestArray;
 
     procedure TestAs;
 
     procedure TestAs;
 
     procedure TestAsm;
 
     procedure TestAsm;
 
+    Procedure TestAsmComments;
 
+    Procedure TestAsmConditionals;
 
     procedure TestBegin;
 
     procedure TestBegin;
 
     procedure TestBitpacked;
 
     procedure TestBitpacked;
 
     procedure TestCase;
 
     procedure TestCase;
 
@@ -1135,6 +1137,19 @@ begin
 
   TestToken(tkasm,'asm');
 
   TestToken(tkasm,'asm');
 
 end;
 
 end;
 
 
 
+procedure TTestScanner.TestAsmComments;
 
+
 
+begin
 
+  Fail('To be implemented');
 
+end;
 
+
 
+procedure TTestScanner.TestAsmConditionals;
 
+
 
+begin
 
+  Fail('To be implemented');
 
+end;
 
+
 
+
 
 
 
 procedure TTestScanner.TestBegin;
 
 procedure TTestScanner.TestBegin;