Browse Source

fcl-passrc: fixed typecast specialized array to specialized type

git-svn-id: trunk@47870 -
Mattias Gaertner 4 years ago
parent
commit
1cc31e73da

+ 3 - 2
packages/fcl-passrc/src/pasresolveeval.pas

@@ -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}

+ 10 - 5
packages/fcl-passrc/src/pasresolver.pp

@@ -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 - 0
packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -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;