mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 09:46:12 +02:00
no message
This commit is contained in:
parent
91cd02e04e
commit
3bd0c0f4b5
105
tests/test/texception5.pp
Normal file
105
tests/test/texception5.pp
Normal file
@ -0,0 +1,105 @@
|
|||||||
|
{ %version=1.1}
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$MODE OBJFPC}
|
||||||
|
{$ENDIF}
|
||||||
|
program texception5;
|
||||||
|
uses
|
||||||
|
SysUtils;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
ETestException = class(Exception)
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
var
|
||||||
|
exc_destroyed: boolean;
|
||||||
|
exc : ETestException;
|
||||||
|
|
||||||
|
constructor ETestException.Create;
|
||||||
|
begin
|
||||||
|
exc_destroyed := false;
|
||||||
|
exc := Self;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor ETestException.Destroy;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
exc_destroyed := true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
exc2: Exception;
|
||||||
|
|
||||||
|
begin
|
||||||
|
// first test, exception should not be freed
|
||||||
|
try
|
||||||
|
raise ETestException.Create;
|
||||||
|
except
|
||||||
|
exc2 := Exception(AcquireExceptionObject);
|
||||||
|
if exc <> exc2 then halt(11);
|
||||||
|
end;
|
||||||
|
if exc_destroyed then halt(12);
|
||||||
|
if exc <> exc2 then halt(13);
|
||||||
|
exc2.Free;
|
||||||
|
|
||||||
|
// second test, exception should be freed
|
||||||
|
try
|
||||||
|
raise ETestException.Create;
|
||||||
|
except
|
||||||
|
exc2 := Exception(AcquireExceptionObject);
|
||||||
|
if exc <> exc2 then halt(21);
|
||||||
|
ReleaseExceptionObject;
|
||||||
|
end;
|
||||||
|
if not exc_destroyed then halt(22);
|
||||||
|
|
||||||
|
// third test, exception should not be freed
|
||||||
|
try
|
||||||
|
raise ETestException.Create;
|
||||||
|
except
|
||||||
|
AcquireExceptionObject;
|
||||||
|
AcquireExceptionObject;
|
||||||
|
ReleaseExceptionObject;
|
||||||
|
end;
|
||||||
|
if exc_destroyed then halt(31);
|
||||||
|
|
||||||
|
// exception should be freed
|
||||||
|
try
|
||||||
|
raise ETestException.Create;
|
||||||
|
except
|
||||||
|
AcquireExceptionObject;
|
||||||
|
AcquireExceptionObject;
|
||||||
|
ReleaseExceptionObject;
|
||||||
|
ReleaseExceptionObject;
|
||||||
|
end;
|
||||||
|
if not exc_destroyed then halt(41);
|
||||||
|
|
||||||
|
// exception should be freed, refcount zeroed when re-raising
|
||||||
|
try
|
||||||
|
try
|
||||||
|
raise ETestException.Create;
|
||||||
|
except
|
||||||
|
on e: exception do begin
|
||||||
|
AcquireExceptionObject;
|
||||||
|
raise;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
if not exc_destroyed then halt(51);
|
||||||
|
|
||||||
|
// same as before but without explicit block
|
||||||
|
try
|
||||||
|
try
|
||||||
|
raise ETestException.Create;
|
||||||
|
except
|
||||||
|
AcquireExceptionObject;
|
||||||
|
raise;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
if not exc_destroyed then halt(61);
|
||||||
|
end.
|
9
tests/test/texception6.pp
Normal file
9
tests/test/texception6.pp
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
{ %version=1.1 }
|
||||||
|
{ %fail }
|
||||||
|
uses
|
||||||
|
sysutils;
|
||||||
|
|
||||||
|
begin
|
||||||
|
// this should fail with a runtime error
|
||||||
|
ReleaseExceptionObject;
|
||||||
|
end.
|
9
tests/test/texception7.pp
Normal file
9
tests/test/texception7.pp
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
{ %version=1.1 }
|
||||||
|
{ %fail }
|
||||||
|
uses
|
||||||
|
sysutils;
|
||||||
|
|
||||||
|
begin
|
||||||
|
// this should fail with a runtime error
|
||||||
|
AcquireExceptionObject;
|
||||||
|
end.
|
13
tests/test/texception8.pp
Normal file
13
tests/test/texception8.pp
Normal file
@ -0,0 +1,13 @@
|
|||||||
|
{ %version=1.1 }
|
||||||
|
{ %fail }
|
||||||
|
uses
|
||||||
|
sysutils;
|
||||||
|
|
||||||
|
begin
|
||||||
|
// this should fail with a runtime error
|
||||||
|
try
|
||||||
|
raise ETestException.Create;
|
||||||
|
except
|
||||||
|
ReleaseExceptionObject;
|
||||||
|
end;
|
||||||
|
end.
|
15
tests/test/texception9.pp
Normal file
15
tests/test/texception9.pp
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
{ %version=1.1 }
|
||||||
|
{ %fail }
|
||||||
|
uses
|
||||||
|
sysutils;
|
||||||
|
|
||||||
|
begin
|
||||||
|
// this should fail with a runtime error
|
||||||
|
try
|
||||||
|
raise ETestException.Create;
|
||||||
|
except
|
||||||
|
AcquireExceptionObject;
|
||||||
|
ReleaseExceptionObject;
|
||||||
|
ReleaseExceptionObject;
|
||||||
|
end;
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user