The Wiert Corner – irregular stream of stuff

Jeroen W. Pluimers on .NET, C#, Delphi, databases, and personal interests

  • My badges

  • Twitter Updates

  • My Flickr Stream

  • Pages

  • All categories

  • Enter your email address to subscribe to this blog and receive notifications of new posts by email.

    Join 1,839 other subscribers

Archive for the ‘Development’ Category

Automatically closing ABBY Finereader 5.0 windows after scanning is completed

Posted by jpluimers on 2021/02/23

Both my Fujitsu ScanSnap ix500 and ix100 scanners can be used from Windows to automatically scan to PDF.

PDF conversion is done through the included ABBYY FineReader 5.0 software.

However, on each scan, it keeps a dialog open with the scan results, even if scanning went fine.

When scanning lots of documents, lots of dialogs are open, causing two problems:

  • a lot of memory and window handle resource usage
    • this can be ~100 megabytes per instance
  • a lot of disk usage:
    • it keeps both the non-OCR and OCR PDF files active (only when closing, the non-OCR PDF file is deleted)

I wanted to close that dialog automatically, but none of the configuration settings allow it.

So I wrote a quick and dirty solution, that could have been in any tool supporting the Windows API and call backs. The solution below should easily translate to tools other than Delphi.

These are the only Windows API functions used:

these types:

and these constants:

The basic structure is an EumWindows call passing a callback that gets called for all top level Windows, then in the callback, for matching captions: call EnumChildWindows with another callback. In that callback, for matching captions and child captions, perform a click or close.

Related posts:

Log of Windows related to both programs:

ParentHWnd=$00000000;HWnd=$00030602;IsVisible=-1;IsOwned=0;IsAppWindow=-1;WindowTextLength=33;WindowText="ABBYY FineReader for ScanSnap 5.0"
> Recursive child windows for ABBYY
  ParentHWnd=$00030602;HWnd=$000205E2;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=0;WindowText=""
  ParentHWnd=$00030602;HWnd=$000205E0;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=0;WindowText=""
  ParentHWnd=$00030602;HWnd=$000205EC;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=0;WindowText=""
  ParentHWnd=$00030602;HWnd=$000205EA;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=74;WindowText="Register your copy of ABBYY FineReader and receive the following benefits:"
  ParentHWnd=$00030602;HWnd=$000205E8;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=25;WindowText="- Free technical support;"
  ParentHWnd=$00030602;HWnd=$000205E6;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=51;WindowText="- Information about new versions of ABBYY products."
  ParentHWnd=$00030602;HWnd=$000205E4;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=12;WindowText="Registration"
  ParentHWnd=$00030602;HWnd=$000205FC;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=0;WindowText=""
  ParentHWnd=$00030602;HWnd=$000205FA;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=6;WindowText="&Close"
  > Child is Close button: clicking.
  < ParentHWnd=$00000000;HWnd=$00030602;IsVisible=-1;IsOwned=0;IsAppWindow=-1;WindowTextLength=33;WindowText="ABBYY FineReader for ScanSnap 5.0"
  ParentHWnd=$00030602;HWnd=$000205F6;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=34;WindowText="Processing finished (warnings: 1)."
  ParentHWnd=$00030602;HWnd=$000205F4;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=31;WindowText="Converting to searchable PDF..."
  ParentHWnd=$00030602;HWnd=$000205F0;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=0;WindowText=""
  ParentHWnd=$00030602;HWnd=$000205EE;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=0;WindowText=""
  ParentHWnd=$00030602;HWnd=$000205D2;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=63;WindowText="Page 1. Make sure the correct recognition language is selected."

ParentHWnd=$00000000;HWnd=$00010248;IsVisible=-1;IsOwned=-1;IsAppWindow=0;WindowTextLength=14;WindowText="Creative Cloud"
> Recursive child windows for Creative Cloud
  ParentHWnd=$00010248;HWnd=$0001024A;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=28;WindowText="Main Container Client Dialog"
  ParentHWnd=$00010248;HWnd=$0002034A;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=3;WindowText="IMS"
  ParentHWnd=$00010248;HWnd=$0001035A;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=0;WindowText=""
  ParentHWnd=$00010248;HWnd=$00020350;IsVisible=-1;IsOwned=0;IsAppWindow=0;WindowTextLength=18;WindowText="Sign in - Adobe ID"
  > Child is Signin button: closing parent.
  < ParentHWnd=$0003011A;HWnd=$00010248;IsVisible=-1;IsOwned=-1;IsAppWindow=0;WindowTextLength=14;WindowText="Creative Cloud"
    < ParentHWnd=$00000000;HWnd=$0003011A;IsVisible=0;IsOwned=0;IsAppWindow=0;WindowTextLength=4;WindowText="Core"

