From 4e278bccb1ad6001cd0a548cc136a491acfb3d23 Mon Sep 17 00:00:00 2001 From: peter Date: Fri, 18 Jul 2008 23:31:02 +0000 Subject: [PATCH] * more generic tests git-svn-id: trunk@11405 - --- .gitattributes | 6 ++++ tests/webtbs/tw10247.pp | 67 ++++++++++++++++++++++++++++++++++++++++ tests/webtbs/tw10247b.pp | 42 +++++++++++++++++++++++++ tests/webtbs/tw11431.pp | 19 ++++++++++++ tests/webtbs/tw11435b.pp | 20 ++++++++++++ tests/webtbs/tw11435c.pp | 33 ++++++++++++++++++++ tests/webtbs/tw11436.pp | 15 +++++++++ 7 files changed, 202 insertions(+) create mode 100644 tests/webtbs/tw10247.pp create mode 100644 tests/webtbs/tw10247b.pp create mode 100644 tests/webtbs/tw11431.pp create mode 100644 tests/webtbs/tw11435b.pp create mode 100644 tests/webtbs/tw11435c.pp create mode 100644 tests/webtbs/tw11436.pp diff --git a/.gitattributes b/.gitattributes index a2689da37f..7fdfbe3a17 100644 --- a/.gitattributes +++ b/.gitattributes @@ -8300,6 +8300,8 @@ tests/webtbs/tw10210.pp svneol=native#text/plain tests/webtbs/tw10224.pp svneol=native#text/plain tests/webtbs/tw1023.pp svneol=native#text/plain tests/webtbs/tw10233.pp svneol=native#text/plain +tests/webtbs/tw10247.pp svneol=native#text/plain +tests/webtbs/tw10247b.pp svneol=native#text/plain tests/webtbs/tw10320.pp svneol=native#text/plain tests/webtbs/tw10350.pp svneol=native#text/plain tests/webtbs/tw10371.pp svneol=native#text/plain @@ -8384,6 +8386,10 @@ tests/webtbs/tw11349.pp svneol=native#text/plain tests/webtbs/tw11354.pp svneol=native#text/plain tests/webtbs/tw11372.pp svneol=native#text/plain tests/webtbs/tw11392.pp svneol=native#text/plain +tests/webtbs/tw11431.pp svneol=native#text/plain +tests/webtbs/tw11435b.pp svneol=native#text/plain +tests/webtbs/tw11435c.pp svneol=native#text/plain +tests/webtbs/tw11436.pp svneol=native#text/plain tests/webtbs/tw1152.pp svneol=native#text/plain tests/webtbs/tw11543.pp svneol=native#text/plain tests/webtbs/tw1157.pp svneol=native#text/plain diff --git a/tests/webtbs/tw10247.pp b/tests/webtbs/tw10247.pp new file mode 100644 index 0000000000..8ea22e449d --- /dev/null +++ b/tests/webtbs/tw10247.pp @@ -0,0 +1,67 @@ +{$mode objfpc}{$h+} +uses classes, sysutils; +type + generic TNode = class + type public + PT = ^T; + var private + Data: T; + public + constructor Create; + destructor Destroy; override; + end; + + generic TContainer = class + type public + TTNode = specialize TNode; + var + private + Data: TTNode; + public + constructor Create; + destructor Destroy; override; + + function GetAddr: TTNode.PT; + procedure SetV(v: TTNode.T); + end; + +constructor TNode.Create; +begin +end; + +destructor TNode.Destroy; +begin + inherited Destroy; +end; + +constructor TContainer.Create; +begin + Data:=TTNode.Create; +end; + +destructor TContainer.Destroy; +begin + Data.Free; + inherited Destroy; +end; + +function TContainer.GetAddr: TTNode.PT; +begin + result := @Data.Data; +end; + + +procedure TContainer.SetV(v: TTNode.T); +begin + Data.Data:=v; +end; + +type + TStringContainer=specialize TContainer; +var + c : TStringContainer; +begin + c:=TStringContainer.Create; + c.Set('abc'); + Writeln(HexStr(c.Get)); +end. diff --git a/tests/webtbs/tw10247b.pp b/tests/webtbs/tw10247b.pp new file mode 100644 index 0000000000..b573950862 --- /dev/null +++ b/tests/webtbs/tw10247b.pp @@ -0,0 +1,42 @@ +{$mode objfpc}{$h+} +type + generic TNode = class + type public + PT = T; + var private + Data: T; + public + constructor Create; + destructor Destroy; override; + end; + + TTNodeLongint = specialize TNode; + + TTNodeString = specialize TNode; + +constructor TNode.Create; +begin +end; + +destructor TNode.Destroy; +begin + inherited Destroy; +end; + + +function GetIntNode: TTNodeLongint.T; +begin + result := 10; +end; + + +function GetStringNode: TTNodeString.PT; +begin + result := 'abc'; +end; + +begin + writeln(GetIntNode); + writeln(GetStringNode); +end. + diff --git a/tests/webtbs/tw11431.pp b/tests/webtbs/tw11431.pp new file mode 100644 index 0000000000..e2dd238c2f --- /dev/null +++ b/tests/webtbs/tw11431.pp @@ -0,0 +1,19 @@ +{$mode objfpc} +unit tw11431; + +interface + +uses sysutils; + +type + + generic IGenericCollection<_T> = interface + end; + + generic CGenericCollection<_T> = class( IGenericCollection) + end; + +implementation + + +end. diff --git a/tests/webtbs/tw11435b.pp b/tests/webtbs/tw11435b.pp new file mode 100644 index 0000000000..5d68e13bcd --- /dev/null +++ b/tests/webtbs/tw11435b.pp @@ -0,0 +1,20 @@ +unit tw11435b; +{$MODE ObjFPC} + +interface + +type + generic gCBla<_T> = class + function add( item: _T) : integer; + end; + + CBla = specialize gCBla; + +implementation + +function gCBla.add( item: _T) : integer; +begin + result := 0; +end; + +end. diff --git a/tests/webtbs/tw11435c.pp b/tests/webtbs/tw11435c.pp new file mode 100644 index 0000000000..283924df1b --- /dev/null +++ b/tests/webtbs/tw11435c.pp @@ -0,0 +1,33 @@ +unit tw11435c; + +{$MODE ObjFPC} + +interface + +type + generic TList<_T>=class(TObject) + type public + TCompareFunc = function(const Item1, Item2: _T): Integer; + var public + data : _T; + procedure Add(item: _T); + procedure Sort(compare: TCompareFunc); + end; + +type + TA = specialize TList; + +implementation + +procedure TList.Add(item: _T); +begin + data:=item; +end; + +procedure TList.Sort(compare: TCompareFunc); +begin + if compare(data, 20) <= 0 then + halt(1); +end; + +end. diff --git a/tests/webtbs/tw11436.pp b/tests/webtbs/tw11436.pp new file mode 100644 index 0000000000..ea385e838e --- /dev/null +++ b/tests/webtbs/tw11436.pp @@ -0,0 +1,15 @@ +unit tw11436; +{$MODE ObjFPC} + +interface + +type + generic gIBla<_T> = interface + function add( item: _T) : integer; + end; + + IBla = specialize gIBla; + +implementation + +end.