[fpc-devel] Proof of Concept ARC implementation

[Sven Barth]

Hello together!

I've now finished my Proof of Concept ARC implementation which is based 
on the RFC I published a few weeks back: 
http://lists.freepascal.org/fpc-devel/2014-September/034263.html

To recap:
- there are no reference counted classes by default, but reference 
counting can be introduced to sub hierarchies by declaring a class as 
"refcounted"
- only variables with a static type of those "refcounted" classes will 
experience reference counting and thus IncRef/DecRef calls
- a class instance is destroyed once the reference count reaches zero 
(and Free does not work for them)
- variables/paremeters/fields can be declared as "weak" which disables 
reference counting for them
- all variables/parameters/fields that are of a non reference counted 
class type are implicitely assumed as "weak" (also "self" is assumed as 
"weak")
- TObject is extended with methods to allow manual reference counting 
and to determine whether an instance is reference counted

Please keep in mind that this is a proof of concept implementation to 
have something on which further discussions can be based on, thus there 
can still be bugs here and there (that said: the testsuite completes 
without regressions). Also it's nowhere said that this will be merged to 
trunk as is in the future.

The code is available here: 
http://svn.freepascal.org/svn/fpc/branches/svenbarth/arc

And here is a test program (and compiled with -gh no leaks are reported 
;) ):

=== code begin ===

program trefcounted;

{$mode objfpc}

type
   TTest = class refcounted // a parent class would follow immediately 
after "refcounted" like for "sealed" and "abstract"
     Field: LongInt;
     constructor Create;
     destructor Destroy; override;
     procedure IncField;
   end;

   TTest2 = class
     Test1: TTest;
     Test2: TTest weak;
     Test3: TTest;
     constructor Create(aTest1: TTest; aTest2: TTest weak);
   end;

   TTest3 = class(TTest)
   end;

   TTestRec = record
     NonWeak: TTest;
     IsWeak: TTest weak;
   end;

constructor TTest.Create;
begin
   Field := $1234ABCD;
end;

destructor TTest.Destroy;
begin
   Writeln(ClassName, '.Destroy');
   inherited;
end;

procedure TTest.IncField;
begin
   Inc(Field);
end;

constructor TTest2.Create(aTest1: TTest; aTest2: TTest weak);
begin
   Test1 := aTest1;
   Test2 := aTest2;
   Test3 := TTest.Create;
end;

procedure TestValue(aTest: TTest);
begin
   Writeln(aTest.ARCRefCount);
end;

procedure TestConst(const aTest: TTest);
begin
   Writeln(aTest.ARCRefCount);
end;

procedure TestVar(var aTest: TTest);
begin
   Writeln(aTest.ARCRefCount);
end;

procedure TestWeak(aTest: TTest weak);
begin
   Writeln(aTest.ARCRefCount);
end;

function TestWeakResult(aTest: TTest weak): TTest weak;
begin
   Result := aTest;
end;

procedure Test;
var
   t: TTest;
   t2: TTest;
   o: TObject;
   t3: TTest weak;
begin
   Writeln('Test');
   Writeln(HexStr(Pointer(t)));
   t := TTest.Create;
   Writeln(HexStr(t));
   Writeln('Before TTest assignment: ', t.ARCRefCount);
   t2 := t;
   Writeln('Before TObject assignment: ', t.ARCRefCount);
   o := t;
   Writeln('Before weak assignment: ', t.ARCRefCount);
   t3 := t;
   Writeln('Before TestValue: ', t.ARCRefCount);
   TestValue(t);
   Writeln('Before TestConst: ', t.ARCRefCount);
   TestConst(t);
   Writeln('Before TestVar: ', t.ARCRefCount);
   TestVar(t);
   Writeln('Before TestWeak: ', t.ARCRefCount);
   TestWeak(t);
   Writeln('Before TestWeakResult: ', t.ARCRefCount);
   t2 := TestWeakResult(t);
   Writeln('Before IncField: ', t.ARCRefCount);
   t.IncField;
end;

procedure Test2;
var
   r, r2: TTestRec;
begin
   Writeln('Test2');
   Writeln(HexStr(Pointer(r.NonWeak)), ' ', HexStr(Pointer(r.IsWeak)));
   r.NonWeak := TTest.Create;
   Writeln('After create: ', r.NonWeak.ARCRefCount);
   r.IsWeak := r.NonWeak;
   Writeln('After weak assignment: ', r.NonWeak.ARCRefCount);
   r2 := r;
   Writeln('After record assignment: ', r.NonWeak.ARCRefCount);
   r.NonWeak := Nil;
   Writeln('After nil: ', r2.NonWeak.ARCRefCount);
end;

procedure Test3;
var
   t, t1: TTest;
   t2: TTest2;
begin
   Writeln('Test3');
   t := TTest.Create;
   t1 := TTest.Create;
   t2 := TTest2.Create(t, t1);
   Writeln('t: ', t.ARCRefCount, ' t1: ', t1.ARCRefCount);
   t2.Free;
   Writeln('t: ', t.ARCRefCount, ' t1: ', t1.ARCRefCount);
end;

procedure Test4;
var
   t: TTest;
   t2, t1: TTest3;
begin
   Writeln('Test4');
   t2 := TTest3.Create;
   Writeln('t2: ', t2.ARCRefCount);
   t := t2;
   Writeln('t2: ', t2.ARCRefCount);
   t1 := t2;
   Writeln('t2: ', t2.ARCRefCount);
   t := Nil;
   Writeln('t2: ', t2.ARCRefCount);
end;

begin
   Test;
   Test2;
   Test3;
   Test4;
   Writeln('Done');
end.

=== code end ===

Regards,
Sven