It appears that ABBYY has a different set of booleans than Creative Cloud.

This is kind of odd, as delphi – How to get captions of actual windows currently running? – Stack Overflow points to Window Features – Windows applications | Microsoft Docs: Owned Windows stating:

The Shell creates a button on the taskbar whenever an application creates a window that isn’t owned. To ensure that the window button is placed on the taskbar, create an unowned window with the WS_EX_APPWINDOW extended style. To prevent the window button from being placed on the taskbar, create the unowned window with the WS_EX_TOOLWINDOW extended style. As an alternative, you can create a hidden window and make this hidden window the owner of your visible window.

Apparently, ABBYY fully plays by the rules, but Creatheive Cloud cheats a bit: none of the Windows are WS_EX_APPWINDOW, but the hidden unowned “Core” owner of the “Creative Cloud” still makes it appear on the taskbar.

–jeroen

Read the rest of this entry »

Posted in Delphi, Development, Fujitsu ScanSnap, Hardware, ix100, ix500, Power User, Scanners, Software Development, Windows Development | Leave a Comment »

Unittesting FizzBuzz

Posted by jpluimers on 2021/02/23

Keep a version history of how you approach the below TDD driven approach, then discuss it with one of your co-workers.

Note there is no “right” approach, though probably you will experience that some environments and approaches may lead to code that is better, for instance because it is:

  • easier to explain
  • shorter
  • more performant

