mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-03 07:27:22 +01:00
* Support for functions in records
git-svn-id: trunk@29553 -
This commit is contained in:
michael
parent
817555cd6e
commit
a842569bf1
@ -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;
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -34,13 +34,10 @@
|
||||
<LaunchingApplication Use="True"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="FPCUnitConsoleRunner"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item2>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="12">
|
||||
<Unit0>
|
||||
@ -109,6 +106,7 @@
|
||||
<Version Value="11"/>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="../src"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user