mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 21:46:00 +02:00
* new bugs
This commit is contained in:
parent
ac1332a388
commit
0f17fe1bd3
20
tests/webtbs/tw2897.pp
Normal file
20
tests/webtbs/tw2897.pp
Normal 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
31
tests/webtbs/tw2899.pp
Normal 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
64
tests/webtbs/tw2911.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user