Casting anonymous procedures in Delphi 2009 - delphi

The following code (constructed only to demonstrate the problem) compiles and works in Delphi 2010. In Delphi 2009, compiler fails with "E2035 Not enough actual parameters".
program Project50;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TMyProc = reference to procedure(param: integer);
var
a: TProc;
b: TMyProc;
begin
b := procedure (param: integer)
begin
end;
a := TProc(b); // <-- [DCC Error] Project50.dpr(19): E2035 Not enough actual parameters
end.
I have found only one very ugly hack to work around the problem (a: TProc absolute b). Does anybody knows of a nicer workaround for this compiler deficiency?
[TProc field is actually hidden inside a record that can store various 'executable' code - TProcedure, TMethod and TProc. Casting is used to store specific anonymous proc into this field.]

The trick is not to do
a := TProc(b);
but
TMyProc(a) := b;
That compiles and works in D2009. Sample project attached below.
program Project51;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TMyProc = reference to procedure(var param: integer);
TStorage = record
FDelegate: TProc;
end;
var
a : TMyProc;
b : TMyProc;
param: integer;
stg : TStorage;
begin
b := procedure (var param: integer)
begin
param := 2*param;
end;
// stg.FDelegate := TMyProc(b); // doesn't compile in Delphi 2009, compiles in Delphi 2010
TMyProc(stg.FDelegate) := b;
param := 21;
TMyProc(stg.FDelegate)(param);
Writeln(param);
Readln;
end.
However, this doesn't work if casting to a local variable.
var
p: TProc;
a: TMyProc;
TMyProc(p) := a; // this will not compile
Curiouser and curiouser.

