fcl-passrc: typecast to inlinespecialize

git-svn-id: trunk@42952 -

packages/fcl-passrc/src/pasresolver.pp

@@ -10008,6 +10008,7 @@ var
   Value: TPasExpr;
   SubParams: TParamsExpr;
   ResolvedEl: TPasResolverResult;
+  InlineSpecExpr: TInlineSpecializeExpr;
 begin
   Value:=Params.Value;
   if Value is TBinaryExpr then
@@ -10038,6 +10039,21 @@ begin
     begin
     ResolveFuncParamsExprName(Value,Params,Access);
     end
+  else if Value is TInlineSpecializeExpr then
+    begin
+    // specialize A<B>()  -> typecast
+    InlineSpecExpr:=TInlineSpecializeExpr(Value);
+    ResolveInlineSpecializeExpr(InlineSpecExpr);
+    if length(Params.Params)<1 then
+      RaiseMsg(20190908180612,nWrongNumberOfParametersForTypeCast,
+        sWrongNumberOfParametersForTypeCast,
+        [GetTypeDescription(InlineSpecExpr.DestType)],Params)
+     else if length(Params.Params)>1 then
+      RaiseMsg(20190908180837,nWrongNumberOfParametersForTypeCast,
+        sWrongNumberOfParametersForTypeCast,
+        [GetTypeDescription(InlineSpecExpr.DestType)],Params.Params[1]);
+    FinishCallArgAccess(Params.Params[0],Access);
+    end
   else if Value.ClassType=TParamsExpr then
     begin
     SubParams:=TParamsExpr(Value);
@@ -10690,6 +10706,7 @@ var
   SpecType: TPasSpecializeType;
   Expr: TPasExpr;
   GenType: TPasGenericType;
+  DeclType: TPasType;
 begin
   SpecType:=El.DestType;
   if SpecType.DestType<>nil then
@@ -10716,6 +10733,14 @@ begin
   GenType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasAliasType.DestType'){$ENDIF};
 
   FinishSpecializeType(SpecType);
+
+  if SpecType.CustomData is TPasSpecializeTypeData then
+    begin
+    DeclType:=TPasSpecializeTypeData(SpecType.CustomData).SpecializedType;
+    CreateReference(DeclType,El,rraRead);
+    end
+  else
+    CreateReference(GenType,El,rraRead);
 end;
 
 function TPasResolver.ResolveAccessor(Expr: TPasExpr): TPasElement;
@@ -12402,15 +12427,21 @@ begin
           RaiseXExpectedButYFound(20170322105252,'class type',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
         end
       else if LeftResolved.LoTypeEl=nil then
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.ComputeBinaryExprRes is-operator: left=',GetResolverResultDbg(LeftResolved),' right=',GetResolverResultDbg(RightResolved));
+        {$ENDIF}
         RaiseMsg(20170216152232,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
-                 [BaseTypeNames[LeftResolved.BaseType]],Bin.left)
+                 [BaseTypeNames[LeftResolved.BaseType]],Bin.left);
+        end
       else
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.ComputeBinaryExprRes is-operator: left=',GetResolverResultDbg(LeftResolved),' right=',GetResolverResultDbg(RightResolved));
+        {$ENDIF}
         RaiseMsg(20170216152234,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
                  [GetElementTypeName(LeftResolved.LoTypeEl)],Bin.left);
-      {$IFDEF VerbosePasResolver}
-      writeln('TPasResolver.ComputeBinaryExprRes is-operator: left=',GetResolverResultDbg(LeftResolved),' right=',GetResolverResultDbg(RightResolved));
-      {$ENDIF}
-      RaiseIncompatibleTypeRes(20170216152236,nTypesAreNotRelatedXY,[],LeftResolved,RightResolved,Bin);
+        end;
       end;
     eopAs:
       begin

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -41,6 +41,7 @@ type
     procedure TestGen_ConstraintMultiParamClassMismatch;
     procedure TestGen_ConstraintClassType_DotIsAsTypeCast;
     procedure TestGen_ConstraintClassType_ForInT;
+    procedure TestGen_ConstraintClassType_IsAs;
 
     // generic record
     procedure TestGen_RecordLocalNameDuplicateFail;
@@ -533,6 +534,28 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_ConstraintClassType_IsAs;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TAnt<U> = class',
+  '    v: U;',
+  '    function Run: U;',
+  '  end;',
+  'function TAnt.Run: U;',
+  'begin',
+  '  if v is TObject then ;',
+  '  if v is specialize TAnt<TObject> then',
+  '    specialize TAnt<TObject>(v).v:=nil;',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_RecordLocalNameDuplicateFail;
 begin
   StartProgram(false);