# revisions: 32896,32897,32985,32988,32044,33061,33151,33170,33194,33206,33207,33220,33221,33226,33237,33241,33265

git-svn-id: branches/fixes_3_0@33749 -

.gitattributes

@@ -1893,6 +1893,7 @@ packages/fcl-base/examples/b64test2.pp svneol=native#text/plain
 packages/fcl-base/examples/base64decodingtestcase.pas svneol=native#text/plain
 packages/fcl-base/examples/cachetest.pp svneol=native#text/plain
 packages/fcl-base/examples/cfgtest.pp svneol=native#text/plain
+packages/fcl-base/examples/contit.pp svneol=native#text/plain
 packages/fcl-base/examples/crittest.pp svneol=native#text/plain
 packages/fcl-base/examples/dbugsrv.pp svneol=native#text/plain
 packages/fcl-base/examples/debugtest.pp svneol=native#text/plain

compiler/cclasses.pas

@@ -2900,7 +2900,7 @@ end;
           end
         else
           begin
-            New(Result);
+            GetMem(Result,SizeOfItem);
             if FOwnsKeys then
             begin
               GetMem(Result^.Key, KeyLen);
@@ -3007,7 +3007,7 @@ end;
           end
         else
           begin
-            New(Result);
+            Getmem(Result,SizeOfItem);
             if FOwnsKeys then
             begin
               GetMem(Result^.Key, KeyLen);

packages/fcl-base/examples/README.txt

@@ -73,4 +73,5 @@ poolmm2.pp   Test for pooledmm (nonfree) (VS)
 testweb.pp   Test for fpcgi (MVC)
 daemon.pp    Test for daemonapp (MVC)
 testtimer.pp Test for TFPTimer (MVC)
-testini.pp   Test/Demo for inifiles, ReadSectionValues.
+testini.pp   Test/Demo for inifiles, ReadSectionValues.
+contit.pp    Test/Demo for iterators in contnr.pp

packages/fcl-base/examples/contit.pp

@@ -0,0 +1,118 @@
+{$MODE OBJFPC}
+{$H+}
+{$C+}
+program test;
+
+uses
+  contnrs,
+  sysutils;
+
+const
+  KEYS: array [0..5] of string = (
+    'a',
+    'b',
+    'c',
+    'd',
+    'e',
+    'f'
+    );
+
+  TERMINATE_KEY_ID = 2;
+
+
+procedure DataStaticIterator(Item: Pointer; const Key: string; var Continue: Boolean);
+begin
+  Assert(Key = String(Item^));
+  Continue := TRUE;
+end;
+
+procedure DataStaticIteratorTerminated(Item: Pointer; const Key: string; var Continue: Boolean);
+begin
+  Continue := Key <> KEYS[TERMINATE_KEY_ID];
+end;
+
+
+procedure StringStaticIterator(Item: String; const Key: string; var Continue: Boolean);
+begin
+  Assert(Key = Item);
+  Continue := TRUE;
+end;
+
+procedure StringStaticIteratorTerminated(Item: String; const Key: string; var Continue: Boolean);
+begin
+  Continue := Key <> KEYS[TERMINATE_KEY_ID];
+end;
+
+
+type
+  TTestObject = class
+  private
+    FStr: string;
+  public
+    constructor Create(const S: string);
+    property Str: string read FStr;
+  end;
+
+constructor TTestObject.Create(const S: string);
+begin
+  FStr := S;
+end;
+
+
+procedure ObjectStaticIterator(Item: TObject; const Key: string; var Continue: Boolean);
+begin
+  Assert(Key = TTestObject(Item).Str);
+  Continue := TRUE;
+end;
+
+procedure ObjectStaticIteratorTerminated(Item: TObject; const Key: string; var Continue: Boolean);
+begin
+  Continue := Key <> KEYS[TERMINATE_KEY_ID];
+end;
+
+
+var
+  i: integer;
+  data_hash_table: TFPDataHashTable;
+  last_data: pointer;
+  string_hash_table: TFPStringHashTable;
+  last_string: string;
+  object_hash_table: TFPObjectHashTable;
+  last_object: TTestObject;
+
+begin
+  data_hash_table := TFPDataHashTable.Create;
+  for i := 0 to High(KEYS) do
+    data_hash_table.Add(KEYS[i], @KEYS[i]);
+
+  last_data := data_hash_table.Iterate(@DataStaticIterator);
+  Assert(last_data = NIL);
+  last_data := data_hash_table.Iterate(@DataStaticIteratorTerminated);
+  Assert(last_data = @KEYS[TERMINATE_KEY_ID]);
+
+  data_hash_table.Free;
+
+  string_hash_table := TFPStringHashTable.Create;
+  for i := 0 to High(KEYS) do
+    string_hash_table.Add(KEYS[i], KEYS[i]);
+
+  last_string := string_hash_table.Iterate(@StringStaticIterator);
+  Assert(last_string = '');
+  last_string := string_hash_table.Iterate(@StringStaticIteratorTerminated);
+  Assert(last_string = KEYS[TERMINATE_KEY_ID]);
+
+  string_hash_table.Free;
+
+  object_hash_table := TFPObjectHashTable.Create(TRUE);
+  for i := 0 to High(KEYS) do
+    object_hash_table.Add(KEYS[i], TTestObject.Create(KEYS[i]));
+
+  last_object := TTestObject(object_hash_table.Iterate(@ObjectStaticIterator));
+  Assert(last_object = NIL);
+  last_object := TTestObject(object_hash_table.Iterate(@ObjectStaticIteratorTerminated));
+  Assert(last_object.Str = KEYS[TERMINATE_KEY_ID]);
+
+  object_hash_table.Free;
+
+  WriteLn('All is OK');
+end.

packages/fcl-base/src/contnrs.pp

@@ -412,10 +412,15 @@ type
   THTNode = THTDataNode;
 
   TDataIteratorMethod = Procedure(Item: Pointer; const Key: string; var Continue: Boolean) of object;
+  TDataIteratorCallBack = Procedure(Item: Pointer; const Key: string; var Continue: Boolean);
+
   // For compatibility
   TIteratorMethod = TDataIteratorMethod;
 
   TFPDataHashTable = Class(TFPCustomHashTable)
+  Private
+    FIteratorCallBack: TDataIteratorCallBack;
+    Procedure CallbackIterator(Item: Pointer; const Key: string; var Continue: Boolean);
   Protected
     Function CreateNewNode(const aKey : String) : THTCustomNode; override;
     Procedure AddNode(ANode : THTCustomNode); override;
@@ -424,6 +429,7 @@ type
     Function ForEachCall(aMethod: TDataIteratorMethod): THTDataNode; virtual;
   Public
     Function Iterate(aMethod: TDataIteratorMethod): Pointer; virtual;
+    Function Iterate(aMethod: TDataIteratorCallBack): Pointer; virtual;
     Procedure Add(const aKey: string; AItem: pointer); virtual;
     property Items[const index: string]: Pointer read GetData write SetData; default;
   end;
@@ -435,9 +441,14 @@ type
   public
     property Data: String read FData write FData;
   end;
+  
   TStringIteratorMethod = Procedure(Item: String; const Key: string; var Continue: Boolean) of object;
