paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-06 02:27:48 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed typecast specialized array to specialized type

Browse Source
This commit is contained in:
mattias 2020-12-28 16:51:25 +00:00
parent 19213ac89b
commit dc85b9283f
3 changed files with 17 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
compiler/packages/fcl-passrc/src/pasresolveeval.pas
View File

@ -4337,8 +4337,8 @@ var
begin
// split into two
dec(u,$10000);
ValueUTF16.S:=ValueUTF16.S+WideChar($D800+(u shr 10));
ValueUTF16.S:=ValueUTF16.S+WideChar($DC00+(u and $3ff));
ValueUTF16.S:=ValueUTF16.S
+WideChar($D800+(u shr 10))+WideChar($DC00+(u and $3ff));
end
else
ValueUTF16.S:=ValueUTF16.S+WideChar(u);
@ -4401,6 +4401,7 @@ begin
Result:=TResEvalUTF16.Create;
{$endif}
p:=1;
//writeln('TResExprEvaluator.EvalPrimitiveExprString ',GetObjPath(Expr),' ',Expr.SourceFilename,' ',Expr.SourceLinenumber div 2048,' S=[',S,']');
while p<=l do
case S[p] of
{$ifdef UsePChar}

15
compiler/packages/fcl-passrc/src/pasresolver.pp
View File

@ -10993,7 +10993,7 @@ begin
FoundEl:=GetSpecializedEl(NameExpr,FoundEl,TemplParams);
if FoundEl is TPasProcedure then
begin
// check if params fit the implicit specialized function
// check if params fit the explicit specialized function, e.g. Run<Word>()
CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
end;
end
@ -11007,7 +11007,7 @@ begin
try
CheckTemplParams(GenTemplates,InferenceParams);
FoundEl:=GetSpecializedEl(NameExpr,FoundEl,InferenceParams);
// check if params fit the implicit specialized function
// check if params fit the implicit specialized function, e.g. Run()
CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
finally
ReleaseElementList(InferenceParams{$IFDEF CheckPasTreeRefCount},RefIdInferenceParamsExpr{$ENDIF});
@ -11034,13 +11034,12 @@ begin
else
begin
// typecast to user type
CheckTypeCast(TypeEl,Params,true); // emit warnings
CheckTypeCast(TypeEl,Params,true); // emit warnings, and errors for specializations
end;
end;
// 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);
@ -27255,6 +27254,11 @@ begin
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' ToType=',GetTypeDescription(ToType));
{$ENDIF}
if not RaiseOnError then
begin
if (ToType.GenericTemplateTypes<>nil) and (ToType.GenericTemplateTypes.Count>0) then
exit(cCompatible); // is later checked when specialized
end;
StartFromType:=FromType;
StartToType:=ToType;
Result:=cIncompatible;
@ -27284,10 +27288,11 @@ begin
break; // ToType has more dimensions
end;
// have same dimension -> check ElType
Include(FromElTypeRes.Flags,rrfReadable);
FromElTypeRes.IdentEl:=nil;
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.CheckTypeCastArray check ElType From=',GetResolverResultDbg(FromElTypeRes),' To=',GetResolverResultDbg(ToElTypeRes));
{$ENDIF}
Include(FromElTypeRes.Flags,rrfReadable);
Result:=CheckTypeCastRes(FromElTypeRes,ToElTypeRes,ErrorEl,false);
break;
end

4
compiler/packages/fcl-passrc/tests/tcresolvegenerics.pas
View File

@ -2991,6 +2991,7 @@ begin
'interface',
'type',
' TObject = class end;',
' TAnt = class end;',
' TArray<T> = array of T;',
' TBird = class',
' F: TArray<TObject>;',
@ -3002,6 +3003,9 @@ begin
' a:=TArray<S>(a);',
' F:=TArray<TObject>(a);',
'end;',
'var B: TBird;',
'initialization',
' B.Run<TAnt>(nil);',
'']);
ParseUnit;
end;