mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 09:59:17 +02:00
* new bugs
This commit is contained in:
parent
bedf31abe9
commit
92a6e151ff
47
tests/test/texception10.pp
Normal file
47
tests/test/texception10.pp
Normal file
@ -0,0 +1,47 @@
|
|||||||
|
{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ TMyObject }
|
||||||
|
|
||||||
|
TMyObject = class(TObject)
|
||||||
|
public
|
||||||
|
constructor Create(TheOwner: TObject);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TMyObject }
|
||||||
|
|
||||||
|
constructor TMyObject.Create(TheOwner: TObject);
|
||||||
|
begin
|
||||||
|
// create AV
|
||||||
|
if TheOwner.ClassName='' then;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
i : integer;
|
||||||
|
begin
|
||||||
|
i:=0;
|
||||||
|
writeln('Creating the first time');
|
||||||
|
try
|
||||||
|
TMyObject.Create(nil);
|
||||||
|
except
|
||||||
|
on E: Exception do begin
|
||||||
|
writeln('E='+E.Message);
|
||||||
|
inc(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
writeln('Creating the second time');
|
||||||
|
try
|
||||||
|
TMyObject.Create(nil);
|
||||||
|
except
|
||||||
|
on E: Exception do begin
|
||||||
|
writeln('E='+E.Message);
|
||||||
|
inc(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
writeln('Ending ..');
|
||||||
|
if i<>2 then
|
||||||
|
halt(1);
|
||||||
|
end.
|
20
tests/webtbs/tw3572.pp
Normal file
20
tests/webtbs/tw3572.pp
Normal file
@ -0,0 +1,20 @@
|
|||||||
|
{ Source provided for Free Pascal Bug Report 3572 }
|
||||||
|
{ Submitted by "Lukas Gebauer" on 2005-01-18 }
|
||||||
|
{ e-mail: gebauerl@mlp.cz }
|
||||||
|
{$MODE DELPHI}
|
||||||
|
program rtest;
|
||||||
|
|
||||||
|
function x(value: string): string;
|
||||||
|
begin
|
||||||
|
result := Value;
|
||||||
|
result := result;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
s: string;
|
||||||
|
begin
|
||||||
|
s := 'ahoy!';
|
||||||
|
writeln(x(s));
|
||||||
|
if x(s)<>s then
|
||||||
|
halt(1);
|
||||||
|
end.
|
22
tests/webtbs/tw3573.pp
Normal file
22
tests/webtbs/tw3573.pp
Normal file
@ -0,0 +1,22 @@
|
|||||||
|
{ Source provided for Free Pascal Bug Report 3573 }
|
||||||
|
{ Submitted by "Simon Kissel" on 2005-01-18 }
|
||||||
|
{ e-mail: scamp@untergrund.net }
|
||||||
|
|
||||||
|
{$ifdef fpc}{$mode delphi}{$endif}
|
||||||
|
|
||||||
|
resourcestring
|
||||||
|
wurst = 'jo' deprecated;
|
||||||
|
|
||||||
|
var
|
||||||
|
VersionNumber: Real library;
|
||||||
|
|
||||||
|
type
|
||||||
|
AppError = class(TObject)
|
||||||
|
end platform;
|
||||||
|
|
||||||
|
procedure SomeOldRoutine; stdcall; deprecated;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user