Browse Source

--- Merging r29553 into '.':
U packages/fcl-passrc/src/pparser.pp
U packages/fcl-passrc/tests/tctypeparser.pas
U packages/fcl-passrc/tests/testpassrc.lpi
--- Recording mergeinfo for merge of r29553 into '.':
U .
--- Merging r29555 into '.':
G packages/fcl-passrc/tests/testpassrc.lpi
G packages/fcl-passrc/tests/tctypeparser.pas
G packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r29555 into '.':
G .
--- Merging r29556 into '.':
U packages/fcl-passrc/tests/tcvarparser.pas
G packages/fcl-passrc/tests/tctypeparser.pas
G packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r29556 into '.':
G .
--- Merging r29615 into '.':
U packages/fcl-passrc/tests/tcprocfunc.pas
G packages/fcl-passrc/tests/testpassrc.lpi
U packages/fcl-passrc/tests/tcbaseparser.pas
U packages/fcl-passrc/tests/tcclasstype.pas
U packages/fcl-passrc/tests/tcstatements.pas
G packages/fcl-passrc/tests/tctypeparser.pas
U packages/fcl-passrc/src/pastree.pp
G packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r29615 into '.':
G .
--- Merging r30143 into '.':
G packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r30143 into '.':
G .
--- Merging r30326 into '.':
G packages/fcl-passrc/tests/tcclasstype.pas
G packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r30326 into '.':
G .
--- Merging r30625 into '.':
G packages/fcl-passrc/src/pastree.pp
G packages/fcl-passrc/src/pparser.pp
G packages/fcl-passrc/tests/tcstatements.pas
--- Recording mergeinfo for merge of r30625 into '.':
G .

# revisions: 29553,29555,29556,29615,30143,30326,30625

git-svn-id: branches/fixes_3_0@31080 -

marco 10 years ago
parent
commit
73006756df

+ 30 - 2
packages/fcl-passrc/src/pastree.pp

@@ -105,6 +105,7 @@ type
   TPasElement = class(TPasElementBase)
   private
     FData: TObject;
+    FDocComment: String;
     FRefCount: LongWord;
     FName: string;
     FParent: TPasElement;
@@ -133,6 +134,7 @@ type
     Property Hints : TPasMemberHints Read FHints Write FHints;
     Property CustomData : TObject Read FData Write FData;
     Property HintMessage : String Read FHintMessage Write FHintMessage;
+    Property DocComment : String Read FDocComment Write FDocComment;
   end;
 
   TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst, pekRange,
@@ -956,6 +958,17 @@ type
   TFinalizationSection = class(TPasImplBlock)
   end;
 
+  { TPasImplAsmStatement }
+
+  TPasImplAsmStatement = class (TPasImplStatement)
+  private
+    FTokens: TStrings;
+  Public
+    constructor Create(const AName: string; AParent: TPasElement); override;
+    destructor Destroy; override;
+    Property Tokens : TStrings Read FTokens;
+  end;
+
   { TPasImplRepeatUntil }
 
   TPasImplRepeatUntil = class(TPasImplBlock)
@@ -1182,6 +1195,21 @@ implementation
 
 uses SysUtils;
 
+{ TPasImplAsmStatement }
+
+constructor TPasImplAsmStatement.Create(const AName: string;
+  AParent: TPasElement);
+begin
+  inherited Create(AName, AParent);
+  FTokens:=TStringList.Create;
+end;
+
+destructor TPasImplAsmStatement.Destroy;
+begin
+  FreeAndNil(FTokens);
+  inherited Destroy;
+end;
+
 { TPasClassConstructor }
 
 function TPasClassConstructor.TypeName: string;
@@ -1306,7 +1334,7 @@ end;
 
 function TPasElement.ElementTypeName: string; begin Result := SPasTreeElement end;
 
-function TPasElement.HintsString: String;
+Function TPasElement.HintsString: String;
 
 Var
   H : TPasmemberHint;
@@ -1567,7 +1595,7 @@ begin
   end;
 end;
 
-function TPasElement.GetDeclaration (full : boolean): string;
+function TPasElement.GetDeclaration(full: Boolean): string;
 
 begin
   if Full then

+ 186 - 38
packages/fcl-passrc/src/pparser.pp

@@ -63,16 +63,19 @@ resourcestring
   SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Record helpers';
   SParserNoFieldsAllowed = 'Fields are not allowed in Interfaces';
   SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
-
+  SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location.';
 type
   TPasParserLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
   TPParserLogEvent = (pleInterface,pleImplementation);
   TPParserLogEvents = set of TPParserLogEvent;
+  TPasParser = Class;
 
   { TPasTreeContainer }
 
   TPasTreeContainer = class
   private
+    FCurrentParser: TPasParser;
+    FNeedComments: Boolean;
     FOnLog: TPasParserLogHandler;
     FPParserLogEvents: TPParserLogEvents;
     FScannerLogEvents: TPScannerLogEvents;
@@ -97,6 +100,8 @@ type
     Property ScannerLogEvents : TPScannerLogEvents Read FScannerLogEvents Write FScannerLogEvents;
     Property ParserLogEvents : TPParserLogEvents Read FPParserLogEvents Write FPParserLogEvents;
     Property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
+    Property CurrentParser : TPasParser Read FCurrentParser;
+    Property NeedComments : Boolean Read FNeedComments Write FNeedComments;
   end;
 
   EParserError = class(Exception)
@@ -131,9 +136,12 @@ type
     FEngine: TPasTreeContainer;
     FCurToken: TToken;
     FCurTokenString: String;
+    FCurComments : TStrings;
+    FSavedComments : String;
     // UngetToken support:
     FTokenBuffer: array[0..1] of TToken;
     FTokenStringBuffer: array[0..1] of String;
+    FCommentsBuffer: array[0..1] of TStrings;
     FTokenBufferIndex: Integer; // current index in FTokenBuffer
     FTokenBufferSize: Integer; // maximum valid index in FTokenBuffer
     FDumpIndent : String;
@@ -142,15 +150,18 @@ type
     function GetVariableModifiers(Out VarMods : TVariableModifiers; Out Libname,ExportName : string): string;
     function GetVariableValueAndLocation(Parent : TPasElement; Out Value : TPasExpr; Out Location: String): Boolean;
     procedure HandleProcedureModifier(Parent: TPasElement; pm : TProcedureModifier);
+    procedure ParseAsmBlock(AsmBlock: TPasImplAsmStatement);
     procedure ParseClassLocalConsts(AType: TPasClassType; AVisibility: TPasMemberVisibility);
     procedure ParseClassLocalTypes(AType: TPasClassType; AVisibility: TPasMemberVisibility);
     procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full: Boolean);
   protected
+    Function SaveComments : String;
+    Function SaveComments(Const AValue : String) : String;
     function LogEvent(E : TPParserLogEvent) : Boolean; inline;
     Procedure DoLog(Const Msg : String; SkipSourceInfo : Boolean = False);overload;
     Procedure DoLog(Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
     function GetProcTypeFromToken(tk: TToken; IsClass: Boolean=False ): TProcType;
-    procedure ParseRecordFieldList(ARec: TPasRecordType; AEndToken: TToken);
+    procedure ParseRecordFieldList(ARec: TPasRecordType; AEndToken: TToken; AllowMethods : Boolean);
     procedure ParseRecordVariantParts(ARec: TPasRecordType; AEndToken: TToken);
     function GetProcedureClass(ProcType : TProcType): TPTreeElement;
     procedure ParseClassFields(AType: TPasClassType; const AVisibility: TPasMemberVisibility; IsClassField : Boolean);
@@ -182,9 +193,12 @@ type
     function  CheckIfOverloaded(AParent: TPasElement; const AName: String): TPasElement;
   public
     constructor Create(AScanner: TPascalScanner; AFileResolver: TBaseFileResolver;  AEngine: TPasTreeContainer);
+    Destructor Destroy; override;
     // General parsing routines
     function CurTokenName: String;
     function CurTokenText: String;
+    Function CurComments : TStrings;
+    Function SavedComments : String;
     procedure NextToken; // read next non whitespace, non space
     procedure UngetToken;
     procedure CheckToken(tk: TToken);
@@ -539,6 +553,23 @@ begin
   FScanner := AScanner;
   FFileResolver := AFileResolver;
   FEngine := AEngine;
+  FCommentsBuffer[0]:=TStringList.Create;
+  FCommentsBuffer[1]:=TStringList.Create;
+  if Assigned(FEngine) then
+    begin
+    FEngine.FCurrentParser:=Self;
+    If FEngine.NeedComments then
+      FScanner.SkipComments:=Not FEngine.NeedComments;
+    end;
+end;
+
+Destructor TPasParser.Destroy;
+begin
+  FreeAndNil(FCommentsBuffer[0]);
+  FreeAndNil(FCommentsBuffer[1]);
+  if Assigned(FEngine) then
+    FEngine.FCurrentParser:=Nil;
+  inherited Destroy;
 end;
 
 function TPasParser.CurTokenName: String;
@@ -559,13 +590,27 @@ begin
   end;
 end;
 
+Function TPasParser.CurComments: TStrings;
+begin
+  Result:=FCurComments;
+end;
+
+Function TPasParser.SavedComments: String;
+begin
+  Result:=FSavedComments;
+end;
+
 procedure TPasParser.NextToken;
+
+Var
+  T : TStrings;
 begin
   if FTokenBufferIndex < FTokenBufferSize then
   begin
     // Get token from buffer
     FCurToken := FTokenBuffer[FTokenBufferIndex];
     FCurTokenString := FTokenStringBuffer[FTokenBufferIndex];
+    FCurComments:=FCommentsBuffer[FTokenBufferIndex];
     Inc(FTokenBufferIndex);
     //writeln('TPasParser.NextToken From Buf ',CurTokenText,' id=',FTokenBufferIndex);
   end else
@@ -573,16 +618,22 @@ begin
     { We have to fetch a new token. But first check, wether there is space left
       in the token buffer.}
     if FTokenBufferSize = 2 then
-    begin
+      begin
       FTokenBuffer[0] := FTokenBuffer[1];
       FTokenStringBuffer[0] := FTokenStringBuffer[1];
+      T:=FCommentsBuffer[0];
+      FCommentsBuffer[0]:=FCommentsBuffer[1];
+      FCommentsBuffer[1]:=T;
       Dec(FTokenBufferSize);
       Dec(FTokenBufferIndex);
-    end;
+      end;
     // Fetch new token
     try
+      FCommentsBuffer[FTokenBufferSize].Clear;
       repeat
         FCurToken := Scanner.FetchToken;
+        if FCurToken=tkComment then
+          FCommentsBuffer[FTokenBufferSize].Add(Scanner.CurTokenString);
       until not (FCurToken in WhitespaceTokensToIgnore);
     except
       on e: EScannerError do
@@ -592,9 +643,10 @@ begin
     FCurTokenString := Scanner.CurTokenString;
     FTokenBuffer[FTokenBufferSize] := FCurToken;
     FTokenStringBuffer[FTokenBufferSize] := FCurTokenString;
+    FCurComments:=FCommentsBuffer[FTokenBufferSize];
     Inc(FTokenBufferSize);
     Inc(FTokenBufferIndex);
-    //writeln('TPasParser.NextToken New ',CurTokenText,' id=',FTokenBufferIndex);
+  //  writeln('TPasParser.NextToken New ',CurTokenText,' id=',FTokenBufferIndex,' comments = ',FCurComments.text);
   end;
 end;
 
@@ -609,9 +661,11 @@ begin
     begin
       FCurToken := FTokenBuffer[FTokenBufferIndex-1];
       FCurTokenString := FTokenStringBuffer[FTokenBufferIndex-1];
+      FCurComments:=FCommentsBuffer[FTokenBufferIndex-1];
     end else begin
       FCurToken := tkWhitespace;
       FCurTokenString := '';
+      FCurComments.Clear;
     end;
     //writeln('TPasParser.UngetToken ',CurTokenText,' id=',FTokenBufferIndex);
   end;
@@ -636,7 +690,7 @@ begin
   Result := CurTokenString;
 end;
 
-function TPasParser.CurTokenIsIdentifier(Const S: String): Boolean;
+Function TPasParser.CurTokenIsIdentifier(Const S: String): Boolean;
 begin
   Result:=(Curtoken=tkidentifier) and (CompareText(S,CurtokenText)=0);
 end;
@@ -658,18 +712,19 @@ begin
   Result:=IsCurTokenHint(dummy);
 end;
 
-function TPasParser.TokenIsCallingConvention(S: String;
-  out CC: TCallingConvention): Boolean;
+Function TPasParser.TokenIsCallingConvention(S: String; out
+  CC: TCallingConvention): Boolean;
 begin
   Result:=IsCallingConvention(S,CC);
 end;
 
-function TPasParser.TokenIsProcedureModifier(Parent : TPasElement; S: String; out Pm: TProcedureModifier): Boolean;
+Function TPasParser.TokenIsProcedureModifier(Parent: TPasElement; S: String;
+  Out Pm: TProcedureModifier): Boolean;
 begin
   Result:=IsModifier(S,PM);
   if result and (pm in [pmPublic,pmForward]) then
     begin
-    While (Parent<>Nil) and Not (Parent is TPasClassType) do
+    While (Parent<>Nil) and Not ((Parent is TPasClassType) or (Parent is TPasRecordType)) do
      Parent:=Parent.Parent;
     Result:=Not Assigned(Parent);
     end;
@@ -707,7 +762,7 @@ begin
     ExpectToken(tkSemiColon);
 end;
 
-Function TPasParser.CheckPackMode :  TPackMode;
+function TPasParser.CheckPackMode: TPackMode;
 
 begin
   NextToken;
@@ -750,7 +805,8 @@ begin
     AName:=SimpleTypeCaseNames[I];
 end;
 
-function TPasParser.ParseStringType(Parent : TPasElement; Const TypeName : String) : TPasAliasType;
+function TPasParser.ParseStringType(Parent: TPasElement; const TypeName: String
+  ): TPasAliasType;
 
 Var
   S : String;
@@ -878,7 +934,8 @@ begin
   end;
 end;
 
-function TPasParser.ParseEnumType(Parent : TPasElement; Const TypeName : String) : TPasEnumType;
+function TPasParser.ParseEnumType(Parent: TPasElement; const TypeName: String
+  ): TPasEnumType;
 
 Var
   EnumValue: TPasEnumValue;
@@ -889,6 +946,7 @@ begin
     while True do
       begin
       NextToken;
+      SaveComments;
       EnumValue := TPasEnumValue(CreateElement(TPasEnumValue, CurTokenString, Result));
       Result.Values.Add(EnumValue);
       NextToken;
@@ -913,7 +971,8 @@ begin
   end;
 end;
 
-function TPasParser.ParseSetType(Parent: TPasElement; Const TypeName : String): TPasSetType;
+function TPasParser.ParseSetType(Parent: TPasElement; const TypeName: String
+  ): TPasSetType;
 
 begin
   Result := TPasSetType(CreateElement(TPasSetType, TypeName, Parent));
@@ -930,7 +989,7 @@ function TPasParser.ParseType(Parent: TPasElement; Const TypeName : String = '';
 
 Const
   // These types are allowed only when full type declarations
-  FullTypeTokens = [tkGeneric,tkSpecialize,tkClass,tkInterface,tkType];
+  FullTypeTokens = [tkGeneric,{tkSpecialize,}tkClass,tkInterface,tkType];
   // Parsing of these types already takes care of hints
   NoHintTokens = [tkProcedure,tkFunction];
 var
@@ -1558,7 +1617,8 @@ begin
   end;
 end;
 
-Function TPasParser.CheckOverloadList(AList : TFPList; AName : String; Out OldMember : TPasElement) : TPasOverloadedProc;
+function TPasParser.CheckOverloadList(AList: TFPList; AName: String; out
+  OldMember: TPasElement): TPasOverloadedProc;
 
 Var
   I : Integer;
@@ -1578,6 +1638,9 @@ begin
         Result:=TPasOverloadedProc.Create(AName, OldMember.Parent);
         Result.Visibility:=OldMember.Visibility;
         Result.Overloads.Add(OldMember);
+        Result.SourceFilename:=OldMember.SourceFilename;
+        Result.SourceLinenumber:=OldMember.SourceLinenumber;
+        Result.DocComment:=Oldmember.DocComment;
         AList[i] := Result;
         end;
       end;
@@ -1638,6 +1701,7 @@ procedure TPasParser.ParseMain(var Module: TPasModule);
 begin
   Module:=nil;
   NextToken;
+  SaveComments;
   case CurToken of
     tkUnit:
       ParseUnit(Module);
@@ -1836,7 +1900,8 @@ begin
   UngetToken;
 end;
 
-Function TPasParser.GetProcTypeFromToken(tk : TToken; IsClass : Boolean = False) : TProcType;
+function TPasParser.GetProcTypeFromToken(tk: TToken; IsClass: Boolean
+  ): TProcType;
 
 begin
   Case tk of
@@ -1942,12 +2007,14 @@ begin
         CurBlock := declProperty;
       tkProcedure, tkFunction, tkConstructor, tkDestructor,tkOperator:
         begin
+        SaveComments;
         pt:=GetProcTypeFromToken(CurToken);
         AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt));
         CurBlock := declNone;
         end;
       tkClass:
         begin
