paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-11 13:29:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* updated for new refcnt

Browse Source
This commit is contained in:
peter 2004-07-13 14:40:34 +00:00
parent f32221853d
commit 94aebf36f1
3 changed files with 58 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
tests/test/tstring6.pp
View File

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

39
tests/webtbs/tw1677.pp
View File

@ -3,11 +3,39 @@
{ e-mail: anders.lindeberg@telia.com }
program test;
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);
begin
end;
procedure p2(r:trec);
procedure p2(r:trec);
begin
end;
@ -24,16 +52,13 @@ begin
s:=chr(ord('A')+random(26));
r.s:=s;
writeln('init');
if plongint(pointer(s)-4)^<>3 then
halt(1);
RefCount(s,3);
writeln('p1()');
p1(r);
if plongint(pointer(s)-4)^<>3 then
halt(1);
RefCount(s,3);
writeln('p2()');
p2(r);
if plongint(pointer(s)-4)^<>3 then
halt(1);
RefCount(s,3);
writeln('ok');
end.

6
tests/webtbs/tw2911.pp
View File

@ -33,9 +33,13 @@ begin
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)^);
rc:=plongint(pchar(p)-8)^;
{$endif}
writeln('Ref count is ',rc,' expected ',expect);
if rc<>expect then