freepascal reference testing experiment

refs.pas

{ 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

}