Browse Source

fcl-passrc: resolver: implicit function specialization: widen common types

git-svn-id: trunk@43296 -
Mattias Gaertner 5 years ago
parent
commit
fae04744d0
2 changed files with 43 additions and 2 deletions
  1. 4 2
      packages/fcl-passrc/src/pasresolver.pp
  2. 39 0
      packages/pastojs/tests/tcgenerics.pas

+ 4 - 2
packages/fcl-passrc/src/pasresolver.pp

@@ -15640,10 +15640,12 @@ type
           begin
           begin
           NewBaseType:=TResolverBaseType(Max(ord(BaseType1),ord(BaseType2)));
           NewBaseType:=TResolverBaseType(Max(ord(BaseType1),ord(BaseType2)));
           if (BaseTypes[btLongint]<>nil)
           if (BaseTypes[btLongint]<>nil)
-              and (NewBaseType in [btByte,btShortInt,btWord,btSmallInt,btIntSingle,btUIntSingle,btLongint]) then
+              and (NewBaseType in [btByte,btShortInt,btWord,btSmallInt,btIntSingle,btUIntSingle,btLongint])
+              and (BaseType1<>btLongWord) and (BaseType2<>btLongWord) then
             NewBaseType:=btLongint
             NewBaseType:=btLongint
           else if (BaseTypes[btInt64]<>nil)
           else if (BaseTypes[btInt64]<>nil)
-              and (NewBaseType<=btInt64) then
+              and (NewBaseType<=btInt64)
+              and (BaseType1<>btQWord) and (BaseType2<>btQWord) then
             NewBaseType:=btInt64
             NewBaseType:=btInt64
           else if (BaseTypes[btIntDouble]<>nil)
           else if (BaseTypes[btIntDouble]<>nil)
               and (NewBaseType<=btIntDouble) then
               and (NewBaseType<=btIntDouble) then

+ 39 - 0
packages/pastojs/tests/tcgenerics.pas

@@ -53,6 +53,7 @@ type
     procedure TestGenProc_Forward;
     procedure TestGenProc_Forward;
     procedure TestGenProc_Infer_OverloadForward;
     procedure TestGenProc_Infer_OverloadForward;
     procedure TestGenProc_TypeInfo;
     procedure TestGenProc_TypeInfo;
+    procedure TestGenProc_Infer_Widen;
     // ToDo: FuncName:=
     // ToDo: FuncName:=
 
 
     // generic methods
     // generic methods
@@ -1068,6 +1069,44 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestGenerics.TestGenProc_Infer_Widen;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'procedure Run<S>(a: S; b: S);',
+  'begin',
+  'end;',
+  'begin',
+  '  Run(word(1),longint(2));',
+  '  Run(byte(2),smallint(2));',
+  '  Run(longword(3),longint(2));',
+  '  Run(nativeint(4),longint(2));',
+  '  Run(nativeint(5),nativeuint(2));',
+  '  Run(''a'',''foo'');',
+  '  Run(''bar'',''c'');',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGenProc_Infer_Widen',
+    LinesToStr([ // statements
+    'this.Run$s0 = function (a, b) {',
+    '};',
+    'this.Run$s1 = function (a, b) {',
+    '};',
+    'this.Run$s2 = function (a, b) {',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Run$s0(1, 2);',
+    '$mod.Run$s0(2, 2);',
+    '$mod.Run$s1(3, 2);',
+    '$mod.Run$s1(4, 2);',
+    '$mod.Run$s1(5, 2);',
+    '$mod.Run$s2("a", "foo");',
+    '$mod.Run$s2("bar", "c");',
+    '']));
+end;
+
 procedure TTestGenerics.TestGenMethod_ObjFPC;
 procedure TTestGenerics.TestGenMethod_ObjFPC;
 begin
 begin
   StartProgram(false);
   StartProgram(false);