+  TStringIteratorCallback = Procedure(Item: String; const Key: string; var Continue: Boolean);
 
   TFPStringHashTable = Class(TFPCustomHashTable)
+  Private
+    FIteratorCallBack: TStringIteratorCallback;
+    Procedure CallbackIterator(Item: String; const Key: string; var Continue: Boolean);
   Protected
     Function CreateNewNode(const aKey : String) : THTCustomNode; override;
     Procedure AddNode(ANode : THTCustomNode); override;
@@ -446,6 +457,7 @@ type
     Function ForEachCall(aMethod: TStringIteratorMethod): THTStringNode; virtual;
   Public
     Function Iterate(aMethod: TStringIteratorMethod): String; virtual;
+    Function Iterate(aMethod: TStringIteratorCallback): String; virtual;
     Procedure Add(const aKey,aItem: string); virtual;
     property Items[const index: string]: String read GetData write SetData; default;
   end;
@@ -464,11 +476,15 @@ type
   public
     destructor Destroy; override;
   end;
+
   TObjectIteratorMethod = Procedure(Item: TObject; const Key: string; var Continue: Boolean) of object;
+  TObjectIteratorCallback = Procedure(Item: TObject; const Key: string; var Continue: Boolean);
 
   TFPObjectHashTable = Class(TFPCustomHashTable)
   Private
     FOwnsObjects : Boolean;
+    FIteratorCallBack: TObjectIteratorCallback;
+    procedure CallbackIterator(Item: TObject; const Key: string; var Continue: Boolean);
   Protected
     Function CreateNewNode(const aKey : String) : THTCustomNode; override;
     Procedure AddNode(ANode : THTCustomNode); override;
@@ -479,6 +495,7 @@ type
     constructor Create(AOwnsObjects : Boolean = True);
     constructor CreateWith(AHashTableSize: Longword; aHashFunc: THashFunction; AOwnsObjects : Boolean = True);
     Function Iterate(aMethod: TObjectIteratorMethod): TObject; virtual;
+    Function Iterate(aMethod: TObjectIteratorCallback): TObject; virtual;
     Procedure Add(const aKey: string; AItem : TObject); virtual;
     property Items[const index: string]: TObject read GetData write SetData; default;
     Property OwnsObjects : Boolean Read FOwnsObjects;
@@ -1939,13 +1956,7 @@ end;
 
 Function THTCustomNode.HasKey(const AKey: string): boolean;
 begin
-  if Length(AKey) <> Length(FKey) then
-    begin
-    Result:=false;
-    Exit;
-    end
-  else
-    Result:=CompareMem(PChar(FKey), PChar(AKey), Length(AKey));
+  Result:=(AKey=FKey);
 end;
 
 { TFPCustomHashTable }
@@ -2053,11 +2064,8 @@ begin
   if Assigned(chn) then
     if chn.count>0 then
       for i:=0 to chn.Count - 1 do
-        if THTCustomNode(chn[i]).HasKey(aKey) then
-          begin
-          Result:=THTCustomNode(chn[i]);
-          Exit;
-          end;
+        if THTCustomNode(chn[i]).Key=aKey then
+          Exit(THTCustomNode(chn[i]));
   Result:=nil;
 end;
 
@@ -2072,7 +2080,7 @@ begin
     begin
     if Result.count>0 then
       for i:=0 to Result.Count - 1 do
-        if THTCustomNode(Result[i]).HasKey(aKey) then
+        if (THTCustomNode(Result[i]).Key=aKey) then
           raise EDuplicate.CreateFmt(DuplicateMsg, [aKey]);
     end
   else
@@ -2095,7 +2103,7 @@ begin
   if Assigned(chn) then
     if chn.count>0 then
       for i:=0 to chn.Count - 1 do
-        if THTCustomNode(chn[i]).HasKey(aKey) then
+        if THTCustomNode(chn[i]).Key=aKey then
           begin
           chn.Delete(i);
           dec(FCount);
@@ -2159,11 +2167,8 @@ begin
     begin
     if chn.count>0 then
       for i:=0 to chn.Count - 1 do
-        if THTCustomNode(chn[i]).HasKey(aKey) then
-          begin
-          Result:=THTNode(chn[i]);
-          Exit;
-          end
+        if (THTCustomNode(chn[i]).Key=aKey) then
+          Exit(THTNode(chn[i]));
     end
   else
     begin
@@ -2242,6 +2247,17 @@ begin
     Result:=nil;
 end;
 
+Procedure TFPDataHashTable.CallbackIterator(Item: Pointer; const Key: string; var Continue: Boolean);
+begin
+  FIteratorCallBack(Item, Key, Continue);
+end;
+
+Function TFPDataHashTable.Iterate(aMethod: TDataIteratorCallBack): Pointer;
+begin
+  FIteratorCallBack := aMethod;
+  Result := Iterate(@CallbackIterator);
+end;
+
 Function TFPDataHashTable.ForEachCall(aMethod: TDataIteratorMethod): THTDataNode;
 var
   i, j: Longword;
@@ -2321,6 +2337,17 @@ begin
     Result:='';
 end;
 
+Procedure TFPStringHashTable.CallbackIterator(Item: String; const Key: string; var Continue: Boolean);
+begin
+  FIteratorCallBack(Item, Key, Continue);
+end;
+
+Function TFPStringHashTable.Iterate(aMethod: TStringIteratorCallback): String;
+begin
+  FIteratorCallBack := aMethod;
+  Result := Iterate(@CallbackIterator);
+end;
+
 Function TFPStringHashTable.ForEachCall(aMethod: TStringIteratorMethod): THTStringNode;
 var
   i, j: Longword;
@@ -2398,6 +2425,17 @@ begin
     Result:=nil;
 end;
 
+Procedure TFPObjectHashTable.CallbackIterator(Item: TObject; const Key: string; var Continue: Boolean);
+begin
+  FIteratorCallBack(Item, Key, Continue);
+end;
+
+Function TFPObjectHashTable.Iterate(aMethod: TObjectIteratorCallback): TObject;
+begin
+  FIteratorCallBack := aMethod;
+  Result := Iterate(@CallbackIterator);
+end;
+
 Function TFPObjectHashTable.ForEachCall(aMethod: TObjectIteratorMethod): THTObjectNode;
 var
   i, j: Longword;

packages/fcl-base/src/inifiles.pp

@@ -543,8 +543,13 @@ begin
 end;
 
 procedure TCustomIniFile.SetOptions(AValue: TIniFileOptions);
+
+Const
+  CreateOnlyOptions = [ifoStripComments,ifoStripInvalid];
 begin
   if FOptions=AValue then Exit;
+  if (Foptions*CreateOnlyOptions)<>(AValue*CreateOnlyOptions) then
+    Raise Exception.Create('Can only change StripComments or StripInvalid in constructor');
   FOptions:=AValue;
 end;
 

packages/fcl-db/src/base/sqlscript.pp

@@ -19,7 +19,10 @@ unit sqlscript;
 interface
 
 uses
-  Classes, SysUtils; 
+  Classes, SysUtils;
+
+Const
+  MinSQLSeps = 5; // Default, minimum number of standard SQL separators.
 
 type
 
