* new bugs

This commit is contained in:
peter 2004-01-21 21:20:39 +00:00
parent ac1332a388
commit 0f17fe1bd3
3 changed files with 115 additions and 0 deletions

20
tests/webtbs/tw2897.pp Normal file
View File

@ -0,0 +1,20 @@
{ Source provided for Free Pascal Bug Report 2897 }
{ Submitted by "C Western" on 2004-01-17 }
{ e-mail: mftq75@dsl.pipex.com }
program stackerr;
{$S+}
procedure Show(v: Integer);
begin
WriteLn(v);
if v<>27 then
begin
writeln('Error!');
halt(1);
end;
end;
begin
Show(27)
end.

31
tests/webtbs/tw2899.pp Normal file
View File

@ -0,0 +1,31 @@
{ Source provided for Free Pascal Bug Report 2899 }
{ Submitted by "Mattias Gaertner" on 2004-01-17 }
{ e-mail: mattias@freepascal.org }
program StringCallByRef;
{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
uses
Classes, SysUtils;
procedure DoSomething(const AString: string);
procedure NestedProc(var Dummy: string);
begin
Dummy:=Dummy; // dummy statement, no change
end;
var
s: String;
begin
s:=copy(AString,5,11);
writeln('Before NestedProc: "',s,'"');
NestedProc(s);
writeln('After NestedProc: "',s,'"'); // s is now emtpy
if s<>'WhatAStrangeBug' then
halt(1);
end;
begin
DoSomething('WhatAStrangeBug');
end.

64
tests/webtbs/tw2911.pp Normal file
View File

@ -0,0 +1,64 @@
{ Source provided for Free Pascal Bug Report 2911 }
{ Submitted by "Chris Hilder" on 2004-01-19 }
{ e-mail: cj.hilder@astronomyinyourhands.com }
program bug_demo;
{$LONGSTRINGS ON}
{$ifdef fpc}{$Mode objfpc}{$endif}
type
RecordWithStrings =
record
one,
two : string;
end;
var
onestring,
twostring : string;
ARecordWithStrings : RecordWithStrings;
procedure RefCount(const s : string;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}
rc:=(p-1)^;
{$else}
rc:=plongint(pchar(p)-8)^);
{$endif}
writeln('Ref count is ',rc,' expected ',expect);
if rc<>expect then
halt(1);
end;
function FunctionResultIsRecord(a : RecordWithStrings) : RecordWithStrings;
begin
result := a;
end;
begin
writeln('All reference counts should be 1 for the following...');
onestring := 'one';
twostring := 'two';
ARecordWithStrings.one := onestring + twostring;
twostring := onestring + twostring;
RefCount(ARecordWithStrings.one,1);
ARecordWithStrings := FunctionResultIsRecord(ARecordWithStrings);
twostring := onestring + twostring;
RefCount(ARecordWithStrings.one,2);
ARecordWithStrings := FunctionResultIsRecord(ARecordWithStrings);
twostring := onestring + twostring;
RefCount(ARecordWithStrings.one,3);
ARecordWithStrings := FunctionResultIsRecord(ARecordWithStrings);
twostring := onestring + twostring;
RefCount(ARecordWithStrings.one,4);
end.