Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
freepascal reference testing experiment
{ freepascal reference experiment
--------------------------------------------------------
Kaco_ / Phavel suggested the following problem
in #fpc on 11/15/2012:
layout2:tgui_layout;
layou1:=tgui_layout.init (..);
layout2:=layout1;
layout1.free;
layout2.visible=1; <-- crash
The question is, can we have two references to the same object,
and free one of them?
oliebol said that by using interfaces you get reference counting
for free. He also at one point in the conversation suggested
looking at freeAndNil.
Free is a method on TOBject:
http://www.freepascal.org/docs-html/rtl/system/tobject.html
FreeAndNil is a procedure in SysUtils;
http://www.freepascal.org/docs-html/rtl/sysutils/freeandnil.html
Free and nil does not perform reference counting.
}
{$mode objfpc }
{$checkpointer on}
program reftest;
uses sysutils;
type TStorm = class
data : string;
constructor create( s : string );
end;
constructor TStorm.create( s : string );
begin
self.data := s;
end;
var a, b : TStorm;
procedure doescrash;
begin
a := TStorm.create( 'doescrash' );
b := a;
writeln( b.data, ': good day, cruel world. This will surely crash:' );
writeln( '---------------------------------------------------------' );
a.free;
{ according to Phavel, this should crash: }
writeln( b.data, ': I SAID GOOD DAY!' );
writeln( b.data, ': It didn''t crash. But my name disappeared.' );
writeln( b.data, ': Is it just luck that I didn''t segfault?' );
end;
procedure mightcrash;
begin
a := TStorm.create( 'wontcrash' );
b := a;
writeln( b.data, ': You may take our lives, but you will never take our freedom!' );
writeln( '-----------------------------------------------------------------------' );
sysutils.freeAndNil( a );
writeln( b.data, ': it actually does not crash! But my name is an empty string now.' );
writeln( b.data, ': the next line, however, will definitely crash:' );
sysutils.freeAndNil( b );
end;
begin
writeln; writeln; doescrash; { actually does not crash }
writeln; writeln; mightcrash; { does crash }
end.
{ output from: fpc -glh refs.pas ; ./refs.exe ( on an old winxp box )
doescrash: good day, cruel world. This will surely crash:
---------------------------------------------------------
: I SAID GOOD DAY!
: It didn't crash. But my name disappeared.
: Is it just luck that I didn't segfault?
wontcrash: You may take our lives, but you will never take our freedom!
-----------------------------------------------------------------------
: it actually does not crash! But my name is an empty string now.
: the next line, however, will definitely crash:
An unhandled exception occurred at $00000000 :
EAccessViolation : Access violation
$00000000
$00401984 main, line 79 of refs.pas
}
{ output from: fpc -gl refs.pas ; ./refs.exe ( on same box )
doescrash: good day, cruel world. This will surely crash:
---------------------------------------------------------
pointer $0006DB08 does not point to valid memory block
Marked memory at $0006DB48 invalid
An unhandled exception occurred at $0040C19F :
EAccessViolation : Access violation
$0040C19F
$0040DB10
$00401795 DOESCRASH, line 60 of refs.pas
$00401AA7 main, line 78 of refs.pas
Wrong signature $F0F0F0F0 instead of Heap dump by heaptrc unit
60 memory blocks allocated : 1442/1672
57 memory blocks freed : 1338/1568
3 unfreed memory blocks : 104
True heap size : 262144 (112 used in System startup)
True free heap : 261696
Should be : 261736
Call trace for block $00075B10 size 64
$00407D98
$00406E71
$00412D65
$0040788E
$0040DB10
$00401795 DOESCRASH, line 60 of refs.pas
$00401AA7 main, line 78 of refs.pas
$0040B601
Call trace for block $00056C90 size 24
$00406E71
$00412D65
$0040788E
$0040DB10
$00401795 DOESCRASH, line 60 of refs.pas
$00401AA7 main, line 78 of refs.pas
$0040B601
Call trace for block $00056C30 size 16
$00412B77
$0040788E
$0040DB10
$00401795 DOESCRASH, line 60 of refs.pas
$00401AA7 main, line 78 of refs.pas
$0040B601
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.