The above 3 might points bite each other (;

Based on FizzBuzz: One Simple Interview Question – YouTube.

Write initial tests

Write unit tests for this unit under test in pseudo code:

type OutputMethod: method(string Value)
class FizzBuzzGame:
    method Construct(OutputMethod Value)
    method Process(int Value)

Unit test that captures Output with a certain set of Values, then tests for the four possible combinations:

  • number
  • Fizz
  • Buzz
  • FizzBuzz

and also ensures that the passed OutputMethod is being called once for each call to Process.

Extend the tests

Now extend the tests to cover the below multiples and all the permutations caused by the longer list. Think carefully about the permutations.

  • 3 -> Fizz
  • 5 -> Buzz
  • 7 -> Fuzz
  • 11 -> Bizz
  • 13 -> Biff

Write the unit under test

The least tricky bit should be this step.

Be sure to test the solution with your co-workers as well.

Non positive numbers.

Did you think about negative numbers?

Did you think about the number zero?

What would you do about them in the tests and unit under test?

–jeroen

Read the rest of this entry »

Posted in Conference Topics, Conferences, Development, Event, Software Development | Leave a Comment »

Delphi intrinsic functions that evaluate to consts

Posted by jpluimers on 2021/02/23

A long time ago, I wondered Are these really Windows compiler unsupported Delphi Intrinsic Routines about [WayBack/Archive.is] Delphi Intrinsic Routines – RAD Studio.

Today, I limited the documented intrinsic list to the constant intrinsic functions:

const
  _Abs = System.Abs(1);
  _Chr = System.Chr(1);
  _Concat = System.Concat(1);
  _Hi = System.Hi(1);
  _High = System.High(1);
  _Length = System.Length('');
  _Lo = System.Lo(1);
  _Low = System.Low(1);
  _Odd = System.Odd(1);
  _Ord = System.Ord(1);
  _Pi = System.Pi();
  _Pred = System.Pred(1);
  _Ptr = System.Ptr(1);
  _Round = System.Round(1);
  _SizeOf = System.SizeOf(1);
  _Sqr = System.Sqr(1);
  _Succ = System.Succ(1);
  _Swap = System.Swap(1);
  _Trunc = System.Trunc(1);

The limited table is below the fold.

There is also a set of undocumented generic intrinsics that I wrote about in Source: Delphi Compiler Intrinsics can help you collapse generated code for generics a lot.

Of the those undocumented functions, these are constant intrinsic functions:

const // undocumented compiler intrinsics
  _Default = Default(Integer);
  _IsManagedType = IsManagedType(1);
  _GetTypeKind = GetTypeKind(1);
  _IsConstValue = IsConstValue(1);

–jeroen

Read the rest of this entry »

Posted in Conference Topics, Conferences, Delphi, Development, Event, Software Development, Undocumented Delphi | 2 Comments »

Python: saving a web page to a jpeg image file by using the Google base64url encoded screenshot of it

Posted by jpluimers on 2021/02/19

As a follow-up on Still looking for base64url decoding tools, both on-line and for MacOS homebrew: this is in Python, works on MacOS, Linux and Windows, and can be integrated in a web page.

It is based on the ideas in [WayBack] Python-Twitter-Hacks/websiteScreenshot.py at master · edent/Python-Twitter-Hacks · GitHub, which was more like a code snippet with hard coded literals.

It downloads a jpeg web-site screenshot using the Google PageSpeed API V1, which generates the screenshot as a base64url encoded blob inside a JSON structure.

Python does not have native Python base64url support, but the concept of it is fairly straightforward: [WayBack] RFC 4648 – The Base16, Base32, and Base64 Data Encodings: Base 64 Encoding with URL and Filename Safe Alphabet, which allows data to be passed inside URLs without reverting to [WayBack] Percent-encoding – Wikipedia.

My changes work, but are by no means in canonical form or Idiomatic Python. I have a long way to go to reach that level of Python.

So I forked the repository, and fixed the script basing it on Python 3.

I might make it V2 compatible in the future. More information on V2 in [WayBack] Google APIs Explorer: Services > PageSpeed Insights API v2 > pagespeedonline.pagespeedapi.runpagespeed

Content is in the below gist.

–jeroen

Read the rest of this entry »

Posted in base64, base64url, Development, Encoding, Python, Scripting, Software Development | Leave a Comment »

PowerShell: avoid Write-Output, use Return only for ending execution, use $Output variable for returning additional output

Posted by jpluimers on 2021/02/18

Recently, I bumped into [WayBack] Write-Output confusion for the upteenth time.

Luckily I had the below links archived, basically invalidating the use of Write-Output, and invalidating the answer at [WayBack] powershell – What’s the difference between “Write-Host”, “Write-Output”, or “[console]::WriteLine”? – Stack Overflow.

Read the rest of this entry »

Posted in CommandLine, Development, PowerShell, PowerShell, Scripting, Software Development | Leave a Comment »

showthedocs

Posted by jpluimers on 2021/02/18

[WayBack] showthedocs

is a documentation browser that finds the relevant docs for your code. It works by parsing the code and connecting parts of it to their explanation in the docs

, and supports these languages:

  • SQL
    • postgresql
    • mysql
  • Configuration
    • nginx
    • gitconfig

You can enter any language text, then click the language, followed by clicking the “SHOW ME THE DOCS!” button, for which an example is further below.

The site has an open architecture, allowing to plug in more languages and documentation:

 

gitconfig example

So for instance the below ./git/config file leads to this result [WayBack] where you can click on all the coloured areas for easy navigation through the documentation:

Read the rest of this entry »

Posted in *nix, *nix-tools, Database Development, Development, DVCS - Distributed Version Control, git, MySQL, nginx, PostgreSQL, Power User, Software Development | Leave a Comment »

Delphi: not all lists need to be generic

Posted by jpluimers on 2021/02/18

Lots of Delphi programmers made, or are making the move, of classic Delphi based containers like TObjectList into generic containers like TList<T>.

A while ago, I got into a project that needed to extend lifetime of some objects. Virtually all of them were interface based, and most of the code was from the non-Unicode era, and most of the developers there had a strong background in that era, so they started fiddling with TList, found it hard, then thought “maybe TList<IInterface>” where will help.

The problem however, is that Delphi has no IList<T>. For that, you have to go to the Spring4D library.

Then I sat down with them, and proposed to use an instance good old TInterfacedList of which the context was maintained in an IInterfacedList field.

Back in the days where Delphi did not support non-generic types, TInterfacedList was the only built-in way to store interface references, and the Collection Classes framework by Ray Lischner were the only ways to do that in a more structured way (as they were based on interfaces, an idiom that Embarcadero should have used for their generic collections as well; Spring4D did, so use those collection classes and interfaces whenever possible as they are way more versatile than the Delphi built-in ones)

Back to using TInferfacedList, as it can still be useful today in:

unit InterfacesHolderUnit;

interface

uses
  DebuggableInterfacedObjectUnit, System.Classes;

type
  IInterfacesHolder = interface
    procedure Add(const aReference: IInterface);
  end;

  TInterfacesHolder = class(TInterfacedObject, IInterfacesHolder)
  strict private
    FInterfaces: IInterfaceList;
  public
    constructor Create();
    procedure Add(const aReference: IInterface);
  end;

implementation

{ TInterfacesHolder }

procedure TInterfacesHolder.Add(const aReference: IInterface);
begin
   FInterfaces.Add(aReference);
end;

constructor TInterfacesHolder.Create();
begin
   inherited Create();
   FInterfaces := TInterfaceList.Create();
end;

end.

and some tests:

Read the rest of this entry »

Posted in Conference Topics, Conferences, Delphi, Development, Event, Software Development | 1 Comment »

How not to do updates of your wiki site

Posted by jpluimers on 2021/02/17

If your company manages your own infrastructure, be sure you have monitoring on all levels.

It saves you from customers discovering issues like this: [WayBack] Thread by @jpluimers: “The @EmbarcaderoTech docwiki is down due to an error in duobook2.[…]”:

The @EmbarcaderoTech docwiki is down due to an error in duobook2. URLs pointing to wiki content fail, no matter the product. Examples for Rio and XE2 grabbed from docwiki.embarcadero.com/Libraries/Rio/… and docwiki.embarcadero.com/Libraries/XE2/…


This is the #1 reason for allowing archival of all your product documentation web-content in the @internetarchive, even for non-current products, as now only parts that have been allowed to save in the past are available.

Apart from nobody noticing the outage yet, which is bad in it’s own way, I hope the cause is not somebody fiddling with duobook (3 year old and unmaintained) without testing the consequences. As that would make the cause of the outage embarrassing.

[WayBack] https://github.com/ElectricVersion/DuoBook

Finally it is rather odd to get a HTTP 200 SUCCESS code on a failure. A HTTP 500 or 503 would be far more appropriate.

I wonder if that is a @mediawiki thing; maybe they could shed some light on that.

References en.wikipedia.org/wiki/List_of_H… and en.wikipedia.org/wiki/List_of_H….

The cool thing is that the stack traces teach you a lot about how a framework is structured.

Related:

  • [Archive.is/WayBack] RAD Studio API Documentation: Rio
    Exception encountered, of type "ArgumentCountError"
    [6a5b64d3a502a9acff148fe1] /Libraries/Rio/en/Main_Page ArgumentCountError from line 420 of /var/www/html/shared/BaseWiki27/skins/DuoBook2/DuoBook2.php: Too few arguments to function DuoBook2Template::displayPrefs(), 0 passed in /var/www/html/shared/BaseWiki27/skins/DuoBook2/DuoBook2.php on line 99 and exactly 1 expected
    Backtrace:
    #0 /var/www/html/shared/BaseWiki27/skins/DuoBook2/DuoBook2.php(99): DuoBook2Template->displayPrefs()
    #1 /var/www/html/shared/BaseWiki27/includes/skins/SkinTemplate.php(248): DuoBook2Template->execute()
    #2 /var/www/html/shared/BaseWiki27/includes/OutputPage.php(2335): SkinTemplate->outputPage()
    #3 /var/www/html/shared/BaseWiki27/includes/MediaWiki.php(743): OutputPage->output()
    #4 /var/www/html/shared/BaseWiki27/includes/MediaWiki.php(509): MediaWiki->main()
    #5 /var/www/html/shared/BaseWiki27/index.php(43): MediaWiki->run()
    #6 {main}
  • [Archive.is/WayBack] XE2 API Documentation
    Exception encountered, of type "ArgumentCountError"
    [d3d353581c3915881b976ab6] /Libraries/XE2/en/Main_Page ArgumentCountError from line 420 of /var/www/html/shared/BaseWiki27/skins/DuoBook2/DuoBook2.php: Too few arguments to function DuoBook2Template::displayPrefs(), 0 passed in /var/www/html/shared/BaseWiki27/skins/DuoBook2/DuoBook2.php on line 99 and exactly 1 expected
    Backtrace:
    #0 /var/www/html/shared/BaseWiki27/skins/DuoBook2/DuoBook2.php(99): DuoBook2Template->displayPrefs()
    #1 /var/www/html/shared/BaseWiki27/includes/skins/SkinTemplate.php(248): DuoBook2Template->execute()
    #2 /var/www/html/shared/BaseWiki27/includes/OutputPage.php(2335): SkinTemplate->outputPage()
    #3 /var/www/html/shared/BaseWiki27/includes/MediaWiki.php(743): OutputPage->output()
    #4 /var/www/html/shared/BaseWiki27/includes/MediaWiki.php(509): MediaWiki->main()
    #5 /var/www/html/shared/BaseWiki27/index.php(43): MediaWiki->run()
    #6 {main}

–jeroen

Read the rest of this entry »

Posted in Development, DevOps, Infrastructure, Power User, Software Development, Web Development | Leave a Comment »

explainshell.com: parse and explain just about any shell command

Posted by jpluimers on 2021/02/17

I bumped into the tremendously site [WayBack] explainshell.com – match command-line arguments to their help text only after documenting the relevant cURL options of yesterdays post on checking your CertBot domain expiration dates.

The site allows put in a shell command-line to see the help text that, including matches for each argument.

It works so well because it parses both the shell command-line and the man pages, then constructs a web-page linking the relevant man page content to the shell command-line in the correct shell command-line order.

The explainshell has a counterpart showthedocs (both are open source) for explaining other languages (on the one hand more extended as it goes much deeper into parsing for instance SQL, on the other hand more limited as it only supports a few languages). More on showthedocs later.

The links

The parsing results

The first bit below is just the text output, and the second bit the screenshot, of a relatively simple command like [WayBack] explainshell.com – curl -fsSL example.org:

curl(1) -fsSL example.org
transfer a URL
-f, --fail
       (HTTP)  Fail  silently  (no  output at all) on server errors. This is mostly done to better enable
       scripts etc to better deal with failed attempts. In normal cases  when  a  HTTP  server  fails  to
       deliver  a  document,  it  returns an HTML document stating so (which often also describes why and
       more). This flag will prevent curl from outputting that and return error 22.

       This method is not fail-safe and there are occasions where non-successful response codes will slip
       through, especially when authentication is involved (response codes 401 and 407).
-s, --silent
       Silent or quiet mode. Don't show progress meter or error messages.  Makes Curl mute.
-S, --show-error
       When used with -s it makes curl show an error message if it fails.
-L, --location
       (HTTP/HTTPS) If the server reports that the requested page  has  moved  to  a  different  location
       (indicated  with  a Location: header and a 3XX response code), this option will make curl redo the
       request on the new place. If used together with -i, --include or  -I,  --head,  headers  from  all
       requested pages will be shown. When authentication is used, curl only sends its credentials to the
       initial host. If a redirect takes curl to a different host, it won't  be  able  to  intercept  the
       user+password.  See  also  --location-trusted  on  how to change this. You can limit the amount of
       redirects to follow by using the --max-redirs option.

       When curl follows a redirect and the request is not a plain GET (for example POST or PUT), it will
       do  the  following  request  with a GET if the HTTP response was 301, 302, or 303. If the response
       code was any other 3xx code, curl will re-send the following request  using  the  same  unmodified
       method.
source manpages: curl

The screenshot is even more impressive:

Read the rest of this entry »

Posted in *nix, *nix-tools, bash, bash, Development, Power User, Scripting, Software Development | Leave a Comment »

DUnit testing code that should raise a specific exception

Posted by jpluimers on 2021/02/17

A while back, I was writing some code to demonstrate a few inner workings of TInterfacedObject, interface reference counting and mixing object references with interface references.

One way to show this is through a test case that expects a certain exception to happen, but I forgot how to do that in DUnit. Luckily this pointed me on the right track: [WayBack] delphi – CheckException only accepts 0-parameter methods; how do I test that other methods throw exceptions? – Stack Overflow.

The solution shows that DUnit has had support for something similar as DUnitX: now has a WillRaiseAttribute to ease defining tests around code that should throw exceptions for a very long time (I think this was introduced around Delphi 2005).

You can do it in a property way:

unit InterfacedObjectTestCaseUnit;

interface

uses
  TestFramework;

type
  TDebuggableInterfacedObjectTestCase = class(TTestCase)
  published
    procedure System_TInterfacedObject_Free_Before_RefCount_Should_Raise_EInvalidPointer();
  end;

implementation

uses
  System.SysUtils,

procedure TInterfacedObjectTestCase.System_TInterfacedObject_Free_Before_RefCount_Should_Raise_EInvalidPointer();
var
  ObjectReference:    System.TInterfacedObject;
  InterfaceReference: IInterface;
begin
  ObjectReference    := System.TInterfacedObject.Create();
  InterfaceReference := ObjectReference;
  ExpectedException  := System.SysUtils.EInvalidPointer;
  ObjectReference.Free(); // this should raise an exception in System.TInterfacedObject.BeforeDestruction, as it checks the RefCount to be zero
  // the below is optional; should not be reached. If it is reached, it will fail earlier than the encompassing `RunTest` method would
  ExpectedException := nil; // or `StopExpectingException();`
end;

end.

or in a method way for an exception that happens in the current method:

procedure TInterfacedObjectTestCase.System_TInterfacedObject_Free_Before_RefCount_Should_Raise_EInvalidPointer();
var
  ObjectReference:    System.TInterfacedObject;
  InterfaceReference: IInterface;
begin
  ObjectReference    := System.TInterfacedObject.Create();
  InterfaceReference := ObjectReference;
  StartExpectingException(System.SysUtils.EInvalidPointer);
  ObjectReference.Free(); // this should raise an exception in System.TInterfacedObject.BeforeDestruction, as it checks the RefCount to be zero
  // the below is optional; should not be reached. If it is reached, it will fail earlier than the encompassing `RunTest` method would
  StopExpectingException();
end;

The alternative using CheckException that will raise earlier, but also tests the results of a complete method which also has to be parameterless:

procedure TDebuggableInterfacedObjectTestCase.System_TInterfacedObject_Free_Before_RefCount();
var
  ObjectReference:    System.TInterfacedObject;
  InterfaceReference: IInterface;
begin
  ObjectReference    := System.TInterfacedObject.Create();
  InterfaceReference := ObjectReference;
  ObjectReference.Free(); // this should raise an exception in System.TInterfacedObject.BeforeDestruction, as it checks the RefCount to be zero
end;

procedure TDebuggableInterfacedObjectTestCase.System_TInterfacedObject_Free_Before_RefCount_Should_Raise_EInvalidPointer_TTestMethod_Based();
begin
  CheckException(System_TInterfacedObject_Free_Before_RefCount, System.SysUtils.EInvalidPointer);
end;

So I wrote a class helper based on TProc that allows you to test an anonymous method which usually has more fine grained testing potential.

Because of type compatibility, you have to call the inherited version of CheckException inside the new one:

unit TestCaseHelperUnit;

interface

uses
  System.SysUtils,
  TestFramework;

type
  TTestCaseHelper = class helper for TTestCase
  public
    procedure CheckException(const AProc: TProc; const AExceptionClass: TClass; const msg: string = '');
  end;

implementation

type
  TTestCaseInvoker = class
  strict private
    FProc: TProc;
  public
    constructor Create(const AProc: TProc);
    procedure Execute();
  end;

{ TTestCaseInvoker }

constructor TTestCaseInvoker.Create(const AProc: TProc);
begin
  inherited Create();
  FProc := AProc;
end;

procedure TTestCaseInvoker.Execute();
begin
  if Assigned(FProc) then
    FProc();
end;

procedure TTestCaseHelper.CheckException(const AProc: TProc; const AExceptionClass: TClass; const msg: string = '');
var
  TestCaseInvoker: TTestCaseInvoker;
begin
  TestCaseInvoker := TTestCaseInvoker.Create(AProc);
  try
    inherited CheckException(TestCaseInvoker.Execute, AExceptionClass, msg); // `inherited`, to avoid stack overflow because `TProc` is compatible with `TTestMethod`
  finally
    TestCaseInvoker.Free();
  end;
end;

end.

The test then becomes this:

procedure TDebuggableInterfacedObjectTestCase.System_TInterfacedObject_Free_Before_RefCount_Should_Raise_EInvalidPointer_TProc_Based();
var
  ObjectReference:    System.TInterfacedObject;
  InterfaceReference: IInterface;
begin
  ObjectReference    := System.TInterfacedObject.Create();
  InterfaceReference := ObjectReference;
  CheckException(procedure ()
  begin
    ObjectReference.Free(); // this should raise an exception in System.TInterfacedObject.BeforeDestruction, as it checks the RefCount to be zero
  end,
  System.SysUtils.EInvalidPointer);
end;

DUnit code snippets

Read the rest of this entry »

Posted in Agile, Conference Topics, Conferences, Delphi, Development, Event, Software Development, Unit Testing | Leave a Comment »