From 790f6b0a4bca9de24632fe2e646919f77c9ba56c Mon Sep 17 00:00:00 2001 From: paul Date: Tue, 27 Jul 2010 00:59:32 +0000 Subject: [PATCH] compiler: use delphi syntax for type, const and var section declarations in classes instead of fpc generics syntax rtl: fix fgl to use the new syntax tests: fix generics tests to use the new syntax git-svn-id: trunk@15646 - --- compiler/pdecobj.pas | 7 +++- rtl/objpas/fgl.pp | 82 ++++++++++++++++++++++------------------ tests/test/tgeneric11.pp | 5 ++- tests/test/tgeneric18.pp | 5 ++- tests/test/ugeneric10.pp | 10 +++-- tests/webtbs/tw10247.pp | 47 ++++++++++++----------- tests/webtbs/tw10247b.pp | 30 ++++++++------- tests/webtbs/tw11435c.pp | 10 +++-- tests/webtbs/tw9827.pp | 5 ++- tests/webtbs/uw14124.pp | 7 ++-- 10 files changed, 117 insertions(+), 91 deletions(-) diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 40c1b7be94..e3bd4b5c22 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -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 diff --git a/rtl/objpas/fgl.pp b/rtl/objpas/fgl.pp index 826e394301..1d736b091d 100644 --- a/rtl/objpas/fgl.pp +++ b/rtl/objpas/fgl.pp @@ -85,7 +85,7 @@ const type generic TFPGListEnumerator = class(TObject) - var protected + protected FList: TFPSList; FPosition: Integer; function GetCurrent: T; @@ -96,14 +96,16 @@ type end; generic TFPGList = class(TFPSList) - type public - TCompareFunc = function(const Item1, Item2: T): Integer; - TTypeList = array[0..MaxGListSize] of T; - PTypeList = ^TTypeList; - PT = ^T; - TFPGListEnumeratorSpec = specialize TFPGListEnumerator; - 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; + 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 = 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 = 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 = 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} diff --git a/tests/test/tgeneric11.pp b/tests/test/tgeneric11.pp index 3b4d9585f6..6b2aa76677 100644 --- a/tests/test/tgeneric11.pp +++ b/tests/test/tgeneric11.pp @@ -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; diff --git a/tests/test/tgeneric18.pp b/tests/test/tgeneric18.pp index cda5aaff13..fb5fe1e8f5 100644 --- a/tests/test/tgeneric18.pp +++ b/tests/test/tgeneric18.pp @@ -12,8 +12,9 @@ type { TSecondGeneric } generic TSecondGeneric = class(TObject) - type public - TFirstGenericType = specialize TFirstGeneric; + public + type + TFirstGenericType = specialize TFirstGeneric; end; var diff --git a/tests/test/ugeneric10.pp b/tests/test/ugeneric10.pp index 7bfbdb1028..eff201d708 100644 --- a/tests/test/ugeneric10.pp +++ b/tests/test/ugeneric10.pp @@ -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; diff --git a/tests/webtbs/tw10247.pp b/tests/webtbs/tw10247.pp index d8d2b510bc..582b6479b4 100644 --- a/tests/webtbs/tw10247.pp +++ b/tests/webtbs/tw10247.pp @@ -1,29 +1,32 @@ {$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 TNode = class + public + type + PT = ^T; + private + var + 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; + generic TContainer = class + public + type + TTNode = specialize TNode; + 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; diff --git a/tests/webtbs/tw10247b.pp b/tests/webtbs/tw10247b.pp index b573950862..b94b745670 100644 --- a/tests/webtbs/tw10247b.pp +++ b/tests/webtbs/tw10247b.pp @@ -1,18 +1,20 @@ {$mode objfpc}{$h+} type - generic TNode = class - type public - PT = T; - var private - Data: T; - public - constructor Create; - destructor Destroy; override; - end; + generic TNode = class + public + type + PT = T; + private + var + Data: T; + public + constructor Create; + destructor Destroy; override; + end; - TTNodeLongint = specialize TNode; + TTNodeLongint = specialize TNode; - TTNodeString = specialize TNode; + TTNodeString = specialize TNode; 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 diff --git a/tests/webtbs/tw11435c.pp b/tests/webtbs/tw11435c.pp index 283924df1b..1bd55d9107 100644 --- a/tests/webtbs/tw11435c.pp +++ b/tests/webtbs/tw11435c.pp @@ -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; diff --git a/tests/webtbs/tw9827.pp b/tests/webtbs/tw9827.pp index ec73c16121..ba42512298 100644 --- a/tests/webtbs/tw9827.pp +++ b/tests/webtbs/tw9827.pp @@ -2,8 +2,9 @@ type generic GList<_T> = class - var private - i : integer; + private + var + i : integer; function some_func(): integer; end; diff --git a/tests/webtbs/uw14124.pp b/tests/webtbs/uw14124.pp index d8b6e04e7b..02e8d4290e 100644 --- a/tests/webtbs/uw14124.pp +++ b/tests/webtbs/uw14124.pp @@ -6,9 +6,10 @@ interface type generic TGenericType = class - var private - FDefault: TParamType; static; - F: TParamType; + private + var + FDefault: TParamType; static; + F: TParamType; public procedure P; end;