@@ -33,6 +36,7 @@ type
   TCustomSQLScript = class(TComponent)
   private
     FAutoCommit: Boolean;
+    FDollarStrings: Tstrings;
     FLine: Integer;
     FCol: Integer;
     FDefines: TStrings;
@@ -43,6 +47,7 @@ type
     FSkipModeStack: array[0..255] of TSQLSkipMode;
     FIsSkippingStack: array[0..255] of Boolean;
     FAborted: Boolean;
+    FUseDollarString: Boolean;
     FUseSetTerm, FUseDefines, FUseCommit,
     FCommentsInSQL: Boolean;
     FTerminator: AnsiString;
@@ -52,12 +57,18 @@ type
     FDirectives: TStrings;
     FComment,
     FEmitLine: Boolean;
+    FSeps : Array of string;
     procedure SetDefines(const Value: TStrings);
-    function FindNextSeparator(sep: array of string): AnsiString;
+    function  FindNextSeparator(ASeps: Array of string; Out IsExtended : Boolean): AnsiString;
     procedure AddToStatement(value: AnsiString; ForceNewLine : boolean);
     procedure SetDirectives(value: TStrings);
+    procedure SetDollarStrings(AValue: TStrings);
     procedure SetSQL(value: TStrings);
+    procedure SetTerminator(AValue: AnsiString);
+    procedure SetUseDollarString(AValue: Boolean);
     procedure SQLChange(Sender: TObject);
+    procedure DollarStringsChange(Sender : TObject);
+    Procedure RecalcSeps;
     function GetLine: Integer;
   protected
     procedure ClearStatement; virtual;
@@ -86,10 +97,12 @@ type
     property UseSetTerm: Boolean read FUseSetTerm write FUseSetTerm;
     property UseCommit: Boolean read FUseCommit write FUseCommit;
     property UseDefines: Boolean read FUseDefines write FUseDefines;
+    Property UseDollarString : Boolean Read FUseDollarString Write SetUseDollarString;
+    Property DollarStrings : TStrings Read FDollarStrings Write SetDollarStrings;
     property Defines : TStrings Read FDefines Write SetDefines;
     property Directives: TStrings read FDirectives write SetDirectives;
     property Script: TStrings read FSQL write SetSQL;  // script to execute
-    property Terminator: AnsiString read FTerminator write FTerminator;
+    property Terminator: AnsiString read FTerminator write SetTerminator;
     property OnException : TSQLScriptExceptionEvent read FOnException write FOnException;
   end;
 
@@ -155,21 +168,21 @@ begin
   Result := Result and ((L2 = L1) or (s1[L2+1] = ' '));
 end;
 
-function GetFirstSeparator(S: AnsiString; Sep: array of string): AnsiString;
+function GetFirstSeparator(S: AnsiString; Sep: array of string): integer;
 
 var
   i, C, M: Integer;
 
 begin
   M:=length(S) + 1;
-  Result:='';
+  Result:=-1;
   for i:=0 to high(Sep) do
     begin
     C:=Pos(Sep[i],S);
     if (C<>0) and (C<M) then
       begin
       M:=C;
-      Result:=Sep[i];
+      Result:=i;
       end;
     end;
 end;
@@ -192,6 +205,34 @@ begin
   FCol:=1;
 end;
 
+procedure TCustomSQLScript.DollarStringsChange(Sender: TObject);
+begin
+  RecalcSeps;
+end;
+
+procedure TCustomSQLScript.RecalcSeps;
+
+Var
+  L : Integer;
+
+begin
+  L:=MinSQLSeps;
+  If UseDollarString then
+     L:=L+1+DollarStrings.Count;
+  SetLength(FSeps,L);
+  FSeps[0]:=FTerminator;
+  FSeps[1]:='/*';
+  FSeps[2]:='"';
+  FSeps[3]:='''';
+  FSeps[4]:='--';
+  If UseDollarString then
+    begin
+    FSeps[MinSQLSeps]:='$$';
+    For L:=0 to FDollarStrings.Count-1 do
+      FSeps[MinSQLSeps+1+L]:='$'+FDollarStrings[L]+'$';
+    end;
+end;
+
 procedure TCustomSQLScript.SetDirectives(value: TStrings);
 
 var 
@@ -212,6 +253,14 @@ begin
   DefaultDirectives;
 end;
 
+procedure TCustomSQLScript.SetDollarStrings(AValue: TStrings);
+begin
+  if FDollarStrings=AValue then Exit;
+  FDollarStrings.Assign(AValue);
+  If FUseDollarString then
+    RecalcSeps;
+end;
+
 procedure TCustomSQLScript.SetSQL(value: TStrings);
 begin
   FSQL.Assign(value);
@@ -219,12 +268,27 @@ begin
   FCol:=1;
 end;
 
+procedure TCustomSQLScript.SetTerminator(AValue: AnsiString);
+begin
+  if FTerminator=AValue then Exit;
+  FTerminator:=AValue;
+  if Length(FSeps)>0 then
+    FSeps[0]:=FTerminator;
+end;
+
+procedure TCustomSQLScript.SetUseDollarString(AValue: Boolean);
+begin
+  if FUseDollarString=AValue then Exit;
+  FUseDollarString:=AValue;
+  RecalcSeps;
+end;
 function TCustomSQLScript.GetLine: Integer;
 begin
   Result:=FLine - 1;
 end;
 
-procedure TCustomSQLScript.AddToStatement(value: AnsiString; ForceNewLine : Boolean);
+procedure TCustomSQLScript.AddToStatement(value: AnsiString;
+  ForceNewLine: boolean);
 
   Procedure DA(L : TStrings);
 
@@ -242,10 +306,12 @@ begin
     DA(FCurrentStripped);
 end;
 
-function TCustomSQLScript.FindNextSeparator(Sep: array of string): AnsiString;
+function TCustomSQLScript.FindNextSeparator(ASeps: array of string; out
+  IsExtended: Boolean): AnsiString;
 
 var
   S: AnsiString;
+  I : Integer;
 
 begin
   Result:='';
@@ -256,8 +322,8 @@ begin
       begin
       S:=Copy(S,FCol,length(S));
       end;
-    Result:=GetFirstSeparator(S,Sep);
-    if (Result='') then
+    I:=GetFirstSeparator(S,ASeps);
+    if (I=-1) then
       begin
       if FEmitLine then
         AddToStatement(S,(FCol<=1));
@@ -266,6 +332,8 @@ begin
       end
     else
       begin
+      Result:=ASeps[i];
+      IsExtended:=I>=MinSQLSeps;
       if FEmitLine then
         AddToStatement(Copy(S,1,Pos(Result,S)-1),(FCol=1));
       FCol:=(FCol-1)+Pos(Result,S);
@@ -413,7 +481,10 @@ begin
         InternalCommit(true)
       else if FUseSetTerm
         and (Directive = 'SET TERM' {Firebird/Interbase only}) then
-        FTerminator:=S
+          begin
+          FTerminator:=S;
+          RecalcSeps;
+          end
       else
         InternalDirective (Directive,S,FAborted)
       end
@@ -446,14 +517,14 @@ function TCustomSQLScript.NextStatement: AnsiString;
 
 var
   pnt: AnsiString;
-  terminator_found: Boolean;
+  b,isExtra,terminator_found: Boolean;
 
 begin
   terminator_found:=False;
   ClearStatement;
   while FLine <= FSQL.Count do
     begin
-    pnt:=FindNextSeparator([FTerminator, '/*', '"', '''', '--']);
+    pnt:=FindNextSeparator(FSeps,isExtra);
     if (pnt=FTerminator) then
       begin
       FCol:=FCol + length(pnt);