+          SaveComments;
           NextToken;
           If CurToken in [tkprocedure,tkFunction,tkConstructor, tkDestructor] then
             begin
@@ -1960,6 +2027,7 @@ begin
         end;
       tkIdentifier:
         begin
+          SaveComments;
           case CurBlock of
             declConst:
               begin
@@ -2153,6 +2221,7 @@ end;
 // Starts after the variable name
 function TPasParser.ParseConstDecl(Parent: TPasElement): TPasConst;
 begin
+  SaveComments;
   Result := TPasConst(CreateElement(TPasConst, CurTokenString, Parent));
   try
     NextToken;
@@ -2174,6 +2243,7 @@ end;
 // Starts after the variable name
 function TPasParser.ParseResourcestringDecl(Parent: TPasElement): TPasResString;
 begin
+  SaveComments;
   Result := TPasResString(CreateElement(TPasResString, CurTokenString, Parent));
   try
     ExpectToken(tkEqual);
@@ -2205,7 +2275,8 @@ begin
 end;
 
 // Starts after the type name
-Function TPasParser.ParseRangeType(AParent : TPasElement; Const TypeName : String; Full : Boolean = True) : TPasRangeType;
+function TPasParser.ParseRangeType(AParent: TPasElement;
+  Const TypeName: String; Full: Boolean): TPasRangeType;
 
 Var
   PE : TPasExpr;
@@ -2259,7 +2330,8 @@ begin
   until (CurToken=tkSemicolon);
 end;
 
-Function TPasParser.ParseSpecializeType(Parent : TPasElement; Const TypeName : String) : TPasClassType;
+function TPasParser.ParseSpecializeType(Parent: TPasElement;
+  Const TypeName: String): TPasClassType;
 
 begin
   Result := TPasClassType(Engine.CreateElement(TPasClassType, TypeName, Parent, Scanner.CurFilename, Scanner.CurRow));
@@ -2274,7 +2346,8 @@ begin
   end;
 end;
 
-Function TPasParser.ParseProcedureType(Parent : TPasElement; Const TypeName : String; Const PT : TProcType) : TPasProcedureType;
+function TPasParser.ParseProcedureType(Parent: TPasElement;
+  const TypeName: String; const PT: TProcType): TPasProcedureType;
 
 begin
   if PT in [ptFunction,ptClassFunction] then
@@ -2299,7 +2372,8 @@ begin
   Result:=ParseType(Parent,TypeName,True);
 end;
 
-Function TPasParser.GetVariableValueAndLocation(Parent : TPasElement; out Value : TPasExpr; Out Location : String) : Boolean;
+function TPasParser.GetVariableValueAndLocation(Parent: TPasElement; Out
+  Value: TPasExpr; Out Location: String): Boolean;
 
 begin
   Value:=Nil;
@@ -2329,7 +2403,8 @@ begin
     UngetToken;
 end;
 
-Function TPasParser.GetVariableModifiers(Out Varmods : TVariableModifiers; Out Libname,ExportName : string) : string;
+function TPasParser.GetVariableModifiers(Out VarMods: TVariableModifiers; Out
+  Libname, ExportName: string): string;
 
 Var
   S : String;
@@ -2399,11 +2474,12 @@ var
   VarEl: TPasVariable;
   H : TPasMemberHints;
   varmods: TVariableModifiers;
-  Mods,Loc,alibname,aexpname : string;
+  D,Mods,Loc,alibname,aexpname : string;
 
 begin
   VarNames := TStringList.Create;
   try
+    D:=SaveComments; // This means we support only one comment per 'list'.
     Repeat
       VarNames.Add(CurTokenString);
       NextToken;
@@ -2417,13 +2493,15 @@ begin
     else
       VarType := ParseComplexType(Parent);
     Value:=Nil;
+    H:=CheckHint(Nil,False);
     If Full then
       GetVariableValueAndLocation(Parent,Value,Loc);
-    H:=CheckHint(Nil,Full);
+    H:=H+CheckHint(Nil,Full);
     if full then
       Mods:=GetVariableModifiers(varmods,alibname,aexpname)
     else
       NextToken;
+    SaveComments(D);
     for i := 0 to VarNames.Count - 1 do
       begin
       VarEl:=TPasVariable(CreateElement(TPasVariable,VarNames[i],Parent,AVisibility));
@@ -2449,12 +2527,25 @@ begin
   end;
 end;
 
+Function TPasParser.SaveComments: String;
+begin
+  if Engine.NeedComments then
+    FSavedComments:=CurComments.Text; // Expensive, so don't do unless needed.
+  Result:=FSavedComments;
+end;
+
+Function TPasParser.SaveComments(Const AValue: String): String;
+begin
+  FSavedComments:=AValue;
+  Result:=FSavedComments;
+end;
+
 function TPasParser.LogEvent(E: TPParserLogEvent): Boolean;
 begin
   Result:=E in FLogEvents;
 end;
 
-procedure TPasParser.DoLog(const Msg: String; SkipSourceInfo: Boolean);
+Procedure TPasParser.DoLog(Const Msg: String; SkipSourceInfo: Boolean);
 begin
   If Assigned(FOnLog) then
     if SkipSourceInfo or not assigned(scanner) then
@@ -2463,7 +2554,7 @@ begin
       FOnLog(Self,Format('%s(%d) : %s',[Scanner.CurFilename,SCanner.CurRow,Msg]));
 end;
 
