paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-09-13 14:09:13 +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 begin
// split into two // split into two
dec(u,$10000); dec(u,$10000);
ValueUTF16.S:=ValueUTF16.S+WideChar($D800+(u shr 10)); ValueUTF16.S:=ValueUTF16.S
ValueUTF16.S:=ValueUTF16.S+WideChar($DC00+(u and $3ff)); +WideChar($D800+(u shr 10))+WideChar($DC00+(u and $3ff));
end end
else else
ValueUTF16.S:=ValueUTF16.S+WideChar(u); ValueUTF16.S:=ValueUTF16.S+WideChar(u);
@ -4401,6 +4401,7 @@ begin
Result:=TResEvalUTF16.Create; Result:=TResEvalUTF16.Create;
{$endif} {$endif}
p:=1; p:=1;
//writeln('TResExprEvaluator.EvalPrimitiveExprString ',GetObjPath(Expr),' ',Expr.SourceFilename,' ',Expr.SourceLinenumber div 2048,' S=[',S,']');
while p<=l do while p<=l do
case S[p] of case S[p] of
{$ifdef UsePChar} {$ifdef UsePChar}

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

@ -10993,7 +10993,7 @@ begin
FoundEl:=GetSpecializedEl(NameExpr,FoundEl,TemplParams); FoundEl:=GetSpecializedEl(NameExpr,FoundEl,TemplParams);
if FoundEl is TPasProcedure then if FoundEl is TPasProcedure then
begin 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); CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
end; end;
end end
@ -11007,7 +11007,7 @@ begin
try try
CheckTemplParams(GenTemplates,InferenceParams); CheckTemplParams(GenTemplates,InferenceParams);
FoundEl:=GetSpecializedEl(NameExpr,FoundEl,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); CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
finally finally
ReleaseElementList(InferenceParams{$IFDEF CheckPasTreeRefCount},RefIdInferenceParamsExpr{$ENDIF}); ReleaseElementList(InferenceParams{$IFDEF CheckPasTreeRefCount},RefIdInferenceParamsExpr{$ENDIF});
@ -11034,13 +11034,12 @@ begin
else else
begin begin
// typecast to user type // typecast to user type
CheckTypeCast(TypeEl,Params,true); // emit warnings CheckTypeCast(TypeEl,Params,true); // emit warnings, and errors for specializations
end; end;
end; end;
// FoundEl compatible element -> create reference // FoundEl compatible element -> create reference
Ref:=CreateReference(FoundEl,NameExpr,rraRead); Ref:=CreateReference(FoundEl,NameExpr,rraRead);
if FindCallData.StartScope.ClassType=ScopeClass_WithExpr then if FindCallData.StartScope.ClassType=ScopeClass_WithExpr then
Ref.WithExprScope:=TPasWithExprScope(FindCallData.StartScope); Ref.WithExprScope:=TPasWithExprScope(FindCallData.StartScope);
FindData:=Default(TPRFindData); FindData:=Default(TPRFindData);
@ -27255,6 +27254,11 @@ begin
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' ToType=',GetTypeDescription(ToType)); writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' ToType=',GetTypeDescription(ToType));
{$ENDIF} {$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; StartFromType:=FromType;
StartToType:=ToType; StartToType:=ToType;
Result:=cIncompatible; Result:=cIncompatible;
@ -27284,10 +27288,11 @@ begin
break; // ToType has more dimensions break; // ToType has more dimensions
end; end;
// have same dimension -> check ElType // have same dimension -> check ElType
Include(FromElTypeRes.Flags,rrfReadable);
FromElTypeRes.IdentEl:=nil;
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
writeln('TPasResolver.CheckTypeCastArray check ElType From=',GetResolverResultDbg(FromElTypeRes),' To=',GetResolverResultDbg(ToElTypeRes)); writeln('TPasResolver.CheckTypeCastArray check ElType From=',GetResolverResultDbg(FromElTypeRes),' To=',GetResolverResultDbg(ToElTypeRes));
{$ENDIF} {$ENDIF}
Include(FromElTypeRes.Flags,rrfReadable);
Result:=CheckTypeCastRes(FromElTypeRes,ToElTypeRes,ErrorEl,false); Result:=CheckTypeCastRes(FromElTypeRes,ToElTypeRes,ErrorEl,false);
break; break;
end end

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

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