I recently migrated from D2010 to DXE2 and found a showstopper bug (Or feature?) in XE2 and XE3 (Tested in my friend XE3) related to RTTI generation for TBytes fields inside classes.
I found that the RTTI information for a TBytes variable inside a class is never generated.
The following code works well in D2010, but shows the message "Error" in XE2/XE3
Does anyone have any clue? This will totally break all our software data serialization implementation
To test the code please add Rtti unit to the uses declaration
type
TMyClass = class
public
Field1: Integer;
Field2: TBytes;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
i: Integer;
Data: TMyClass;
Rtti: TRttiContext;
RttiClassType: TRttiInstanceType;
begin
Data := TMyClass.Create;
try
// Get the context
Rtti := TRttiContext.Create;
try
// Get the type for the class
RttiClassType := TRttiInstanceType(Rtti.GetType(Data.ClassInfo));
// Check the fields
for i := 0 to High(RttiClassType.GetFields) do
begin
// Check the field type
if not Assigned(RttiClassType.GetFields[i].FieldType) then
ShowMessage('Error');
end;
finally
Rtti.Free;
end;
finally
Data.Free;
end;
end;
The error message will be displayed when checking for Field2 that is a TBytes becayse the FieldType is always nil!!!
Does anyone has any clue of what have changed in the RTTI from D2010 do XE2? Maybe because the TBytes type was changed from array of Byte to the generic array?
You can fix this error (it is actually not the same bug as the one Mason mentioned).
type
FixTypeInfoAttribute = class(TCustomAttribute)
public
FTypeInfo: PPTypeInfo;
constructor Create(TypeInfo: PTypeInfo);
end;
procedure FixFieldType(TypeInfo: PTypeInfo);
var
ctx: TRttiContext;
t: TRttiType;
f: TRttiField;
a: TCustomAttribute;
n: Cardinal;
begin
t := ctx.GetType(TypeInfo);
for f in t.GetFields do
begin
for a in f.GetAttributes do
begin
if (a is FixTypeInfoAttribute) and f.ClassNameIs('TRttiInstanceFieldEx') then
begin
WriteProcessMemory(GetCurrentProcess, #PFieldExEntry(f.Handle).TypeRef,
#FixTypeInfoAttribute(a).FTypeInfo, SizeOf(Pointer), n);
end;
end;
end;
end;
constructor FixTypeInfoAttribute.Create(TypeInfo: PTypeInfo);
begin
FTypeInfo := PPTypeInfo(PByte(TypeInfo) - SizeOf(Pointer));
end;
Then you add the attribute to your class definition:
type
TMyClass = class
private
Field1: Integer;
[FixTypeInfo(TypeInfo(TBytes))]
Field2: TBytes;
end;
and make sure the FixFieldType routine is called:
initialization
FixFieldType(TypeInfo(TMyClass));
Tested on XE
This is a known issue that was fixed in XE3. Unfortunately, upgrading is the only way to get a fix for it; bug fixes don't usually get ported back.
EDIT: Or not. Apparently this is not actually fixed, as it still occurs in XE3. Reporting it as a new case and mentioning 103729 would probably be the best course of action.
Related
I'm using a TMemoryStream and I need to pass it to var TStream procedure (external lib). I just cast my TMemoryStream to TStream like this:
var
myStream: TMemoryStream;
begin
//...
ExternalProcedure(TStream(myStream)); //procedure ExternalProcedure(var AStream: TStream);
end;
Is this something to avoid? Does it take a lot of extra memory (the stream in question can be several MB)? My guess is no, but not 100% sure in Delphi.
MBo is right: this kind of cast will only instruct the compiler to assume that the type is the one you specify. This is essentially a cast that will make no additional code being generated. (But there are many exceptions when you cast value types.)
However, I generally would avoid this kind of unsafe cast. Here is an example of what can go wrong:
type
TAnimal = class
DNASequence: string;
end;
TSpider = class(TAnimal)
MoultCount: Integer;
end;
procedure ChangeAnimal(var AAnimal: TAnimal);
begin
FreeAndNil(AAnimal);
AAnimal := TAnimal.Create;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Spider: TSpider;
begin
Spider := TSpider.Create;
try
Spider.DNASequence := 'CTGA...';
Spider.MoultCount := 3;
ChangeAnimal(TAnimal(Spider));
ShowMessage(Spider.MoultCount.ToString); // Oops! The `TSpider` variable
// points to a `TAnimal` object!
finally
Spider.Free;
end;
end;
Casting does not create new objects and correpondingly does not get new memory. It is just instruction for compiler to provide type compatibility
In a common Delphi pattern, i am passing a value as an untyped const to a function:
procedure DoSomething(const Something; SomethingLength: Integer);
begin
//...
end;
In this example, i happen to be passing Windows FORMATETC structure:
procedure Test;
var
omgp: TFormatEtc;
begin
omgp := Default(TFormatEtc);
omgp.cfFormat := RegisterClipboardFormat('CF_PNG');
omgp.ptd := nil;
omgp.dwAspect := DVASPECT_CONTENT or DVASPECT_THUMBNAIL;
omgp.lindex := -1; //all pages
omgp.tymed := TYMED_HGLOBAL;
DoSomething(omgp, SizeOf(omgp));
end;
I need to get the address of this data, so i can pass it to an underlying Windows function something that requires the pointer to the data.
In order to do this, i have always used Pointer(#data):
procedure DoSomething(const Something; SomethingLength: Integer);
begin
SomethingThatNeedsAPointer(Pointer(#Something));
end;
Until this one API call, in one particular case, is failing (it's returning the wrong values). For no particular reason, I happened to look closely at the pointer value being passed. When i was checking everythe parameter value in the debugger i noticed something horrifying. I noticed that:
#Something
Pointer(#Something)
return different values.
#Something should already be a pointer
Pointer(#Something) should be a redundant cast
Which way is the right way to get the address of untyped data?
Edit: People went to lunch on something unrelated to the question. I've edited the question so that hopefully people will focus on the question, and not the example.
This is a debugger bug, whereby the debugger is mis-reporting the value of Pointer(#Salt). I can reproduce the fault in XE5, XE6 and XE7, but not in XE4 and XE8. So it seems that this is a defect introduced in XE5 and removed in XE8.
Whenever you see an issue like this, a debugger fault is always a possibility. In this case we can demonstrate that the fault lies in the debugger with this program:
{$APPTYPE CONSOLE}
uses
System.SysUtils;
procedure DoSomething(const Salt; SaltLength: Integer);
begin
Writeln(IntToHex(NativeUInt(Pointer(#Salt)), 8));
Writeln(IntToHex(NativeUInt(#Salt), 8));
end;
procedure Test;
var
salt: AnsiString;
begin
salt := 'salt';
DoSomething(salt[1], Length(salt));
end;
begin
Test;
end.
This program outputs:
007C9BD4
007C9BD4
even though #Salt and Pointer(#Salt) are accorded different values by the debugger.
Note that this program
{$APPTYPE CONSOLE}
procedure DoSomething(const Salt; SaltLength: Integer);
var
i: Integer;
P: PAnsiChar;
begin
P := #Salt;
for i := 0 to SaltLength-1 do
begin
Writeln(P^);
inc(P);
end;
end;
procedure Test;
var
salt: AnsiString;
begin
salt := 'salt';
DoSomething(salt[1], Length(salt));
end;
begin
Test;
end.
outputs:
s
a
l
t
I cannot reproduce your case in XE8.
The debugger shows same address for both #Salt and Pointer(#Salt).
Likewise the output of this test snippet is identical.
I can only assume that what the debugger is telling you is untrue somehow.
(Update: A test in XE7 reproduces the error in the debugger. The outcome of the snippet is the same though.)
program Test;
{$APPTYPE CONSOLE}
procedure Test1(p: Pointer);
begin
WriteLn(Cardinal(p));
end;
procedure Test(const Salt);
begin
Test1(#Salt);
Test1(Pointer(#Salt));
Test1(Addr(Salt));
end;
var
s:AnsiString;
begin
s := 'Test';
Test( s[1]);
ReadLn;
end.
Given the following record type:
type
TMyRecord = record
private
procedure SomeMethod(_Sender: TObject);
end;
should it be possible to assign this method as the event handler?
var
MyRecord: TMyRecord;
begin
Button1.OnClick := MyRecord.SomeMethod;
end;
In Delphi 2007 I get an internal compiler error C1264 after the assignment.
I am not sure whether the internal structure of a Record's method fulfill the requirements for being assigned to an event pointer.
EDIT:
As David Heffernan pointed out, this is a compiler bug in Delhpi 2007. I ended up using the following workaround:
type
TMyRecord = record
private
procedure SomeMethod(_Sender: TObject);
function GenerateNotifyEvent(_CodePtr: pointer): TNotifyEvent;
end;
function TMyRecord.GenerateNotifyEvent(_CodePtr: pointer): TNotifyEvent;
var
Method: TMethod;
begin
Method.Data := #Self;
Method.Code := _CodePtr;
Result := TNotifyEvent(Method);
end;
var
MyRecord: TMyRecord;
begin
Button1.OnClick := MyRecord.GenerateNotifyEvent(#TMyRecord.SomeMethod);
end;
Not as nice as a simple assignment, but good enough. I just wish I could simply update to a newer version of Delphi where that bug has been fixed.
Yes, you should be able to do this. You can assign the following type of methods:
Instance methods of classes.
Class methods of classes.
Instance methods of records.
Instance methods of objects, that is the deprecated types introduced with the object keyword.
Since this is an internal compiler error, this would appear to be a compiler bug in Delphi 2007. Certainly your code will compile in later versions of Delphi.
QC#59807 seems to be very similar to your issue. According to that bug report it was resolved in build 11.0.2902.10471. Then again, perhaps it is this one: QC#60621 which is reported as being resolved in build 12.0.0.15784.
If you cannot upgrade to a compiler that does not have the fault, then do this:
var
Method: TMethod;
....
Method.Code := #TMyRecord.SomeMethod;
Method.Data := #MyRecord;
Button1.OnClick := TNotifyEvent(Method);
It works in XE7. No warnings. Method content executes as expected on button click.
EDIT - See Update at end
This is for Delphi 7.0 Build 4.453
Summary
I need to be able to take the Handle property from a TMonitor object (an element in the Monitors array in the TScreen component) which is a HMONITOR, and turn it into the string you would use in calls to EnumDisplaySettings as the lpszDeviceName parameter.
(my end goal is to get a list of device settings from a given HMONITOR value, by passing the resolved lpszDeviceName into calls to EnumDisplaySettings).
Detailed Information
As mentioned above, the Screen.Monitors[x].Handle property is of type HMONITOR and is normally used to pass into the GetMonitorInfo function, which returns, geometry information, but no lpszDeviceName. (note: there is a TMonitorInfoEx structure that has a szDevice field, but it does not seem to get filled in on my system, even though i am setting the cbSize field to the appropriate size).
Alternatively, if i can use a szDeviceName to get the equivalent HMONITOR value, i could plug it into the following function, which would use it in a comparison (I have inserted a call to fictitious function called hMonitorFromDeviceName in the code below) to indicate how it would be used.
function GetMonitorDeviceName(hmon : HMONITOR) : string;
var
DispDev : TDisplayDevice;
deviceName : string;
nDeviceIndex : integer;
begin
Result := '';
FillChar(DispDev, sizeof(DispDev),0);
DispDev.cb := sizeof(DispDev);
nDeviceIndex := 0;
while (EnumDisplayDevices(nil, nDeviceIndex, DispDev, 0)) do
begin
if ( hMonitorFromDeviceName(DispDev.DeviceString) = hmon ) then
begin
Result := StrPas(DispDev.DeviceString);
exit;
end;
inc(nDeviceIndex);
end;
end;
Update
Thanks to David Heffernan, I have tested his solution, and here is a sample function to get the monitor name from a given handle:
function GetMonitorName(hmon : HMONITOR) : string;
type
TMonitorInfoEx = record
cbSize: DWORD;
rcMonitor: TRect;
rcWork: TRect;
dwFlags: DWORD;
szDevice: array[0..CCHDEVICENAME - 1] of AnsiChar;
end;
var
DispDev : TDisplayDevice;
deviceName : string;
monInfo : TMonitorInfoEx;
begin
Result := '';
monInfo.cbSize := sizeof(monInfo);
if GetMonitorInfo(hmon,#monInfo) then
begin
DispDev.cb := sizeof(DispDev);
EnumDisplayDevices(#monInfo.szDevice, 0, DispDev, 0);
Result := StrPas(DispDev.DeviceString);
end;
end;
I think that you must be calling GetMonitorInfo incorrectly. This code:
{$APPTYPE CONSOLE}
uses
SysUtils, MultiMon, Windows, Forms;
var
i: Integer;
MonitorInfo: TMonitorInfoEx;
begin
MonitorInfo.cbSize := SizeOf(MonitorInfo);
for i := 0 to Screen.MonitorCount-1 do
begin
if not GetMonitorInfo(Screen.Monitors[i].Handle, #MonitorInfo) then
RaiseLastOSError;
Writeln(MonitorInfo.szDevice);
end;
Readln;
end.
produces this output on my machine:
\\.\DISPLAY1
\\.\DISPLAY2
I suspect that your call to GetMonitorInfo is failing in some way and perhaps you are not checking the return value for errors.
Having searched QualityCentral I suspect you have fallen victim to a known bug in older versions of Delphi: QC#3239. This is reported fixed in version 10.0.2124.6661 which is Delphi 2006.
Your comments confirm this diagnosis. To fix the problem you'll need a new TMonitorInfoEx definition. Here's one that will work on your pre-Unicode Delphi:
type
TMonitorInfoEx = record
cbSize: DWORD;
rcMonitor: TRect;
rcWork: TRect;
dwFlags: DWORD;
szDevice: array[0..CCHDEVICENAME - 1] of AnsiChar;
end;
If you add that to the code above (before you declare the variables of course) then I believe it will resolve your problem.
As an interesting aside, even in XE3, these structs have not been translated correctly: QC#114460. Admittedly the error is rather benign as it only affects PMonitorInfoExA and TMonitorInfoExA, but the error caught me out whilst trying to solve the problem in this question!
This unit fails to compile in XE2 Update 3 with error "Internal Error: SY6315". In XE there is no such problem.
unit Test;
interface
uses
SysUtils;
var
Proc: TProc;
implementation
initialization
Proc := procedure
var ByteArr: array of Byte;
begin
SetLength(ByteArr, 10);
end;
end.
Does anyone have any experience of this problem?
Update: I have submitted a QC report: QC#102888.
Looks like a compiler bug, this is a workaround using TBytes
Proc := procedure
var
ByteArr: TBytes;
begin
SetLength(ByteArr, 10);
end;