* Call correct newinstance when overridden. Fixes issue #41090

packages/rtl-objpas/src/inc/rtti.pp

@@ -2247,21 +2247,18 @@ var
 begin
   if IsConstructor then
   begin
-    if aInstance.IsEmpty or not aInstance.IsObject then
-    begin
-      MetaClass := Parent.AsInstance.GetMetaClassType;
-      pNewInst := PVmt(MetaClass)^.vNewInstance;
-    end;
     case aInstance.Kind of
-      { TValue.Empty }
-      tkUnknown:
+      tkUnknown, tkClassRef:
       begin
+        { TValue.Empty }
+        if aInstance.Kind = tkUnknown then
+          MetaClass := Parent.AsInstance.GetMetaClassType
+        else
+          MetaClass := aInstance.AsClass;
+
+        pNewInst := PVmt(MetaClass)^.vNewInstance;
         aInstance := TNewInstance(pNewInst)(MetaClass);
       end;
-      tkClassRef:
-      begin
-        aInstance := TNewInstance(pNewInst)(aInstance.AsClass);
-      end;
       tkClass:
         { late constructor of already created object };
       else
@@ -8420,4 +8417,4 @@ initialization
 {$ifdef SYSTEM_HAS_INVOKE}
   InitSystemFunctionCallManager;
 {$endif}
-end.
+end.

packages/rtl-objpas/tests/testrunner.rtlobjpas.lpi

@@ -105,7 +105,7 @@
   <CompilerOptions>
     <Version Value="11"/>
     <Target>
-      <Filename Value="testrunner.rtlobjpas.js" ApplyConventions="False"/>
+      <Filename Value="testrunner.rtlobjpas"/>
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>

packages/rtl-objpas/tests/tests.rtti.invoke.pas

@@ -76,6 +76,9 @@ type
     procedure TestInheritedClassConstructor;
     procedure TestClassProperty;
     procedure TestIndexedProperty;
+    Procedure TestNewInstance1;
+    Procedure TestNewInstance2;
+
   end;
 
   { TTestInvokeIntfMethods }
@@ -1632,6 +1635,45 @@ begin
   AssertTrue('The getter of an indexed property for a class is incorrectly called', (testClass.fa = 384) and (testClass.fa2 = 170));
 end;
 
+procedure TTestInvoke.TestNewInstance1;
+
+var
+  obj: TTestBaseNewInstance;
+  lType: TRttiType;
+  lMethod : TRttiMethod;
+
+begin
+  TTestBaseNewInstance.BaseNewCount:=0;
+  TTestNewInstance.TestNewCount:=0;
+  lType:=TRttiContext.Create(False).GetType(TTestNewInstance);
+  AssertNotNull('Have type',lType);
+  lMethod:=lType.GetMethod('Create');
+  AssertNotNull('Have method',lMethod);
+  obj := TTestBaseNewInstance(lMethod.Invoke(TTestNewInstance, []).AsObject);
+  Obj.Free;
+  AssertEquals('Calls to TTestNewInstance.NewInstance',1,TTestNewInstance.TestNewCount);
+  AssertEquals('Calls to TTestBaseNewInstance.NewInstance',1,TTestBaseNewInstance.BaseNewCount);
+end;
+
+procedure TTestInvoke.TestNewInstance2;
+var
+  obj: TTestBaseNewInstance;
+  lType: TRttiType;
+  lMethod : TRttiMethod;
+
+begin
+  TTestBaseNewInstance.BaseNewCount:=0;
+  TTestNewInstance.TestNewCount:=0;
+  lType:=TRttiContext.Create(False).GetType(TTestNewInstance);
+  AssertNotNull('Have type',lType);
+  lMethod:=lType.GetMethod('Create');
+  AssertNotNull('Have method',lMethod);
+  obj := TTestBaseNewInstance(lMethod.Invoke(TTestBaseNewInstance, []).AsObject);
+  Obj.Free;
+  AssertEquals('Calls to TTestNewInstance.NewInstance',0,TTestNewInstance.TestNewCount);
+  AssertEquals('Calls to TTestBaseNewInstance.NewInstance',1,TTestBaseNewInstance.BaseNewCount);
+end;
+
 procedure TTestInvoke.TestTObject;
 
   procedure DoStaticInvokeTestClassCompare(

packages/rtl-objpas/tests/tests.rtti.invoketypes.pas

@@ -274,6 +274,25 @@ type
     function DoTest : String; override;
   end;
 
+  { test for newinstance 41090 }
+
+  { TTestBaseNewInstance }
+
+  TTestBaseNewInstance = class
+  public
+    // So it is found in every RTL
+    constructor create;
+    class var BaseNewCount : Integer;
+    class function NewInstance: TObject; override;
+  end;
+
+  TTestNewInstance = class(TTestBaseNewInstance)
+  public
+    class var TestNewCount : Integer;
+    class function NewInstance: TObject; override;
+  end;
+
+
 type
   TEnum1 = (en1_1, en1_2);
   TEnum2 = (en2_1);
@@ -1182,5 +1201,25 @@ begin
   Result := Arg + 1;
 end;
 
+
+{ Test }
+
+constructor TTestBaseNewInstance.create;
+begin
+  //
+end;
+
+class function TTestBaseNewInstance.NewInstance: TObject;
+begin
+  Result := inherited NewInstance;
+  Inc(BaseNewCount);
+end;
+
+class function TTestNewInstance.NewInstance: TObject;
+begin
+  Result := inherited NewInstance;
+  Inc(TestNewCount);
+end;
+
 end.