diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp
index ed7c908175..019dc76c77 100644
--- a/packages/fcl-passrc/src/pparser.pp
+++ b/packages/fcl-passrc/src/pparser.pp
@@ -63,7 +63,7 @@ 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);
@@ -150,7 +150,7 @@ type
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);
@@ -3587,7 +3587,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,16 +3612,31 @@ 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;
begin
+ v:=visPublic;
while CurToken<>AEndToken do
begin
Case CurToken of
+ 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;
@@ -3669,7 +3684,7 @@ begin
try
Result.PackMode:=PackMode;
NextToken;
- ParseRecordFieldList(Result,tkEnd);
+ ParseRecordFieldList(Result,tkEnd,true);
except
FreeAndNil(Result);
Raise;
diff --git a/packages/fcl-passrc/tests/tctypeparser.pas b/packages/fcl-passrc/tests/tctypeparser.pas
index 4cbeddfe03..e4ed8bbc9c 100644
--- a/packages/fcl-passrc/tests/tctypeparser.pas
+++ b/packages/fcl-passrc/tests/tctypeparser.pas
@@ -160,12 +160,14 @@ type
procedure AssertVariantSelector(AName, AType: string);
procedure AssertField1(Hints: TPasMemberHints);
procedure AssertField2(Hints: TPasMemberHints);
+ procedure AssertMethod2(Hints: TPasMemberHints);
procedure AssertVariant1(Hints: TPasMemberHints);
procedure AssertVariant1(Hints: TPasMemberHints; VariantLabels : Array of string);
procedure AssertVariant2(Hints: TPasMemberHints);
procedure AssertVariant2(Hints: TPasMemberHints; VariantLabels : Array of string);
procedure AssertOneIntegerField(Hints: TPasMemberHints);
procedure AssertTwoIntegerFields(Hints1, Hints2: TPasMemberHints);
+ procedure AssertIntegerFieldAndMethod(Hints1, Hints2: TPasMemberHints);
procedure AssertRecordField(AIndex: Integer;Hints: TPasMemberHints);
procedure AssertRecordVariant(AIndex: Integer;Hints: TPasMemberHints; VariantLabels : Array of string);
Procedure AssertRecordVariantVariant(AIndex: Integer;Const AFieldName,ATypeName: string;Hints: TPasMemberHints; VariantLabels : Array of string);
@@ -228,6 +230,8 @@ type
Procedure TestTwoDeprecatedFieldsCombined;
Procedure TestTwoDeprecatedFieldsCombinedDeprecated;
Procedure TestTwoDeprecatedFieldsCombinedPlatform;
+ Procedure TestFieldAndMethod;
+ Procedure TestFieldAnd2Methods;
Procedure TestNested;
Procedure TestNestedDeprecated;
Procedure TestNestedPlatform;
@@ -1434,6 +1438,18 @@ begin
AssertTrue('Field 2 hints match',Field2.Hints=Hints)
end;
+procedure TTestRecordTypeParser.AssertMethod2(Hints: TPasMemberHints);
+
+Var
+ P : TPasProcedure;
+
+begin
+ AssertEquals('Member 2 type',TPasProcedure,TObject(TheRecord.Members[1]).ClassType);
+ P:=TPasProcedure(TheRecord.Members[1]);
+ AssertEquals('Method name','dosomething2',P.Name);
+ AssertTrue('Method hints match',P.Hints=Hints)
+end;
+
procedure TTestRecordTypeParser.AssertOneIntegerField(Hints : TPasMemberHints);
begin
@@ -1449,6 +1465,14 @@ begin
AssertField2(Hints2);
end;
+procedure TTestRecordTypeParser.AssertIntegerFieldAndMethod(Hints1,
+ Hints2: TPasMemberHints);
+begin
+ AssertEquals('Two members',2,TheRecord.Members.Count);
+ AssertField1(Hints1);
+ AssertMethod2(Hints2);
+end;
+
procedure TTestRecordTypeParser.AssertRecordField(AIndex: Integer;
Hints: TPasMemberHints);
@@ -1771,6 +1795,29 @@ begin
AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
end;
+procedure TTestRecordTypeParser.TestFieldAndMethod;
+begin
+ TestFields(['x : integer;','procedure dosomething2;'],'',False);
+ AssertIntegerFieldAndMethod([],[]);
+end;
+
+procedure TTestRecordTypeParser.TestFieldAnd2Methods;
+Var
+ P : TPasFunction;
+
+begin
+ TestFields(['x : integer;','procedure dosomething2;','function dosomething3 : Integer;'],'',False);
+ AssertEquals('Member count',3,TheRecord.Members.Count);
+ AssertField1([]);
+ AssertMethod2([]);
+ AssertEquals('Member 3 type',TPasFunction,TObject(TheRecord.Members[2]).ClassType);
+ P:=TPasFunction(TheRecord.Members[2]);
+ AssertEquals('Method 2 name','dosomething3',P.Name);
+ AssertTrue('Method 2 hints match',[]=P.Hints);
+ // Standard type
+ AssertEquals('Method 2 result type','Integer', P.FuncType.ResultEl.ResultType.Name);
+end;
+
procedure TTestRecordTypeParser.TestNested;
begin
TestFields(['x : integer;','y : record',' z : integer;','end'],'',False);
diff --git a/packages/fcl-passrc/tests/testpassrc.lpi b/packages/fcl-passrc/tests/testpassrc.lpi
index 5ecd63b6ce..3686d7cc87 100644
--- a/packages/fcl-passrc/tests/testpassrc.lpi
+++ b/packages/fcl-passrc/tests/testpassrc.lpi
@@ -34,13 +34,10 @@
-
+
-
-
-
-
+
@@ -109,6 +106,7 @@
+