Browse Source

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 -

paul 15 years ago
parent
commit
790f6b0a4b

+ 6 - 1
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

+ 45 - 37
rtl/objpas/fgl.pp

@@ -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}

+ 3 - 2
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;

+ 3 - 2
tests/test/tgeneric18.pp

@@ -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

+ 6 - 4
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;

+ 25 - 22
tests/webtbs/tw10247.pp

@@ -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;

+ 18 - 16
tests/webtbs/tw10247b.pp

@@ -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;
-
-        TTNodeLongint = specialize TNode<Longint>;
-
-        TTNodeString = specialize TNode<String>;
+  generic TNode<T> = class
+  public
+    type
+      PT = T;
+  private
+    var
+      Data: T;
+  public
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  TTNodeLongint = specialize TNode<Longint>;
+
+  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

+ 6 - 4
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;

+ 3 - 2
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;
 

+ 4 - 3
tests/webtbs/uw14124.pp

@@ -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;