Browse Source

Issue #40392; replaced test with correct one

Jonas Maebe 1 year ago
parent
commit
decbac8e8b
1 changed files with 87 additions and 61 deletions
  1. 87 61
      tests/webtbs/tw40413.pp

+ 87 - 61
tests/webtbs/tw40413.pp

@@ -1,67 +1,93 @@
-{$mode objfpc}
-{$h+}
-{$codepage utf8}
-program defaulting;
+program Project1;
+{$mode objfpc}{$ModeSwitch arrayoperators}{$ModeSwitch advancedrecords}
 
+uses sysutils;
+type IXQValue = record //something like a smart pointer
+  x: pinteger;
+  class operator initialize(var xx: IXQValue);
+  class operator finalize(var xx: IXQValue);
+  class operator addref(var xx: IXQValue);
+  class operator Copy(constref s: IXQValue; var xx: IXQValue);
+  class function create: IXQValue;static;
+end;
+class operator IXQValue.initialize(var xx: IXQValue);
+begin
+  xx.x := new(pinteger);
+  xx.x^ := 1;
+end;
+
+class operator IXQValue.finalize(var xx: IXQValue);
+begin
+  dec(xx.x^);
+  writeln(inttohex(ptruint(@xx),8), ' ',inttohex(ptruint(xx.x),8), ' ', xx.x^);
+  if xx.x^ < -1 then
+    halt(1);
+ // if xx.x^ = 0 then dispose(xx.x);
+end;
+
+class operator IXQValue.addref(var xx: IXQValue);
+begin
+  inc(xx.x^);
+end;
+
+class operator IXQValue.Copy(constref s: IXQValue; var xx: IXQValue);
+begin
+  inc(s.x^);
+  write('  copy ');
+  //finalize(xx);
+//  writeln(inttohex(ptruint(@xx),8), ' ',inttohex(ptruint(xx.x),8));
+  dec(xx.x^);
+  writeln(inttohex(ptruint(@xx),8), ' ',inttohex(ptruint(xx.x),8), ' ', xx.x^);
+  xx.x := s.x;
+end;
+
+class function IXQValue.create: IXQValue;
+begin
+  //result := default(IXQValue);
+end;
+
+
+
+function test(const previous: IXQValue): IXQValue;
+
+
+var
+  newList: IXQValue;
+  {$define doublefree}
+  {$ifdef doublefree}
+procedure print(const v: IXQValue);
+var
+  temp: IXQValue;
+
+begin
+ writeln(newList.x^);
 
+end;
+
+{$endif}
 var
-  a: integer = 0;
-  b: integer = default(integer);
-
-function c (d: integer = 0): integer;
-  begin
-    result := d;
-  end;
-
-procedure g (h: integer = 0);
-  var
-    i: integer = default(integer);
-  begin
-    writeln(h, i);
-    if h<>0 then
-      halt(1);
-    if i<>0 then
-      halt(2);
-  end;
-
-procedure j (k: integer = default(integer));
-  var
-    l: integer = default(integer);
-  begin
-    writeln(k, l);
-    if k<>0 then
-      halt(3);
-    if l<>0 then
-      halt(4);
-  end;
-
-function e (f: integer = default(integer)): integer;
-  begin
-    result := f;
-  end;
-
-function m (n: string = default(string)): string;
-  var
-    o: string = '1';
-    p: string = default(string);
-    q: string = '';
-    r: string = '2';
-  begin
-    result := n + o + p + q + r;
-  end;
+  i: SizeInt;
+  resultList: IXQValue;
+
+  tempList: IXQValue;
+
+
+
 
 begin
-  writeln(a, b, c);
-  if a<>0 then
-    halt(5);
-  if b<>0 then
-    halt(6);
-  if c<>0 then
-    halt(7);
-  g;
-  j;
-  writeln(m);
-  if m<>'12' then
-    halt(8);
-end.
+    resultList:=ixqvalue.create;
+    newList := ixqvalue.create;
+  newlist := ixqvalue.create;
+
+     tempList := newList;
+     resultList := tempList        ;
 
+
+  writeln(result.x^);
+ writeln('newList: ',inttohex(ptruint(@newList), 8));
+  writeln('tempList: ',inttohex(ptruint(@tempList), 8));
+  result := resultList;
+end;
+begin
+  test(ixqvalue.create);
+end.