mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 01:09:31 +02:00
fcl-passrc: fixed resolving with-do x, where x is in helper and class
git-svn-id: trunk@44431 -
This commit is contained in:
Mattias Gaertner
parent
20749e1ee2
commit
b8bcccc1f1
@ -4864,8 +4864,6 @@ begin
|
||||
begin
|
||||
// this proc was already found. This happens when this is the forward
|
||||
// declaration or a previously found implementation.
|
||||
Data^.ElScope:=ElScope;
|
||||
Data^.StartScope:=StartScope;
|
||||
exit;
|
||||
end;
|
||||
|
||||
@ -10774,6 +10772,7 @@ begin
|
||||
|
||||
// FoundEl compatible element -> create reference
|
||||
Ref:=CreateReference(FoundEl,NameExpr,rraRead);
|
||||
|
||||
if FindCallData.StartScope.ClassType=ScopeClass_WithExpr then
|
||||
Ref.WithExprScope:=TPasWithExprScope(FindCallData.StartScope);
|
||||
FindData:=Default(TPRFindData);
|
||||
@ -21572,6 +21571,7 @@ begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.CreateReference RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
|
||||
{$ENDIF}
|
||||
|
||||
Result:=TResolvedReference.Create;
|
||||
if FindData<>nil then
|
||||
begin
|
||||
|
||||
@ -475,7 +475,7 @@ type
|
||||
Procedure TestAnonymousProc_Typecast_ObjFPC;
|
||||
Procedure TestAnonymousProc_Typecast_Delphi;
|
||||
Procedure TestAnonymousProc_TypecastToResultFail;
|
||||
Procedure TestAnonymousProc_With;
|
||||
Procedure TestAnonymousProc_WithDo;
|
||||
Procedure TestAnonymousProc_ExceptOn;
|
||||
Procedure TestAnonymousProc_Nested;
|
||||
Procedure TestAnonymousProc_ForLoop;
|
||||
@ -485,9 +485,9 @@ type
|
||||
Procedure TestRecordVariant;
|
||||
Procedure TestRecordVariantNested;
|
||||
Procedure TestRecord_WriteConstParamFail;
|
||||
Procedure TestRecord_WriteConstParam_WithFail;
|
||||
Procedure TestRecord_WriteConstParam_WithDoFail;
|
||||
Procedure TestRecord_WriteNestedConstParamFail;
|
||||
Procedure TestRecord_WriteNestedConstParamWithFail;
|
||||
Procedure TestRecord_WriteNestedConstParamWithDoFail;
|
||||
Procedure TestRecord_TypeCast;
|
||||
Procedure TestRecord_NewDispose;
|
||||
Procedure TestRecord_Const;
|
||||
@ -612,7 +612,7 @@ type
|
||||
Procedure TestClass_ConDestructor_CallInherited;
|
||||
Procedure TestClass_Constructor_Inherited;
|
||||
Procedure TestClass_SubObject;
|
||||
Procedure TestClass_WithClassInstance;
|
||||
Procedure TestClass_WithDoClassInstance;
|
||||
Procedure TestClass_ProcedureExternal;
|
||||
Procedure TestClass_ReintroducePublicVarFail;
|
||||
Procedure TestClass_ReintroducePrivateVar;
|
||||
@ -765,11 +765,11 @@ type
|
||||
Procedure TestClassInterface_PassTypecastIntfToClassAsVarParamFail;
|
||||
Procedure TestClassInterface_GUID;
|
||||
|
||||
// with
|
||||
Procedure TestWithBlock1;
|
||||
Procedure TestWithBlock2;
|
||||
Procedure TestWithBlockFuncResult;
|
||||
Procedure TestWithBlockConstructor;
|
||||
// with-do
|
||||
Procedure TestWithDo1;
|
||||
Procedure TestWithDo2;
|
||||
Procedure TestWithDoFuncResult;
|
||||
Procedure TestWithDoConstructor;
|
||||
|
||||
// arrays
|
||||
Procedure TestDynArrayOfLongint;
|
||||
@ -925,8 +925,9 @@ type
|
||||
Procedure TestClassHelper_NestedInheritedParentFail;
|
||||
Procedure TestClassHelper_AccessFields;
|
||||
Procedure TestClassHelper_HelperDotClassMethodFail;
|
||||
Procedure TestClassHelper_WithHelperFail;
|
||||
Procedure TestClassHelper_WithDoHelperFail;
|
||||
Procedure TestClassHelper_AsTypeFail;
|
||||
Procedure TestClassHelper_WithDo;
|
||||
Procedure TestClassHelper_ClassMethod;
|
||||
Procedure TestClassHelper_Enumerator;
|
||||
Procedure TestClassHelper_FromUnitInterface;
|
||||
@ -7866,7 +7867,7 @@ begin
|
||||
nIllegalTypeConversionTo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAnonymousProc_With;
|
||||
procedure TTestResolver.TestAnonymousProc_WithDo;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
@ -8052,7 +8053,7 @@ begin
|
||||
CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestRecord_WriteConstParam_WithFail;
|
||||
procedure TTestResolver.TestRecord_WriteConstParam_WithDoFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
@ -8085,7 +8086,7 @@ begin
|
||||
CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestRecord_WriteNestedConstParamWithFail;
|
||||
procedure TTestResolver.TestRecord_WriteNestedConstParamWithDoFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
@ -10927,7 +10928,7 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_WithClassInstance;
|
||||
procedure TTestResolver.TestClass_WithDoClassInstance;
|
||||
var
|
||||
aMarker: PSrcMarker;
|
||||
Elements: TFPList;
|
||||
@ -13930,7 +13931,7 @@ begin
|
||||
CheckResolverException('not readable',nNotReadable);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestWithBlock1;
|
||||
procedure TTestResolver.TestWithDo1;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
@ -13947,7 +13948,7 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestWithBlock2;
|
||||
procedure TTestResolver.TestWithDo2;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
@ -13975,7 +13976,7 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestWithBlockFuncResult;
|
||||
procedure TTestResolver.TestWithDoFuncResult;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
@ -14003,7 +14004,7 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestWithBlockConstructor;
|
||||
procedure TTestResolver.TestWithDoConstructor;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
@ -14306,7 +14307,8 @@ begin
|
||||
Add('begin');
|
||||
Add(' doit({#a}getarr[1+1]);');
|
||||
Add(' doit({#b}getarr()[2+1]);');
|
||||
Add(' doit({#b}getarr(7)[3+1]);');
|
||||
Add(' doit({#c}getarr(7)[3+1]);');
|
||||
ParseProgram;
|
||||
aMarker:=FirstSrcMarker;
|
||||
while aMarker<>nil do
|
||||
begin
|
||||
@ -17210,7 +17212,7 @@ begin
|
||||
CheckResolverException(sHelpersCannotBeUsedAsTypes,nHelpersCannotBeUsedAsTypes);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClassHelper_WithHelperFail;
|
||||
procedure TTestResolver.TestClassHelper_WithDoHelperFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
@ -17238,6 +17240,92 @@ begin
|
||||
CheckResolverException(sHelpersCannotBeUsedAsTypes,nHelpersCannotBeUsedAsTypes);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClassHelper_WithDo;
|
||||
var
|
||||
aMarker: PSrcMarker;
|
||||
Elements: TFPList;
|
||||
ActualWith, ExpectedWith: Boolean;
|
||||
i: Integer;
|
||||
El: TPasElement;
|
||||
Ref: TResolvedReference;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' TBird = class',
|
||||
' procedure Run;',
|
||||
' end;',
|
||||
' THelper = class helper for TBird',
|
||||
' procedure Foo(w: word = 1);',
|
||||
' end;',
|
||||
'procedure TBird.Run;',
|
||||
'var b: TBird;',
|
||||
'begin',
|
||||
' b.{#a1_not}Foo;',
|
||||
' b.{#b1_not}Foo();',
|
||||
' b.{#c1_not}Foo(2);',
|
||||
' with b do begin',
|
||||
' {#d1_with}Foo;',
|
||||
' {#e1_with}Foo();',
|
||||
' {#f1_with}Foo(3);',
|
||||
' end;',
|
||||
'end;',
|
||||
'procedure THelper.Foo(w: word);',
|
||||
'var b: TBird;',
|
||||
'begin',
|
||||
' b.{#a2_not}Foo;',
|
||||
' b.{#b2_not}Foo();',
|
||||
' b.{#c2_not}Foo(2);',
|
||||
' with b do begin',
|
||||
' {#d2_with}Foo;',
|
||||
' {#e2_with}Foo();',
|
||||
' {#f2_with}Foo(3);',
|
||||
' end;',
|
||||
'end;',
|
||||
'var b: TBird;',
|
||||
'begin',
|
||||
' b.{#a3_not}Foo;',
|
||||
' b.{#b3_not}Foo();',
|
||||
' b.{#c3_not}Foo(4);',
|
||||
' with b do begin',
|
||||
' {#d3_with}Foo;',
|
||||
' {#e3_with}Foo();',
|
||||
' {#f3_with}Foo(5);',
|
||||
' end;',
|
||||
'']);
|
||||
ParseProgram;
|
||||
|
||||
aMarker:=FirstSrcMarker;
|
||||
while aMarker<>nil do
|
||||
begin
|
||||
//writeln('TTestResolver.TestClassHelper_WithDo ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
|
||||
Elements:=FindElementsAt(aMarker);
|
||||
try
|
||||
ActualWith:=false;
|
||||
for i:=0 to Elements.Count-1 do
|
||||
begin
|
||||
El:=TPasElement(Elements[i]);
|
||||
writeln('TTestResolver.TestClassHelper_WithDo ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
|
||||
if not (El.CustomData is TResolvedReference) then continue;
|
||||
Ref:=TResolvedReference(El.CustomData);
|
||||
if Ref.WithExprScope<>nil then
|
||||
ActualWith:=true;
|
||||
break;
|
||||
end;
|
||||
ExpectedWith:=RightStr(aMarker^.Identifier,5)='_with';
|
||||
if ActualWith<>ExpectedWith then
|
||||
if ExpectedWith then
|
||||
RaiseErrorAtSrcMarker('expected Ref.WithExprScope<>nil at "#'+aMarker^.Identifier+'"',aMarker)
|
||||
else
|
||||
RaiseErrorAtSrcMarker('expected Ref.WithExprScope=nil at "#'+aMarker^.Identifier+'"',aMarker);
|
||||
finally
|
||||
Elements.Free;
|
||||
end;
|
||||
aMarker:=aMarker^.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClassHelper_ClassMethod;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user