Browse Source

fcl-passrc: v as specialize

git-svn-id: trunk@42953 -
Mattias Gaertner 6 years ago
parent
commit
a52153d424

+ 36 - 0
packages/fcl-passrc/src/pasresolver.pp

@@ -12039,6 +12039,20 @@ begin
   if IsGenericTemplType(LeftResolved) or IsGenericTemplType(RightResolved) then
   if IsGenericTemplType(LeftResolved) or IsGenericTemplType(RightResolved) then
     begin
     begin
     // cannot yet be decided
     // cannot yet be decided
+    case Bin.OpCode of
+    eopEqual, eopNotEqual,
+    eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual,
+    eopIn,eopIs:
+      begin
+      SetBaseType(btBoolean);
+      exit;
+      end;
+    eopAs:
+      begin
+      SetRightValueExpr([rrfReadable]);
+      exit;
+      end;
+    end;
     ResolvedEl:=LeftResolved;
     ResolvedEl:=LeftResolved;
     ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
     ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
     exit;
     exit;
@@ -12491,6 +12505,28 @@ begin
             end;
             end;
           end;
           end;
         RaiseIncompatibleTypeRes(20180324190713,nTypesAreNotRelatedXY,[],LeftResolved,RightResolved,Bin);
         RaiseIncompatibleTypeRes(20180324190713,nTypesAreNotRelatedXY,[],LeftResolved,RightResolved,Bin);
+        end
+      else if LeftTypeEl.ClassType=TPasGenericTemplateType then
+        begin
+        // genericvar as ...
+        if (LeftResolved.IdentEl is TPasType)
+            or (not (rrfReadable in LeftResolved.Flags)) then
+          RaiseIncompatibleTypeRes(20190908191127,nOperatorIsNotOverloadedAOpB,
+            [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
+        if RightResolved.IdentEl=nil then
+          RaiseXExpectedButYFound(20190908191202,'class',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
+        if not (RightResolved.IdentEl is TPasType) then
+          RaiseXExpectedButYFound(20190908191204,'class',RightResolved.IdentEl.Name,Bin.right);
+        if not (RightResolved.BaseType=btContext) then
+          RaiseXExpectedButYFound(20190908191206,'class',RightResolved.IdentEl.Name,Bin.right);
+        RightTypeEl:=RightResolved.LoTypeEl;
+        if RightTypeEl is TPasClassType then
+          begin
+          // e.g. genericvar as classtype
+          SetRightValueExpr([rrfReadable]);
+          exit;
+          end;
+        RaiseIncompatibleTypeRes(20190908192345,nTypesAreNotRelatedXY,[],LeftResolved,RightResolved,Bin);
         end;
         end;
       end;
       end;
     eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual:
     eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual:

+ 3 - 0
packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -546,10 +546,13 @@ begin
   '    function Run: U;',
   '    function Run: U;',
   '  end;',
   '  end;',
   'function TAnt.Run: U;',
   'function TAnt.Run: U;',
+  'var a: specialize TAnt<U>;',
   'begin',
   'begin',
   '  if v is TObject then ;',
   '  if v is TObject then ;',
   '  if v is specialize TAnt<TObject> then',
   '  if v is specialize TAnt<TObject> then',
   '    specialize TAnt<TObject>(v).v:=nil;',
   '    specialize TAnt<TObject>(v).v:=nil;',
+  '  a:=v as specialize TAnt<U>;',
+  '  if (v as specialize TAnt<TObject>).v=nil then ;',
   'end;',
   'end;',
   'begin',
   'begin',
   '']);
   '']);