Browse Source

* updated for new refcnt

peter 21 years ago
parent
commit
94aebf36f1
3 changed files with 58 additions and 21 deletions
  1. 21 13
      tests/test/tstring6.pp
  2. 32 7
      tests/webtbs/tw1677.pp
  3. 5 1
      tests/webtbs/tw2911.pp

+ 21 - 13
tests/test/tstring6.pp

@@ -1,12 +1,14 @@
 { %VERSION=1.1 }
 { %VERSION=1.1 }
 Program widetest;
 Program widetest;
 
 
-{$ifndef fpc}
-Function Memavail : Longint;
+Function MemUsed : Longint;
 begin
 begin
- Result:=0;
-end;
+{$ifdef fpc}
+ MemUsed:=Heapsize-Memavail;
+{$else}
+ MemUsed:=0;
 {$endif}
 {$endif}
+end;
 
 
 { -------------------------------------------------------------------
 { -------------------------------------------------------------------
     General stuff
     General stuff
@@ -15,8 +17,8 @@ end;
 Procedure DoMem (Var StartMem : Longint);
 Procedure DoMem (Var StartMem : Longint);
 
 
 begin
 begin
-  Writeln ('Lost ',StartMem-Memavail,' Bytes.');
-  StartMem:=MemAvail;
+  Writeln ('Lost ',StartMem-MemUsed,' Bytes.');
+  StartMem:=MemUsed;
 end;
 end;
 
 
 Procedure DoRef (P : Pointer);
 Procedure DoRef (P : Pointer);
@@ -27,11 +29,17 @@ begin
   If P=Nil then
   If P=Nil then
     Writeln ('(Ref : Empty string)')
     Writeln ('(Ref : Empty string)')
   else
   else
+    begin
 {$ifdef fpc}
 {$ifdef fpc}
-    Writeln (' (Ref: ',Plongint(Longint(P)-4)^,',Len: ',PLongint(Longint(P)-8)^,')');
+  {$if defined(ver1_0) or defined(ver1_9_4)}
+      Writeln (' (Ref: ',Plongint(Longint(P)-4)^,',Len: ',PLongint(Longint(P)-8)^,')');
+  {$else}
+      Writeln (' (Ref: ',Plongint(Longint(P)-8)^,',Len: ',PLongint(Longint(P)-4)^,')');
+  {$endif}
 {$else}
 {$else}
-    Writeln (' (Ref: ',Plongint(Longint(P)-8)^,',Len: ',PLongint(Longint(P)-4)^ div sizeof(WideChar),')');
+      Writeln (' (Ref: ',Plongint(Longint(P)-8)^,',Len: ',PLongint(Longint(P)-4)^ div sizeof(WideChar),')');
 {$endif}
 {$endif}
+    end;
 end;
 end;
 
 
 { -------------------------------------------------------------------
 { -------------------------------------------------------------------
@@ -124,7 +132,7 @@ Var S : WideString;
     Mem : Longint;
     Mem : Longint;
 
 
 begin
 begin
-  Mem:=MemAvail;
+  Mem:=MemUsed;
   S :='This is another WideString';
   S :='This is another WideString';
   Writeln ('Calling testvalparam with "',s,'"');
   Writeln ('Calling testvalparam with "',s,'"');
   testvalparam (s);
   testvalparam (s);
@@ -321,7 +329,7 @@ Var I : Integer;
     mem : Longint;
     mem : Longint;
 
 
 begin
 begin
- mem:=memavail;
+ mem:=MemUsed;
  S3 := 'ABCDEF';
  S3 := 'ABCDEF';
  Write ('S1+S2=S3 :');
  Write ('S1+S2=S3 :');
  If S1+S2=S3 then writeln (ok) else writeln (nok);
  If S1+S2=S3 then writeln (ok) else writeln (nok);
@@ -364,7 +372,7 @@ Var S,T : WideString;
     Co : Comp;
     Co : Comp;
     TempMem:Longint;
     TempMem:Longint;
 begin
 begin
-  TempMem:=Memavail;
+  TempMem:=MemUsed;
   S:='ABCDEF';
   S:='ABCDEF';
   Write ('S = "',S,'"');Doref(Pointer(S));
   Write ('S = "',S,'"');Doref(Pointer(S));
   T:=Copy(S,1,3);
   T:=Copy(S,1,3);
@@ -451,8 +459,8 @@ end;
 Var GlobalStartMem,StartMem : Longint;
 Var GlobalStartMem,StartMem : Longint;
 
 
 begin
 begin
-  GlobalStartMem:=MemAvail;
-  StartMem:=MemAvail;
+  GlobalStartMem:=MemUsed;
+  StartMem:=MemUsed;
   Writeln ('Testing Initialize/Finalize.');
   Writeln ('Testing Initialize/Finalize.');
   TestInitFinal;
   TestInitFinal;
   Write ('End of Initialize/finalize test : ');DoMem(StartMem);
   Write ('End of Initialize/finalize test : ');DoMem(StartMem);

+ 32 - 7
tests/webtbs/tw1677.pp

@@ -3,11 +3,39 @@
 { e-mail: [email protected] }
 { e-mail: [email protected] }
 program test;
 program test;
 type trec = record i:integer; s:ansistring end;
 type trec = record i:integer; s:ansistring end;
+
+procedure RefCount(const s : ansistring;expect:longint);
+type
+        PLongint = ^Longint;
+var
+        P : PLongint;
+        rc : longint;
+begin
+        P := PLongint(s);
+        rc:=0;
+        if (p = nil)
+        then writeln('Nil string.')
+        else
+{$ifdef  fpc}
+  {$if defined(ver1_0) or defined(ver1_9_4)}
+         rc:=(p-1)^;
+  {$else}
+         rc:=plongint(pchar(p)-8)^;
+  {$endif}
+{$else}
+         rc:=plongint(pchar(p)-8)^;
+{$endif}
+  writeln('Ref count is ',rc,' expected ',expect);
+  if rc<>expect then
+    halt(1);
+end;
+
+
 procedure p1(const r:trec);
 procedure p1(const r:trec);
   begin
   begin
   end;
   end;
 
 
-procedure p2(r:trec); 
+procedure p2(r:trec);
   begin
   begin
   end;
   end;
 
 
@@ -24,16 +52,13 @@ begin
   s:=chr(ord('A')+random(26));
   s:=chr(ord('A')+random(26));
   r.s:=s;
   r.s:=s;
   writeln('init');
   writeln('init');
-  if plongint(pointer(s)-4)^<>3 then
-    halt(1);
+  RefCount(s,3);
   writeln('p1()');
   writeln('p1()');
   p1(r);
   p1(r);
-  if plongint(pointer(s)-4)^<>3 then
-    halt(1);
+  RefCount(s,3);
   writeln('p2()');
   writeln('p2()');
   p2(r);
   p2(r);
-  if plongint(pointer(s)-4)^<>3 then
-    halt(1);
+  RefCount(s,3);
   writeln('ok');
   writeln('ok');
 end.
 end.
 
 

+ 5 - 1
tests/webtbs/tw2911.pp

@@ -33,9 +33,13 @@ begin
         then writeln('Nil string.')
         then writeln('Nil string.')
         else
         else
 {$ifdef  fpc}
 {$ifdef  fpc}
+  {$if defined(ver1_0) or defined(ver1_9_4)}
          rc:=(p-1)^;
          rc:=(p-1)^;
+  {$else}
+         rc:=plongint(pchar(p)-8)^;
+  {$endif}
 {$else}
 {$else}
-         rc:=plongint(pchar(p)-8)^);
+         rc:=plongint(pchar(p)-8)^;
 {$endif}
 {$endif}
   writeln('Ref count is ',rc,' expected ',expect);
   writeln('Ref count is ',rc,' expected ',expect);
   if rc<>expect then
   if rc<>expect then