Browse Source

* as long as the type passed into a TypeInfo() is not an undefined or error def the resulting value will always be constant at compile time, so it can be compared to another then no matter if typenode or not
+ added tests

Sven/Sarah Barth 2 years ago
parent
commit
7a34677b2a
5 changed files with 80 additions and 3 deletions
  1. 4 3
      compiler/nadd.pas
  2. 16 0
      tests/tbs/tb0699.pp
  3. 14 0
      tests/tbs/tb0700.pp
  4. 24 0
      tests/tbs/tb0701.pp
  5. 22 0
      tests/tbs/tb0702.pp

+ 4 - 3
compiler/nadd.pas

@@ -1429,13 +1429,14 @@ implementation
         righttarget:=actualtargetnode(@right)^;
         if (nodetype in [equaln,unequaln]) and (lefttarget.nodetype=inlinen) and (righttarget.nodetype=inlinen) and
           (tinlinenode(lefttarget).inlinenumber=in_typeinfo_x) and (tinlinenode(righttarget).inlinenumber=in_typeinfo_x) and
-          (tinlinenode(lefttarget).left.nodetype=typen) and (tinlinenode(righttarget).left.nodetype=typen) then
+          not (tinlinenode(lefttarget).left.resultdef.typ in [undefineddef,errordef]) and
+          not (tinlinenode(righttarget).left.resultdef.typ in [undefineddef,errordef]) then
           begin
             case nodetype of
               equaln:
-                result:=cordconstnode.create(ord(ttypenode(tinlinenode(lefttarget).left).resultdef=ttypenode(tinlinenode(righttarget).left).resultdef),bool8type,false);
+                result:=cordconstnode.create(ord(tinlinenode(lefttarget).left.resultdef=tinlinenode(righttarget).left.resultdef),bool8type,false);
               unequaln:
-                result:=cordconstnode.create(ord(ttypenode(tinlinenode(lefttarget).left).resultdef<>ttypenode(tinlinenode(righttarget).left).resultdef),bool8type,false);
+                result:=cordconstnode.create(ord(tinlinenode(lefttarget).left.resultdef<>tinlinenode(righttarget).left.resultdef),bool8type,false);
               else
                 Internalerror(2020092901);
             end;

+ 16 - 0
tests/tbs/tb0699.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+{ %OPT=-Sew }
+
+{ Note: we are speculating for "Unreachable code" warnings here }
+
+program tb0699;
+
+procedure Test(aArg: LongInt);
+begin
+  if TypeInfo(aArg) <> TypeInfo(LongInt) then
+    Writeln('False');
+end;
+
+begin
+
+end.

+ 14 - 0
tests/tbs/tb0700.pp

@@ -0,0 +1,14 @@
+{ %FAIL }
+{ %OPT=-Sew }
+
+{ Note: we are speculating for "Unreachable code" warnings here }
+
+program tb0700;
+
+var
+  arr: array of LongInt;
+begin
+  arr := Nil;
+  if TypeInfo(arr[0]) <> TypeInfo(LongInt) then
+    Writeln('False');
+end.

+ 24 - 0
tests/tbs/tb0701.pp

@@ -0,0 +1,24 @@
+{ %FAIL }
+{ %OPT=-Sew }
+
+{ Note: we are speculating for "Unreachable code" warnings here }
+
+program tb0701;
+
+{$mode objfpc}
+
+type
+  TTest = class
+    f: LongInt;
+    procedure Test;
+  end;
+
+procedure TTest.Test;
+begin
+  if TypeInfo(f) <> TypeInfo(LongInt) then
+    Writeln('False');
+end;
+
+begin
+
+end.

+ 22 - 0
tests/tbs/tb0702.pp

@@ -0,0 +1,22 @@
+{ %OPT=-Sew }
+
+{ don't optimize TypeInfo comparisons if undefined types are involved }
+
+program tb0702;
+
+{$mode objfpc}
+
+type
+  generic TTest<S> = class
+    procedure Test;
+  end;
+
+procedure TTest.Test;
+begin
+  if TypeInfo(S) = TypeInfo(LongInt) then
+    Writeln('Test');
+end;
+
+begin
+
+end.