If you make a new multi-device application project, set Project > Option > Compiling > Optimization : True, and then copy the code below to unit1.pas:
unit Unit1;
interface
uses
System.SysUtils,
FMX.Forms,
FMX.StdCtrls,
System.Classes,
FMX.Types,
FMX.Controls,
FMX.Controls.Presentation;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
FKey: integer;
public
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.Button1Click(Sender: TObject);
begin
FKey := 2;
var LCompareKey: integer := 2;
AtomicCmpExchange(FKey{target}, LCompareKey{NewValue}, LCompareKey{Comparand});
if FKey <> LCompareKey then raise Exception.Create('Error 2');
TThread.queue(nil,
procedure
begin
if LCompareKey <> FKey
then raise Exception.Create('Error 3');
end);
end;
end.
Why does this code crash on Win32 on if FKey <> LCompareKey then raise Exception.Create('Error 2');?
I'm using Delphi 10.4 Sydney Update 3. I didn't yet try in Delphi 11 Alexandria, so I don't know if it's working in that version.
Is there any workaround except deactivating the optimization?
Another question - is it really safe to activate the optimization?
Yes, codegen for AtomicCmpExchange is broken on Win32 compiler when optimization is turned on.
Problem happens in combination with anonymous method variable capture that happens in TThread.Queue call. Without variable capture, assembly code for AtomicCmpExchange is properly generated.
Workaround for the issue is using TInterlocked.CompareExchange.
...
var LCompareKey: integer := 2;
TInterlocked.CompareExchange(FKey{target}, LCompareKey{NewValue}, LCompareKey{Comparand});
if FKey <> LCompareKey then raise Exception.Create('Error 2');
...
TInterlocked.CompareExchange function still uses AtomicCmpExchange, but at place of call it works with captured variables through parameters instead of directly and generated code is correct in those situations.
class function TInterlocked.CompareExchange(var Target: Integer; Value, Comparand: Integer): Integer;
begin
Result := AtomicCmpExchange(Target, Value, Comparand);
end;
Another, less optimal solution would be turning off optimization around broken method Button1Click with {$O-} compiler directive and then turning it back on with {$O+}
Since AtomicCmpExchange is Delphi intrinsic function, its code is directly generated by compiler when it is called and bad codegen only affects that procedure, not general code - in other words anonymous method capture is working correctly in other code (unless there are other, bugs in compiler, unrelated to this particular one).
In other places in RTL where AtomicCmpExchange is used, there is no code where variable capture is involved, so RTL, VCL and FMX code is not affected by this issue and optimization can be turned on in application.
Note: There may be other optimization bugs in compiler that we don't know about.
Related
I´m facing a problem between Delphi 2010 and Delphi Berlin (last update) during my code migration....
I made a simple code to demonstrante an strange behaviour...
I have an application that use TList (the former one) and TList (from Generics.Collections)
I know that this piece of code (below) doesn´t make any sense for you, but it´s for demonstration purposes
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TTest = class
Name: string;
constructor Create(Nome: string);
end;
TForm1 = class(TForm)
btn1: TButton;
procedure btn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FList: TList;
end;
var
Form1: TForm1;
implementation
uses
System.Generics.Collections;
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
var
tmpList: TList<TTest>;
begin
tmpList := TList<TTest>.Create;
tmpList.Add(TTest.Create('A'));
tmpList.Add(TTest.Create('B'));
tmpList.Add(TTest.Create('C'));
tmpList.Add(TTest.Create('D'));
tmpList.Add(TTest.Create('E'));
FList := TList(tmpList);
ShowMessage(TTest(FList[0]).Name);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FList := TList.Create;
end;
constructor TTest.Create(Nome: string);
begin
Name := Nome;
end;
end.
At Delphi 2010 the ShowMessage shows 'A' character, but on the Delphi Berlin it raises an Acess Violation
Both applications with Optimization set to False
FList := TList(tmpList);
This is the problem. The cast is simply wrong, because tmpList is not a TList.
Your code only compiles because of the cast, but the cast does not change the fact that the object on the right hand side is not of the type being casted to. All the cast does is stop the compiler from complaining and saving you from yourself. Your cast is a lie to the compiler, and the runtime error is the consequence.
This code might have worked in older versions, but only by chance. Your luck has changed.
Hard to know what to suggest for a fix. As you say, the code makes little sense. Every time you press the button, you leak a list. I'd suggest that you remove all the casts, stop using the non-Generic TList and use only Generic lists.
The class TList<T> is not castable to/from TList.
You cannot cast one to the other and expect sensible results any more than you could cast a TForm to TButton (for example).
In Delphi, typecasts of this form are unchecked, sometimes referred to as hard-casting. That is, the compiler will simply trust that you know what you are doing and will simply comply, but if the typecast is invalid then the results will be unpredictable.
For conversions between object reference types (and/or interface references) you can use a checked cast using the as operator:
FList := tmpList as TList;
If a checked cast is invalid (such as this one is) then the compiler will throw a runtime exception, alerting you to the mistake.
Why does the compiler even allow unchecked casts ?
In some cases unchecked casting can be useful and safely relied upon, within specific use cases. But outside of those specific conditions unchecked casts are at best trusting to luck or on specific compiler behaviours or RTL characteristics which may be subject to change.
e.g. the 32-bit trick of storing object references or other pointer values in an Integer variable. Such code may continue to work when recompiled for 64-bit, but now only as a matter of luck and only in some cases, since only a subset of possible 64-bit pointer values can safely be stored in a 32-bit Integer.
If you have code which is successfully hard-casting between TList and TList<T> then it worked only by luck, as a result of some particular behaviour of the compiler or RTL at that time.
I'm making use of a GDI+ canvas in Delphi 10.1 Berlin, using the built-in units GDIPAPI and GDIPOBJ. I have a thread which is performing drawing, and while looking for ways to improve the performance of the thread, one major drawback is the fact that I'm currently forced to instantiate an instance of this canvas (TGPGraphics), perform the drawing, and destroy the canvas, all together at the same time, at the moment I wish to draw. Instead, I would like to maintain a single constant instance of TGPGraphics.
Problem
The problem is that when I attempt to create a single global instance of TGPGraphics and use it in the future, for some reason it ends up drawing nothing onto the canvas. It results in just an empty unpainted canvas. It only works when I create/destroy the canvas at the exact moment I need to actually draw anything. I seem to be forced to create the instance, perform the painting, then destroy it, before I'm allowed to read that bitmap image.
The same problem happens elsewhere, not just inside the thread and not just on a TBitmap. I faced this issue in the past, but I was able to get away with constantly creating/freeing it for that project. This one though, it's not acceptable.
Question
How can I retain a single instance of TGPGraphics instead of creating/destroying it each time I need to draw?
Example
Here's a minimal test application which demonstrates the issue. Turn the GLOBAL_CANVAS conditional on and off - be sure to do a Build when changing, don't immediately go to Run. It's just a blank form with no components, just code:
unit uMain;
interface
{$DEFINE GLOBAL_CANVAS}
{$DEFINE FLUSH_SYNC}
{ $DEFINE FLUSH_BEFORE}
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
GDIPAPI, GDIPOBJ;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
private
FCan: TGPGraphics;
FPen: TGPPen;
FBmp: TBitmap;
function CreateCanvas: TGPGraphics;
procedure DoFlush;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FBmp:= TBitmap.Create;
FBmp.Width:= ClientWidth;
FBmp.Height:= ClientHeight;
{$IFDEF GLOBAL_CANVAS}
FCan:= CreateCanvas;
{$ENDIF}
FPen:= TGPPen.Create(MakeColor(255, 0, 0));
FPen.SetWidth(4.0);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FPen.Free;
{$IFDEF GLOBAL_CANVAS}
FCan.Free;
{$ENDIF}
FBmp.Free;
end;
function TForm1.CreateCanvas: TGPGraphics;
begin
Result:= TGPGraphics.Create(FBmp.Canvas.Handle);
Result.SetInterpolationMode(InterpolationMode.InterpolationModeHighQuality);
Result.SetSmoothingMode(SmoothingMode.SmoothingModeHighQuality);
Result.SetCompositingQuality(CompositingQuality.CompositingQualityHighQuality);
end;
procedure TForm1.DoFlush;
begin
{$IFDEF FLUSH_SYNC}
FCan.Flush(FlushIntention.FlushIntentionSync);
{$ELSE}
FCan.Flush(FlushIntention.FlushIntentionFlush);
{$ENDIF}
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
{$IFNDEF GLOBAL_CANVAS}
FCan:= CreateCanvas;
try
{$ENDIF}
{$IFDEF FLUSH_BEFORE}
DoFlush;
{$ENDIF}
FCan.DrawEllipse(FPen, 5, 5, 50, 50);
{$IFNDEF FLUSH_BEFORE}
DoFlush;
{$ENDIF}
{$IFNDEF GLOBAL_CANVAS}
finally
FCan.Free;
end;
{$ENDIF}
Caption:= 'Handle: ' + IntToStr(FBmp.Canvas.Handle);
Canvas.Draw(0, 0, FBmp);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
FBmp.Width:= ClientWidth;
FBmp.Height:= ClientHeight;
end;
end.
The left is when I create/free the canvas at the time of painting, and the right is when I create/free the canvas at startup/shutdown.
EDIT
I just noticed something - when GLOBAL_CANVAS is enabled in the test above, and then you resize the form to complete minimal size, then make it bigger again, you can see little bits and pieces of the drawing, but not the entire thing.
EDIT 2
I tried the recommendation to use Flush, and I switched it from FlushIntentionFlush to FlushIntentionSync, and now I have about a 50/50 success rate. Sometimes I run the app and it shows, and other times, making no changes at all, I run the app and nothing draws. I tried many different combinations of using Flush, using both methods, before drawing and after drawing. The few times it does appear to work, I resize the form to hide it, and make it larger again, and I can only see a glitchy image...
EDIT 3
I discovered the cause of the problem: the canvas handle keeps getting recreated, so each time I go to draw, the canvas has a whole new handle. I get the same behavior with both TForm.Canvas.Handle and TBitmap.Canvas.Handle. I'm not sure what the appropriate solution is though. I can't find a way to pass the new handle into the canvas object. The reason why it sometimes draws a glitchy image is because sometimes it obtains the same handle, but most of the time, it's different.
The default font of the object inspector is ridiculously small, esp on a high resolution screen.
Is there a way to make it bigger?
Yes there is and it's really easy.
You can alter any window in the IDE by creating a package and installing this in the IDE.
Because the bpl gets loaded into the main process of the Delphi IDE you can alter any IDE window's properties from there.
Code by Mike Fletcher
Create a new package and add the following unit:
unit AdjustOIFont;
interface
uses Vcl.Forms, Vcl.Controls, Vcl.Dialogs, Vcl.StdCtrls;
procedure Register;
implementation
function GetOIForm: TForm;
var
i: Integer;
begin
Result:= nil;
for i:= 0 to Screen.FormCount - 1 do begin
if Screen.Forms[i].Name = 'PropertyInspector' then begin
Result:= Screen.Forms[I];
Exit;
end;
end;
end;
function GetChildControl(AParent: TWinControl; AName: string): TWinControl;
var
i: Integer;
begin
Result:= nil;
for i:= 0 to AParent.ControlCount - 1 do begin
if AParent.Controls[i].Name = AName then begin
Result:= TWinControl(AParent.Controls[i]);
Exit;
end;
end;
end;
function GetOIControl: TCustomListBox;
var
OIForm: TForm;
begin
OIForm:= GetOIForm;
Result:= TCustomListBox(GetChildControl(GetChildControl(OIForm, 'Panel3'), 'PropList'));
end;
procedure Register;
var
OI: TListBox;
OIForm: TForm;
begin
OIForm:= GetOIForm;
OIForm.Font.Size:= 10;
OI:= TListBox(GetOIControl);
OI.Font.Size:= 10;
OI.ItemHeight:= 20;
end;
end.
Build the package and install.
The change will take effect immediately.
Knowing this trick it's also be easy to collect all the enumerated names in a stringlist and copy them to the clipboard.
These names can than be used to expand the code and fix the fonts of other IDE elements as well (e.g. the Structure pane).
Much better.
Works on Seattle and XE7.
One way to achieving this is by modifying registry like it is described in Malcolm Groves article here: http://www.malcolmgroves.com/blog/?p=1804
Another option is to use Delphi IDE Colorizer which is a third party application designed to greatly change appearance of Delphi IDE by changing fonts, colors, etc. You can find it here: https://github.com/RRUZ/Delphi-IDE-Colorizer
And if you perhaps also want to change syntax fonts and syntax highlighting you can also check Delphi IDE Theme Editor which is designed to change the appearance of code highlighting based on your desires. You can find it here: https://github.com/RRUZ/delphi-ide-theme-editor
I am having a strange problem of using interface in different versions of Delphi. The following minimized code compiles and runs as expected in Delphi XE and higher but not in Delphi 7. Specificaly, it seems when compiling in Delphi 7, the function TForm1.Load: IMoleculeSubject; does not returns the correct result, i.e., the correct reference to the newly created instance. Could you help to comment about the reason and possible workaround? Many thanks!
uInterface.pas
unit uInterface;
interface
type
IMoleculeSubject = interface
['{BEB4425A-186C-45DF-9DCE-C7175DB0CA90}']
end;
TMoleculeSubject = class(TInterfacedObject, IMoleculeSubject)
end;
implementation
end.
uBusiness.pas
unit uBusiness;
interface
uses
uInterface;
type
TMoleculeDecorator = class(TMoleculeSubject)
private
FID: Integer;
public
property ID: Integer read FID;
constructor Create;
end;
implementation
{ TMoleculeDecorator }
constructor TMoleculeDecorator.Create;
begin
inherited Create;
FID := Random(100);
end;
end.
Unit1.pas
unit Unit1;
interface
uses
uInterface, uBusiness,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms, Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
function Load: IMoleculeSubject;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
MolSubject: IMoleculeSubject;
begin
MolSubject := Load;
// The down-cast is to show the returned result is wrong in Delphi 7!
Caption := IntToStr(TMoleculeDecorator(MolSubject).ID);
end;
function TForm1.Load: IMoleculeSubject;
var
MolSubject: IMoleculeSubject;
begin
MolSubject := TMoleculeDecorator.Create;
Result := MolSubject;
end;
end.
The Load function works perfectly well in all versions of Delphi. The problem is your cast, which is what is known as an unsafe typecast. An unsafe typecast from an interface reference to an object has ill-defined behaviour in older versions of Delphi. However, the behaviour is well-defined in modern Delphi. The documentation says more.
So, the basic problem is that your expectations for the behaviour are not compatible with the Delphi 7 version of the language.
If you get the interface to return the ID you will find that the interface you are creating is as expected.
program InterfaceDemo;
{$APPTYPE CONSOLE}
uses
Classes;
type
IMyIntf = interface
function GetID: Integer;
end;
TImplementingObject = class(TInterfacedObject, IMyIntf)
private
FID: Integer;
function GetID: Integer;
public
constructor Create;
end;
{ TImplementingObject }
constructor TImplementingObject.Create;
begin
FID := Random(100);
Writeln(FID);
end;
function TImplementingObject.GetID: Integer;
begin
Result := FID;
end;
var
MyIntf: IMyIntf;
begin
Randomize;
MyIntf := TImplementingObject.Create;
Writeln(MyIntf.GetID);
Readln;
end.
It's rather unusual to ask for the implementing object from an interface. To do so suggests that there is a problem with your design. Should you really need to do so there are a few options:
In modern Delphi you can use the type-safe case with the as operator.
In older Delphi versions there are hacks that retrieve the implementing object: Casting a delphi interface to its implementation class without modifying the interface
You could add a function to the interface that returns the implementing object.
The latter option works in all versions of Delphi and does so without resorting to subterfuge.
Casting interfaces to objects is available since Delphi 2010. Where are workarounds for older Delphi versions, see for example How to cast a Interface to a Object in Delphi
I got a very serious problem when I'm trying to access TDictionary variable in host program from a dynamicly loaded dll. Here is the complete code, anyone can give some help? thanks!
===========main program project source code===================
program main;
uses
ShareMem,
Forms,
uMain in 'uMain.pas' {Form1},
uCommon in 'uCommon.pas';
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
==============unit uMain================
unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, uCommon;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
Tfoo = function(ADic: TMyDic): string; stdcall;
procedure TForm1.Button1Click(Sender: TObject);
var
Dic: TMyDic;
HLib: THandle;
foo: Tfoo;
begin
Dic := TMyDic.Create;
try
Dic.Add(1, 'World!');
Dic.Add(2, 'Hello, ');
HLib := LoadLibrary('Mydll.dll');
try
#foo := GetProcAddress(HLib, 'foo');
ShowMessage(foo(Dic));
finally
FreeLibrary(HLib);
end;
finally
Dic.Free;
end;
end;
end.
=================dll project source code=====================
library MyDll;
uses
ShareMem,
SysUtils,
Classes,
uCommon in 'uCommon.pas';
function foo(ADic: TMyDic):string; stdcall;
var
I: Integer;
S: string;
begin
for I in ADic.Keys do
begin
S := S + ADic[I];
end;
Result := s;
end;
exports
foo;
end.
================unit uCommon==============
unit uCommon;
interface
uses
SysUtils, Generics.Collections;
type
TMyDic = TDictionary<Integer, string>;
implementation
end.
Are you getting exceptions? Maybe access violations or invalid pointer operations?
You can't share strings and objects between Delphi and a DLL if the DLL has its own memory manager. Since you're using Delphi 2010, you should have FastMM installed by default. Add "SimpleShareMem" as the first thing in the uses list for both the DLL and the EXE, and see if that doesn't fix the problem?
EDIT: In response to additional information from the poster:
You're calling dic.free after you unload the DLL. Even if you share memory managers, that's going to give you an access violation. Here's why.
Free calls TObject.Destroy, which is a virtual method. The compiler generates code to look it up in the object's Virtual Method Table. But the VMT is stored in static memory that's specific to the module, not in shared memory allocated by the memory manager. You unloaded the DLL and pulled the rug out from underneath the VMT pointer in the object, and so when it tries to call a virtual method you get an access violation.
You can fix this by making sure to call Free before unloading the DLL. Or you can use runtime packages instead of a DLL, which gets around this problem by putting the VMT for the object in an external package that won't be unloaded before you're done with it.
I would strongly discourage passing object instances between an executable and a regular DLL. Mainly for the exact reasons you are are encountering. What happens if the DLL is rebuilt and you've changed the object in some incompatible subtle way?
As Mason points out, packages are the preferred way to partition your application into modules.
I finally found what the real problem is! It seems like this: "For..in keys" loop will cause TDictionary create an instance for its data field FKeyCollection:
function TDictionary<TKey,TValue>.GetKeys: TKeyCollection;
begin
if FKeyCollection = nil then
FKeyCollection := TKeyCollection.Create(Self);
Result := FKeyCollection;
end;
So when the dll is unloaded, the memory that FKeyCollection pointed is also freed, thus left a "dangling pointer".
destructor TDictionary<TKey,TValue>.Destroy;
begin
Clear;
FKeyCollection.Free; //here will throw an exception
FValueCollection.Free;
inherited;
end;