I have found a hack #2:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TMyProc = reference to procedure(param: integer);
var
a: TProc;
b: TMyProc;
begin
b := procedure (param: integer)
begin
Writeln('asdf');
end;
PPointer(#a)^ := PPointer(#b)^;
a;
readln;
end.
I am in doubt what are you trying to achieve by assigning TMyProc (with param argument) to TProc (without argument)?
Updated: A hack #3 (should increment ref counter, the idea is stolen from System._IntfCopy):
procedure AnonCopy(var Dest; const Source);
var
P: Pointer;
begin
P:= Pointer(Dest);
if Pointer(Source) <> nil
then IInterface(Source)._AddRef;
Pointer(Dest):= Pointer(Source);
if P <> nil then
IInterface(P)._Release;
end;
var
a: TProc;
b: TMyProc;
begin
b := procedure (param: integer)
begin
Writeln('asdf');
end;
AnonCopy(a, b);
// PPointer(#a)^ := PPointer(#b)^;
a;
readln;
end.

It appears that the best way would be to use generics to store the correct type of delegate in the record. No hacks required.
program Project51;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TMyProc = reference to procedure(var param: integer);
TStorage<T> = record
FDelegate: T;
end;
var
a : TMyProc;
b : TMyProc;
p : TProc;
param: integer;
stg : TStorage<TMyProc>;
begin
b := procedure (var param: integer)
begin
param := 2*param;
end;
stg.FDelegate := b;
param := 21;
stg.FDelegate(param);
Writeln(param);
Readln;
end.

Related

What does "Reference to" do exactly in Delphi?

While reading the documentation at Anonymous Methods in Delphi I started to wonder. I've always used something like this:
type TMathFn = Function(A, B: Integer): Integer;
var fn: TMathFn;
Always worked for me. But this document tells me to use this instead:
type TMathFn = Reference to Function(A, B: Integer): Integer;
var fn: TMathFn;
And as I've been developing in Delphi from 1994 until 2010 I'm a bit unfamiliar with this "Reference to" part. Still, both options seem to work identically. So...
Are they identical?
"REFERENCE TO" is to allow Anonymous Methods (inline definitions of PROCEDUREs/FUNCTIONs), which can Capture a context (for example local variables, which are captured as references, ie. if you change the variable after capture, it's the modified value that is captured, see below).
TYPE TMyProc = REFERENCE TO PROCEDURE(CONST S : STRING);
PROCEDURE Information(CONST S : STRING);
BEGIN
MessageDlg(S,mtInformation,[mbOK],0)
END;
PROCEDURE RunProc(P : TMyProc ; CONST S : STRING);
BEGIN
P(S)
END;
PROCEDURE A(B,C : INTEGER);
VAR
D : INTEGER;
P : TMyProc;
BEGIN
D:=3;
// D is 3 at the time of capture
P:=PROCEDURE(CONST S : STRING)
BEGIN
Information(S+': '+IntToStr(D)+' -> '+IntToStr(B))
END;
// D is now 4 - and is reflected in the captured routine, as
// the capture is done by REFERENCE and not by VALUE.
INC(D);
RunProc(P,'Hello')
END;
BEGIN
A(2,3)
END.
Will show "Hello: 4 -> 2" in a message box.
The above definition of P "captures" (includes) the variables D and B so that even if you pass it to another function, where these variables don't exist, you can still access them.
This would be (nearly) impossible to do with ordinary PROCEDURE [OF OBJECT] types, as they can't access local variables declared at the point of execution.
No, they are not identical.
The difference is that
TMathFn = function(A, B: Integer): Integer;
is an ordinary function,
TMathMethod = function(A, B: Integer): Integer of object;
is a method, and
TMathAnonMethod = reference to function(A, B: Integer): Integer;
is an anonymous method, but you can also assign an ordinary function or a method to a variable of this type.
So, for instance, if
type
TMathFn = function(A, B: Integer): Integer;
TMathMethod = function(A, B: Integer): Integer of object;
TMathAnonMethod = reference to function(A, B: Integer): Integer;
function Test(A, B: Integer): Integer;
begin
Result := A + B;
end;
type
TTestClass = class
function Test(A, B: Integer): Integer;
end;
{ TTestClass }
function TTestClass.Test(A, B: Integer): Integer;
begin
Result := A + B;
end;
then the following applies:
procedure TForm1.FormCreate(Sender: TObject);
var
T: TTestClass;
F: TMathFn;
M: TMathMethod;
AM: TMathAnonMethod;
begin
T := TTestClass.Create;
try
F := Test; // compiles
F := T.Test; // doesn't compile
F := function(A, B: Integer): Integer
begin
Result := A + B;
end; // doesn't compile
M := Test; // doesn't compile
M := T.Test; // compiles
M := function(A, B: Integer): Integer
begin
Result := A + B;
end; // doesn't compile
AM := Test; // compiles
AM := T.Test; // compiles
AM := function(A, B: Integer): Integer
begin
Result := A + B;
end; // compiles
finally
T.Free;
end;
end;
Under the hood, as you probably already know, F is simply a (function) pointer and M is a method pointer. Anonymous methods, on the other hand, have a more involved interface-based implementation, which allows all their magic (like variable capture).

Initial value of OleVariant variable

I always was thinking that OleVariant variables always has initial value equal to Unassigned (type VT_EMPTY). But the following simple code compiled with XE3 shows me it is not true.
{$APPTYPE CONSOLE}
uses
ActiveX;
function GetValue: OleVariant;
begin
Result := TVariantArg(Result).vt;
end;
function GetValue2: OleVariant;
begin
Result := 10;
Result := GetValue;
end;
var
Msg: string;
begin
Msg := GetValue2;
Writeln(Msg);
end.
App writes "3". Is it normal?
The return value of a Delphi function, for types that don't fit in a register, are passed as var parameters. So the compiler transforms the code to be like so:
procedure GetValue(var Result: OleVariant);
Hence the value of Result on entry to the function is the value of the variable that you assign the return value to.
So your calling code is transformed to
function GetValue2: OleVariant;
begin
Result := 10;
GetValue(Result);
end;
So in its entirety your program becomes
{$APPTYPE CONSOLE}
uses
ActiveX;
procedure GetValue(var Result: OleVariant);
begin
Result := TVariantArg(Result).vt;
end;
procedure GetValue2(var Result: OleVariant);
begin
Result := 10;
GetValue(Result);
end;
var
tmp: OleVariant;
Msg: string;
begin
GetValue2(tmp);
Msg := tmp;
Writeln(Msg);
end.
Which explains the output of VT_I4.
Of course this is all a consequence of implementation detail. You should always initialize function return values.

How to use varargs to print out strings?

How can I use varargs to print out multiple strings? I tried this but I cannot determine the size of the array. It just prints garbage.
program Project1;
{$APPTYPE CONSOLE}
{$POINTERMATH ON}
function _Print(const S: String): string; cdecl;
var
Args: Array[0..100] of Pointer absolute S;
I: Integer;
begin
I := 0;
while Args[I] <> nil do
begin
WriteLn(PString(#Args[I])^);
Inc(I);
end;
end;
const Print: function(const S: String): string; cdecl varargs = _Print;
var
A, B: String;
begin
A := 'ABC';
B := 'CDE';
Print(a, b, 'asdasd', 'fasd', ' ')
end.
A varargs function has no automated way to determine the number of arguments being passed, because only the caller knows how many parameters it is putting on the call stack. The function must determine the arguments manually, either by:
requiring the caller to pass the actual number of parameter as a fixed parameter:
function _Print(NumStrings: Integer; const Strings: string): string; cdecl;
var
Args: Array[0..100] of Pointer absolute Strings;
I: Integer;
begin
for I := 0 to NumStrings-1 do
begin
WriteLn(PString(#Strings[I])^);
end;
end;
const
Print: function(NumStrings: Integer; const Strings: string): string; cdecl varargs = _Print;
var
A, B: String;
begin
A := 'ABC';
B := 'CDE';
Print(5, a, b, 'asdasd', 'fasd', ' ');
end.
putting a sentry value at the end of the parameter list that the function can then look for. Your function is already coded for this (it is looking for a nil pointer), so just pass one:
Print(a, b, 'asdasd', 'fasd', ' ', nil);
That being said, either approach is subject to caller error and thus potentially dangerous if misused, which is why varargs-style functions are not used very often. You should consider using an open-array parameter instead:
program Project1;
{$APPTYPE CONSOLE}
{$POINTERMATH ON}
function _Print(const Args: array of string): string;
var
I: Integer;
begin
for I := Low(Args) to High(Args) do
begin
WriteLn(Args[I]);
end;
end;
const
Print: function(const Args: array of string): string = _Print;
var
A, B: String;
begin
A := 'ABC';
B := 'CDE';
Print([a, b, 'asdasd', 'fasd', ' ']);
end.

How to overload Inc (Dec) operators in Delphi?

Delphi documentation says that it is possible to overload the Inc and Dec operators; I see no valid way to do it. Here are attempts to overload the Inc operator; some attempts lead to compile errors, some to runtime access violation (Delphi XE):
program OverloadInc;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TMyInt = record
FValue: Integer;
// class operator Inc(var A: TMyInt); DCC error E2023
class operator Inc(var A: TMyInt): TMyInt;
property Value: Integer read FValue write FValue;
end;
class operator TMyInt.Inc(var A: TMyInt): TMyInt;
begin
Inc(A.FValue);
Result:= A;
end;
type
TMyInt2 = record
FValue: Integer;
class operator Inc(A: TMyInt2): TMyInt2;
property Value: Integer read FValue write FValue;
end;
class operator TMyInt2.Inc(A: TMyInt2): TMyInt2;
begin
Result.FValue:= A.FValue + 1;
end;
procedure Test;
var
A: TMyInt;
begin
A.FValue:= 0;
Inc(A);
Writeln(A.FValue);
end;
procedure Test2;
var
A: TMyInt2;
I: Integer;
begin
A.FValue:= 0;
// A:= Inc(A); DCC error E2010
Writeln(A.FValue);
end;
begin
try
Test; // access violation
// Test2;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
The signature of the operator is wrong. It should be:
class operator Inc(const A: TMyInt): TMyInt;
or
class operator Inc(A: TMyInt): TMyInt;
You cannot use a var parameter.
This program
{$APPTYPE CONSOLE}
type
TMyInt = record
FValue: Integer;
class operator Inc(const A: TMyInt): TMyInt;
property Value: Integer read FValue write FValue;
end;
class operator TMyInt.Inc(const A: TMyInt): TMyInt;
begin
Result.FValue := A.FValue + 1;
end;
procedure Test;
var
A: TMyInt;
begin
A.FValue := 0;
Inc(A);
Writeln(A.FValue);
end;
begin
Test;
Readln;
end.
produces this output:
1
Discussion
This is a rather unusual operator when overloaded. In terms of usage the operator is an in-place mutation. However, when overloaded, it works like an addition operator with an implicit addend of one.
So, in the code above this line:
Inc(A);
is effectively transformed into
A := TMyInt.Inc(A);
and then compiled.
If you are wanting to maintain true in-place mutation semantics, and avoid the copying associated with this operator, then I believe that you need to use a method of the type.
procedure Inc; inline;
....
procedure TMyInt.Inc;
begin
inc(FValue);
end;

Sporadic issue with RTTI in Delphi XE

We're seeing an issue with Delphi XE where, at times, TRttiType.GetTypes returns an empty array. Other times, using the exact same code, the array contains the expected types. The error is occurring when marshalling/unmarshalling classes over DataSnap using TJSONMarshal and TJSONUnMarshal.
Any idea why the call to GetTypes in the unit below would return an empty array? (The $M directive should not be required. It is there as I've tried several brute-force approaches, including $STRONGLINKTYPES.)
unit uTest;
interface
uses
Classes;
type
{$M+}
TMyClass = class(TPersistent)
public
Value1 : Integer;
Value2 : String;
Value3 : Currency;
Value4 : Boolean;
Value5 : Double;
end;
procedure Test;
implementation
uses
Dialogs, Rtti, SysUtils;
procedure Test;
var
c: TRttiContext;
t: TRttiType;
a: TArray<TRttiField>;
begin
c := TRttiContext.Create;
t := c.GetType(TypeInfo(TMyClass));
if Assigned(t) then begin
a := t.GetFields;
ShowMessage(IntToStr(High(a)));
end
else
ShowMessage('TMyClass not found');
end;
procedure ForceReferenceToClass(C: TClass);
var
dummy: TObject;
begin
dummy := C.Create();
dummy.Free();
end;
initialization
ForceReferenceToClass(TMyClass);
end.
Thanks

Resources