paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-30 14:01:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: allow anonymous records only for var, const and variants

Browse Source
This commit is contained in:
mattias 2022-03-21 23:01:31 +01:00
parent de98803751
commit 3317078ae1
2 changed files with 173 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
packages/fcl-passrc/src/pasresolver.pp
View File

@ -12254,10 +12254,23 @@ end;
procedure TPasResolver.AddRecordType(El: TPasRecordType; TypeParams: TFPList); procedure TPasResolver.AddRecordType(El: TPasRecordType; TypeParams: TFPList);
var var
Scope: TPasRecordScope; Scope: TPasRecordScope;
C: TClass;
begin begin
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
writeln('TPasResolver.AddRecordType ',GetObjName(El),' Parent=',GetObjName(El.Parent)); writeln('TPasResolver.AddRecordType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
{$ENDIF} {$ENDIF}
if (El.Name='') then
begin
// anonymous record
C:=El.Parent.ClassType;
if (C=TPasVariable)
or (C=TPasConst)
or (C=TPasVariant) then
// ok
else
RaiseMsg(20220321224331,nCannotNestAnonymousX,sCannotNestAnonymousX,['record'],El);
end;
if TypeParams<>nil then if TypeParams<>nil then
begin begin
El.SetGenericTemplates(TypeParams); El.SetGenericTemplates(TypeParams);

160
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -538,6 +538,17 @@ type
Procedure TestAdvRecord_InFunctionFail; Procedure TestAdvRecord_InFunctionFail;
Procedure TestAdvRecord_SubClass; Procedure TestAdvRecord_SubClass;
// anonymous record
Procedure TestRecordAnonym_ResultTypeFail;
Procedure TestRecordAnonym_ArgumentFail;
Procedure TestRecordAnonym_Advanced_ConstFail;
Procedure TestRecordAnonym_Advanced_MethodFail;
Procedure TestRecordAnonym_Advanced_TypeFail;
Procedure TestRecordAnonym_Advanced_PropertyFail;
Procedure TestRecordAnonym_Var;
Procedure TestRecordAnonym_Nested;
Procedure TestRecordAnonym_Advanced_Visibility;
// class // class
Procedure TestClass; Procedure TestClass;
Procedure TestClassDefaultInheritance; Procedure TestClassDefaultInheritance;
@ -891,6 +902,7 @@ type
Procedure TestProcType_PassProcToUntyped; Procedure TestProcType_PassProcToUntyped;
// anonymous procedure type // anonymous procedure type
Procedure TestProcTypeAnonymous_Var;
Procedure TestProcTypeAnonymous_FunctionFunctionFail; Procedure TestProcTypeAnonymous_FunctionFunctionFail;
Procedure TestProcTypeAnonymous_ResultTypeFail; Procedure TestProcTypeAnonymous_ResultTypeFail;
Procedure TestProcTypeAnonymous_ArgumentFail; Procedure TestProcTypeAnonymous_ArgumentFail;
@ -9125,6 +9137,144 @@ begin
ParseProgram; ParseProgram;
end; end;
procedure TTestResolver.TestRecordAnonym_ResultTypeFail;
begin
StartProgram(false);
Add([
'function Fly: record',
' x: word;',
' end;',
'begin',
'end;',
'begin',
'']);
CheckResolverException('Cannot nest anonymous record',nCannotNestAnonymousX);
end;
procedure TTestResolver.TestRecordAnonym_ArgumentFail;
begin
StartProgram(false);
Add([
'procedure Fly(const r: record',
' x: word;',
' end);',
'begin',
'end;',
'begin',
'']);
CheckResolverException('Cannot nest anonymous record',nCannotNestAnonymousX);
end;
procedure TTestResolver.TestRecordAnonym_Advanced_ConstFail;
begin
StartProgram(false);
Add([
'{$modeswitch AdvancedRecords}',
'var',
' r: record',
' const c = 3;',
' var x: word;',
' end;',
'begin',
'']);
CheckParserException(SErrRecordConstantsNotAllowed,nErrRecordConstantsNotAllowed);
end;
procedure TTestResolver.TestRecordAnonym_Advanced_MethodFail;
begin
StartProgram(false);
Add([
'{$modeswitch AdvancedRecords}',
'var',
' r: record',
' procedure Fly;',
' end;',
'begin',
'']);
CheckParserException(SErrRecordMethodsNotAllowed,nErrRecordMethodsNotAllowed);
end;
procedure TTestResolver.TestRecordAnonym_Advanced_TypeFail;
begin
StartProgram(false);
Add([
'{$modeswitch AdvancedRecords}',
'var',
' r: record',
' type TFlag = word;',
' end;',
'begin',
'']);
CheckParserException(SErrRecordTypesNotAllowed,nErrRecordTypesNotAllowed);
end;
procedure TTestResolver.TestRecordAnonym_Advanced_PropertyFail;
begin
StartProgram(false);
Add([
'{$modeswitch AdvancedRecords}',
'var',
' r: record',
' FSize: word;',
' property Size: word read FSize;',
' end;',
'begin',
'']);
CheckParserException(SErrRecordPropertiesNotAllowed,nErrRecordPropertiesNotAllowed);
end;
procedure TTestResolver.TestRecordAnonym_Var;
begin
StartProgram(false);
Add([
'var',
' r: record',
' x: word;',
' end;',
'begin',
' r.x:=3;',
' r.x:=r.x + 4;',
'']);
ParseProgram;
end;
procedure TTestResolver.TestRecordAnonym_Nested;
begin
StartProgram(false);
Add([
'var',
' r: record',
' p: record',
' x: word;',
' end;',
' end;',
'begin',
' r.p.x:=3;',
' r.p.x:=r.p.x + 4;',
'']);
ParseProgram;
end;
procedure TTestResolver.TestRecordAnonym_Advanced_Visibility;
begin
StartProgram(false);
Add([
'{$modeswitch AdvancedRecords}',
'var',
' r: record',
' private',
' Size: word;',
' public',
' Color: word;',
' end;',
'begin',
' r.Size:=3;',
' r.Size:=r.Size+4;',
' r.Color:=r.Color+5;',
'']);
ParseProgram;
end;
procedure TTestResolver.TestClass; procedure TTestResolver.TestClass;
begin begin
StartProgram(false); StartProgram(false);
@ -16527,6 +16677,16 @@ begin
end; end;
end; end;
procedure TTestResolver.TestProcTypeAnonymous_Var;
begin
StartProgram(false);
Add([
'var',
' f: function: word;',
'begin']);
ParseProgram;
end;
procedure TTestResolver.TestProcTypeAnonymous_FunctionFunctionFail; procedure TTestResolver.TestProcTypeAnonymous_FunctionFunctionFail;
begin begin
StartProgram(false); StartProgram(false);