I am new to DUnitx and Delphi-Mocks so please be patient. The only other post I could find on this topic was 3 years old and not answered. Returning records in Delphi-Mocks
Delphi Rio 10.3.
Windows 10
I want to test this procedure:
procedure TdmMariaDBConnection.Notify;
var
LViewModel : IPsViewModel;
begin
FMainViewModel.HandleCommands(FCommandRecord);
for LViewModel in FObservers do
LViewModel.HandleCommands(FCommandRecord);
end;
The interfaces and record type are declared as:
IPsView = interface(IInvokable)
['{F5532762-09F8-42C4-9F9F-A8F7FF7FA0C6}']
procedure HandleCommands(const Value: TPsCommandRecord);
procedure AfterCreate;
procedure BeforeDestroy;
end;
IPsViewModel = interface(IInvokable)
['{322DAB08-6A7C-4B61-B656-BC5346ACFC14}']
procedure HandleCommands(const Value: TPsCommandRecord);
end;
IPsMainViewModel = interface(IInvokable)
['{98FFB416-6C22-492F-BC85-D9A1ECA667FE}']
procedure Attach(const observer: IPsView);
procedure Notify;
procedure LoadFrame(const Value: TPanel);
procedure LoadForm(const Value: integer);
procedure LoadModalForm(const Value: integer);
procedure HandleCommands(const Value: TPsCommandRecord);
procedure SetViewFactory(Value: IPsViewFactory);
property ViewFactory: IPsViewFactory write SetViewFactory;
end;
TPsCommandRecord = record
CommandType: integer;
CommandObject: TObject;
CommandMessage: TPsTaskDialogMessageRecord;
end;
I have the Notify procedure in the protected section
type
TdmMariaDBConnection = class(TDataModule, IPsModel)
procedure DataModuleDestroy(Sender: TObject);
procedure DataModuleCreate(Sender: TObject);
private
FObservers : TList<IPsViewModel>;
FMainViewModel : IPsMainViewModel;
FCommandRecord : TPsCommandRecord;
protected
procedure Notify;
….
end;
In my test project I have a descendent class
TTestabledmMariaDBConnection = class(TdmMariaDBConnection)
end;
var
CUT : TTestabledmMariaDBConnection;
procedure TTestModel_MariaDBConnection.Setup;
begin
CUT := TTestabledmMariaDBConnection.Create(nil);
end;
so I can call protected methods. What I have so far that doesn't work because I cannot provide the private record instance from TdmMariaDBConnection, and just focusing on the MainViewModel for now.
procedure TTestModel_MariaDBConnection.NotifyCallsMainViewModelHandleCommands;
var
MVMMock : TMock<IPsMainViewModel>;
LCommandRecord : TPsCommandRecord;
begin
//Arrange
MVMMock := TMock<IPsMainViewModel>.Create;
MVMMock.Setup.Expect.Once.When.HandleCommands(LCommandRecord);
//Act
CUT.Attach(MVMMock);
CUT.Notify;
//Assert
try
MVMMock.Verify();
Assert.Pass();
except on E: EMockException do
Assert.Fail(E.Message);
end;
end;
Obviously the addition of LCommandRecord are wrong I just added them to get it to compile. I need(I think) the record instance from The test class in the setup. I tried adding a function to get that but it didn't work either.
function TdmMariaDBConnection.GetCommandRecord: TPsCommandRecord;
begin
Result := FCommandRecord;
end;
MVMMock.Setup.Expect.Once.When.HandleCommands(CUT.GetCommandRecord);
The test doesn't even complete, I get an incomplete circle in TestInsight GUI instead of the hoped for Green check.
Any help would be appreciated. Also is this the right use of Verify? I can only find the explanation that it does nothing when passing, so how to add an Assert?
Thanks in advance
Gary
The way you setup the mock it will be very strict about the parameters being passed and checks for equality to the specified setup when calling Verify.
There is also a long standing issue in Delphi Mocks that record parameters are not properly compared for equality (they only equal if the parameters where the exact same address - see SameValue in Delphi.Mocks.Helpers.pas - I know of this issue because it is my code being used with my permission - I wrote a better version some while ago being used in Spring4D which also has mocking fwiw). This is why even if it would not run in a circle with your added GetCommandRecord it might not pass.
What I usually suggest people to do (I wrote 2 mocking libraries for Delphi so far) when using mocks is to be as permissive as possible. Fortunately Delphi Mocks supports parameter matcher that let you specify that actually you don't care that much for the exact value of the parameter being passed.
That being said simply change your setup to call
MVMMock.Setup.Expect.Once.When.HandleCommands(It0.IsAny<TPsCommandRecord>);
That tells the internal matcher recording calls to the mock from the SUT that it does not matter what value comes in which satisfies the expectation.
By the way for a similar reason as with the SameValue bug it will not work using It0.IsEqualTo(LCommandRecord) because the used comparer for records internally calls System.Generics.Defaults.Equals_Binary which just does a flat memory compare of the record which possibly fails for any reference type.
Related
Like many other Firemonkey developers, I need a general multi-platform solution to send messages from a thread to the main thread (to replace PostMessage). I need it to also work on iOS.
There is a solution by François Piette that is implemented for Android and Windows, but not for iOS:
TMessagingSystem.
However, I think it can be done much more simple by using the "new" TMessageManager in combination with TThread.Queue(). But no one have published code, using this aproach, that actually works (e.g. this one is not complete).
Do you have a tested implementation you would like to share with the community (or maybe just suggestions how to implement it right)?
Ok, here is my implementation. I did not use TMessagingSystem as it seems to just add complexity (for my situation at least). It works so far, but if anyone have suggestions for improvements, I will be happy to improve it.
I looked at the solution by Uwe Raabe but I wanted to make it more straightforward and easy to implement in the large codebase that I am converting to FMX.
With the solution below I can simply replace all PostMessage() with gMessageHandler.PostMessage (removing the win handle argument), and add the message functions in the form to tMainForm.MessageCallBack.
I created a small unit that I can include everywhere I need the PostMessage function. Those places does not need to know about the form:
unit MessageHandler
interface
tAllOSMessage = procedure(aMessageID, aData1, aData2: integer) of object;
tAllOSMessageHandler = class
private
fOnMessage : tAllOSMessage;
public
constructor Create(aMessageCallBack: tAllOSMessage);
procedure PostMessage(aMessageID, aData1, aData2: integer; aSourceThread: TThread = nil);
end;
var
gMessageHandler: tAllOSMessageHandler;
implementation
constructor tAllOSMessageHandler.Create(aMessageCallBack: tAllOSMessage);
begin
fOnMessage := aMessageCallBack;
end;
procedure tAllOSMessageHandler.PostMessage(aMessageID, aData1, aData2: integer; aSourceThread: TThread);
begin
if aSourceThread=nil then
aSourceThread := TThread.CurrentThread;
aSourceThread.Queue(nil, procedure
begin
if Assigned(fOnMessage) then
fOnMessage(aMessageID, aData1, aData2);
end );
end;
end.
Then I add these lines to the main form unit:
//Added to main form:
tMainForm = class(TForm)
...
procedure MessageCallBack(aMessageID, aData1, aData2: integer);
//Added to MainFormCreate
gMessageHandler := tAllOSMessageHandler.Create(MessageCallBack);
//Added to MainFormDestroy
FreeAndNil(gMessageHandler)
procedure tMainForm.MessageCallBack(aMessageID, aData1, aData2: integer);
begin
case aMessageID of
MyMessage1 : MyFunction1(aData1,aData2);
...
end;
end;
In the following type:
MyClass = class(TInterfacedPersistent)
private
FMyProperty: Integer;
published
procedure setMyProperty(Value: Integer); virtual;
property MyProperty: Integer read FMyProperty write setMyProperty;
I would like to know the name of the setter method of the "MyProperty" property via RTTI. I've tried the following:
procedure ShowSetterMethodsNames(pMyObject: TObject);
var
vPropList: TPropList;
vCount, I: Integer;
begin
vCount:= GetPropList(pMyObject.ClassInfo, tkProperties, #vPropList);
for I:= 0 to vCount -1 do
begin
if Assigned(vPropList[I]^.SetProc) then
ShowMessage(pMyObject.ClassType.MethodName(vPropList[I]^.SetProc));
end;
end;
Although the pointer is not nil, all I have is an empty message. Does anybody have some tip to me?
P.S.: I'm using Delphi XE4, and I know I should use extended RTTI instead of classic, but anyway, I can't do what I want in both features... So, any help will be appreciated. Thanks for the replies.
FINAL EDITION, problem solved:
Here is the code working, based in the (help of my friends and...) RTTI unit (DoSetValue method of TRTTIInstanceProperty class):
procedure ShowVirtualSettersNames(pObject: Pointer);
var
vSetter, vPointer: Pointer;
vPropList: TArray<TRttiProperty>;
vProp: TRttiProperty;
begin
vPropList:= RTTIUtils.ExtractProperties(TObject(pObject).ClassType); // Helper to get properties from a type, based in extended RTTI
for vProp in vPropList do
begin
vPointer:= TRttiInstanceProperty(vProp).PropInfo^.SetProc;
vPointer:= PPointer(PInteger(pObject)^ + Smallint(vPointer))^;
ShowMessage(TObject(pObject).ClassType.MethodName(vPointer));
end;
end;
This ONLY WORKS FOR VIRTUAL SETTERS, for statics the message is empty. Thanks everyone!
You can retrieve this method name, if
a) move the method to the published section (classic RTTI works with this section only (more accurately - compiled with {$M+} directive))
b) use right class specifier - MyClass.MethodName, because MethodName is class function
This code works on D7 and XE3:
MyClass = class(TInterfacedPersistent)
private
FMyProperty: Integer;
published
procedure setMyProperty(Value: Integer);
property MyProperty: Integer read FMyProperty write setMyProperty;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ppi: PPropInfo;
begin
ppi := GetPropInfo(MyClass, 'MyProperty');
ShowMessage(MyClass.MethodName(ppi.SetProc));
end;
P.S. What Delphi version are you using? What about Extended RTTI (since D2010)?
Read c:\rad studio\9.0\source\rtl\common\System.Rtti.pas
procedure TRttiInstanceProperty.DoSetValue
The setter of the property may be
a field (variable)
a static procedure
a virtual procedure (your case)
And those cases make PropInfo^.SetProc have different semantics of its value.
Direct address only applies to static procedures. For virtual methods you add a VMT offset and take the code address from that memory cell, as specified in that code i mentioned (but would not quote for copyright reasons).
Or you just could use TRttiProperty.SetValue and let Delphi do all those little under the hood details. See http://docwiki.embarcadero.com/Libraries/XE2/en/System.Rtti.TRttiProperty.SetValue
EDIT:
the code removed - it did not worked verbatim and the topic starter provided working version.
Regarding and I know I should use Extended RTTI instead of classic one - that is questionable claim. Extended RTTI is known to work noticeably slower than classic one. Dunno if someone did profiled it, but i suspect that is mostly due to the slow code of TValue. You can google and find that lot of people complained of slow TValue implementation and provided alternative ones with fixed efficiency. However since Extended RTTI only uses stock TValue it cannot benefit from those implementations and remains slower than classic one.
I tried my hand at a generic class, and on a second attempt I've tried to make a generic locked pool. I almost got it to work
I stumble on the spot where I want to put a generic typed class into a locked tlist obtained from tthreadlist.
The main question is:
Does anybody know a solution to this problem? (see "problem spot" in the source)
Hints, minor questions:
Do I need an additional constraint that signals reference? (I tried adding ,reference to the already existing class and constructor)
Does sb know a good overview page of all "special" generic constraints (class,constructor) . Couldn't find much in the manual.
the company is at D2009, but I've a single license DXE for migration preparation purposes.
The objects used by this pool are tobject, and worse, some of them have some crucial methods that must be inlined. (it is an image processing app, which is also why I'm not that concerned with relative simply locks. Granularity is coarse). I mention this, since it might make interface based solutions difficult.
type
TLockedPool<T:class,constructor> = class
private
lst : tthreadlist;
public
type sometype =t; // part of workarounds.
destructor destroy;
constructor create;
function getitem:T;
procedure putitem(var b:T);
end;
constructor TLockedPool<T>.create;
begin
lst:=TThreadlist.Create;
end;
destructor TLockedPool<T>.destroy;
var i : integer;
v: tlist;
begin
v:=lst.locklist;
for i:=0 to v.count-1 do
Tobject(v[i]).Free;
lst.unlocklist;
v.clear;
freeandnil(lst);
inherited;
end;
function TLockedPool<T>.getitem: T;
var cnt:integer;
v : tlist;
begin
v:=lst.LockList;
cnt:=v.Count;
if cnt>0 then
begin
result:=tobject(v[cnt-1]);
v.delete(cnt-1);
end
else
begin
result:=T.create;
end;
lst.UnlockList;
end;
procedure TLockedPool<T>.putitem(var b: T);
var v : Tlist;
x : sometype;
begin
if assigned(b) then // some older parts of the framework are dirty and try to put in NILs.
begin
v:=lst.LockList;
x:=b;
v.Add(pointer(sometype(x))); // <--- the problemspot
lst.unlocklist;
end;
b:=nil;
end;
Use v.Add(TObject(x)) or, if you must (it may not work in 2009, awkward for me to check), v.Add(PPointer(#x)^).
As much I know - Subroutines are with Private access mode to its parent unction / procedure, right?
Is there any way to access them from "outer-world" - dpr or other function / procedure in unit?
Also - which way takes more calcualtion and space to compiled file?
for example:
function blablabla(parameter : tparameter) : abcde;
procedure xyz(par_ : tpar_);
begin
// ...
end;
begin
// ...
end;
procedure albalbalb(param : tparam) : www;
begin
xyz(par_ : tpar_); // is there any way to make this function public / published to access it therefore enabling to call it this way?
end;
// all text is random.
// also, is there way to call it from DPR in this manner?
// in C++ this can be done by specifing access mode and/or using "Friend" class .. but in DELPHI?
Nested procedures/functions - those declared inside another procedure or function, are a special type, because they can access the stack (and thereby parameters/local variables) of the procedure they are nested in. Because of this, and Delphi scope rules, there is no way to access them outside the "parent" procedure. You use them only if you need to take advantage of their special features. AFAIK Delphi/Pascal is one of the few languages to have this feature. From a compiler point of view the call has some extra code to allow accessing the parent stack frame, IIRC.
AFAIK "friend" class/functions in C++ are different - they are class access methods, while in your example you are using plain procedures/functions.
In Delphi all procedure/classes declared in the same unit are automatically "friend", unless strict private declarations are used in latest Delphi releases. For example this code snippets will work, as long everything is in the same unit:
type
TExample = class
private
procedure HelloWorld;
public
...
end;
implementation
function DoSomething(AExample: TExample);
begin
// Calling a private method here works
AExample.HelloWordl;
end;
Note: Embedded Routines <> Private/Protected Methods.
Embedded routines i.e. routines inside routines can not be accessed by external routines.
You have posted an example of an Embedded routine, I also heard them called Internal Routines.
Here is another example:
procedure DoThis;
function DoThat : Boolean;
begin
// This Routine is embedded or internal routine.
end;
begin
// DoThat() can only be accessed from here no other place.
end;
Regardless of visibility, methods on classes, can be called using Delphi 2010 via RTTI. I have detailed how to do this in this article.
If you are in the same Unit methods on a class can be accessed by any other code regardless of visibility, unless they are marked with Strict Private. This Question has more details and good example code in the accepted answer.
If you are in two different units you can use the Protected Method Hack to access the protected methods. Which is detailed in detailed in this article.
Yes, you can access a subroutine, which is nested in other (parent) subroutine, from the outer world. Though it's somewhat tricky. I've found this howto in the web.
How to pass nested routine as a procedural parameter (32 bit)
Delphi normally does not support passing nested routines as procedural parameters:
// This code does not compile:
procedure testpass(p: tprocedure);
begin
p;
end;
procedure calltestpass;
procedure inner;
begin
showmessage('hello');
end;
begin
testpass(inner);
end;
The obvious workaround is to pass procedure address and typecast it within testpass:
// This code compiles and runs OK
procedure testpass(p: pointer);
begin
tProcedure(p);
end;
procedure calltestpass;
procedure inner;
begin
showmessage('hello');
end;
begin
testpass(#inner);
end;
There is, however, a pitfall in the above example - if the "inner" routine references any variable that was pushed onto the stack before the "inner" procedure was called from testpass (calltestpass parameters - if there were any, or local variables in calltestpass - if there were any), your system most probably crashes:
// This code compiles OK but generates runtime exception (could even be
// EMachineHangs :-) )
procedure testpass(p: pointer);
begin
tProcedure(p);
end;
procedure calltestpass;
var msg: string;
procedure inner;
begin
msg := 'hello';
showmessage(msg);
end;
begin
testpass(#inner);
end;
The reason is, in simple words, that the stack frame arrangement
was "broken" by the call to testpass routine and "inner" procedure
incorrectly calculates parameters and local variables location
(do not blame Delphi, please).
The workaround is to set up the correct stack context before
"inner" is called from within "testpass".
// This code compiles and runs OK
{$O-}
procedure testpass(p: pointer);
var callersBP: longint;
begin
asm // get caller's base pointer value at the very beginning
push dword ptr [ebp]
pop callersBP
end;
// here we can have some other OP code
asm // pushes caller's base pointer value onto stack and calls tProcedure(p)
push CallersBP
Call p
Pop CallersBP
end;
// here we can have some other OP code
end;
{$O+}
procedure calltestpass;
var msg: string;
procedure inner;
begin
msg := 'hello';
showmessage(msg);
end;
begin
testpass(#inner);
end;
Please note the optimization is switched OFF for testpass routine - optimization generally does not handle mixed OP/assembler code very well.
No, there is no way to do what you're asking. The xyz function is callable only by the enclosing blablabla function. Outside that function, xyz is not in scope and there is no way to name it. If C++ allowed nested function, there wouldn't be any way to refer to it, either, just like there's no way to refer to functions with static linkage from outside the current translation unit.
If you need to call xyz from outside the blablabla function, then move xyz outside. If you need to call it from outside the current unit, then you need to declare that function in the unit's interface section. Then, add that unit to the external code's uses clause and you can call xyz from wherever you want, even the DPR file.
If xyz refers to variables or parameters of the blablabla function, then you'll need to pass them in as parameters since xyz will no longer have access to them otherwise.
The concept of access specifiers isn't really relevant here since we're not talking about classes. Units have interface and implementation sections, which aren't really the same as public and private sections of a class.
I've got a lot of older code that uses the old-style pascal object type that I'm trying to get working in Delphi 2009. It compiles, but there seems to be several problems dealing with virtual methods. It appears that this problem has already been reports on Quality Central:
http://qc.embarcadero.com/wc/qcmain.aspx?d=71723
I was hoping anyone who still uses these (PatrickvL maybe?) could respond with more information. We've got A LOT of code that uses objects and if this isn't going to get fixed, we're stuck. Thanks in advance!
If you're using virtual methods, then you're clearly accessing the objects by reference, not by value. That's how classes always work in Delphi, so switching to classes shouldn't be too hard.
For any object types that don't have virtual methods, you should be able to turn them into records. Records are allowed to have methods now, as well as visibility specifiers. The don't support inheritance, though.
Old-style objects have been deprecated since February 14, 1994, the release date of the first version of Delphi. They've been deteriorating ever since. You should have moved away from them years ago.
I must admit I had a couple of beers looking at this, just for the challenge :) You need some magic bytes. According to legend Old style objects ONLY create a space for the pointers if you use ANY virtual methods. No Virtual methods NO VMT.
The VMT pointer is ALWAYS FIRST with new style objects because they all declare virtual methods. Seems Someone forgot that with old style objects the VMT can come later. so assuming its a just one pointer this makes it work on my D2009. I'm not into the guts of the compiler, a guy called Dave Jewell who used to write for PC pro could possibly confirm that this will be stable...
Type
PObject1 = ^TObject1;
TObject1 = Object
Magic: Array[0..3] of Byte; //or integer or whatever I was playing with the size
FCount : Integer;
Constructor Init;
Procedure Add; virtual;
Procedure Deduct; virtual;
end;
Type
PObject2 = ^TObject2;
TObject2 = Object(TObject1)
Constructor Init;
end;
Then after construction these work:
.
.
.
Object2^.Add;
Object2^.Deduct;
and I get the appropriate console output
I added an additional proc just to make sure that it worked for 2 virtuals :)
Incidentally they work whether you put the ^ or not 2009 knows what you mean :(
Lacking a proper fix from embracodeland You still may still have to alter each BASE object definition. Hopefully you could do it with find and insert/replace or Grep... Good luck.
Ok - Done that - I cannot get it to fail.... Is your D2009 Fully Patched?
Project/Compiler Options?
For absolute certainty and comparison here are my units:
---------------Project File
program testD2009;
{$APPTYPE CONSOLE}
uses
SysUtils,
Object1U in 'Object1U.pas',
Object2U in 'Object2U.pas';
Var
Object1 : PObject1;
Object2 : PObject2;
begin
try
Object1 := New(PObject1,Init);
Object1^.Add;
Object1^.Deduct;
Object2 := New(PObject2,Init);
Object2^.Add;
Object2^.Deduct;
readln;
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
end.
--------------Object1 unit
unit Object1U;
interface
uses SysUtils;
Type
PObject1 = ^TObject1;
TObject1 = Object
Magic: Array[0..3] of Byte;
FCount : Integer;
Constructor Init;
Procedure Add; virtual; { removing virtual allows the program to run }
Procedure Deduct; virtual; { removing virtual allows the program to run }
end;
implementation
Procedure TObject1.Add;
begin
Writeln('Object1 Add');
end;
procedure TObject1.Deduct;
begin
Writeln('Object1 Deduct');
end;
Constructor TObject1.Init;
begin
inherited;
FCount := 0;
Writeln('TObject1 Init');
end;
end.
----------------Object 2 unit
unit Object2U;
interface
uses Object1U;
Type
PObject2 = ^TObject2;
TObject2 = Object(TObject1)
Constructor Init;
Procedure Add; virtual; { removing virtual allows the program to run }
Procedure Deduct; virtual; { removing virtual allows the program to run }
end;
implementation
procedure TObject2.Add;
begin
Writeln('Object2 Add');
inherited;
end;
procedure TObject2.Deduct;
begin
Writeln('Object2 Deduct');
inherited;
end;
Constructor TObject2.Init;
begin
Inherited Init;
fCount := 1;
Writeln('TObject2:Init');
end;
end.
----------------Program Output:
TObject1 Init
Object1 Add
Object1 Deduct
TObject1 Init
TObject2:Init
Object2 Add
Object1 Add
Object2 Deduct
Object1 Deduct
Puzzled I am :).
I sent an e-mail to our local representatives from Embarcadero in regards to this problem and referred them to the report on Quality Central. They basically told us to move all objects to classes, so I'm guessing they're not planning on fixing this...ever. I think we've pretty much accepted that this is the way we have to go if we want to move forward, so now we just have to schedule that work before we can proceed with our upgrade to Delphi 2009.
Just wanted to thank everyone who tried to help, but I believe at this point it's a lost cause :-(