paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 15:47:53 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: use delphi syntax for type, const and var section declarations in classes instead of fpc generics syntax

Browse Source 
rtl: fix fgl to use the new syntax
tests: fix generics tests to use the new syntax

git-svn-id: trunk@15646 -
This commit is contained in:
paul 2010-07-27 00:59:32 +00:00
parent a7510e581c
commit 790f6b0a4b
10 changed files with 117 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/pdecobj.pas
View File

@ -648,6 +648,7 @@ implementation
current_objectdef.symtable.currentvisibility:=vis_private;
include(current_objectdef.objectoptions,oo_has_private);
fields_allowed:=true;
object_member_blocktype:=bt_general;
end;
_PROTECTED :
begin
@ -658,6 +659,7 @@ implementation
current_objectdef.symtable.currentvisibility:=vis_protected;
include(current_objectdef.objectoptions,oo_has_protected);
fields_allowed:=true;
object_member_blocktype:=bt_general;
end;
_PUBLIC :
begin
@ -667,6 +669,7 @@ implementation
consume(_PUBLIC);
current_objectdef.symtable.currentvisibility:=vis_public;
fields_allowed:=true;
object_member_blocktype:=bt_general;
end;
_PUBLISHED :
begin
@ -682,6 +685,7 @@ implementation
consume(_PUBLISHED);
current_objectdef.symtable.currentvisibility:=vis_published;
fields_allowed:=true;
object_member_blocktype:=bt_general;
end;
_STRICT :
begin
@ -711,7 +715,8 @@ implementation
else
message(parser_e_protected_or_private_expected);
fields_allowed:=true;
end;
object_member_blocktype:=bt_general;
end
else
begin
if object_member_blocktype=bt_general then

82
rtl/objpas/fgl.pp
View File

@ -85,7 +85,7 @@ const
type
generic TFPGListEnumerator<T> = class(TObject)
var protected
protected
FList: TFPSList;
FPosition: Integer;
function GetCurrent: T;
@ -96,14 +96,16 @@ type
end;
generic TFPGList<T> = class(TFPSList)
type public
TCompareFunc = function(const Item1, Item2: T): Integer;
TTypeList = array[0..MaxGListSize] of T;
PTypeList = ^TTypeList;
PT = ^T;
TFPGListEnumeratorSpec = specialize TFPGListEnumerator<T>;
var protected
FOnCompare: TCompareFunc;
public
type
TCompareFunc = function(const Item1, Item2: T): Integer;
TTypeList = array[0..MaxGListSize] of T;
PTypeList = ^TTypeList;
PT = ^T;
TFPGListEnumeratorSpec = specialize TFPGListEnumerator<T>;
protected
var
FOnCompare: TCompareFunc;
procedure CopyItem(Src, Dest: Pointer); override;
procedure Deref(Item: Pointer); override;
function Get(Index: Integer): T; {$ifdef CLASSESINLINE} inline; {$endif}
@ -128,14 +130,16 @@ type
end;
generic TFPGObjectList<T> = class(TFPSList)
type public
TCompareFunc = function(const Item1, Item2: T): Integer;
TTypeList = array[0..MaxGListSize] of T;
PTypeList = ^TTypeList;
PT = ^T;
var protected
FOnCompare: TCompareFunc;
FFreeObjects: Boolean;
public
type
TCompareFunc = function(const Item1, Item2: T): Integer;
TTypeList = array[0..MaxGListSize] of T;
PTypeList = ^TTypeList;
PT = ^T;
protected
var
FOnCompare: TCompareFunc;
FFreeObjects: Boolean;
procedure CopyItem(Src, Dest: Pointer); override;
procedure Deref(Item: Pointer); override;
function Get(Index: Integer): T; {$ifdef CLASSESINLINE} inline; {$endif}
@ -160,13 +164,15 @@ type
end;
generic TFPGInterfacedObjectList<T> = class(TFPSList)
type public
TCompareFunc = function(const Item1, Item2: T): Integer;
TTypeList = array[0..MaxGListSize] of T;
PTypeList = ^TTypeList;
PT = ^T;
var protected
FOnCompare: TCompareFunc;
public
type
TCompareFunc = function(const Item1, Item2: T): Integer;
TTypeList = array[0..MaxGListSize] of T;
PTypeList = ^TTypeList;
PT = ^T;
protected
var
FOnCompare: TCompareFunc;
procedure CopyItem(Src, Dest: Pointer); override;
procedure Deref(Item: Pointer); override;
function Get(Index: Integer): T; {$ifdef CLASSESINLINE} inline; {$endif}
@ -244,19 +250,21 @@ type
{$ifndef VER2_0}
generic TFPGMap<TKey, TData> = class(TFPSMap)
type public
TKeyCompareFunc = function(const Key1, Key2: TKey): Integer;
TDataCompareFunc = function(const Data1, Data2: TData): Integer;
PKey = ^TKey;
PData = ^TData;
var protected
FOnKeyCompare: TKeyCompareFunc;
FOnDataCompare: TDataCompareFunc;
procedure CopyItem(Src, Dest: Pointer); override;
procedure CopyKey(Src, Dest: Pointer); override;
procedure CopyData(Src, Dest: Pointer); override;
procedure Deref(Item: Pointer); override;
procedure InitOnPtrCompare; override;
public
type
TKeyCompareFunc = function(const Key1, Key2: TKey): Integer;
TDataCompareFunc = function(const Data1, Data2: TData): Integer;
PKey = ^TKey;
PData = ^TData;
protected
var
FOnKeyCompare: TKeyCompareFunc;
FOnDataCompare: TDataCompareFunc;
procedure CopyItem(Src, Dest: Pointer); override;
procedure CopyKey(Src, Dest: Pointer); override;
procedure CopyData(Src, Dest: Pointer); override;
procedure Deref(Item: Pointer); override;
procedure InitOnPtrCompare; override;
function GetKey(Index: Integer): TKey; {$ifdef CLASSESINLINE} inline; {$endif}
function GetKeyData(const AKey: TKey): TData; {$ifdef CLASSESINLINE} inline; {$endif}
function GetData(Index: Integer): TData; {$ifdef CLASSESINLINE} inline; {$endif}

