From 5ffba57b5193f5a6bd3f7eface5715d8d8f4786a Mon Sep 17 00:00:00 2001 From: svenbarth Date: Sun, 11 Dec 2011 15:49:22 +0000 Subject: [PATCH] Add tests for resolved generic bug reports. Also adjusted test for report 20836 (removed unneeded units and the {$R ...} directive completely and added a "%NORUN" modifier). git-svn-id: trunk@19817 - --- .gitattributes | 7 ++++++ tests/webtbs/tw19500.pp | 20 +++++++++++++++++ tests/webtbs/tw20407.pp | 14 ++++++++++++ tests/webtbs/tw20627.pp | 48 ++++++++++++++++++++++++++++++++++++++++ tests/webtbs/tw20629.pp | 12 ++++++++++ tests/webtbs/tw20796a.pp | 39 ++++++++++++++++++++++++++++++++ tests/webtbs/tw20796b.pp | 40 +++++++++++++++++++++++++++++++++ tests/webtbs/tw20796c.pp | 40 +++++++++++++++++++++++++++++++++ tests/webtbs/tw20836.pp | 11 +++------ 9 files changed, 223 insertions(+), 8 deletions(-) create mode 100644 tests/webtbs/tw19500.pp create mode 100644 tests/webtbs/tw20407.pp create mode 100644 tests/webtbs/tw20627.pp create mode 100644 tests/webtbs/tw20629.pp create mode 100644 tests/webtbs/tw20796a.pp create mode 100644 tests/webtbs/tw20796b.pp create mode 100644 tests/webtbs/tw20796c.pp diff --git a/.gitattributes b/.gitattributes index 430c28d46a..ba36a87fe8 100644 --- a/.gitattributes +++ b/.gitattributes @@ -11896,6 +11896,7 @@ tests/webtbs/tw19368.pp svneol=native#text/pascal tests/webtbs/tw1938.pp svneol=native#text/plain tests/webtbs/tw1948.pp svneol=native#text/plain tests/webtbs/tw1950.pp svneol=native#text/plain +tests/webtbs/tw19500.pp svneol=native#text/pascal tests/webtbs/tw19548.pp svneol=native#text/pascal tests/webtbs/tw19555.pp svneol=native#text/pascal tests/webtbs/tw1964.pp svneol=native#text/plain @@ -11932,6 +11933,7 @@ tests/webtbs/tw2031.pp svneol=native#text/plain tests/webtbs/tw2037.pp svneol=native#text/plain tests/webtbs/tw20396.pp svneol=native#text/plain tests/webtbs/tw2040.pp svneol=native#text/plain +tests/webtbs/tw20407.pp svneol=native#text/pascal tests/webtbs/tw2041.pp svneol=native#text/plain tests/webtbs/tw20421.pp svneol=native#text/pascal tests/webtbs/tw2045.pp svneol=native#text/plain @@ -11940,12 +11942,17 @@ tests/webtbs/tw20527.pp svneol=native#text/plain tests/webtbs/tw20557.pp svneol=native#text/pascal tests/webtbs/tw2059.pp svneol=native#text/plain tests/webtbs/tw20594.pp svneol=native#text/pascal +tests/webtbs/tw20627.pp svneol=native#text/pascal +tests/webtbs/tw20629.pp svneol=native#text/pascal tests/webtbs/tw20638.pp svneol=native#text/pascal tests/webtbs/tw2065.pp svneol=native#text/plain tests/webtbs/tw2069.pp svneol=native#text/plain tests/webtbs/tw20690.pp svneol=native#text/pascal tests/webtbs/tw2072.pp svneol=native#text/plain tests/webtbs/tw20744.pp svneol=native#text/plain +tests/webtbs/tw20796a.pp svneol=native#text/pascal +tests/webtbs/tw20796b.pp svneol=native#text/pascal +tests/webtbs/tw20796c.pp svneol=native#text/pascal tests/webtbs/tw20821.pp svneol=native#text/pascal tests/webtbs/tw20836.pp svneol=native#text/pascal tests/webtbs/tw2109.pp svneol=native#text/plain diff --git a/tests/webtbs/tw19500.pp b/tests/webtbs/tw19500.pp new file mode 100644 index 0000000000..8acf122a6c --- /dev/null +++ b/tests/webtbs/tw19500.pp @@ -0,0 +1,20 @@ +{ %NORUN } + +{$MODE OBJFPC} { -*- text -*- } +program tw19500; + +type + generic TFoo = class + type + TBar = class + function Baz(): T; + end; + end; + +function TFoo.TBar.Baz(): T; +begin + Result := nil; +end; + +begin +end. diff --git a/tests/webtbs/tw20407.pp b/tests/webtbs/tw20407.pp new file mode 100644 index 0000000000..3c28c40417 --- /dev/null +++ b/tests/webtbs/tw20407.pp @@ -0,0 +1,14 @@ +{ %NORUN } + +program tw20407; + +{$mode delphi} + +type + tbwimagegen = class + type + TLocalType = tbwimagegen; + end; + +begin +end. diff --git a/tests/webtbs/tw20627.pp b/tests/webtbs/tw20627.pp new file mode 100644 index 0000000000..759c25fde6 --- /dev/null +++ b/tests/webtbs/tw20627.pp @@ -0,0 +1,48 @@ +{ based on the file attached to bug 20627, but modified for usage in FPC's + testsuite } + +{$MODE delphi} + +type + TWrapper = class + strict private + FValue: TValue; + public + type + TWrapperState = class + strict private + FValue: TValue; + public + property Value: TValue read FValue write FValue; + function GetValueSize: Integer; + { The compiler will report that forward declaration + TWrapper$LongInt.TWrapperState.GetValueSize is not resolved. } + end; + public + property Value: TValue read FValue write FValue; + function CaptureState: TWrapperState; + end; + +function TWrapper.CaptureState: TWrapperState; +begin + Result := TWrapperState.Create; + Result.Value := FValue; +end; + +function TWrapper.TWrapperState.GetValueSize: Integer; +begin + Result := SizeOf(FValue); +end; + + +begin + with TWrapper.Create do begin + Value := 123; + with CaptureState do begin + if GetValueSize <> SizeOf(Integer) then + Halt(1); + Free; + end; + Free; + end; +end. diff --git a/tests/webtbs/tw20629.pp b/tests/webtbs/tw20629.pp new file mode 100644 index 0000000000..63748229c3 --- /dev/null +++ b/tests/webtbs/tw20629.pp @@ -0,0 +1,12 @@ +{ %NORUN } + +{$MODE delphi} + +type + TWrapper = class end; + TObjectWrapper = TWrapper; + +begin + with TObjectWrapper.Create do Free; { OK } + with TWrapper.Create do Free; { Error } +end. diff --git a/tests/webtbs/tw20796a.pp b/tests/webtbs/tw20796a.pp new file mode 100644 index 0000000000..5fc36c1136 --- /dev/null +++ b/tests/webtbs/tw20796a.pp @@ -0,0 +1,39 @@ +unit tw20796a; + +{$MODE DELPHI} +{$DEFINE CRASHCOMPILER} + +interface + +type + TWrapper = class + strict private + FValue: TValue; + public + property Value: TValue read FValue write FValue; + {$IFDEF CRASHCOMPILER} + procedure SomeMethod; + {$ENDIF} + end; + + TTestClass = class + public + procedure DoTest; + end; + +implementation + +{$IFDEF CRASHCOMPILER} +procedure TWrapper.SomeMethod; +begin +end; +{$ENDIF} + +procedure TTestClass.DoTest; +var + w: TWrapper; +begin +end; + +end. + diff --git a/tests/webtbs/tw20796b.pp b/tests/webtbs/tw20796b.pp new file mode 100644 index 0000000000..cfafe7155a --- /dev/null +++ b/tests/webtbs/tw20796b.pp @@ -0,0 +1,40 @@ +unit tw20796b; + +{$MODE DELPHI} +{$DEFINE CRASHCOMPILER} + +interface + +type + TWrapper = class + strict private + FValue: TValue; + public + property Value: TValue read FValue write FValue; + {$IFDEF CRASHCOMPILER} + procedure SomeMethod; + {$ENDIF} + end; + + TTestClass = class + public + procedure DoTest; + end; + +implementation + +{$IFDEF CRASHCOMPILER} +procedure TWrapper.SomeMethod; +begin +end; +{$ENDIF} + +procedure TTestClass.DoTest; +type + TByteWrapper = TWrapper; +var + w: TByteWrapper; +begin +end; + +end. diff --git a/tests/webtbs/tw20796c.pp b/tests/webtbs/tw20796c.pp new file mode 100644 index 0000000000..f689101cc8 --- /dev/null +++ b/tests/webtbs/tw20796c.pp @@ -0,0 +1,40 @@ +unit tw20796c; + +{$MODE OBJFPC} +{$DEFINE CRASHCOMPILER} + +interface + +type + generic TWrapper = class + strict private + FValue: TValue; + public + property Value: TValue read FValue write FValue; + {$IFDEF CRASHCOMPILER} + procedure SomeMethod; + {$ENDIF} + end; + + TTestClass = class + public + procedure DoTest; + end; + +implementation + +{$IFDEF CRASHCOMPILER} +procedure TWrapper.SomeMethod; +begin +end; +{$ENDIF} + +procedure TTestClass.DoTest; +type + TByteWrapper = specialize TWrapper; +var + w: TByteWrapper; +begin +end; + +end. diff --git a/tests/webtbs/tw20836.pp b/tests/webtbs/tw20836.pp index 471e5d5060..00eb9ee666 100644 --- a/tests/webtbs/tw20836.pp +++ b/tests/webtbs/tw20836.pp @@ -1,15 +1,10 @@ +{ %NORUN } + +{ adjusted test by removing some "Lazarusisms" } program tw20836; {$mode objfpc}{$H+} -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes - { you can add units after this }; - -{.$R *.res} type generic TGObjectChangeCommand<_T>=object private