@@ -468,7 +539,7 @@ begin
       else
         FEmitLine:=False;
       FCol:=FCol + length(pnt);
-      pnt:=FindNextSeparator(['*/']);
+      pnt:=FindNextSeparator(['*/'],b);
       if FCommentsInSQL then
         AddToStatement(pnt,false)
       else
@@ -489,7 +560,7 @@ begin
       begin
       AddToStatement(pnt,false);
       FCol:=FCol + length(pnt);
-      pnt:=FindNextSeparator(['"']);
+      pnt:=FindNextSeparator(['"'],b);
       AddToStatement(pnt,false);
       FCol:=FCol + length(pnt);
       end
@@ -497,9 +568,17 @@ begin
       begin
       AddToStatement(pnt,False);
       FCol:=FCol + length(pnt);
-      pnt:=FindNextSeparator(['''']);
+      pnt:=FindNextSeparator([''''],b);
       AddToStatement(pnt,false);
       FCol:=FCol + length(pnt);
+      end
+    else if IsExtra then
+      begin
+        AddToStatement(pnt,false);
+        FCol:=FCol + length(pnt);
+        pnt:=FindNextSeparator([pnt],b);
+        AddToStatement(pnt,false);
+        FCol:=FCol + length(pnt);
       end;
     end;
   if not terminator_found then
@@ -511,7 +590,7 @@ begin
   Result:=FCurrentStatement.Text;
 end;
 
-Constructor TCustomSQLScript.Create (AnOwner: TComponent);
+constructor TCustomSQLScript.Create(AnOwner: TComponent);
 
 Var
   L : TStringList;
@@ -530,6 +609,10 @@ begin
   L:=TStringList.Create();
   L.OnChange:=@SQLChange;
   FSQL:=L;
+  L:=TStringList.Create();
+  L.OnChange:=@DollarStringsChange;
+  FDollarStrings:=L;
+  ReCalcSeps;
   FDirectives:=TStringList.Create();
   FCurrentStripped:=TStringList.Create();
   FCurrentStatement:=TStringList.Create();
@@ -562,6 +645,7 @@ procedure TCustomSQLScript.DefaultDirectives;
 begin
   With FDirectives do
     begin
+  FreeAndNil(FDollarStrings);
     // Insertion order matters as testing for directives will be done with StartsWith
     if FUseSetTerm then
       Add('SET TERM');
@@ -584,7 +668,8 @@ begin
     end;
 end;
 
-Function TCustomSQLScript.ProcessConditional(Directive: String; Param : String) : Boolean;
+function TCustomSQLScript.ProcessConditional(Directive: String; Param: String
+  ): Boolean;
 
   Procedure PushSkipMode;
 

packages/fcl-db/tests/testsqlscript.pas

@@ -44,6 +44,8 @@ type
     property DoException : string read FExcept write FExcept;
     property Aborted;
     property Line;
+    property UseDollarString;
+    property dollarstrings;
     property Directives;
     property Defines;
     property Script;
@@ -114,6 +116,9 @@ type
     procedure TestDirectiveOnException2;
     procedure TestCommitOnException1;
     procedure TestCommitOnException2;
+    procedure TestUseDollarSign;
+    procedure TestUseDollarSign2;
+    procedure TestUseDollarSign3;
   end;
 
   { TTestEventSQLScript }
@@ -693,6 +698,77 @@ begin
   AssertEquals ('commit count', 1, Script.FCommits);
 end;
 
+
+Const
+  PLSQL1 = 'CREATE or replace FUNCTION test_double_bad_sum ( value1 int, value2 int ) '+
+    'RETURNS int AS $$  '+
+    'DECLARE  '+
+    '  TheDoubleSum int;  '+
+    'BEGIN  '+
+    '  -- Start  '+
+    '  TheDoubleSum := value1; '+
+    '  /* sum  '+
+    '       number  '+
+    '       1 */  '+
+    '  TheDoubleSum := TheDoubleSum + value2; '+
+    '  TheDoubleSum := TheDoubleSum + value2; -- Sum number 2  '+
+    '  return TheDoubleSum; '+
+    'END;  '+
+    '$$ '+
+    'LANGUAGE plpgsql';
+  PLSQL2 = 'COMMENT ON FUNCTION test_double_bad_sum(IN integer, IN integer) '+
+    '  IS ''Just a  '+
+    '  test function '+
+    '  !!!''';
+  PLSQL3 = 'CREATE or replace FUNCTION test_double_bad_sum ( value1 int, value2 int ) '+
+    'RETURNS int AS $BOB$  '+
+    'DECLARE  '+
+    '  TheDoubleSum int;  '+
+    'BEGIN  '+
+    '  -- Start  '+
+    '  TheDoubleSum := value1; '+
+    '  /* sum  '+
+    '       number  '+
+    '       1 */  '+
+    '  TheDoubleSum := TheDoubleSum + value2; '+
+    '  TheDoubleSum := TheDoubleSum + value2; -- Sum number 2  '+
+    '  return TheDoubleSum; '+
+    'END;  '+
+    '$BOB$ '+
+    'LANGUAGE plpgsql';
+
+procedure TTestSQLScript.TestUseDollarSign;
+
+begin
+  script.UseDollarString:=True;
+  Add(PLSQL1+';');
+  script.execute;
+  // Double quotes because there are spaces.
+  AssertStatDir('"'+plsql1+'"', '');
+end;
+
+procedure TTestSQLScript.TestUseDollarSign2;
+begin
+  script.UseDollarString:=True;
+  Add(PLSQL1+';');
+  Add(PLSQL2+';');
+  script.execute;
+  // Double quotes because there are spaces.
+  AssertStatDir('"'+plsql1+'","'+PLSQL2+'"', '');
+
+end;
+
+procedure TTestSQLScript.TestUseDollarSign3;
+begin
+  script.UseDollarString:=True;
+  script.DollarStrings.Add('BOB');
+  Add(PLSQL3+';');
+  script.execute;
+  // Double quotes because there are spaces.
+  AssertStatDir('"'+plsql3+'"', '');
+
+end;
+
 { TTestEventSQLScript }
 
 procedure TTestEventSQLScript.Notify(Sender: TObject);

packages/fcl-fpcunit/src/consoletestrunner.pas

@@ -295,8 +295,8 @@ Var
   I : Integer;
 begin
   If (T is TTestSuite) then
-    for I:=0 to TTestSuite(t).Tests.Count-1 do
-      FreeDecorators(TTest(TTestSuite(t).Tests[i]));
+    for I:=0 to TTestSuite(t).ChildTestCount-1 do
+      FreeDecorators(TTest(TTestSuite(t).Test[i]));
   if (T is TTestDecorator) and (TTestDecorator(T).Test is TDecoratorTestSuite) then
     T.free;
 end;
@@ -306,6 +306,7 @@ end;
 destructor TDecoratorTestSuite.Destroy;
 begin
   FreeDecorators(Self);
+  // We need to find something for this.
   Tests.Clear;
   inherited Destroy;
 end;
@@ -339,7 +340,7 @@ procedure TTestRunner.DoRun;
         begin
         if (test is ttestsuite) then
           begin
-          for I := 0 to TTestSuite(test).Tests.Count - 1 do
+          for I := 0 to TTestSuite(test).ChildTestCount - 1 do
              CheckTestRegistry ((test as TTestSuite).Test[I], c, res)
           end
         else if (test is TTestDecorator) then
@@ -391,7 +392,7 @@ begin
     S := '';
     S := GetOptionValue('suite');
     if S = '' then
-      for I := 0 to GetTestRegistry.Tests.Count - 1 do
+      for I := 0 to GetTestRegistry.ChildTestCount - 1 do
         writeln(GetTestRegistry[i].TestName)
     else
       begin
@@ -402,13 +403,13 @@ begin
             P:=Pos(',',S);
             if P = 0 Then
               begin
-                for I := 0 to GetTestRegistry.Tests.count-1 do
+                for I := 0 to GetTestRegistry.ChildTestCount-1 do
                   CheckTestRegistry (GetTestregistry[I], S, TS);
                 S := '';
               end
             else
               begin
-                for I := 0 to GetTestRegistry.Tests.count-1 do
+                for I := 0 to GetTestRegistry.ChildTestCount-1 do
                   CheckTestRegistry (GetTestregistry[I],Copy(S, 1,P - 1), TS);
                 Delete(S, 1, P);
               end;

packages/fcl-fpcunit/src/fpcunit.pp

@@ -241,6 +241,7 @@ type
     FTestSuiteName: string;
     FEnableIgnores: boolean;
     function GetTest(Index: integer): TTest;
+    function GetTestCount: Integer;
   protected
     Function DoAddTest(ATest : TTest) : Integer;
     function GetTestName: string; override;
@@ -263,9 +264,11 @@ type
     procedure AddTestSuiteFromClass(ATestClass: TClass); virtual;
     class function Warning(const aMessage: string): TTestCase;
     property Test[Index: integer]: TTest read GetTest; default;
+    Property ChildTestCount : Integer Read GetTestCount;
     property TestSuiteName: string read GetTestSuiteName write SetTestSuiteName;
     property TestName: string read GetTestName write SetTestName;
-    property Tests: TFPList read FTests;
+    // Only for backwards compatibility. Use Test and ChildTestCount.
+    property Tests: TFPList read FTests; deprecated;
   end;
   
   TProtect = procedure(aTest: TTest; aResult: TTestResult);
@@ -1199,6 +1202,11 @@ begin
   Result := TTestItem(FTests[Index]).Test;
 end;
 
+function TTestSuite.GetTestCount: Integer;
+begin
+  Result:=FTests.Count;
+end;
+
 function TTestSuite.DoAddTest(ATest: TTest): Integer;
 begin
   Result:=FTests.Add(TTestItem.Create(ATest));

packages/fcl-fpcunit/src/latextestreport.pp

@@ -255,19 +255,22 @@ var
   i,j: integer;
   s: TTestSuite;
 begin
-  Result := '\flushleft' + System.sLineBreak;
-  for i := 0 to aSuite.Tests.Count - 1 do
-  begin
-    s := TTestSuite(ASuite.Tests.Items[i]);
-    Result := Result + TLatexResultsWriter.EscapeText(s.TestSuiteName) + System.sLineBreak;
-    Result := Result + '\begin{itemize}'+ System.sLineBreak;
-    for j := 0 to s.Tests.Count - 1 do
-      if TTest(s.Tests.Items[j]) is TTestCase then
-        Result := Result + '\item[-] ' + 
-          TLatexResultsWriter.EscapeText(TTestcase(s.Tests.Items[j]).TestName)
-          + System.sLineBreak;
-    Result := Result +'\end{itemize}' + System.sLineBreak;
-  end;
+  Result := TLatexResultsWriter.EscapeText(aSuite.TestSuiteName) + System.sLineBreak;
+  Result := Result + '\begin{itemize}'+ System.sLineBreak;
+  for i := 0 to aSuite.ChildTestCount - 1 do
+    if ASuite.Test[i] is TTestSuite then
+      begin
+      Result:=Result + '\item[-] ';
+      Result := Result + '\flushleft' + System.sLineBreak;
+      Result:=Result+TestSuiteAsLatex(TTestSuite(ASuite.Test[i]))+System.sLineBreak;
+      end
+    else   
+      begin
+      Result := Result + '\item[-] ' + 
+               TLatexResultsWriter.EscapeText(TTestcase(aSuite.Test[i]).TestName)
+               + System.sLineBreak;
+      end;    
+  Result := Result +'\end{itemize}' + System.sLineBreak;
 end;
 
 

packages/fcl-fpcunit/src/plaintestreport.pp

@@ -208,17 +208,28 @@ begin
   FSuiteHeaderIdx.Add(Pointer(FDoc.Count - 1));
 end;
 
-function TestSuiteAsPlain(aSuite:TTestSuite; Options : TTestResultOptions = []): string;
+function DoTestSuiteAsPlain(aSuite:TTestSuite; Prefix : String; Options : TTestResultOptions = []): string;
 var
   i: integer;
+  p : string;
 begin
-  Result := '';
-  for i := 0 to aSuite.Tests.Count - 1 do
-    if TTest(aSuite.Tests.Items[i]) is TTestSuite then
-      Result := Result + TestSuiteAsPlain(TTestSuite(aSuite.Tests.Items[i]),Options)
-    else
-      if TTest(aSuite.Tests.Items[i]) is TTestCase then
-        Result := Result + '  ' + ASuite.TestName+'.' + TTestcase(aSuite.Tests.Items[i]).TestName + System.sLineBreak;
+  Result := Prefix+ASuite.TestName+System.sLineBreak;
+  for i := 0 to aSuite.ChildTestCount - 1 do
+    if aSuite.Test[i] is TTestSuite then
+      begin
+      P:=Prefix;
+      if (ASuite.TestName<>'') then
+        P:=P+'  ';
+      Result := Result + DoTestSuiteAsPlain(TTestSuite(aSuite.Test[i]),P,Options);
+      end
+    else if aSuite.Test[i] is TTestCase then
+      Result := Result + Prefix+'  ' + ASuite.TestName+'.' + TTestcase(aSuite.Test[i]).TestName + System.sLineBreak;
+end;
+
+function TestSuiteAsPlain(aSuite:TTestSuite; Options : TTestResultOptions = []): string;
+
+begin
+  Result:=DoTestSuiteAsPLain(ASuite,'',Options);
 end;
 
 function GetSuiteAsPlain(aSuite: TTestSuite; Options : TTestResultOptions = []): string;

packages/fcl-fpcunit/src/testregistry.pp

@@ -63,7 +63,7 @@ var
   lSuiteName: String;
   lPathRemainder: String;
   lDotPos: Integer;
-  lTests: TFPList;
+
 begin
   if APath = '' then
   begin
@@ -89,19 +89,15 @@ begin
 
     // Check to see if the path already exists
     lTargetSuite := nil;
-    lTests := ARootSuite.Tests;
-    for i := 0 to lTests.Count -1 do
-    begin
-      lCurrentTest := TTest(lTests[i]);
-      if lCurrentTest is TTestSuite then
+    I:=0;
+    While (lTargetSuite=Nil) and (I<ARootSuite.ChildTestCount) do
       begin
+      lCurrentTest:= ARootSuite.Test[i];
+      if lCurrentTest is TTestSuite then
         if (lCurrentTest.TestName = lSuiteName) then
-        begin
           lTargetSuite := TTestSuite(lCurrentTest);
-          break;
-        end;
+      Inc(I);
       end;  { if }
-    end;  { for }
 
     if not Assigned(lTargetSuite) then
     begin

packages/fcl-fpcunit/src/testreport.pp

@@ -186,33 +186,59 @@ var
 begin
   Result := StringOfChar(' ',Indent) + '<TestSuite name="' + ASuite.TestName + '">' + System.sLineBreak;
   Inc(Indent, 2);
-  for i := 0 to aSuite.Tests.Count - 1 do
-    if TTest(aSuite.Tests.Items[i]) is TTestSuite then
-      Result := Result + TestSuiteAsXML(TTestSuite(aSuite.Tests.Items[i]),Indent)
+  for i := 0 to aSuite.ChildTestCount - 1 do
+    if TTest(aSuite.Test[i]) is TTestSuite then
+      Result := Result + TestSuiteAsXML(TTestSuite(aSuite.Test[i]),Indent)
     else
-      if TTest(aSuite.Tests.Items[i]) is TTestCase then
-        Result := Result + StringOfChar(' ',Indent) + '<test>' + TTestcase(aSuite.Tests.Items[i]).TestName + '</test>' + System.sLineBreak;
+      if TTest(aSuite.Test[i]) is TTestCase then
+        Result := Result + StringOfChar(' ',Indent) + '<test>' + TTestcase(aSuite.Test[i]).TestName + '</test>' + System.sLineBreak;
   Dec(Indent, 2);
   Result := Result + StringOfChar(' ',Indent) + '</TestSuite>' + System.sLineBreak;
 end;
 
+function EscapeText(const S: string): String;
+var
+  i: integer;
+begin
+  SetLength(Result, 0);
+    for i := 1 to Length(S) do
+      case S[i] of
+        '&','{','}','#','_','$','%':     // Escape these characters
+          Result := Result + '\' + S[i];
+        '~','^':
+          Result := Result + '\'+S[i]+' ';
+        '\':
+          Result := Result + '$\backslash$';
+        '<':
+          Result := Result + '$<$';
+        '>':
+          Result := Result + '$>$'
+        else
+          Result := Result + S[i];
+      end;
+end;
 
 function TestSuiteAsLatex(aSuite:TTestSuite): string;
 var
   i,j: integer;
   s: TTestSuite;
 begin
-  Result := '\flushleft' + System.sLineBreak;
-  for i := 0 to aSuite.Tests.Count - 1 do
-  begin
-    s := TTestSuite(ASuite.Tests.Items[i]);
-    Result := Result + s.TestSuiteName + System.sLineBreak;
-    Result := Result + '\begin{itemize}'+ System.sLineBreak;
-    for j := 0 to s.Tests.Count - 1 do
-      if TTest(s.Tests.Items[j]) is TTestCase then
-        Result := Result + '\item[-] ' + TTestcase(s.Tests.Items[j]).TestName  + System.sLineBreak;
-    Result := Result +'\end{itemize}' + System.sLineBreak;
-  end;
+  Result := EscapeText(aSuite.TestSuiteName) + System.sLineBreak;
+  Result := Result + '\begin{itemize}'+ System.sLineBreak;
+  for i := 0 to aSuite.ChildTestCount - 1 do
+    if ASuite.Test[i] is TTestSuite then
+      begin
+      Result:=Result + '\item[-] ';
+      Result := Result + '\flushleft' + System.sLineBreak;
+      Result:=Result+TestSuiteAsLatex(TTestSuite(ASuite.Test[i]))+System.sLineBreak;
+      end
+    else   
+      begin
+      Result := Result + '\item[-] ' + 
+               EscapeText(TTestcase(aSuite.Test[i]).TestName)
+               + System.sLineBreak;
+      end;    
+  Result := Result +'\end{itemize}' + System.sLineBreak;
 end;
 
 function TestSuiteAsPlain(aSuite:TTestSuite): string;
@@ -220,12 +246,12 @@ var
   i,j: integer;
   s: TTestSuite;
 begin
-  for i := 0 to aSuite.Tests.Count - 1 do
-    if TTest(aSuite.Tests.Items[i]) is TTestSuite then
-      Result := Result + TestSuiteAsPlain(TTestSuite(aSuite.Tests.Items[i]))
+  for i := 0 to aSuite.ChildTestCount - 1 do
+    if TTest(aSuite.Test[i]) is TTestSuite then
+      Result := Result + TestSuiteAsPlain(TTestSuite(aSuite.Test[i]))
     else
-      if TTest(aSuite.Tests.Items[i]) is TTestCase then
-        Result := Result + '  ' + ASuite.TestName+'.' + TTestcase(aSuite.Tests.Items[i]).TestName + System.sLineBreak;
+      if TTest(aSuite.Test[i]) is TTestCase then
+        Result := Result + '  ' + ASuite.TestName+'.' + TTestcase(aSuite.Test[i]).TestName + System.sLineBreak;
 end;
 
 function GetSuiteAsXML(aSuite: TTestSuite): string;

packages/fcl-fpcunit/src/xmltestreport.pp

@@ -101,13 +101,27 @@ end;
 function TestSuiteAsXML(n: TDOMElement; FDoc: TXMLDocument; aSuite:TTestSuite): string;
 var
   i: integer;
+  E,T : TDomElement;
+  
 begin
-  for i := 0 to Pred(aSuite.Tests.Count) do
-    if TTest(aSuite.Tests.Items[i]) is TTestSuite then
-      TestSuiteAsXML(n, FDoc, TTestSuite(aSuite.Tests.Items[i]))
+  if aSuite.TestName<>'' then
+    begin
+    E:=FDoc.CreateElement('Suite');
+    E['Name']:=aSuite.TestName;
+    N.AppendChild(E);
+    end
+  else
+    E:=N;
+  for i:=0 to Pred(aSuite.ChildTestCount) do
+    if TTest(aSuite.Test[i]) is TTestSuite then
+      TestSuiteAsXML(E, FDoc, TTestSuite(aSuite.Test[i]))
     else
-      if TTest(aSuite.Tests.Items[i]) is TTestCase then
-        n.AppendChild(FDoc.CreateTextNode(TTestcase(aSuite.Tests.Items[i]).TestName + ' '));
+      if TTest(aSuite.Test[i]) is TTestCase then
+        begin
+        T:=FDoc.CreateElement('Test');
+        T['name']:=TTestCase(aSuite.Test[i]).TestName;
+        E.AppendChild(T);
+        end;
 end;
 
 

packages/fcl-registry/src/registry.pp

@@ -613,4 +613,9 @@ begin
       end;
 end;
 
+{$ifdef XMLREG}
+finalization
+  TXMLRegistryInstance.FreeXMLRegistryCache;
+{$endif}
+
 end.

packages/fcl-registry/src/xmlreg.pp

@@ -605,15 +605,17 @@ Var
   N  : TDomElement;
   DN : TDomNode;
   L : Integer;
+  S: Ansistring; 
 begin
   N:=FindValueKey(Name);
   Result:=(N<>Nil);
   If Result then
     begin
     DN:=N.FirstChild;
-    if Assigned(DN) and (DN.NodeType=TEXT_NODE) then
-      L:=TDOMText(DN).Length
-    else
+    if Assigned(DN) and (DN.NodeType=TEXT_NODE) then begin
+      S := DN.NodeValue;
+      L:=Length(S);
+    end else
       L:=0;
     With Info do
       begin

packages/fcl-registry/src/xregreg.inc

@@ -5,16 +5,88 @@
 
 uses xmlreg;
 
+type
+
+  { TXMLRegistryInstance }
+
+  TXMLRegistryInstance = class(TXMLRegistry)
+  private
+    FRefCount: integer;
+    Class Var XMLRegistryCache: Tlist;
+    Class procedure FreeXMLRegistryCache;
+  public
+    constructor Create(AFileName : String);
+    Class Function GetXMLRegistry(aFileName: string): TXMLRegistry;
+    Class Procedure FreeXMLRegistry(XMLRegistry: TXMLRegistry);
+    procedure IncRefCount;
+    procedure DecRefCount;
+    property RefCount: integer read FRefCount;
+  end;
+
+Class function TXMLRegistryInstance.GetXMLRegistry(aFileName: string): TXMLRegistry;
+var i: integer;
+begin
+  if not assigned(XMLRegistryCache) then
+    XMLRegistryCache := TList.Create;
+
+  for i := 0 to XMLRegistryCache.Count - 1 do
+    if TXMLRegistryInstance(XMLRegistryCache[i]).FileName = aFileName then
+    begin
+      TXMLRegistryInstance(XMLRegistryCache[i]).IncRefCount;
+      Result :=  TXMLRegistry(XMLRegistryCache[i]);
+      Exit;
+    end;
+
+  Result := TXMLRegistryInstance.Create(aFileName);
+  XMLRegistryCache.Add(Result);
+end;
+
+Class procedure TXMLRegistryInstance.FreeXMLRegistry(XMLRegistry: TXMLRegistry);
+begin
+  TXMLRegistryInstance(XMLRegistry).DecRefCount;
+  if TXMLRegistryInstance(XMLRegistry).RefCount = 0 then
+  begin
+    XMLRegistryCache.Remove(XMLRegistry);
+    XMLRegistry.Free;
+  end;
+end;
+
+class procedure TXMLRegistryInstance.FreeXMLRegistryCache;
+
+var i: integer;
+begin
+  for i := 0 to XMLRegistryCache.Count - 1 do
+    TXMLRegistryInstance(XMLRegistryCache[i]).Free;
+  FreeAndNil(XMLRegistryCache);
+end;
 
 Const
   XFileName = 'reg.xml';
 
+{ TXMLRegistryInstance }
+
+constructor TXMLRegistryInstance.Create(AFileName: String);
+begin
+  inherited;
+  FRefCount := 1;
+end;
+
+procedure TXMLRegistryInstance.IncRefCount;
+begin
+  Inc(FRefCount);
+end;
+
+procedure TXMLRegistryInstance.DecRefCount;
+begin
+  Dec(FRefCount);
+end;
+
 Procedure TRegistry.SysRegCreate;
 var s : string;
 begin
   s:=includetrailingpathdelimiter(GetAppConfigDir(GlobalXMLFile));
   ForceDirectories(s);
-  FSysData:=TXMLRegistry.Create(s+XFileName);
+  FSysData:=TXMLRegistryInstance.GetXMLRegistry(s+XFileName);
   TXmlRegistry(FSysData).AutoFlush:=False;
 end;
 
@@ -23,7 +95,7 @@ Procedure TRegistry.SysRegFree;
 begin
   if Assigned(FSysData) then
     TXMLRegistry(FSysData).Flush;
-  TXMLRegistry(FSysData).Free;
+  TXMLRegistryInstance.	FreeXMLRegistry(TXMLRegistry(FSysData));
 end;
 
 function TRegistry.SysCreateKey(const Key: String): Boolean;

rtl/inc/system.fpd

@@ -65,12 +65,12 @@ Procedure Write (Args : Arguments);
 Procedure Writeln (Args : Arguments);
 Procedure Write (Var F : Text; Args : Arguments);
 Procedure WriteLn (Var F : Text; Args : Arguments);
-Function Copy(S : AStringType; Index,Count : Integer) : String;
-Function Copy(A : DynArrayType; Index,Count : Integer) : DynArray;
-Procedure SetLength(Var S : AStringType; Len : Integer);
-Procedure SetLength(Var A : DynArrayType; Len : Integer);
-Function Length(S : AStringType) : Integer;
-Function Length(A : DynArrayType) : Integer;
+Function Copy(S : AStringType; Index,Count : SizeInt) : String;
+Function Copy(A : DynArrayType; Index,Count : SizeInt) : DynArray;
+Procedure SetLength(Var S : AStringType; Len : SizeInt);
+Procedure SetLength(Var A : DynArrayType; Len : SizeInt);
+Function Length(S : AStringType) : SizeInt;
+Function Length(A : DynArrayType) : SizeInt;
 Procedure WriteStr(Out S : String; Args : Arguments);
 Procedure ReadStr(Const S : String; Args : Arguments);
 Procedure Pack(Const A : UnpackedArrayType; StartIndex : TIndexType; Out Z : PackedArrayType);
@@ -79,8 +79,8 @@ Function Slice(Const A : ArrayType; ACount : Integer) : ArrayType2;
 Function TypeInfo(Const T : AnyType) : Pointer;
 Procedure Fail;
 Function TypeOf(T : TObjectType) : Pointer;
-Procedure Initialize(Var T : TAnyType; ACount : Integer = 1);
-Procedure Finalize(Var T : TAnyType; ACount : Integer = 1);
+Procedure Initialize(Var T : TAnyType; ACount : SizeInt = 1);
+Procedure Finalize(Var T : TAnyType; ACount : SizeInt = 1);
 Function Default(Const T : AnyType) : AnyType;
  
 {$IFNDEF GO32V2}

rtl/objpas/sysutils/filutilh.inc

@@ -82,14 +82,20 @@ Type
 
 Const
   { File attributes }
-  faReadOnly  = $00000001;
-  faHidden    = $00000002;
-  faSysFile   = $00000004;
-  faVolumeId  = $00000008;
-  faDirectory = $00000010;
-  faArchive   = $00000020;
-  faSymLink   = $00000040;
-  faAnyFile   = $0000003f;
+  faReadOnly   = $00000001;
+  faHidden     = $00000002 platform;
+  faSysFile    = $00000004 platform;
+  faVolumeId   = $00000008 platform deprecated;
+  faDirectory  = $00000010;
+  faArchive    = $00000020;
+  faNormal     = $00000080;
+  faTemporary  = $00000100 platform;
+  faSymLink    = $00000400 platform;
+  faCompressed = $00000800 platform;
+  faEncrypted  = $00004000 platform;
+  faVirtual    = $00010000 platform;
+  faAnyFile    = $000001FF;
+             
 
   { File open modes }
   fmOpenRead       = $0000;

utils/fpdoc/dw_html.pp

@@ -3236,6 +3236,8 @@ begin
         AppendKw(CodeEl, 'property ');
         AppendHyperlink(CodeEl, Member);
         t:=TPasProperty(Member).ResolvedType;
+        if Assigned(TPasProperty(Member).Args) and (TPasProperty(Member).Args.Count>0) then
+           AppendText(CodeEl, ' []');
         if Assigned(T) then
         begin
           AppendSym(CodeEl, ': ');
@@ -3674,12 +3676,31 @@ var
   var
     NeedBreak: Boolean;
     T : TPasType;
+    A : TPasArgument;
+    I : integer;
 
   begin
     AppendKw(CodeEl, 'property ');
     AppendHyperlink(CodeEl, Element.Parent);
     AppendSym(CodeEl, '.');
     AppendText(CodeEl, Element.Name);
+    if Assigned(Element.Args) and (Element.Args.Count>0) then
+      begin
+      AppendSym(CodeEl,'[');
+      For I:=0 to Element.Args.Count-1 do
+        begin
+        If I>0 then
+          AppendSym(CodeEl,',');
+        A:=TPasArgument(Element.Args[i]);
+        AppendText(CodeEl, A.Name);
+        AppendSym(CodeEl,': ');
+        if Assigned(A.ArgType) then
+          AppendText(CodeEl,A.ArgType.Name)
+        else
+          AppendText(CodeEl,'<Unknown>');
+        end;
+      AppendSym(CodeEl,']');
+      end;
     T:=Element.ResolvedType;
     if Assigned(T) then
     begin

utils/fpdoc/dw_latex.pp

@@ -23,6 +23,7 @@ uses DOM, dGlobals, PasTree;
 
 const
   LateXHighLight : Boolean = False;
+  MaxVerbatimLength : Integer = 65;
   TexExtension   : String = '.tex';
 
 Procedure CreateLaTeXDocForPackage(APackage: TPasPackage; AEngine: TFPDocEngine);
@@ -130,8 +131,10 @@ Type
     // TFPDocWriter class methods
     Property ImageDir : String Read FImageDir Write FImageDir;
   public
+    Function SplitLine (ALine : String): String; virtual;
     Function InterPretOption(Const Cmd,Arg : String) : boolean; override;
     Class Function FileNameExtension : String; override;
+    class procedure Usage(List: TStrings); override;
   end;
 
 
@@ -153,15 +156,75 @@ begin
       Result[i] := ':';
 end;
 
+Function TLaTeXWriter.SplitLine (ALine : String): String;
+
+  Function FindLastSplit(S : String) : Integer;
+
+  Const
+    NonSplit = ['a'..'z','A'..'Z','0'..'9','_'];
+   
+   Var
+     L,I : integer;
+     C : PChar;
+     InString : Boolean;
+    
+  begin
+    Result:=0;
+    L:=Length(S);
+    if (L>MaxVerbatimLength) then
+      begin
+      InString:=False;
+      Result:=0;
+      I:=1;
+      C:=@S[1];
+      While (I<=MaxVerbatimLength) do
+        begin
+        If C^='''' then
+          InString:=Not Instring
+        else if Not InString then
+          begin
+          if Not (C^ in NonSplit) then  
+            Result:=I;
+          end;  
+        Inc(I);
+        Inc(C);
+        end;    
+      end;  
+    If Result=0 then
+      Result:=L+1;
+  end;
+   
+Var
+  SP : Integer;   
+  L : String;
+   
+begin
+  Result:='';
+  While (Aline<>'') do
+    begin
+    SP:=FindLastSplit(Aline);
+    L:=Copy(ALine,1,SP-1);
+    Delete(ALine,1,SP-1);
+    If (Result<>'') then
+      Result:=Result+sLineBreak+'  ';
+    Result:=Result+Trim(L);
+    end;
+end;
 
 function TLaTeXWriter.EscapeText(S: String): String;
 
+
 var
   i: Integer;
 
 begin
   if FInVerBatim=True then
-    Result:=S
+    begin
+    if (MaxVerbatimLength=0) or (length(S)<=MaxVerbatimLength) then
+      Result:=S
+    else 
+      Result:=SplitLine(S);
+    end
   else
     begin
     SetLength(Result, 0);
@@ -725,12 +788,34 @@ begin
     LatexHighLight:=True
   else if Cmd = '--latex-extension' then
      TexExtension:=Arg
+  else if Cmd = '--latex--verbatim-length' then
+     MaxVerbatimLength:=StrToInt(Arg)
   else if Cmd = '--image-dir' then
      ImageDir:=Arg
   else
     Result:=False;
 end;
 
+Resourcestring
+  SLatexHighlightDocs = 'Use the syntax highlighter for declarations.';
+  SLatexExtensionDocs = 'Specify the extension for the latex files.';
+  SLatexVerbatimLengthDocs = 'Specify maximum line length for verbatim environments (default 64).';
+  SLatexImageDirDocs = 'Specify the directory where the images are stored.';
+
+class procedure TLaTeXWriter.Usage(List: TStrings); 
+
+begin
+  Inherited;
+  List.Add('--latex-highlight');
+  List.Add(SLatexHighlightDocs);
+  List.Add('--latex-extension=ext');
+  List.Add(SLatexExtensionDocs);
+  List.Add('--latex-verbatim-length=len');
+  List.Add(SLatexVerbatimLengthDocs);
+  List.Add('--image-dir=dir');
+  List.Add(SLatexImageDirDocs);
+end;
+
 initialization
   // Do not localize.
   RegisterWriter(TLaTeXWriter,'latex','Latex output using fpc.sty class.');

utils/instantfpc/instantfpc.pas

@@ -29,9 +29,11 @@ const
   // 1.3 compile in a separate directory, so that parallel invocations do not overwrite link.res files
 
 
-Procedure Usage;
+Procedure Usage(Err : string);
 
 begin
+  if (Err<>'') then
+    Writeln('Error : ',Err);
   writeln('instantfpc '+Version);
   writeln;
   writeln('Run pascal source files as scripts.');
@@ -76,7 +78,7 @@ begin
   writeln;
   writeln('  -B');
   writeln('      Always recompile.');
-  Halt(0);
+  Halt(Ord(Err<>''));
 end;
 
 Procedure DisplayCache;
@@ -108,7 +110,7 @@ begin
     Halt(1);
     end
   else if p='-h' then 
-    usage
+    usage('')
   else if p='--get-cache' then 
     DisplayCache
   else if copy(p,1,11)='--compiler=' then 
@@ -167,12 +169,8 @@ begin
       end;  
   end;
   if (Filename='') then 
-    begin
-    writeln('missing source file');
-    Halt(1);
-    end;
+    Usage('Missing source file');
   CheckSourceName(Filename);
-
   Src:=TStringList.Create;
   try
     Src.LoadFromFile(Filename);