5
tests/test/tgeneric11.pp
View File

@ -2,8 +2,9 @@
type
generic TList<_T>=class(TObject)
var public
data : _T;
public
var
data : _T;
procedure Add(item: _T);
procedure Assign(Source: specialize TList<_T>);
end;

5
tests/test/tgeneric18.pp
View File

@ -12,8 +12,9 @@ type
{ TSecondGeneric }
generic TSecondGeneric<T> = class(TObject)
type public
TFirstGenericType = specialize TFirstGeneric<T>;
public
type
TFirstGenericType = specialize TFirstGeneric<T>;
end;
var

10
tests/test/ugeneric10.pp
View File

@ -6,10 +6,12 @@ interface
type
generic TList<_T>=class(TObject)
type public
TCompareFunc = function(const Item1, Item2: _T): Integer;
var public
data : _T;
public
type
TCompareFunc = function(const Item1, Item2: _T): Integer;
public
var
data : _T;
procedure Add(item: _T);
procedure Sort(compare: TCompareFunc);
end;

47
tests/webtbs/tw10247.pp
View File

@ -1,29 +1,32 @@
{$mode objfpc}{$h+}
uses classes, sysutils;
type
generic TNode<T> = class
type public
PT = ^T;
var private
Data: T;
public
constructor Create;
destructor Destroy; override;
end;
generic TNode<T> = class
public
type
PT = ^T;
private
var
Data: T;
public
constructor Create;
destructor Destroy; override;
end;
generic TContainer<T> = class
type public
TTNode = specialize TNode<T>;
var
private
Data: TTNode;
public
constructor Create;
destructor Destroy; override;
generic TContainer<T> = class
public
type
TTNode = specialize TNode<T>;
private
var
Data: TTNode;
public
constructor Create;
destructor Destroy; override;
function GetAddr: TTNode.PT;
procedure SetV(v: TTNode.T);
end;
function GetAddr: TTNode.PT;
procedure SetV(v: TTNode.T);
end;
constructor TNode.Create;
begin
@ -31,7 +34,7 @@ end;
destructor TNode.Destroy;
begin
inherited Destroy;
inherited Destroy;
end;
constructor TContainer.Create;

30
tests/webtbs/tw10247b.pp
View File

@ -1,18 +1,20 @@
{$mode objfpc}{$h+}
type
generic TNode<T> = class
type public
PT = T;
var private
Data: T;
public
constructor Create;
destructor Destroy; override;
end;
generic TNode<T> = class
public
type
PT = T;
private
var
Data: T;
public
constructor Create;
destructor Destroy; override;
end;
TTNodeLongint = specialize TNode<Longint>;
TTNodeLongint = specialize TNode<Longint>;
TTNodeString = specialize TNode<String>;
TTNodeString = specialize TNode<String>;
constructor TNode.Create;
begin
@ -20,19 +22,19 @@ end;
destructor TNode.Destroy;
begin
inherited Destroy;
inherited Destroy;
end;
function GetIntNode: TTNodeLongint.T;
begin
result := 10;
result := 10;
end;
function GetStringNode: TTNodeString.PT;
begin
result := 'abc';
result := 'abc';
end;
begin

10
tests/webtbs/tw11435c.pp
View File

@ -6,10 +6,12 @@ interface
type
generic TList<_T>=class(TObject)
type public
TCompareFunc = function(const Item1, Item2: _T): Integer;
var public
data : _T;
public
type
TCompareFunc = function(const Item1, Item2: _T): Integer;
public
var
data : _T;
procedure Add(item: _T);
procedure Sort(compare: TCompareFunc);
end;

5
tests/webtbs/tw9827.pp
View File

@ -2,8 +2,9 @@
type
generic GList<_T> = class
var private
i : integer;
private
var
i : integer;
function some_func(): integer;
end;

7
tests/webtbs/uw14124.pp
View File

@ -6,9 +6,10 @@ interface
type
generic TGenericType<TParamType> = class
var private
FDefault: TParamType; static;
F: TParamType;
private
var
FDefault: TParamType; static;
F: TParamType;
public
procedure P;
end;