-procedure TPasParser.DoLog(const Fmt: String; Args: array of const;
+Procedure TPasParser.DoLog(Const Fmt: String; Args: Array of const;
   SkipSourceInfo: Boolean);
 begin
   DoLog(Format(Fmt,Args),SkipSourceInfo);
@@ -2594,7 +2685,8 @@ begin
 end;
 
 
-Function TPasParser.CheckProcedureArgs(Parent  : TPasElement; Args : TFPList; Mandatory : Boolean) : boolean;
+function TPasParser.CheckProcedureArgs(Parent: TPasElement; Args: TFPList;
+  Mandatory: Boolean): boolean;
 
 begin
   NextToken;
@@ -3043,6 +3135,19 @@ begin
 //  writeln('TPasParser.ParseProcBeginBlock ended ',curtokenstring);
 end;
 
+procedure TPasParser.ParseAsmBlock(AsmBlock : TPasImplAsmStatement);
+
+begin
+  NextToken;
+  While CurToken<>tkEnd do
+    begin
+    AsmBlock.Tokens.Add(CurTokenText);
+    NextToken;
+    end;
+  // NextToken; // Eat end.
+  // Do not consume end. Current token will normally be end;
+end;
+
 // Next token is start of (compound) statement
 // After parsing CurToken is on last token of statement
 procedure TPasParser.ParseStatement(Parent: TPasImplBlock;
@@ -3104,6 +3209,13 @@ begin
     NextToken;
     //WriteLn(i,'Token=',CurTokenText);
     case CurToken of
+    tkasm :
+      begin
+      el:=TPasImplElement(CreateElement(TPasImplAsmStatement,'',CurBlock));
+      ParseAsmBlock(TPasImplAsmStatement(el));
+      CurBlock.AddElement(el);
+      NewImplElement:=El;
+      end;
     tkbegin:
       begin
       el:=TPasImplElement(CreateElement(TPasImplBeginBlock,'',CurBlock));
@@ -3499,7 +3611,7 @@ begin
 end;
 
 // Starts after the "procedure" or "function" token
-Function TPasParser.GetProcedureClass(ProcType : TProcType) : TPTreeElement;
+function TPasParser.GetProcedureClass(ProcType: TProcType): TPTreeElement;
 
 begin
   Case ProcType of
@@ -3566,7 +3678,8 @@ begin
 end;
 
 // Current token is the first token after tkOf
-Procedure TPasParser.ParseRecordVariantParts(ARec : TPasRecordType; AEndToken: TToken);
+procedure TPasParser.ParseRecordVariantParts(ARec: TPasRecordType;
+  AEndToken: TToken);
 
 Var
   M : TPasRecordType;
@@ -3587,7 +3700,7 @@ begin
     NextToken;
     M:=TPasRecordType(CreateElement(TPasRecordType,'',V));
     V.Members:=M;
-    ParseRecordFieldList(M,tkBraceClose);
+    ParseRecordFieldList(M,tkBraceClose,False);
     // Current token is closing ), so we eat that
     NextToken;
     // If there is a semicolon, we eat that too.
@@ -3612,27 +3725,52 @@ begin
 end;
 
 // Starts on first token after Record or (. Ends on AEndToken
-Procedure TPasParser.ParseRecordFieldList(ARec : TPasRecordType; AEndToken : TToken);
+procedure TPasParser.ParseRecordFieldList(ARec: TPasRecordType;
+  AEndToken: TToken; AllowMethods: Boolean);
 
 Var
   VN : String;
   v : TPasmemberVisibility;
+  Proc: TPasProcedure;
+  ProcType: TProcType;
+  Prop : TPasProperty;
 
 begin
+  v:=visPublic;
   while CurToken<>AEndToken do
     begin
+    SaveComments;
     Case CurToken of
+      tkProperty:
+        begin
+        if Not AllowMethods then
+          ParseExc(SErrRecordMethodsNotAllowed);
+        ExpectToken(tkIdentifier);
+        Prop:=ParseProperty(ARec,CurtokenString,v);
+        Arec.Members.Add(Prop);
+        end;
+      tkProcedure,
+      tkFunction :
+        begin
+        if Not AllowMethods then
+          ParseExc(SErrRecordMethodsNotAllowed);
+        ProcType:=GetProcTypeFromtoken(CurToken,False);
+        Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,v);
+        if Proc.Parent is TPasOverloadedProc then
+          TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
+        else
+          ARec.Members.Add(Proc);
+        end;
       tkIdentifier :
         begin
         v:=visDefault;
-        If po_delphi in Scanner.Options then
+//        If (po_delphi in Scanner.Options) then
           if CheckVisibility(CurtokenString,v) then
             begin
             if not (v in [visPrivate,visPublic,visStrictPrivate]) then
               ParseExc(SParserInvalidRecordVisibility);
             NextToken;
-            if CurToken<>tkIdentifier then
-              ParseExc(SParserTypeSyntaxError);
+            Continue;
             end;
         ParseInlineVarDecl(ARec, ARec.Members, v, AEndToken=tkBraceClose);
         end;
@@ -3669,7 +3807,7 @@ begin
     try
       Result.PackMode:=PackMode;
       NextToken;
-      ParseRecordFieldList(Result,tkEnd);
+      ParseRecordFieldList(Result,tkEnd,true);
     except
       FreeAndNil(Result);
       Raise;
@@ -3698,7 +3836,8 @@ begin
     end;
 end;
 
-Function TPasParser.CheckVisibility(S : String; Var AVisibility :TPasMemberVisibility) : Boolean;
+function TPasParser.CheckVisibility(S: String;
+  var AVisibility: TPasMemberVisibility): Boolean;
 
 Var
   B : Boolean;
@@ -3740,7 +3879,8 @@ begin
     AType.Members.Add(Proc);
 end;
 
-procedure TPasParser.ParseClassFields(AType: TPasClassType; Const AVisibility : TPasMemberVisibility; IsClassField : Boolean);
+procedure TPasParser.ParseClassFields(AType: TPasClassType;
+  const AVisibility: TPasMemberVisibility; IsClassField: Boolean);
 
 Var
   VarList: TFPList;
@@ -3815,11 +3955,13 @@ begin
       tkType:
         begin
         ExpectToken(tkIdentifier);
+        SaveComments;
         ParseClassLocalTypes(AType,CurVisibility);
         end;
       tkConst:
         begin
         ExpectToken(tkIdentifier);
+        SaveComments;
         ParseClassLocalConsts(AType,CurVisibility);
         end;
       tkVar,
@@ -3829,17 +3971,20 @@ begin
           ParseExc(SParserNoFieldsAllowed);
         if CurToken=tkVar then
           ExpectToken(tkIdentifier);
+        SaveComments;
         if Not CheckVisibility(CurtokenString,CurVisibility) then
           ParseClassFields(AType,CurVisibility,false);
         end;
       tkProcedure,tkFunction,tkConstructor,tkDestructor:
         begin
+        SaveComments;
         if (Curtoken in [tkConstructor,tkDestructor]) and (AType.ObjKind in [okInterface,okRecordHelper]) then
           ParseExc(SParserNoConstructorAllowed);
         ProcessMethod(AType,False,CurVisibility);
         end;
       tkclass:
         begin
+         SaveComments;
          NextToken;
          if CurToken in [tkConstructor,tkDestructor,tkprocedure,tkFunction] then
            ProcessMethod(AType,True,CurVisibility)
@@ -3858,6 +4003,7 @@ begin
         end;
       tkProperty:
         begin
+        SaveComments;
         ExpectIdentifier;
         AType.Members.Add(ParseProperty(AType,CurtokenString,CurVisibility));
         end;
@@ -3924,7 +4070,9 @@ begin
     end;
 end;
 
-function TPasParser.ParseClassDecl(Parent: TPasElement; const AClassName: String; AObjKind: TPasObjKind; PackMode : TPackMode= pmNone): TPasType;
+Function TPasParser.ParseClassDecl(Parent: TPasElement;
+  const AClassName: String; AObjKind: TPasObjKind; PackMode: TPackMode
+  ): TPasType;
 
 Var
   SourcefileName : string;

+ 6 - 0
packages/fcl-passrc/tests/tcbaseparser.pas

@@ -77,6 +77,7 @@ Type
     Procedure HaveHint(AHint : TPasMemberHint; AHints : TPasMemberHints);
     Property Resolver : TStreamResolver Read FResolver;
     Property Scanner : TPascalScanner Read FScanner;
+    Property Engine : TTestEngine read FEngine;
     Property Parser : TTestPasParser read FParser ;
     Property Source : TStrings Read FSource;
     Property Module : TPasModule Read FModule;
@@ -108,6 +109,11 @@ begin
   Result.Visibility := AVisibility;
   Result.SourceFilename := ASourceFilename;
   Result.SourceLinenumber := ASourceLinenumber;
+  if NeedComments and Assigned(CurrentParser) then
+    begin
+//    Writeln('Saving comment : ',CurrentParser.SavedComments);
+    Result.DocComment:=CurrentParser.SavedComments;
+    end;
   If not Assigned(FList) then
     FList:=TFPList.Create;
   FList.Add(Result);

+ 187 - 72
packages/fcl-passrc/tests/tcclasstype.pas

@@ -19,6 +19,7 @@ type
     FParent : String;
     FEnded,
     FStarted: Boolean;
+    procedure AssertSpecializedClass(C: TPasClassType);
     function GetC(AIndex: Integer): TPasConst;
     function GetF1: TPasVariable;
     function GetM(AIndex : Integer): TPasElement;
@@ -36,6 +37,7 @@ type
     Procedure EndClass(AEnd : String = 'end');
     Procedure AddMember(S : String);
     Procedure ParseClass;
+    Procedure DoParseClass(FromSpecial : Boolean = False);
     procedure SetUp; override;
     procedure TearDown; override;
     procedure DefaultMethod;
@@ -60,12 +62,16 @@ type
     Property Const2 : TPasConst Index 1 Read GetC;
   published
     procedure TestEmpty;
+    procedure TestEmptyComment;
     procedure TestEmptyDeprecated;
     procedure TestEmptyEnd;
     procedure TestEmptyEndNoParent;
     Procedure TestOneInterface;
     Procedure TestTwoInterfaces;
+    procedure TestOneSpecializedClass;
+    procedure TestOneSpecializedClassInterface;
     Procedure TestOneField;
+    Procedure TestOneFieldComment;
     Procedure TestOneVarField;
     Procedure TestOneClassField;
     Procedure TestOneFieldVisibility;
@@ -83,7 +89,9 @@ type
     procedure TestHintFieldLibraryError;
     procedure TestHintFieldUninmplemented;
     Procedure TestMethodSimple;
+    Procedure TestMethodSimpleComment;
     Procedure TestClassMethodSimple;
+    Procedure TestClassMethodSimpleComment;
     Procedure TestConstructor;
     Procedure TestClassConstructor;
     Procedure TestDestructor;
@@ -108,6 +116,7 @@ type
     Procedure Test2Methods;
     Procedure Test2MethodsDifferentVisibility;
     Procedure TestPropertyRedeclare;
+    Procedure TestPropertyRedeclareComment;
     Procedure TestPropertyRedeclareDefault;
     Procedure TestPropertyReadOnly;
     Procedure TestPropertyReadWrite;
@@ -214,7 +223,7 @@ begin
   Result:=TPasConst(Members[AIndex]);
 end;
 
-Procedure TTestClassType.StartClass(AParent: String; InterfaceList: String);
+procedure TTestClassType.StartClass(AParent: String; InterfaceList: String);
 
 Var
   S : String;
@@ -232,7 +241,7 @@ begin
   FParent:=AParent;
 end;
 
-Procedure TTestClassType.StartClassHelper(ForType: String; AParent: String);
+procedure TTestClassType.StartClassHelper(ForType: String; AParent: String);
 Var
   S : String;
 begin
@@ -248,7 +257,7 @@ begin
   FParent:=AParent;
 end;
 
-Procedure TTestClassType.StartInterface(AParent: String; UUID: String);
+procedure TTestClassType.StartInterface(AParent: String; UUID: String);
 Var
   S : String;
 begin
@@ -262,7 +271,7 @@ begin
   FParent:=AParent;
 end;
 
-Procedure TTestClassType.StartRecordHelper(ForType: String; AParent: String);
+procedure TTestClassType.StartRecordHelper(ForType: String; AParent: String);
 Var
   S : String;
 begin
@@ -278,14 +287,14 @@ begin
   FParent:=AParent;
 end;
 
-Procedure TTestClassType.StartVisibility(A: TPasMemberVisibility);
+procedure TTestClassType.StartVisibility(A: TPasMemberVisibility);
 begin
   if not FStarted then
     StartClass;
   FDecl.Add('  '+VisibilityNames[A]);
 end;
 
-Procedure TTestClassType.EndClass(AEnd: String);
+procedure TTestClassType.EndClass(AEnd: String);
 begin
   if FEnded then exit;
   if not FStarted then
@@ -295,27 +304,46 @@ begin
     FDecl.Add('  '+AEnd);
 end;
 
-Procedure TTestClassType.AddMember(S: String);
+procedure TTestClassType.AddMember(S: String);
 begin
   if Not FStarted then
     StartClass;
   FDecl.Add('    '+S+';');
 end;
 
-Procedure TTestClassType.ParseClass;
+procedure TTestClassType.ParseClass;
+
+begin
+  DoParseClass(False);
+end;
+
+procedure TTestClassType.DoParseClass(FromSpecial: Boolean);
 begin
   EndClass;
   Add('Type');
+  if AddComment then
+    begin
+    Add('// A comment');
+    engine.NeedComments:=True;
+    end;
   Add('  '+TrimRight(FDecl.Text)+';');
   ParseDeclarations;
   AssertEquals('One class type definition',1,Declarations.Classes.Count);
   AssertEquals('First declaration is type definition.',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
   FClass:=TObject(Declarations.Classes[0]) as TPasClassType;
+  TheType:=FClass; // So assertcomment can get to it
   if (FParent<>'') then
      begin
      AssertNotNull('Have parent class',TheClass.AncestorType);
-     AssertEquals('Parent class',TPasUnresolvedTypeRef,TheClass.AncestorType.ClassType);
-     AssertEquals('Parent class name',FParent,TPasUnresolvedTypeRef(TheClass.AncestorType).Name);
+     if FromSpecial then
+       begin
+       AssertEquals('Parent class',TPasClassType,TheClass.AncestorType.ClassType);
+       end
+     else
+       begin
+       AssertEquals('Parent class',TPasUnresolvedTypeRef,TheClass.AncestorType.ClassType);
+       AssertEquals('Parent class name',FParent,TPasUnresolvedTypeRef(TheClass.AncestorType).Name);
+       end;
      end;
   if (TheClass.ObjKind<>okInterface) then
     AssertNull('No interface, No GUID',TheClass.GUIDExpr);
@@ -323,6 +351,7 @@ begin
     AssertNull('No helperfortype if not helper',TheClass.HelperForType);
   if TheClass.Members.Count>0 then
     FMember1:=TObject(TheClass.Members[0]) as TPaselement;
+
 end;
 
 procedure TTestClassType.SetUp;
@@ -341,7 +370,7 @@ begin
   inherited TearDown;
 end;
 
-Procedure TTestClassType.AssertVisibility(V: TPasMemberVisibility;
+procedure TTestClassType.AssertVisibility(V: TPasMemberVisibility;
   Member: TPasElement);
 begin
   If Member=Nil then
@@ -364,7 +393,7 @@ begin
   AssertEquals('Member name ',AName,Member.Name)
 end;
 
-Procedure TTestClassType.AssertProperty(P: TPasProperty;
+procedure TTestClassType.AssertProperty(P: TPasProperty;
   AVisibility: TPasMemberVisibility; AName, ARead, AWrite, AStored,
   AImplements: String; AArgCount: Integer; ADefault, ANodefault: Boolean);
 begin
@@ -385,6 +414,13 @@ begin
   AssertEquals('No members',0,TheClass.Members.Count);
 end;
 
+procedure TTestClassType.TestEmptyComment;
+begin
+  AddComment:=True;
+  TestEmpty;
+  AssertComment;
+end;
+
 procedure TTestClassType.TestEmptyDeprecated;
 begin
   EndClass('end deprecated');
@@ -406,7 +442,7 @@ begin
   AssertEquals('No members',0,TheClass.Members.Count);
 end;
 
-Procedure TTestClassType.TestOneInterface;
+procedure TTestClassType.TestOneInterface;
 begin
   StartClass('TObject','ISomething');
   ParseClass;
@@ -416,7 +452,7 @@ begin
   AssertEquals('Interface name','ISomething',TPasUnresolvedTypeRef(TheClass.Interfaces[0]).Name);
 end;
 
-Procedure TTestClassType.TestTwoInterfaces;
+procedure TTestClassType.TestTwoInterfaces;
 begin
   StartClass('TObject','ISomething, ISomethingElse');
   ParseClass;
@@ -429,7 +465,46 @@ begin
   AssertEquals('Interface name','ISomethingElse',TPasUnresolvedTypeRef(TheClass.Interfaces[1]).Name);
 end;
 
-Procedure TTestClassType.TestOneField;
+procedure TTestClassType.AssertSpecializedClass(C : TPasClassType);
+
+begin
+  AssertEquals('Parent class name is empty','',C.Name);
+  AssertNotNull('Have ancestor type',C.AncestorType);
+  AssertEquals('Have ancestor type name','TMyList',C.AncestorType.Name);
+  AssertNotNull('Have generic template types',C.GenericTemplateTypes);
+  AssertEquals('Have generic template types',1,C.GenericTemplateTypes.Count);
+  AssertEquals('Class name ',TPasGenericTemplateType,TObject(C.GenericTemplateTypes[0]).ClassType);
+  AssertEquals('Have generic template types','Integer',TPasElement(C.GenericTemplateTypes[0]).Name);
+end;
+
+procedure TTestClassType.TestOneSpecializedClass;
+
+Var
+  C : TPasClassType;
+
+begin
+  StartClass('Specialize TMyList<Integer>','');
+  DoParseClass(True);
+  C:=TPasClassType(TheClass.AncestorType);
+  AssertSpecializedClass(C);
+end;
+
+procedure TTestClassType.TestOneSpecializedClassInterface;
+Var
+  C : TPasClassType;
+
+begin
+  StartClass('Specialize TMyList<Integer>','ISomething');
+  DoParseClass(True);
+  C:=TPasClassType(TheClass.AncestorType);
+  AssertSpecializedClass(C);
+  AssertEquals('Have 1 interface',1,TheClass.Interfaces.Count);
+  AssertNotNull('Correct class',TheClass.Interfaces[0]);
+  AssertEquals('Correct class',TPasUnresolvedTypeRef,TObject(TheClass.Interfaces[0]).ClassType);
+  AssertEquals('Interface name','ISomething',TPasUnresolvedTypeRef(TheClass.Interfaces[0]).Name);
+end;
+
+procedure TTestClassType.TestOneField;
 begin
   AddMember('a : integer');
   ParseClass;
@@ -438,7 +513,17 @@ begin
   AssertVisibility;
 end;
 
-Procedure TTestClassType.TestOneVarField;
+procedure TTestClassType.TestOneFieldComment;
+begin
+  AddComment:=true;
+  AddMember('{c}a : integer');
+  ParseClass;
+  AssertNotNull('Have 1 field',Field1);
+  AssertEquals('field comment','c'+sLineBreak,Field1.DocComment);
+  AssertVisibility;
+end;
+
+procedure TTestClassType.TestOneVarField;
 begin
   StartVisibility(visPublished);
   FDecl.Add('var');
@@ -449,7 +534,7 @@ begin
   AssertVisibility(visPublished);
 end;
 
-Procedure TTestClassType.TestOneClassField;
+procedure TTestClassType.TestOneClassField;
 begin
   StartVisibility(visPublished);
   FDecl.Add('class var');
@@ -462,7 +547,7 @@ begin
      Fail('Field is not a class field');
 end;
 
-Procedure TTestClassType.TestOneFieldVisibility;
+procedure TTestClassType.TestOneFieldVisibility;
 begin
   StartVisibility(visPublished);
   AddMember('a : integer');
@@ -472,7 +557,7 @@ begin
   AssertVisibility(visPublished);
 end;
 
-Procedure TTestClassType.TestOneFieldDeprecated;
+procedure TTestClassType.TestOneFieldDeprecated;
 begin
   AddMember('a : integer deprecated');
   ParseClass;
@@ -482,7 +567,7 @@ begin
   AssertVisibility;
 end;
 
-Procedure TTestClassType.TestTwoFields;
+procedure TTestClassType.TestTwoFields;
 begin
   AddMember('a : integer');
   AddMember('b : integer');
@@ -497,7 +582,7 @@ begin
   AssertVisibility(visDefault,Members[1]);
 end;
 
-Procedure TTestClassType.TestTwoFieldsB;
+procedure TTestClassType.TestTwoFieldsB;
 begin
   AddMember('a,b : integer');
   ParseClass;
@@ -511,7 +596,7 @@ begin
   AssertVisibility(visDefault,Members[1]);
 end;
 
-Procedure TTestClassType.TestTwoVarFieldsB;
+procedure TTestClassType.TestTwoVarFieldsB;
 begin
   StartVisibility(visPublic);
   FDecl.Add('var');
@@ -527,7 +612,7 @@ begin
   AssertVisibility(visPublic,Members[1]);
 end;
 
-Procedure TTestClassType.TestTwoFieldsVisibility;
+procedure TTestClassType.TestTwoFieldsVisibility;
 begin
   StartVisibility(visPublic);
   AddMember('a,b : integer');
@@ -542,7 +627,7 @@ begin
   AssertVisibility(visPublic,Members[1]);
 end;
 
-Procedure TTestClassType.TestConstProtectedEnd;
+procedure TTestClassType.TestConstProtectedEnd;
 begin
   // After bug report 25720
    StartVisibility(visPrivate);
@@ -556,7 +641,7 @@ begin
    ParseClass;
 end;
 
-Procedure TTestClassType.TestTypeProtectedEnd;
+procedure TTestClassType.TestTypeProtectedEnd;
 begin
   // After bug report 25720
    StartVisibility(visPrivate);
@@ -570,7 +655,7 @@ begin
    ParseClass;
 end;
 
-Procedure TTestClassType.TestVarProtectedEnd;
+procedure TTestClassType.TestVarProtectedEnd;
 begin
   // After bug report 25720
    StartVisibility(visPrivate);
@@ -626,7 +711,7 @@ begin
   AssertMemberName('unimplemented');
 end;
 
-Procedure TTestClassType.TestMethodSimple;
+procedure TTestClassType.TestMethodSimple;
 begin
   AddMember('Procedure DoSomething');
   ParseClass;
@@ -640,7 +725,19 @@ begin
   AssertEquals('No arguments',0,Method1.ProcType.Args.Count)
 end;
 
-Procedure TTestClassType.TestClassMethodSimple;
+procedure TTestClassType.TestMethodSimpleComment;
+begin
+  AddComment:=True;
+  AddMember('{c} Procedure DoSomething');
+  ParseClass;
+  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertEquals('Default visibility',visDefault,Method1.Visibility);
+  AssertNotNull('Have method',Method1);
+  AssertMemberName('DoSomething');
+  AssertEquals('Comment','c'+sLineBreak,Method1.DocComment);
+end;
+
+procedure TTestClassType.TestClassMethodSimple;
 begin
   AddMember('Class Procedure DoSomething');
   ParseClass;
@@ -654,7 +751,15 @@ begin
   AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
 end;
 
-Procedure TTestClassType.TestConstructor;
+procedure TTestClassType.TestClassMethodSimpleComment;
+begin
+  AddComment:=True;
+  AddMember('{c} Class Procedure DoSomething');
+  ParseClass;
+  AssertEquals('Comment','c'+sLineBreak,Members[0].DocComment);
+end;
+
+procedure TTestClassType.TestConstructor;
 begin
   AddMember('Constructor Create');
   ParseClass;
@@ -668,7 +773,7 @@ begin
   AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
 end;
 
-Procedure TTestClassType.TestClassConstructor;
+procedure TTestClassType.TestClassConstructor;
 begin
   AddMember('Class Constructor Create');
   ParseClass;
@@ -682,7 +787,7 @@ begin
   AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
 end;
 
-Procedure TTestClassType.TestDestructor;
+procedure TTestClassType.TestDestructor;
 begin
   AddMember('Destructor Destroy');
   ParseClass;
@@ -696,7 +801,7 @@ begin
   AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
 end;
 
-Procedure TTestClassType.TestClassDestructor;
+procedure TTestClassType.TestClassDestructor;
 begin
   AddMember('Class Destructor Destroy');
   ParseClass;
@@ -710,7 +815,7 @@ begin
   AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
 end;
 
-Procedure TTestClassType.TestFunctionMethodSimple;
+procedure TTestClassType.TestFunctionMethodSimple;
 begin
   AddMember('Function DoSomething : integer');
   ParseClass;
@@ -724,7 +829,7 @@ begin
   AssertEquals('No arguments',0,functionMethod1.ProcType.Args.Count)
 end;
 
-Procedure TTestClassType.TestClassFunctionMethodSimple;
+procedure TTestClassType.TestClassFunctionMethodSimple;
 begin
   AddMember('Class Function DoSomething : integer');
   ParseClass;
@@ -750,12 +855,12 @@ begin
   AssertEquals('Argument name','A',TPasVariable(Method1.ProcType.Args[0]).Name);
 end;
 
-Procedure TTestClassType.AssertParserError(Const Msg: String);
+procedure TTestClassType.AssertParserError(const Msg: String);
 begin
   AssertException(Msg,EParserError,@ParseClass)
 end;
 
-Procedure TTestClassType.TestMethodOneArg;
+procedure TTestClassType.TestMethodOneArg;
 begin
   AddMember('Procedure DoSomething(A : Integer)');
   ParseClass;
@@ -765,7 +870,7 @@ begin
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
 end;
 
-Procedure TTestClassType.TestMethodVirtual;
+procedure TTestClassType.TestMethodVirtual;
 begin
   AddMember('Procedure DoSomething(A : Integer) virtual');
   ParseClass;
@@ -775,7 +880,7 @@ begin
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
 end;
 
-Procedure TTestClassType.TestMethodVirtualSemicolon;
+procedure TTestClassType.TestMethodVirtualSemicolon;
 begin
   AddMember('Procedure DoSomething(A : Integer); virtual');
   ParseClass;
@@ -785,7 +890,7 @@ begin
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
 end;
 
-Procedure TTestClassType.TestMethodVirtualAbstract;
+procedure TTestClassType.TestMethodVirtualAbstract;
 begin
   AddMember('Procedure DoSomething(A : Integer) virtual abstract');
   ParseClass;
@@ -796,7 +901,7 @@ begin
 end;
 
 
-Procedure TTestClassType.TestMethodOverride;
+procedure TTestClassType.TestMethodOverride;
 begin
   AddMember('Procedure DoSomething(A : Integer) override');
   ParseClass;
@@ -836,7 +941,7 @@ begin
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
 end;
 
-Procedure TTestClassType.TestMethodVisibility;
+procedure TTestClassType.TestMethodVisibility;
 begin
   StartVisibility(visPublic);
   AddMember('Procedure DoSomething(A : Integer)');
@@ -847,7 +952,7 @@ begin
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
 end;
 
-Procedure TTestClassType.TestMethodSVisibility;
+procedure TTestClassType.TestMethodSVisibility;
 begin
   AddMember('Procedure DoSomething(A : Integer)');
   StartVisibility(visPublic);
@@ -865,7 +970,7 @@ begin
   AssertEquals('Argument name','A',TPasVariable(Method2.ProcType.Args[0]).Name);
 end;
 
-Procedure TTestClassType.TestMethodOverloadVisibility;
+procedure TTestClassType.TestMethodOverloadVisibility;
 begin
   AddMember('Procedure DoSomething(A : Integer)');
   StartVisibility(visPublic);
@@ -876,7 +981,7 @@ begin
   AssertEquals('Default visibility',visDefault,Member1.Visibility);
 end;
 
-Procedure TTestClassType.TestMethodHint;
+procedure TTestClassType.TestMethodHint;
 begin
   AddMember('Procedure DoSomething(A : Integer) deprecated');
   ParseClass;
@@ -888,7 +993,7 @@ begin
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
 end;
 
-Procedure TTestClassType.TestMethodVirtualHint;
+procedure TTestClassType.TestMethodVirtualHint;
 begin
   AddMember('Procedure DoSomething(A : Integer) virtual; deprecated');
   ParseClass;
@@ -900,7 +1005,7 @@ begin
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
 end;
 
-Procedure TTestClassType.TestIntegerMessageMethod;
+procedure TTestClassType.TestIntegerMessageMethod;
 begin
   AddMember('Procedure DoSomething(A : Integer) message 123');
   ParseClass;
@@ -911,7 +1016,7 @@ begin
   AssertEquals('Message name','123',Method1.MessageName);
 end;
 
-Procedure TTestClassType.TestStringMessageMethod;
+procedure TTestClassType.TestStringMessageMethod;
 begin
   AddMember('Procedure DoSomething(A : Integer) message ''aha''');
   ParseClass;
@@ -922,7 +1027,7 @@ begin
   AssertEquals('Message name','''aha''',Method1.MessageName);
 end;
 
-Procedure TTestClassType.Test2Methods;
+procedure TTestClassType.Test2Methods;
 begin
   AddMember('Procedure DoSomething(A : Integer) virtual');
   AddMember('Procedure DoSomethingElse');
@@ -937,7 +1042,7 @@ begin
   AssertEquals('Default calling convention',ccDefault, TPasProcedure(Members[1]).ProcType.CallingConvention);
 end;
 
-Procedure TTestClassType.Test2MethodsDifferentVisibility;
+procedure TTestClassType.Test2MethodsDifferentVisibility;
 begin
   AddMember('Procedure DoSomething(A : Integer) virtual');
   StartVisibility(visPublic);
@@ -954,7 +1059,7 @@ begin
 
 end;
 
-Procedure TTestClassType.TestPropertyRedeclare;
+procedure TTestClassType.TestPropertyRedeclare;
 begin
   StartVisibility(visPublished);
   AddMember('Property Something');
@@ -967,7 +1072,17 @@ begin
   Assertequals('No default value','',Property1.DefaultValue);
 end;
 
-Procedure TTestClassType.TestPropertyRedeclareDefault;
+procedure TTestClassType.TestPropertyRedeclareComment;
+begin
+  StartVisibility(visPublished);
+  AddComment:=True;
+  AddMember('{p} Property Something');
+  ParseClass;
+  AssertProperty(Property1,visPublished,'Something','','','','',0,False,False);
+  AssertEquals('comment','p'+sLineBreak,Property1.DocComment);
+end;
+
+procedure TTestClassType.TestPropertyRedeclareDefault;
 begin
   StartVisibility(visPublic);
   AddMember('Property Something; default;');
@@ -982,7 +1097,7 @@ begin
   AssertEquals('Is default property',True, Property1.IsDefault);
 end;
 
-Procedure TTestClassType.TestPropertyReadOnly;
+procedure TTestClassType.TestPropertyReadOnly;
 begin
   StartVisibility(visPublished);
   AddMember('Property Something : integer Read FSomething');
@@ -997,7 +1112,7 @@ begin
   Assertequals('No default value','',Property1.DefaultValue);
 end;
 
-Procedure TTestClassType.TestPropertyReadWrite;
+procedure TTestClassType.TestPropertyReadWrite;
 begin
   StartVisibility(visPublished);
   AddMember('Property Something : integer Read FSomething Write FSomething');
@@ -1012,7 +1127,7 @@ begin
   Assertequals('No default value','',Property1.DefaultValue);
 end;
 
-Procedure TTestClassType.TestPropertyWriteOnly;
+procedure TTestClassType.TestPropertyWriteOnly;
 begin
   StartVisibility(visPublished);
   AddMember('Property Something : integer Write FSomething');
@@ -1027,7 +1142,7 @@ begin
   Assertequals('No default value','',Property1.DefaultValue);
 end;
 
-Procedure TTestClassType.TestPropertyDefault;
+procedure TTestClassType.TestPropertyDefault;
 begin
   StartVisibility(visPublished);
   AddMember('Property Something : integer Read FSomething Write FSomething default 1');
@@ -1042,7 +1157,7 @@ begin
   Assertequals('Default value','1',Property1.DefaultValue);
 end;
 
-Procedure TTestClassType.TestPropertyNoDefault;
+procedure TTestClassType.TestPropertyNoDefault;
 begin
   StartVisibility(visPublished);
   AddMember('Property Something : integer Read FSomething Write FSomething nodefault');
@@ -1057,7 +1172,7 @@ begin
   Assertequals('No Default value','',Property1.DefaultValue);
 end;
 
-Procedure TTestClassType.TestPropertyIndex;
+procedure TTestClassType.TestPropertyIndex;
 begin
   StartVisibility(visPublished);
   AddMember('Property Something : integer Index 2 Read GetF Write SetF');
@@ -1072,7 +1187,7 @@ begin
   Assertequals('No Default value','',Property1.DefaultValue);
 end;
 
-Procedure TTestClassType.TestPropertyStored;
+procedure TTestClassType.TestPropertyStored;
 begin
   StartVisibility(visPublished);
   AddMember('Property Something : integer Read GetF Write SetF Stored CheckStored');
@@ -1087,7 +1202,7 @@ begin
   Assertequals('No Default value','',Property1.DefaultValue);
 end;
 
-Procedure TTestClassType.TestPropertyStoredFalse;
+procedure TTestClassType.TestPropertyStoredFalse;
 begin
   StartVisibility(visPublished);
   AddMember('Property Something : integer Read GetF Write SetF Stored False');
@@ -1102,7 +1217,7 @@ begin
   Assertequals('No Default value','',Property1.DefaultValue);
 end;
 
-Procedure TTestClassType.TestPropertyFullyQualifiedType;
+procedure TTestClassType.TestPropertyFullyQualifiedType;
 begin
   StartVisibility(visPublished);
   AddMember('Property Something : unita.typeb Read FSomething');
@@ -1117,7 +1232,7 @@ begin
   Assertequals('No default value','',Property1.DefaultValue);
 end;
 
-Procedure TTestClassType.TestPropertyArrayReadOnly;
+procedure TTestClassType.TestPropertyArrayReadOnly;
 Var
   A : TPasArgument;
 begin
@@ -1141,7 +1256,7 @@ begin
   AssertEquals('Argument class type name','Integer',A.ArgType.Name);
 end;
 
-Procedure TTestClassType.TestPropertyArrayReadWrite;
+procedure TTestClassType.TestPropertyArrayReadWrite;
 Var
   A : TPasArgument;
 begin
@@ -1165,7 +1280,7 @@ begin
   AssertEquals('Argument class type name','Integer',A.ArgType.Name);
 end;
 
-Procedure TTestClassType.TestPropertyArrayReadOnlyDefault;
+procedure TTestClassType.TestPropertyArrayReadOnlyDefault;
 
 Var
   A : TPasArgument;
@@ -1190,7 +1305,7 @@ begin
   AssertEquals('Argument class type name','Integer',A.ArgType.Name);
 end;
 
-Procedure TTestClassType.TestPropertyArrayReadWriteDefault;
+procedure TTestClassType.TestPropertyArrayReadWriteDefault;
 Var
   A : TPasArgument;
 begin
@@ -1214,7 +1329,7 @@ begin
   AssertEquals('Argument class type name','Integer',A.ArgType.Name);
 end;
 
-Procedure TTestClassType.TestPropertyArrayMultiDimReadOnly;
+procedure TTestClassType.TestPropertyArrayMultiDimReadOnly;
 Var
   A : TPasArgument;
 begin
@@ -1246,7 +1361,7 @@ begin
   AssertEquals('Argument 2 class type name','Integer',A.ArgType.Name);
 end;
 
-Procedure TTestClassType.TestPropertyImplements;
+procedure TTestClassType.TestPropertyImplements;
 begin
   StartVisibility(visPublished);
   AddMember('Property Something : AInterface Read FSomething Implements ISomeInterface');
@@ -1262,7 +1377,7 @@ begin
 
 end;
 
-Procedure TTestClassType.TestPropertyImplementsFullyQualifiedName;
+procedure TTestClassType.TestPropertyImplementsFullyQualifiedName;
 begin
   StartVisibility(visPublished);
   AddMember('Property Something : AInterface Read FSomething Implements UnitB.ISomeInterface');
@@ -1277,7 +1392,7 @@ begin
   Assertequals('Default value','',Property1.DefaultValue);
 end;
 
-Procedure TTestClassType.TestPropertyReadFromRecordField;
+procedure TTestClassType.TestPropertyReadFromRecordField;
 begin
   StartVisibility(visPublished);
   AddMember('Property Something : Integer Read FPoint.X');
@@ -1307,7 +1422,7 @@ begin
   Assertequals('Default value','',Property1.DefaultValue);
 end;
 
-Procedure TTestClassType.TestLocalSimpleType;
+procedure TTestClassType.TestLocalSimpleType;
 begin
   StartVisibility(visPublic);
   FDecl.add('Type');
@@ -1322,7 +1437,7 @@ begin
   AssertEquals('method name','Something', Method2.Name);
 end;
 
-Procedure TTestClassType.TestLocalSimpleTypes;
+procedure TTestClassType.TestLocalSimpleTypes;
 begin
   StartVisibility(visPublic);
   FDecl.add('Type');
@@ -1342,7 +1457,7 @@ begin
   AssertEquals('method name','Something', Method3.Name);
 end;
 
-Procedure TTestClassType.TestLocalSimpleConst;
+procedure TTestClassType.TestLocalSimpleConst;
 begin
   StartVisibility(visPublic);
   FDecl.add('Const');
@@ -1358,7 +1473,7 @@ begin
   AssertEquals('method name','Something', Method2.Name);
 end;
 
-Procedure TTestClassType.TestLocalSimpleConsts;
+procedure TTestClassType.TestLocalSimpleConsts;
 begin
   StartVisibility(visPublic);
   FDecl.add('Const');

+ 124 - 89
packages/fcl-passrc/tests/tcprocfunc.pas

@@ -13,6 +13,7 @@ type
 
   TTestProcedureFunction= class(TTestParser)
   private
+    FAddComment: Boolean;
     FFunc: TPasFunction;
     FHint: String;
     FProc: TPasProcedure;
@@ -35,6 +36,8 @@ type
   protected
     procedure SetUp; override;
     procedure TearDown; override;
+    Procedure AssertComment;
+    Property AddComment : Boolean Read FAddComment Write FAddComment;
     Property Hint : String Read FHint Write FHint;
     Property Proc : TPasProcedure Read FProc;
     Property ProcType : TPasProcedureType Read GetPT;
@@ -42,7 +45,9 @@ type
     Property FuncType : TPasFunctionType Read GetFT;
   published
     procedure TestEmptyProcedure;
+    procedure TestEmptyProcedureComment;
     Procedure TestEmptyFunction;
+    Procedure TestEmptyFunctionComment;
     procedure TestEmptyProcedureDeprecated;
     Procedure TestEmptyFunctionDeprecated;
     procedure TestEmptyProcedurePlatform;
@@ -156,7 +161,8 @@ type
 implementation
 
 
-procedure TTestProcedureFunction.AddDeclaration(Const ASource : string; Const AHint : String = '');
+procedure TTestProcedureFunction.AddDeclaration(const ASource: string;
+  const AHint: String);
 
 Var
   D : String;
@@ -176,16 +182,24 @@ begin
   Result:=Proc.ProcType;
 end;
 
-Function TTestProcedureFunction.ParseProcedure(Const ASource : string; Const AHint : String = '') : TPasProcedure;
+function TTestProcedureFunction.ParseProcedure(const ASource: string;
+  const AHint: String): TPasProcedure;
 
 
 begin
+  If AddComment then
+    begin
+    Add('// A comment');
+    Engine.NeedComments:=True;
+    end;
   AddDeclaration('procedure A '+ASource,AHint);
   Self.ParseProcedure;
   Result:=Fproc;
+  If AddComment then
+    AssertComment;
 end;
 
-procedure TTestProcedureFunction.ParseProcedure;
+Procedure TTestProcedureFunction.ParseProcedure;
 
 begin
   //  Writeln(source.text);
@@ -216,7 +230,7 @@ begin
   AssertEquals('Correct function result type name',AResult,FuncType.ResultEl.ResultType.Name);
 end;
 
-procedure TTestProcedureFunction.ParseFunction;
+Procedure TTestProcedureFunction.ParseFunction;
 begin
   //  Writeln(source.text);
   ParseDeclarations;
@@ -261,7 +275,9 @@ begin
   AssertEquals('Not is nested',False,P.ProcType.IsNested);
 end;
 
-Function TTestProcedureFunction.BaseAssertArg(ProcType : TPasProcedureType; AIndex : Integer; AName : String; AAccess : TArgumentAccess; AValue : String='') : TPasArgument;
+function TTestProcedureFunction.BaseAssertArg(ProcType: TPasProcedureType;
+  AIndex: Integer; AName: String; AAccess: TArgumentAccess; AValue: String
+  ): TPasArgument;
 
 Var
   A : TPasArgument;
@@ -287,7 +303,9 @@ begin
   Result:=A;
 end;
 
-procedure TTestProcedureFunction.AssertArg(ProcType : TPasProcedureType; AIndex : Integer; AName : String; AAccess : TArgumentAccess; Const TypeName : String; AValue : String='');
+procedure TTestProcedureFunction.AssertArg(ProcType: TPasProcedureType;
+  AIndex: Integer; AName: String; AAccess: TArgumentAccess;
+  const TypeName: String; AValue: String);
 
 Var
   A : TPasArgument;
@@ -343,19 +361,31 @@ begin
   AssertProc([],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestEmptyFunction;
+procedure TTestProcedureFunction.TestEmptyProcedureComment;
+begin
+  AddComment:=True;
+  TestEmptyProcedure;
+end;
+
+Procedure TTestProcedureFunction.TestEmptyFunction;
 begin
   ParseFunction('');
   AssertFunc([],ccDefault,0);
 end;
 
+Procedure TTestProcedureFunction.TestEmptyFunctionComment;
+begin
+  AddComment:=True;
+  TestEmptyProcedure;
+end;
+
 procedure TTestProcedureFunction.TestEmptyProcedureDeprecated;
 begin
   ParseProcedure('','deprecated');
   AssertProc([],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestEmptyFunctionDeprecated;
+Procedure TTestProcedureFunction.TestEmptyFunctionDeprecated;
 begin
   ParseFunction('','deprecated');
   AssertFunc([],ccDefault,0);
@@ -367,7 +397,7 @@ begin
   AssertProc([],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestEmptyFunctionPlatform;
+Procedure TTestProcedureFunction.TestEmptyFunctionPlatform;
 begin
   ParseFunction('','platform');
   AssertFunc([],ccDefault,0);
@@ -379,7 +409,7 @@ begin
   AssertProc([],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestEmptyFunctionExperimental;
+Procedure TTestProcedureFunction.TestEmptyFunctionExperimental;
 begin
   ParseFunction('','experimental');
   AssertFunc([],ccDefault,0);
@@ -391,7 +421,7 @@ begin
   AssertProc([],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestEmptyFunctionUnimplemented;
+Procedure TTestProcedureFunction.TestEmptyFunctionUnimplemented;
 begin
   ParseFunction('','unimplemented');
   AssertFunc([],ccDefault,0);
@@ -407,7 +437,7 @@ begin
   AssertArg(ProcType,0,'B',argDefault,'Integer','');
 end;
 
-procedure TTestProcedureFunction.TestFunctionOneArg;
+Procedure TTestProcedureFunction.TestFunctionOneArg;
 begin
   ParseFunction('(B : Integer)');
   AssertFunc([],ccDefault,1);
@@ -421,7 +451,7 @@ begin
   AssertArg(ProcType,0,'B',argVar,'Integer','');
 end;
 
-procedure TTestProcedureFunction.TestFunctionOneVarArg;
+Procedure TTestProcedureFunction.TestFunctionOneVarArg;
 begin
   ParseFunction('(Var B : Integer)');
   AssertFunc([],ccDefault,1);
@@ -435,7 +465,7 @@ begin
   AssertArg(ProcType,0,'B',argConst,'Integer','');
 end;
 
-procedure TTestProcedureFunction.TestFunctionOneConstArg;
+Procedure TTestProcedureFunction.TestFunctionOneConstArg;
 begin
   ParseFunction('(Const B : Integer)');
   AssertFunc([],ccDefault,1);
@@ -449,7 +479,7 @@ begin
   AssertArg(ProcType,0,'B',argOut,'Integer','');
 end;
 
-procedure TTestProcedureFunction.TestFunctionOneOutArg;
+Procedure TTestProcedureFunction.TestFunctionOneOutArg;
 begin
   ParseFunction('(Out B : Integer)');
   AssertFunc([],ccDefault,1);
@@ -463,7 +493,7 @@ begin
   AssertArg(ProcType,0,'B',argConstRef,'Integer','');
 end;
 
-procedure TTestProcedureFunction.TestFunctionOneConstRefArg;
+Procedure TTestProcedureFunction.TestFunctionOneConstRefArg;
 begin
   ParseFunction('(ConstRef B : Integer)');
   AssertFunc([],ccDefault,1);
@@ -478,7 +508,7 @@ begin
   AssertArg(ProcType,1,'C',argDefault,'Integer','');
 end;
 
-procedure TTestProcedureFunction.TestFunctionTwoArgs;
+Procedure TTestProcedureFunction.TestFunctionTwoArgs;
 begin
   ParseFunction('(B,C : Integer)');
   AssertFunc([],ccDefault,2);
@@ -494,7 +524,7 @@ begin
   AssertArg(ProcType,1,'C',argDefault,'Integer','');
 end;
 
-procedure TTestProcedureFunction.TestFunctionTwoArgsSeparate;
+Procedure TTestProcedureFunction.TestFunctionTwoArgsSeparate;
 begin
   ParseFunction('(B : Integer;C : Integer)');
   AssertFunc([],ccDefault,2);
@@ -509,7 +539,7 @@ begin
   AssertArg(ProcType,0,'B',argDefault,'Integer','1');
 end;
 
-procedure TTestProcedureFunction.TestFunctionOneArgDefault;
+Procedure TTestProcedureFunction.TestFunctionOneArgDefault;
 begin
   ParseFunction('(B : Integer = 1)');
   AssertFunc([],ccDefault,1);
@@ -523,7 +553,7 @@ begin
   AssertArg(ProcType,0,'B',argDefault,'MySet','[1, 2]');
 end;
 
-procedure TTestProcedureFunction.TestFunctionOneArgDefaultSet;
+Procedure TTestProcedureFunction.TestFunctionOneArgDefaultSet;
 begin
   ParseFunction('(B : MySet = [1,2])');
   AssertFunc([],ccDefault,1);
@@ -537,7 +567,7 @@ begin
   AssertArg(ProcType,0,'B',argDefault,'Integer','1 + 2');
 end;
 
-procedure TTestProcedureFunction.TestFunctionOneArgDefaultExpr;
+Procedure TTestProcedureFunction.TestFunctionOneArgDefaultExpr;
 begin
   ParseFunction('(B : Integer = 1 + 2)');
   AssertFunc([],ccDefault,1);
@@ -552,7 +582,7 @@ begin
   AssertArg(ProcType,1,'C',argDefault,'Integer','2');
 end;
 
-procedure TTestProcedureFunction.TestFunctionTwoArgsDefault;
+Procedure TTestProcedureFunction.TestFunctionTwoArgsDefault;
 begin
   ParseFunction('(B : Integer = 1; C : Integer = 2)');
   AssertFunc([],ccDefault,2);
@@ -567,7 +597,7 @@ begin
   AssertArg(ProcType,0,'B',argVar,'','');
 end;
 
-procedure TTestProcedureFunction.TestFunctionOneUntypedVarArg;
+Procedure TTestProcedureFunction.TestFunctionOneUntypedVarArg;
 begin
   ParseFunction('(Var B)');
   AssertFunc([],ccDefault,1);
@@ -582,7 +612,7 @@ begin
   AssertArg(ProcType,1,'C',argVar,'','');
 end;
 
-procedure TTestProcedureFunction.TestFunctionTwoUntypedVarArgs;
+Procedure TTestProcedureFunction.TestFunctionTwoUntypedVarArgs;
 begin
   ParseFunction('(Var B; Var C)');
   AssertFunc([],ccDefault,2);
@@ -597,7 +627,7 @@ begin
   AssertArg(ProcType,0,'B',argConst,'','');
 end;
 
-procedure TTestProcedureFunction.TestFunctionOneUntypedConstArg;
+Procedure TTestProcedureFunction.TestFunctionOneUntypedConstArg;
 begin
   ParseFunction('(Const B)');
   AssertFunc([],ccDefault,1);
@@ -612,7 +642,7 @@ begin
   AssertArg(ProcType,1,'C',argConst,'','');
 end;
 
-procedure TTestProcedureFunction.TestFunctionTwoUntypedConstArgs;
+Procedure TTestProcedureFunction.TestFunctionTwoUntypedConstArgs;
 begin
   ParseFunction('(Const B; Const C)');
   AssertFunc([],ccDefault,2);
@@ -627,7 +657,7 @@ begin
   AssertArrayArg(ProcType,0,'B',argDefault,'Integer');
 end;
 
-procedure TTestProcedureFunction.TestFunctionOpenArrayArg;
+Procedure TTestProcedureFunction.TestFunctionOpenArrayArg;
 begin
   ParseFunction('(B : Array of Integer)');
   AssertFunc([],ccDefault,1);
@@ -642,7 +672,7 @@ begin
   AssertArrayArg(ProcType,1,'C',argDefault,'Integer');
 end;
 
-procedure TTestProcedureFunction.TestFunctionTwoOpenArrayArgs;
+Procedure TTestProcedureFunction.TestFunctionTwoOpenArrayArgs;
 begin
   ParseFunction('(B : Array of Integer;C : Array of Integer)');
   AssertFunc([],ccDefault,2);
@@ -657,7 +687,7 @@ begin
   AssertArrayArg(ProcType,0,'B',argConst,'Integer');
 end;
 
-procedure TTestProcedureFunction.TestFunctionConstOpenArrayArg;
+Procedure TTestProcedureFunction.TestFunctionConstOpenArrayArg;
 begin
   ParseFunction('(Const B : Array of Integer)');
   AssertFunc([],ccDefault,1);
@@ -671,7 +701,7 @@ begin
   AssertArrayArg(ProcType,0,'B',argVar,'Integer');
 end;
 
-procedure TTestProcedureFunction.TestFunctionVarOpenArrayArg;
+Procedure TTestProcedureFunction.TestFunctionVarOpenArrayArg;
 begin
   ParseFunction('(Var B : Array of Integer)');
   AssertFunc([],ccDefault,1);
@@ -685,7 +715,7 @@ begin
   AssertArrayArg(ProcType,0,'B',argDefault,'');
 end;
 
-procedure TTestProcedureFunction.TestFunctionArrayOfConstArg;
+Procedure TTestProcedureFunction.TestFunctionArrayOfConstArg;
 begin
   ParseFunction('(B : Array of Const)');
   AssertFunc([],ccDefault,1);
@@ -699,100 +729,100 @@ begin
   AssertArrayArg(ProcType,0,'B',argConst,'');
 end;
 
-procedure TTestProcedureFunction.TestFunctionConstArrayOfConstArg;
+Procedure TTestProcedureFunction.TestFunctionConstArrayOfConstArg;
 begin
   ParseFunction('(Const B : Array of Const)');
   AssertFunc([],ccDefault,1);
   AssertArrayArg(FuncType,0,'B',argConst,'');
 end;
 
-procedure TTestProcedureFunction.TestProcedureCdecl;
+Procedure TTestProcedureFunction.TestProcedureCdecl;
 begin
   ParseProcedure('; cdecl');
   AssertProc([],ccCdecl,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionCdecl;
+Procedure TTestProcedureFunction.TestFunctionCdecl;
 begin
   ParseFunction('','','',ccCdecl);
   AssertFunc([],ccCdecl,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureCdeclDeprecated;
+Procedure TTestProcedureFunction.TestProcedureCdeclDeprecated;
 begin
   ParseProcedure('; cdecl;','deprecated');
   AssertProc([],ccCdecl,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionCdeclDeprecated;
+Procedure TTestProcedureFunction.TestFunctionCdeclDeprecated;
 begin
   ParseFunction('','','deprecated',ccCdecl);
   AssertFunc([],ccCdecl,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureSafeCall;
+Procedure TTestProcedureFunction.TestProcedureSafeCall;
 begin
   ParseProcedure('; safecall;','');
   AssertProc([],ccSafeCall,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionSafeCall;
+Procedure TTestProcedureFunction.TestFunctionSafeCall;
 begin
   ParseFunction('','','',ccSafecall);
   AssertFunc([],ccSafecall,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedurePascal;
+Procedure TTestProcedureFunction.TestProcedurePascal;
 begin
   ParseProcedure('; pascal;','');
   AssertProc([],ccPascal,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionPascal;
+Procedure TTestProcedureFunction.TestFunctionPascal;
 begin
   ParseFunction('','','',ccPascal);
   AssertFunc([],ccPascal,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureStdCall;
+Procedure TTestProcedureFunction.TestProcedureStdCall;
 begin
   ParseProcedure('; stdcall;','');
   AssertProc([],ccstdcall,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionStdCall;
+Procedure TTestProcedureFunction.TestFunctionStdCall;
 begin
   ParseFunction('','','',ccStdCall);
   AssertFunc([],ccStdCall,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureOldFPCCall;
+Procedure TTestProcedureFunction.TestProcedureOldFPCCall;
 begin
   ParseProcedure('; oldfpccall;','');
   AssertProc([],ccoldfpccall,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionOldFPCCall;
+Procedure TTestProcedureFunction.TestFunctionOldFPCCall;
 begin
   ParseFunction('','','',ccOldFPCCall);
   AssertFunc([],ccOldFPCCall,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedurePublic;
+Procedure TTestProcedureFunction.TestProcedurePublic;
 begin
   ParseProcedure('; public name ''myfunc'';','');
   AssertProc([pmPublic],ccDefault,0);
   AssertExpression('Public name',Proc.PublicName,pekString,'''myfunc''');
 end;
 
-procedure TTestProcedureFunction.TestProcedurePublicIdent;
+Procedure TTestProcedureFunction.TestProcedurePublicIdent;
 begin
   ParseProcedure('; public name exportname;','');
   AssertProc([pmPublic],ccDefault,0);
   AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
 end;
 
-procedure TTestProcedureFunction.TestFunctionPublic;
+Procedure TTestProcedureFunction.TestFunctionPublic;
 begin
   AddDeclaration('function A : Integer; public name exportname');
   ParseFunction;
@@ -800,14 +830,14 @@ begin
   AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
 end;
 
-procedure TTestProcedureFunction.TestProcedureCdeclPublic;
+Procedure TTestProcedureFunction.TestProcedureCdeclPublic;
 begin
   ParseProcedure('; cdecl; public name exportname;','');
   AssertProc([pmPublic],ccCDecl,0);
   AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
 end;
 
-procedure TTestProcedureFunction.TestFunctionCdeclPublic;
+Procedure TTestProcedureFunction.TestFunctionCdeclPublic;
 begin
   AddDeclaration('function A : Integer; cdecl; public name exportname');
   ParseFunction;
@@ -815,58 +845,58 @@ begin
   AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
 end;
 
-procedure TTestProcedureFunction.TestProcedureOverload;
+Procedure TTestProcedureFunction.TestProcedureOverload;
 begin
   ParseProcedure('; overload;','');
   AssertProc([pmOverload],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionOverload;
+Procedure TTestProcedureFunction.TestFunctionOverload;
 begin
   AddDeclaration('function A : Integer; overload');
   ParseFunction;
   AssertFunc([pmOverload],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureVarargs;
+Procedure TTestProcedureFunction.TestProcedureVarargs;
 begin
   ParseProcedure('; varargs;','');
   AssertProc([pmVarArgs],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionVarArgs;
+Procedure TTestProcedureFunction.TestFunctionVarArgs;
 begin
   AddDeclaration('function A : Integer; varargs');
   ParseFunction;
   AssertFunc([pmVarArgs],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureCDeclVarargs;
+Procedure TTestProcedureFunction.TestProcedureCDeclVarargs;
 begin
   ParseProcedure(';cdecl; varargs;','');
   AssertProc([pmVarArgs],ccCDecl,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionCDeclVarArgs;
+Procedure TTestProcedureFunction.TestFunctionCDeclVarArgs;
 begin
   AddDeclaration('function A : Integer; cdecl; varargs');
   ParseFunction;
   AssertFunc([pmVarArgs],ccCdecl,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureForwardInterface;
+Procedure TTestProcedureFunction.TestProcedureForwardInterface;
 begin
   AddDeclaration('procedure A; forward;');
   AssertException(EParserError,@ParseProcedure);
 end;
 
-procedure TTestProcedureFunction.TestFunctionForwardInterface;
+Procedure TTestProcedureFunction.TestFunctionForwardInterface;
 begin
   AddDeclaration('function A : integer; forward;');
   AssertException(EParserError,@ParseFunction);
 end;
 
-procedure TTestProcedureFunction.TestProcedureForward;
+Procedure TTestProcedureFunction.TestProcedureForward;
 begin
   UseImplementation:=True;
   AddDeclaration('procedure A; forward;');
@@ -874,7 +904,7 @@ begin
   AssertProc([pmforward],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionForward;
+Procedure TTestProcedureFunction.TestFunctionForward;
 begin
   UseImplementation:=True;
   AddDeclaration('function A : integer; forward;');
@@ -882,7 +912,7 @@ begin
   AssertFunc([pmforward],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureCdeclForward;
+Procedure TTestProcedureFunction.TestProcedureCdeclForward;
 begin
   UseImplementation:=True;
   AddDeclaration('procedure A; cdecl; forward;');
@@ -890,7 +920,7 @@ begin
   AssertProc([pmforward],ccCDecl,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionCDeclForward;
+Procedure TTestProcedureFunction.TestFunctionCDeclForward;
 begin
   UseImplementation:=True;
   AddDeclaration('function A : integer; cdecl; forward;');
@@ -898,92 +928,92 @@ begin
   AssertFunc([pmforward],ccCDecl,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureCompilerProc;
+Procedure TTestProcedureFunction.TestProcedureCompilerProc;
 begin
   ParseProcedure(';compilerproc;','');
   AssertProc([pmCompilerProc],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionCompilerProc;
+Procedure TTestProcedureFunction.TestFunctionCompilerProc;
 begin
   AddDeclaration('function A : Integer; compilerproc');
   ParseFunction;
   AssertFunc([pmCompilerProc],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureCDeclCompilerProc;
+Procedure TTestProcedureFunction.TestProcedureCDeclCompilerProc;
 begin
   ParseProcedure(';cdecl;compilerproc;','');
   AssertProc([pmCompilerProc],ccCDecl,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionCDeclCompilerProc;
+Procedure TTestProcedureFunction.TestFunctionCDeclCompilerProc;
 begin
   AddDeclaration('function A : Integer; cdecl; compilerproc');
   ParseFunction;
   AssertFunc([pmCompilerProc],ccCDecl,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureAssembler;
+Procedure TTestProcedureFunction.TestProcedureAssembler;
 begin
   ParseProcedure(';assembler;','');
   AssertProc([pmAssembler],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionAssembler;
+Procedure TTestProcedureFunction.TestFunctionAssembler;
 begin
   AddDeclaration('function A : Integer; assembler');
   ParseFunction;
   AssertFunc([pmAssembler],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureCDeclAssembler;
+Procedure TTestProcedureFunction.TestProcedureCDeclAssembler;
 begin
   ParseProcedure(';cdecl;assembler;','');
   AssertProc([pmAssembler],ccCDecl,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionCDeclAssembler;
+Procedure TTestProcedureFunction.TestFunctionCDeclAssembler;
 begin
   AddDeclaration('function A : Integer; cdecl; assembler');
   ParseFunction;
   AssertFunc([pmAssembler],ccCDecl,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureExport;
+Procedure TTestProcedureFunction.TestProcedureExport;
 begin
   ParseProcedure(';export;','');
   AssertProc([pmExport],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionExport;
+Procedure TTestProcedureFunction.TestFunctionExport;
 begin
   AddDeclaration('function A : Integer; export');
   ParseFunction;
   AssertFunc([pmExport],ccDefault,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureCDeclExport;
+Procedure TTestProcedureFunction.TestProcedureCDeclExport;
 begin
   ParseProcedure('cdecl;export;','');
   AssertProc([pmExport],ccCDecl,0);
 end;
 
-procedure TTestProcedureFunction.TestFunctionCDeclExport;
+Procedure TTestProcedureFunction.TestFunctionCDeclExport;
 begin
   AddDeclaration('function A : Integer; cdecl; export');
   ParseFunction;
   AssertFunc([pmExport],ccCDecl,0);
 end;
 
-procedure TTestProcedureFunction.TestProcedureExternal;
+Procedure TTestProcedureFunction.TestProcedureExternal;
 begin
   ParseProcedure(';external','');
   AssertProc([pmExternal],ccDefault,0);
   AssertNull('No Library name expression',Proc.LibraryExpr);
 end;
 
-procedure TTestProcedureFunction.TestFunctionExternal;
+Procedure TTestProcedureFunction.TestFunctionExternal;
 begin
   AddDeclaration('function A : Integer; external');
   ParseFunction;
@@ -991,14 +1021,14 @@ begin
   AssertNull('No Library name expression',Func.LibraryExpr);
 end;
 
-procedure TTestProcedureFunction.TestProcedureExternalLibName;
+Procedure TTestProcedureFunction.TestProcedureExternalLibName;
 begin
   ParseProcedure(';external ''libname''','');
   AssertProc([pmExternal],ccDefault,0);
   AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
 end;
 
-procedure TTestProcedureFunction.TestFunctionExternalLibName;
+Procedure TTestProcedureFunction.TestFunctionExternalLibName;
 begin
   AddDeclaration('function A : Integer; external ''libname''');
   ParseFunction;
@@ -1006,7 +1036,7 @@ begin
   AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
 end;
 
-procedure TTestProcedureFunction.TestProcedureExternalLibNameName;
+Procedure TTestProcedureFunction.TestProcedureExternalLibNameName;
 begin
   ParseProcedure(';external ''libname'' name ''symbolname''','');
   AssertProc([pmExternal],ccDefault,0);
@@ -1014,7 +1044,7 @@ begin
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-procedure TTestProcedureFunction.TestFunctionExternalLibNameName;
+Procedure TTestProcedureFunction.TestFunctionExternalLibNameName;
 begin
   AddDeclaration('function A : Integer; external ''libname'' name ''symbolname''');
   ParseFunction;
@@ -1023,7 +1053,7 @@ begin
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-procedure TTestProcedureFunction.TestProcedureExternalName;
+Procedure TTestProcedureFunction.TestProcedureExternalName;
 begin
   ParseProcedure(';external name ''symbolname''','');
   AssertProc([pmExternal],ccDefault,0);
@@ -1031,7 +1061,7 @@ begin
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-procedure TTestProcedureFunction.TestFunctionExternalName;
+Procedure TTestProcedureFunction.TestFunctionExternalName;
 begin
   AddDeclaration('function A : Integer; external name ''symbolname''');
   ParseFunction;
@@ -1040,14 +1070,14 @@ begin
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-procedure TTestProcedureFunction.TestProcedureCdeclExternal;
+Procedure TTestProcedureFunction.TestProcedureCdeclExternal;
 begin
   ParseProcedure('; cdecl; external','');
   AssertProc([pmExternal],ccCdecl,0);
   AssertNull('No Library name expression',Proc.LibraryExpr);
 end;
 
-procedure TTestProcedureFunction.TestFunctionCdeclExternal;
+Procedure TTestProcedureFunction.TestFunctionCdeclExternal;
 begin
   AddDeclaration('function A : Integer; cdecl; external');
   ParseFunction;
@@ -1055,14 +1085,14 @@ begin
   AssertNull('No Library name expression',Func.LibraryExpr);
 end;
 
-procedure TTestProcedureFunction.TestProcedureCdeclExternalLibName;
+Procedure TTestProcedureFunction.TestProcedureCdeclExternalLibName;
 begin
   ParseProcedure('; cdecl; external ''libname''','');
   AssertProc([pmExternal],ccCdecl,0);
   AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
 end;
 
-procedure TTestProcedureFunction.TestFunctionCdeclExternalLibName;
+Procedure TTestProcedureFunction.TestFunctionCdeclExternalLibName;
 begin
   AddDeclaration('function A : Integer; cdecl; external ''libname''');
   ParseFunction;
@@ -1070,7 +1100,7 @@ begin
   AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
 end;
 
-procedure TTestProcedureFunction.TestProcedureCdeclExternalLibNameName;
+Procedure TTestProcedureFunction.TestProcedureCdeclExternalLibNameName;
 begin
   ParseProcedure('; cdecl; external ''libname'' name ''symbolname''','');
   AssertProc([pmExternal],ccCdecl,0);
@@ -1078,7 +1108,7 @@ begin
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-procedure TTestProcedureFunction.TestFunctionCdeclExternalLibNameName;
+Procedure TTestProcedureFunction.TestFunctionCdeclExternalLibNameName;
 begin
   AddDeclaration('function A : Integer; cdecl; external ''libname'' name ''symbolname''');
   ParseFunction;
@@ -1087,7 +1117,7 @@ begin
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-procedure TTestProcedureFunction.TestProcedureCdeclExternalName;
+Procedure TTestProcedureFunction.TestProcedureCdeclExternalName;
 begin
   ParseProcedure('; cdecl; external name ''symbolname''','');
   AssertProc([pmExternal],ccCdecl,0);
@@ -1095,7 +1125,7 @@ begin
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
-procedure TTestProcedureFunction.TestFunctionCdeclExternalName;
+Procedure TTestProcedureFunction.TestFunctionCdeclExternalName;
 begin
   AddDeclaration('function A : Integer; cdecl; external name ''symbolname''');
   ParseFunction;
@@ -1114,6 +1144,11 @@ begin
    Inherited;
 end;
 
+Procedure TTestProcedureFunction.AssertComment;
+begin
+  AssertEquals('Correct comment',' A comment'+sLineBreak,FProc.DocComment);
+end;
+
 initialization
 
   RegisterTest(TTestProcedureFunction);

+ 67 - 2
packages/fcl-passrc/tests/tcstatements.pas

@@ -31,12 +31,15 @@ Type
     Procedure TestEmptyStatement;
     Procedure TestEmptyStatements;
     Procedure TestBlock;
+    Procedure TestBlockComment;
+    Procedure TestBlock2Comments;
     Procedure TestAssignment;
     Procedure TestAssignmentAdd;
     Procedure TestAssignmentMinus;
     Procedure TestAssignmentMul;
     Procedure TestAssignmentDivision;
     Procedure TestCall;
+    Procedure TestCallComment;
     Procedure TestCallQualified;
     Procedure TestCallQualified2;
     Procedure TestCallNoArgs;
@@ -89,6 +92,7 @@ Type
     Procedure TestTryExceptOn2;
     Procedure TestTryExceptOnElse;
     Procedure TestTryExceptOnIfElse;
+    Procedure TestAsm;
   end;
 
 implementation
@@ -135,7 +139,8 @@ begin
   Result:=TestStatement([ASource]);
 end;
 
-function TTestStatementParser.TestStatement(ASource: array of string): TPasImplElement;
+function TTestStatementParser.TestStatement(ASource: array of string
+  ): TPasImplElement;
 
 
 begin
@@ -152,7 +157,7 @@ begin
   Result:=FStatement;
 end;
 
-procedure TTestStatementParser.ExpectParserError(Const Msg : string);
+procedure TTestStatementParser.ExpectParserError(const Msg: string);
 begin
   AssertException(Msg,EParserError,@ParseModule);
 end;
@@ -207,6 +212,36 @@ begin
   AssertEquals('Empty block',0,B.Elements.Count);
 end;
 
+procedure TTestStatementParser.TestBlockComment;
+Var
+  B : TPasImplBeginBlock;
+
+begin
+  Engine.NeedComments:=True;
+  TestStatement(['{ This is a comment }','begin','end']);
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertNotNull('Statement assigned',PasProgram.InitializationSection.Elements[0]);
+  AssertEquals('Block statement',TPasImplBeginBlock,Statement.ClassType);
+  B:= Statement as TPasImplBeginBlock;
+  AssertEquals('Empty block',0,B.Elements.Count);
+  AssertEquals('No DocComment','',B.DocComment);
+end;
+
+procedure TTestStatementParser.TestBlock2Comments;
+Var
+  B : TPasImplBeginBlock;
+
+begin
+  Engine.NeedComments:=True;
+  TestStatement(['{ This is a comment }','// Another comment','begin','end']);
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertNotNull('Statement assigned',PasProgram.InitializationSection.Elements[0]);
+  AssertEquals('Block statement',TPasImplBeginBlock,Statement.ClassType);
+  B:= Statement as TPasImplBeginBlock;
+  AssertEquals('Empty block',0,B.Elements.Count);
+  AssertEquals('No DocComment','',B.DocComment);
+end;
+
 procedure TTestStatementParser.TestAssignment;
 
 Var
@@ -301,6 +336,21 @@ begin
   AssertExpression('Doit call',S.Expr,pekIdent,'Doit');
 end;
 
+procedure TTestStatementParser.TestCallComment;
+
+Var
+  S : TPasImplSimple;
+begin
+  Engine.NeedComments:=True;
+  TestStatement(['//comment line','Doit;']);
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  S:=Statement as TPasImplSimple;
+  AssertExpression('Doit call',S.Expr,pekIdent,'Doit');
+  AssertEquals('No DocComment','',S.DocComment);
+end;
+
 procedure TTestStatementParser.TestCallQualified;
 
 Var
@@ -1395,6 +1445,21 @@ begin
   AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomethingMore');
 end;
 
+procedure TTestStatementParser.TestAsm;
+
+Var
+  T : TPasImplAsmStatement;
+
+begin
+  TestStatement(['asm','  mov eax,1','end;']);
+  T:=AssertStatement('Asm statement',TPasImplAsmStatement) as TPasImplAsmStatement;
+  AssertEquals('Asm tokens',4,T.Tokens.Count);
+  AssertEquals('token 1 ','mov',T.Tokens[0]);
+  AssertEquals('token 2 ','eax',T.Tokens[1]);
+  AssertEquals('token 3 ',',',T.Tokens[2]);
+  AssertEquals('token 4 ','1',T.Tokens[3]);
+end;
+
 initialization
   RegisterTests([TTestStatementParser]);
 

File diff suppressed because it is too large
+ 220 - 137
packages/fcl-passrc/tests/tctypeparser.pas


+ 15 - 0
packages/fcl-passrc/tests/tcvarparser.pas

@@ -47,6 +47,7 @@ Type
     Procedure TestVarPublic;
     Procedure TestVarPublicName;
     Procedure TestVarDeprecatedExternalName;
+    Procedure TestVarHintPriorToInit;
   end;
 
 implementation
@@ -293,6 +294,20 @@ begin
   AssertEquals('Library name','''me''',TheVar.ExportName);
 end;
 
+procedure TTestVarParser.TestVarHintPriorToInit;
+
+Var
+  E : TBoolConstExpr;
+
+begin
+  ParseVar('boolean platform = false','');
+  CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'hplatform')));
+  AssertNotNull('Correctly initialized',Thevar.Expr);
+  AssertEquals('Correctly initialized',TBoolConstExpr,Thevar.Expr.ClassType);
+  E:=Thevar.Expr as TBoolConstExpr;
+  AssertEquals('Correct initialization value',False, E.Value);
+end;
+
 initialization
 
   RegisterTests([TTestVarParser]);

+ 4 - 17
packages/fcl-passrc/tests/testpassrc.lpi

@@ -30,23 +30,18 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestClassType.TestConstProtected"/>
-        <LaunchingApplication Use="True"/>
+        <CommandLineParams Value="--suite=TTestStatementParser.TestCallComment"/>
       </local>
     </RunParams>
-    <RequiredPackages Count="2">
+    <RequiredPackages Count="1">
       <Item1>
-        <PackageName Value="FPCUnitConsoleRunner"/>
-      </Item1>
-      <Item2>
         <PackageName Value="FCL"/>
-      </Item2>
+      </Item1>
     </RequiredPackages>
     <Units Count="12">
       <Unit0>
         <Filename Value="testpassrc.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="testpassrc"/>
       </Unit0>
       <Unit1>
         <Filename Value="tcscanner.pas"/>
@@ -71,17 +66,14 @@
       <Unit5>
         <Filename Value="tcmoduleparser.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcmoduleparser"/>
       </Unit5>
       <Unit6>
         <Filename Value="tconstparser.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tconstparser"/>
       </Unit6>
       <Unit7>
         <Filename Value="tcvarparser.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcvarparser"/>
       </Unit7>
       <Unit8>
         <Filename Value="tcclasstype.pas"/>
@@ -109,13 +101,8 @@
     <Version Value="11"/>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
     </SearchPaths>
-    <Other>
-      <CompilerMessages>
-        <UseMsgFile Value="True"/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

Some files were not shown because too many files changed in this diff