* Merging revisions r43641,r43642,r43643,r43644,r43645 from trunk:

------------------------------------------------------------------------
    r43641 | michael | 2019-12-05 11:43:02 +0100 (Thu, 05 Dec 2019) | 1 line
    
    * Fix bug #0036361, use buffer when reading csv
    ------------------------------------------------------------------------
    r43642 | michael | 2019-12-05 13:51:14 +0100 (Thu, 05 Dec 2019) | 1 line
    
    * Fix 16 bit support for PNM (bug ID 35080)
    ------------------------------------------------------------------------
    r43643 | michael | 2019-12-05 15:01:43 +0100 (Thu, 05 Dec 2019) | 1 line
    
    * Rework default file mechanism in bufdataset to fix bug #34435
    ------------------------------------------------------------------------
    r43644 | michael | 2019-12-05 15:02:03 +0100 (Thu, 05 Dec 2019) | 1 line
    
    * Fix name array
    ------------------------------------------------------------------------
    r43645 | michael | 2019-12-05 15:54:15 +0100 (Thu, 05 Dec 2019) | 1 line
    
    * Fix bug #32532: AV when killing daemon app
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@43647 -

.gitattributes

@@ -2006,6 +2006,7 @@ packages/fcl-base/src/wtex.pp svneol=native#text/plain
 packages/fcl-base/tests/fclbase-unittests.lpi svneol=native#text/plain
 packages/fcl-base/tests/fclbase-unittests.pp svneol=native#text/plain
 packages/fcl-base/tests/tcbufferedfilestream.pp svneol=native#text/plain
+packages/fcl-base/tests/tccsvdocument.pp svneol=native#text/plain
 packages/fcl-base/tests/tccsvreadwrite.pp svneol=native#text/plain
 packages/fcl-base/tests/tchashlist.pp svneol=native#text/plain
 packages/fcl-base/tests/tcinifile.pp svneol=native#text/plain
@@ -2308,6 +2309,14 @@ packages/fcl-extra/examples/Makefile svneol=native#text/plain
 packages/fcl-extra/examples/Makefile.fpc svneol=native#text/plain
 packages/fcl-extra/examples/daemon.pp svneol=native#text/plain
 packages/fcl-extra/examples/daemon.txt svneol=native#text/plain
+packages/fcl-extra/examples/double/daemonmapperunit1.lfm svneol=native#text/plain
+packages/fcl-extra/examples/double/daemonmapperunit1.pas svneol=native#text/plain
+packages/fcl-extra/examples/double/daemonunit1.lfm svneol=native#text/plain
+packages/fcl-extra/examples/double/daemonunit1.pas svneol=native#text/plain
+packages/fcl-extra/examples/double/daemonunit2.lfm svneol=native#text/plain
+packages/fcl-extra/examples/double/daemonunit2.pas svneol=native#text/plain
+packages/fcl-extra/examples/double/double.pp svneol=native#text/plain
+packages/fcl-extra/examples/double/resdaemonapp.pp svneol=native#text/plain
 packages/fcl-extra/fpmake.pp svneol=native#text/pascal
 packages/fcl-extra/src/daemonapp.pp svneol=native#text/plain
 packages/fcl-extra/src/unix/daemonapp.inc svneol=native#text/plain

packages/fcl-base/src/csvdocument.pp

@@ -44,7 +44,7 @@ unit csvdocument;
 interface
 
 uses
-  Classes, SysUtils, Contnrs, csvreadwrite;
+  Classes, SysUtils, Contnrs, csvreadwrite, bufstream;
 
 type
   TCSVChar = csvreadwrite.TCSVChar;
@@ -73,13 +73,15 @@ type
     function  GetColCount(ARow: Integer): Integer;
     function  GetMaxColCount: Integer;
   public
-    constructor Create;
+    constructor Create; override;
     destructor  Destroy; override;
 
     // Input/output
 
-    // Load document from file AFileName
-    procedure LoadFromFile(const AFilename: String);
+    // Load document from file AFileName. Use default buffer size of 16kb
+    procedure LoadFromFile(const AFilename: String); overload;
+    // Load document from file AFileName. Buffer size is in Kb.
+    procedure LoadFromFile(const AFilename: String; ABufferSize : Integer); overload;
     // Load document from stream AStream
     procedure LoadFromStream(AStream: TStream);
     // Save document to file AFilename
@@ -392,14 +394,27 @@ begin
 end;
 
 procedure TCSVDocument.LoadFromFile(const AFilename: String);
+
+begin
+  LoadFromFile(aFileName,DefaultBufferCapacity);
+end;
+
+procedure TCSVDocument.LoadFromFile(const AFilename: String; ABufferSize : Integer);
 var
   FileStream: TFileStream;
+  B : TBufStream;
+
 begin
+  B:=Nil;
   FileStream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
   try
-    LoadFromStream(FileStream);
+    B:=TReadBufStream.Create(FileStream,aBufferSize);
+    B.SourceOwner:=True;
+    FileStream:=Nil;
+    LoadFromStream(B);
   finally
     FileStream.Free;
+    B.Free;
   end;
 end;
 

packages/fcl-base/tests/fclbase-unittests.lpi

@@ -36,7 +36,7 @@
         </Mode0>
       </Modes>
     </RunParams>
-    <Units Count="7">
+    <Units Count="8">
       <Unit0>
         <Filename Value="fclbase-unittests.pp"/>
         <IsPartOfProject Value="True"/>
@@ -65,6 +65,10 @@
         <Filename Value="tcbufferedfilestream.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit6>
+      <Unit7>
+        <Filename Value="tccsvdocument.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit7>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/fcl-base/tests/fclbase-unittests.pp

@@ -4,7 +4,7 @@ program fclbase_unittests;
 
 uses
   Classes, consoletestrunner, tests_fptemplate, tchashlist,
-  testexprpars, tcmaskutils, tcinifile, tccsvreadwrite,tcbufferedfilestream;
+  testexprpars, tcmaskutils, tcinifile, tccsvreadwrite,tcbufferedfilestream, tccsvdocument;
 
 var
   Application: TTestRunner;

packages/fcl-base/tests/tccsvdocument.pp

@@ -0,0 +1,148 @@
+unit tccsvdocument;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, csvdocument;
+
+Type
+
+  { TTestCSVDocument }
+
+  TTestCSVDocument = Class(TTestCase)
+  private
+    FDoc: TCSVDocument;
+    procedure RemoveTestFile;
+    function StripQuotes(S: String): string;
+    procedure TestTestFile;
+  Public
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Procedure CreateTestFile;
+    Property Doc : TCSVDocument Read FDoc;
+  Published
+    Procedure TestEmpty;
+    Procedure TestRead;
+  end;
+
+
+
+
+
+implementation
+
+Const
+  TestFileName = 'test.csv';
+
+{ TTestCSVDocument }
+
+procedure TTestCSVDocument.SetUp;
+begin
+  FDoc:=TCSVDocument.Create;
+  Inherited;
+end;
+
+procedure TTestCSVDocument.TearDown;
+begin
+  RemoveTestFile;
+  FreeAndNil(FDoc);
+  Inherited;
+end;
+
+procedure TTestCSVDocument.RemoveTestFile;
+
+begin
+  If FileExists(TestFileName) then
+    AssertTrue('Deleting test file',DeleteFile(TestFileName));
+end;
+
+Const
+  ColCount = 3;
+  RowCount = 4;
+
+Type
+  TRow = Array[0..ColCount-1] of string;
+  TCells = Array[0..RowCount-1] of TRow;
+
+Const
+  Cells : TCells = (
+    ('a','b','c'),
+    ('1','"one"','1.1'),
+    ('2','"two"','2.2'),
+    ('3','"three"','3.3')
+  );
+
+procedure TTestCSVDocument.CreateTestFile;
+
+Var
+  L : TStringList;
+  R,C : Integer;
+  S : String;
+
+begin
+  L:=TStringList.Create;
+  try
+    for R:=0 to RowCount-1 do
+      begin
+      S:='';
+      for C:=0 to ColCount-1 do
+        begin
+        if S<>'' then
+          S:=S+',';
+        S:=S+Cells[R,C];
+        end;
+      L.Add(S);
+      end;
+    L.SaveToFile(TestFileName);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TTestCSVDocument.TestEmpty;
+begin
+  AssertNotNull('Have document',Doc);
+end;
+
+Function TTestCSVDocument.StripQuotes(S : String) : string;
+
+Var
+  L : integer;
+
+begin
+  Result:=S;
+  L:=Length(Result);
+  if (L>1) then
+    if (Result[1]='"') and (Result[L]='"') then
+      Result:=Copy(Result,2,L-2);
+end;
+
+procedure TTestCSVDocument.TestTestFile;
+
+Var
+  R,C : Integer;
+
+begin
+  AssertEquals('Row count',RowCount,Doc.RowCount);
+  For R:=0 to RowCount-1 do
+    For C:=0 to ColCount-1 do
+      begin
+      AssertEquals('Col['+IntToStr(R)+'] count',ColCount,Doc.ColCount[R]);
+      AssertEquals(Format('Cell[%d,%d]',[C,R]),StripQuotes(Cells[R,C]),Doc.Cells[C,R]);
+      end;
+end;
+
+procedure TTestCSVDocument.TestRead;
+
+begin
+  CreateTestFile;
+  Doc.LoadFromFile(TestFileName);
+  TestTestFile;
+end;
+
+initialization
+  RegisterTest(TTestCSVDocument);
+end.
+

packages/fcl-base/tests/tccsvreadwrite.pp

@@ -112,7 +112,6 @@ begin
 end;
 
 initialization
-
   RegisterTest(TTestCSVReadWrite);
 end.
 

packages/fcl-db/src/base/bufdataset.pas

@@ -353,7 +353,7 @@ type
 
   { TDataPacketReader }
 
-  TDataPacketFormat = (dfBinary,dfXML,dfXMLUTF8,dfAny);
+  TDataPacketFormat = (dfBinary,dfXML,dfXMLUTF8,dfAny,dfDefault);
 
   TDatapacketReaderClass = class of TDatapacketReader;
   TDataPacketReader = class(TObject)
@@ -564,6 +564,9 @@ type
     Property BufIndexes[Aindex : Integer] : TBufIndex Read GetBufIndex;
   protected
     // abstract & virtual methods of TDataset
+    class function DefaultReadFileFormat : TDataPacketFormat; virtual;
+    class function DefaultWriteFileFormat : TDataPacketFormat; virtual;
+    class function DefaultPacketClass : TDataPacketReaderClass ; virtual;
     procedure SetPacketRecords(aValue : integer); virtual;
     procedure SetRecNo(Value: Longint); override;
     function  GetRecNo: Longint; override;
@@ -640,9 +643,9 @@ type
 
     procedure SetDatasetPacket(AReader : TDataPacketReader);
     procedure GetDatasetPacket(AWriter : TDataPacketReader);
-    procedure LoadFromStream(AStream : TStream; Format: TDataPacketFormat = dfAny);
+    procedure LoadFromStream(AStream : TStream; Format: TDataPacketFormat = dfDefault);
     procedure SaveToStream(AStream : TStream; Format: TDataPacketFormat = dfBinary);
-    procedure LoadFromFile(AFileName: string = ''; Format: TDataPacketFormat = dfAny);
+    procedure LoadFromFile(AFileName: string = ''; Format: TDataPacketFormat = dfDefault);
     procedure SaveToFile(AFileName: string = ''; Format: TDataPacketFormat = dfBinary);
     procedure CreateDataset;
     Procedure Clear; // Will close and remove all field definitions.
@@ -738,17 +741,18 @@ var
 
 begin
   Result := False;
-  for i := 0 to length(RegisteredDatapacketReaders)-1 do if ((AFormat=dfAny) or (AFormat=RegisteredDatapacketReaders[i].Format)) then
-    begin
-    if (AStream=nil) or (RegisteredDatapacketReaders[i].ReaderClass.RecognizeStream(AStream)) then
+  for i := 0 to length(RegisteredDatapacketReaders)-1 do
+    if ((AFormat=dfAny) or (AFormat=RegisteredDatapacketReaders[i].Format)) then
       begin
-      ADataReaderClass := RegisteredDatapacketReaders[i];
-      Result := True;
-      if (AStream <> nil) then AStream.Seek(0,soFromBeginning);
-      break;
+      if (AStream=nil) or (RegisteredDatapacketReaders[i].ReaderClass.RecognizeStream(AStream)) then
+        begin
+        ADataReaderClass := RegisteredDatapacketReaders[i];
+        Result := True;
+        if (AStream <> nil) then AStream.Seek(0,soFromBeginning);
+        break;
+        end;
+      AStream.Seek(0,soFromBeginning);
       end;
-    AStream.Seek(0,soFromBeginning);
-    end;
 end;
 
 function DBCompareText(subValue, aValue: pointer; size: integer; options: TLocateOptions): LargeInt;
@@ -1431,8 +1435,8 @@ end;
 procedure TCustomBufDataset.DoBeforeClose;
 begin
   inherited DoBeforeClose;
-  if FFileName<>'' then
-    SaveToFile(FFileName);
+  if (FFileName<>'') then
+    SaveToFile(FFileName,dfDefault);
 end;
 
 procedure TCustomBufDataset.InternalClose;
@@ -2249,6 +2253,22 @@ begin
       FMaxIndexesCount:=FIndexes.Count+2; // Custom+Default order
 end;
 
+class function TCustomBufDataset.DefaultReadFileFormat: TDataPacketFormat;
+begin
+  Result:=dfAny;
+end;
+
+class function TCustomBufDataset.DefaultWriteFileFormat: TDataPacketFormat;
+begin
+  Result:=dfBinary;
+end;
+
+class function TCustomBufDataset.DefaultPacketClass: TDataPacketReaderClass;
+begin
+  Result:=TFpcBinaryDatapacketReader;
+end;
+
+
 procedure TCustomBufDataset.SetIndexFieldNames(const AValue: String);
 
 begin
@@ -3046,11 +3066,17 @@ end;
 
 function TCustomBufDataset.GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader;
 
-var APacketReader: TDataPacketReader;
-    APacketReaderReg: TDatapacketReaderRegistration;
-
+var
+  APacketReader: TDataPacketReader;
+  APacketReaderReg: TDatapacketReaderRegistration;
+  Fmt : TDataPacketFormat;
 begin
-  if GetRegisterDatapacketReader(AStream, format, APacketReaderReg) then
+  fmt:=Format;
+  if (Fmt=dfDefault) then
+    fmt:=DefaultReadFileFormat;
+  if fmt=dfDefault then
+    APacketReader := DefaultPacketClass.Create(Self, AStream)
+  else if GetRegisterDatapacketReader(AStream, fmt, APacketReaderReg) then
     APacketReader := APacketReaderReg.ReaderClass.Create(Self, AStream)
   else if TFpcBinaryDatapacketReader.RecognizeStream(AStream) then
     begin
@@ -3423,11 +3449,17 @@ end;
 procedure TCustomBufDataset.SaveToStream(AStream: TStream; Format: TDataPacketFormat);
 var APacketReaderReg : TDatapacketReaderRegistration;
     APacketWriter : TDataPacketReader;
+    Fmt : TDataPacketFormat;
 begin
   CheckBiDirectional;
-  if GetRegisterDatapacketReader(Nil,format,APacketReaderReg) then
+  fmt:=Format;
+  if Fmt=dfDefault then
+    fmt:=DefaultWriteFileFormat;
+  if fmt=dfDefault then
+    APacketWriter := DefaultPacketClass.Create(Self, AStream)
+  else if GetRegisterDatapacketReader(Nil,fmt,APacketReaderReg) then
     APacketWriter := APacketReaderReg.ReaderClass.Create(Self, AStream)
-  else if Format = dfBinary then
+  else if fmt = dfBinary then
     APacketWriter := TFpcBinaryDatapacketReader.Create(Self, AStream)
   else
     DatabaseError(SNoReaderClassRegistered,Self);
@@ -3439,9 +3471,13 @@ begin
 end;
 
 procedure TCustomBufDataset.LoadFromFile(AFileName: string; Format: TDataPacketFormat);
-var AFileStream : TFileStream;
+
+var
+  AFileStream : TFileStream;
+
 begin
-  if AFileName='' then AFileName := FFileName;
+  if AFileName='' then
+     AFileName := FFileName;
   AFileStream := TFileStream.Create(AFileName,fmOpenRead);
   try
     LoadFromStream(AFileStream, Format);
@@ -3450,11 +3486,14 @@ begin
   end;
 end;
 
-procedure TCustomBufDataset.SaveToFile(AFileName: string;
-  Format: TDataPacketFormat);
-var AFileStream : TFileStream;
+procedure TCustomBufDataset.SaveToFile(AFileName: string; Format: TDataPacketFormat);
+
+var
+  AFileStream : TFileStream;
+
 begin
-  if AFileName='' then AFileName := FFileName;
+  if AFileName='' then
+    AFileName := FFileName;
   AFileStream := TFileStream.Create(AFileName,fmCreate);
   try
     SaveToStream(AFileStream, Format);
@@ -3526,7 +3565,7 @@ begin
   if not assigned(FDatasetReader) then
     begin
     FFileStream := TFileStream.Create(FileName, fmOpenRead);
-    FDatasetReader := GetPacketReader(dfAny, FFileStream);
+    FDatasetReader := GetPacketReader(dfDefault, FFileStream);
     end;
 
   FieldDefs.Clear;

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

@@ -95,6 +95,9 @@ Type
     FCSVOptions: TCSVOptions;
     procedure SetCSVOptions(AValue: TCSVOptions);
   Protected
+    class function DefaultReadFileFormat : TDataPacketFormat; override;
+    class function DefaultWriteFileFormat : TDataPacketFormat; override;
+    class function DefaultPacketClass : TDataPacketReaderClass ; override;
     function GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader; override;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); override;
     procedure InternalInitFieldDefs; override;
@@ -305,10 +308,25 @@ begin
   FCSVOptions.Assign(AValue);
 end;
 
+class function TCustomCSVDataset.DefaultReadFileFormat: TDataPacketFormat;
+begin
+  Result:=dfDefault;
+end;
+
+class function TCustomCSVDataset.DefaultWriteFileFormat: TDataPacketFormat;
+begin
+  Result:=dfDefault;
+end;
+
+class function TCustomCSVDataset.DefaultPacketClass: TDataPacketReaderClass;
+begin
+  Result:=TCSVDataPacketReader;
+end;
+
 function TCustomCSVDataset.GetPacketReader(const Format: TDataPacketFormat;
   const AStream: TStream): TDataPacketReader;
 begin
-  If (Format=dfAny) then
+  If (Format in [dfAny,dfDefault]) then
     Result:=TCSVDataPacketReader.Create(Self,AStream,FCSVOptions)
   else
     Result:=Inherited GetPacketReader(Format,AStream);

packages/fcl-db/tests/tccsvdataset.pp

@@ -15,6 +15,7 @@ type
   private
     FCSVDataset: TCSVDataset;
     // Load CSVDataset from CSV stream containing lines
+    procedure DoOpenClose;
     Procedure LoadFromLines(Const Lines: Array of string);
     // Save CSVDataset to CSV stream, transform to lines
     Procedure SaveToLines(Const Lines: TStrings);
@@ -47,6 +48,7 @@ type
     Procedure TestLoadPriorFieldDefsNoFieldNamesWrongCount;
     Procedure TestLoadPriorFieldDefsFieldNamesWrongCount;
     Procedure TestLoadPriorFieldDefsFieldNamesWrongNames;
+    Procedure TestOpenCloseCycle;
   end;
 
 implementation
@@ -421,6 +423,89 @@ begin
     Fail(OK);
 end;
 
+const
+  FILENAME = 'test.dat';
+
+procedure TTestCSVDataset.DoOpenClose;
+
+begin
+  CSVDataset.FileName := FILENAME;
+  With CSVDataset do
+     begin
+     CSVOptions.FirstLineAsFieldNames := True;
+     CSVOptions.DefaultFieldLength := 255;
+     CSVOptions.Delimiter := ',';
+     CSVOptions.QuoteChar := '"';
+     CSVOptions.IgnoreOuterWhitespace := False;
+     CSVOptions.QuoteOuterWhitespace := True;
+     end;
+  // When the program runs for the first time, the data file does not yet exist.
+  // We must create the FieldDefs and create the dataset.
+  if FileExists(CSVDataset.FileName) then
+    CSVDataset.Open
+  else
+    with CSVDataset do
+      begin
+      FieldDefs.Add('FirstName', ftString, 20);
+      FieldDefs.Add('LastName', ftstring, 20);
+      FieldDefs.Add('City', ftString, 20);
+      FieldDefs.Add('Address', ftString, 30);
+      FieldDefs.Add('Birthdate', ftDate);
+      CreateDataset;
+
+      // Open the dataset...
+      Open;
+
+      // ... and add some dummy data:
+      // Names from https://donatellanobatti.blogspot.de/
+      Append;
+      FieldByName('FirstName').AsString := 'Walter';
+      FieldByName('LastName').AsString := 'Mellon';
+      FieldByName('City').AsString := 'Oklahoma City';
+      FieldByName('Address').AsString :=  '1261, Main Street';
+      FieldbyName('Birthdate').AsDateTime := EncodeDate(1980, 1, 1);
+      Post;
+
+      Append;
+      FieldByName('FirstName').AsString := 'Mario';
+      FieldByName('LastName').AsString := 'Speedwagon';
+      FieldByName('City').AsString := 'Hollywood';
+      FieldByName('Address').AsString :=  '1500, Hollywood Blvd';
+      FieldbyName('Birthdate').AsDateTime := EncodeDate(1982, 12, 17);
+      Post;
+
+      Append;
+      FieldByName('FirstName').AsString := 'Anna';
+      FieldByName('LastName').AsString := 'Mull';
+      FieldByName('City').AsString := 'Los Angeles';
+      FieldByName('Address').AsString :=  '2202, Capitol Square';
+      FieldbyName('Birthdate').AsDateTime := EncodeDate(1982, 12, 17);
+      Post;
+      end;
+  // This will write the file;
+  CSVDataset.Close;
+end;
+
+procedure TTestCSVDataset.TestOpenCloseCycle;
+begin
+  if FileExists(FileName) then
+    AssertTrue('Delete before',DeleteFile(FileName));
+  try
+    // This will create the file
+    DoOpenClose;
+    // Recreate to be sure
+    FreeAndNil(FCSVDataset);
+    FCSVDataset:=TCSVDataset.Create(Nil);
+    FCSVDataset.Name:='DS';
+    DoOpenClose;
+  except
+    On E : Exception do
+      Fail('Failed using exception %s : %s',[E.ClassName,E.Message]);
+  end;
+  if FileExists(FileName) then
+    AssertTrue('Delete after',DeleteFile(FileName));
+end;
+
 procedure TTestCSVDataset.SetUp;
 begin
   FCSVDataset:=TCSVDataset.Create(Nil);

packages/fcl-db/tests/testbufdatasetstreams.pas

@@ -100,7 +100,7 @@ uses toolsunit, SQLDBToolsUnit, sqldb, XMLDatapacketReader;
 
 const TestXMLFileName = 'test.xml';
       TestBINFileName = 'test.dat';
-      TestFileNames: array[TDataPacketFormat] of string = (TestBINFileName, TestXMLFileName, TestXMLFileName, '');
+      TestFileNames: array[TDataPacketFormat] of string = (TestBINFileName, TestXMLFileName, TestXMLFileName, '','');
 
 { TMyCustomBufDataset }
 

packages/fcl-extra/examples/double/daemonmapperunit1.lfm

@@ -0,0 +1,29 @@
+object DaemonMapper1: TDaemonMapper1
+  DaemonDefs = <  
+    item
+      DaemonClassName = 'TDaemon1'
+      Name = 'TDaemon1'
+      Options = [doAllowStop, doAllowPause]
+      WinBindings.Dependencies = <>
+      WinBindings.StartType = stBoot
+      WinBindings.WaitHint = 0
+      WinBindings.IDTag = 0
+      WinBindings.ServiceType = stWin32
+      WinBindings.ErrorSeverity = esIgnore
+      LogStatusReport = False
+    end  
+    item
+      DaemonClassName = 'TDaemon2'
+      Name = 'TDaemon2'
+      Options = [doAllowStop, doAllowPause]
+      WinBindings.Dependencies = <>
+      WinBindings.StartType = stBoot
+      WinBindings.WaitHint = 0
+      WinBindings.IDTag = 0
+      WinBindings.ServiceType = stWin32
+      WinBindings.ErrorSeverity = esIgnore
+      LogStatusReport = False
+    end>
+  Left = 284
+  Top = 140
+end

packages/fcl-extra/examples/double/daemonmapperunit1.pas

@@ -0,0 +1,34 @@
+unit DaemonMapperUnit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DaemonApp;
+
+type
+  TDaemonMapper1 = class(TDaemonMapper)
+  private
+
+  public
+
+  end;
+
+var
+  DaemonMapper1: TDaemonMapper1;
+
+implementation
+
+procedure RegisterMapper;
+begin
+  RegisterDaemonMapper(TDaemonMapper1)
+end;
+
+{$R *.lfm}
+
+
+initialization
+  RegisterMapper;
+end.
+

packages/fcl-extra/examples/double/daemonunit1.lfm

@@ -0,0 +1,8 @@
+object Daemon1: TDaemon1
+  OldCreateOrder = False
+  OnExecute = DataModuleExecute
+  Height = 150
+  HorizontalOffset = 284
+  VerticalOffset = 140
+  Width = 150
+end

packages/fcl-extra/examples/double/daemonunit1.pas

@@ -0,0 +1,52 @@
+unit DaemonUnit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DaemonApp;
+
+type
+
+  { TDaemon1 }
+
+  TDaemon1 = class(TDaemon)
+    procedure DataModuleExecute(Sender: TCustomDaemon);
+  private
+
+  public
+
+  end;
+
+var
+  Daemon1: TDaemon1;
+
+implementation
+
+procedure RegisterDaemon;
+begin
+  RegisterDaemonClass(TDaemon1)
+end;
+
+{$R *.lfm}
+
+{ TDaemon1 }
+
+procedure TDaemon1.DataModuleExecute(Sender: TCustomDaemon);
+Var
+  I : Integer;
+begin
+  I := 0;
+  Application.EventLog.Log('TDaemon1 execution start');
+  While Self.Status = csRunning Do Begin
+    Sleep(10);
+  end;
+  Application.EventLog.Log('TDaemon1 execution stop');
+end;
+
+
+initialization
+  RegisterDaemon;
+end.
+

packages/fcl-extra/examples/double/daemonunit2.lfm

@@ -0,0 +1,8 @@
+object Daemon2: TDaemon2
+  OldCreateOrder = False
+  OnExecute = DataModuleExecute
+  Height = 150
+  HorizontalOffset = 284
+  VerticalOffset = 140
+  Width = 150
+end

packages/fcl-extra/examples/double/daemonunit2.pas

@@ -0,0 +1,52 @@
+unit daemonunit2;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DaemonApp;
+
+type
+
+  { TDaemon2 }
+
+  TDaemon2 = class(TDaemon)
+    procedure DataModuleExecute(Sender: TCustomDaemon);
+  private
+
+  public
+
+  end;
+
+var
+  Daemon2: TDaemon2;
+
+implementation
+
+procedure RegisterDaemon;
+begin
+  RegisterDaemonClass(TDaemon2)
+end;
+
+{$R *.lfm}
+
+{ TDaemon2 }
+
+procedure TDaemon2.DataModuleExecute(Sender: TCustomDaemon);
+Var
+  I : Integer;
+begin
+  I := 0;
+  Application.EventLog.Log('TDaemon2 execution start');
+  While Self.Status = csRunning Do Begin
+    Sleep(10);
+  end;
+  Application.EventLog.Log('TDaemon2 execution stop');
+end;
+
+
+initialization
+  RegisterDaemon;
+end.
+

packages/fcl-extra/examples/double/double.pp

@@ -0,0 +1,23 @@
+Program double;
+
+Uses
+{$IFDEF UNIX}
+  CThreads,
+{$ENDIF}
+  ResDaemonApp, DaemonApp,  DaemonMapperUnit1, DaemonUnit1, daemonunit2, SysUtils, eventlog
+  { add your units here };
+
+Var
+  AExecutableFilenamePath : String;
+begin
+  AExecutableFilenamePath := ParamStr(0);
+  AExecutableFilenamePath := ExpandFileName(AExecutableFilenamePath);
+  AExecutableFilenamePath := ExtractFilePath(AExecutableFilenamePath);
+  Application.Title:='Daemon application';
+  Application.Initialize;
+  Application.EventLog.FileName := SysUtils.ConcatPaths([AExecutableFilenamePath, 'event-log.txt']);
+  Application.EventLog.LogType := ltFile;
+  Application.EventLog.AppendContent := False;
+  Application.EventLog.Active := True;
+  Application.Run;
+end.

packages/fcl-extra/examples/double/resdaemonapp.pp

@@ -0,0 +1,32 @@
+{
+ *****************************************************************************
+  See the file COPYING.modifiedLGPL.txt, included in this distribution,
+  for details about the license.
+ *****************************************************************************
+}
+{$mode objfpc}
+{$h+}
+unit resdaemonapp;
+
+interface
+
+uses daemonapp;
+
+Type
+  TResDaemonApplication = Class(TCustomDaemonApplication)
+    Procedure CreateDaemonInstance(Var ADaemon : TCustomDaemon; DaemonDef : TDaemonDef); override;
+  end;
+
+implementation
+
+uses classes;
+
+Procedure TResDaemonApplication.CreateDaemonInstance(Var ADaemon : TCustomDaemon; DaemonDef : TDaemonDef); 
+
+begin
+  ADaemon:=DaemonDef.DaemonClass.Create(Self);
+end;
+
+Initialization
+  RegisterDaemonApplicationClass(TResDaemonApplication)
+end.

packages/fcl-extra/src/daemonapp.pp

@@ -56,6 +56,7 @@ Type
     Function Install : Boolean; virtual;
     Function UnInstall: boolean; virtual;
     Function HandleCustomCode(ACode : DWord) : Boolean; Virtual;
+    procedure DoThreadTerminate(Sender: TObject);virtual;
   Public
     Procedure CheckControlMessages(Wait : Boolean);
     Procedure LogMessage(const Msg : String);
@@ -694,7 +695,12 @@ begin
   Result:=False
 end;
 
-Procedure TCustomDaemon.CheckControlMessages(Wait : Boolean);
+procedure TCustomDaemon.DoThreadTerminate(Sender: TObject);
+begin
+  Self.FThread := NIL;
+end;
+
+procedure TCustomDaemon.CheckControlMessages(Wait: Boolean);
 
 begin
   If Assigned(FThread) then

packages/fcl-extra/src/unix/daemonapp.inc

@@ -167,9 +167,8 @@ begin
   Try
     T:=TDaemonThread.Create(FDaemon);
     T.FreeOnTerminate:=True;
+    T.OnTerminate := @FDaemon.DoThreadTerminate;
     T.Resume;
-    T.WaitFor;
-    FDaemon.FThread:=Nil;
   except
     On E : Exception do
       FDaemon.Logmessage(Format(SErrDaemonStartFailed,[FDaemon.Definition.Name,E.Message]));

packages/fcl-image/src/fpreadpnm.pp

@@ -113,6 +113,7 @@ Var
   C : Char;
 
 begin
+  C:=#0;
   Stream.ReadBuffer(C,1);
   If (C<>'P') then
     Raise Exception.Create('Not a valid PNM image.');
@@ -157,7 +158,7 @@ begin
   Case FBitmapType of
     5,6 : FScanLineSize:=(FBitPP div 8) * FWidth;
   else  
-    FScanLineSize:=FBitPP*((FWidth+7)shr 3);
+    FScanLineSize:=FBitPP*((FWidth+7) shr 3);
   end;
   GetMem(FScanLine,FScanLineSize);
   try
@@ -165,6 +166,7 @@ begin
       begin
       ReadScanLine(Row,Stream);
       WriteScanLine(Row,Img);
+//      Writeln(Stream.Position,' ',Stream.Size);
       end;
   finally
     FreeMem(FScanLine);
@@ -212,7 +214,8 @@ begin
           Inc(P)
           end;
         end;
-    4,5,6 : Stream.ReadBuffer(FScanLine^,FScanLineSize);
+    4,5,6 :
+       Stream.ReadBuffer(FScanLine^,FScanLineSize);
     end;
 end;
 
@@ -222,7 +225,7 @@ procedure TFPReaderPNM.WriteScanLine(Row : Integer; Img : TFPCustomImage);
 Var
   C : TFPColor;
   L : Cardinal;
-  Scale: Cardinal;
+  Scale: Int64;
 
   function ScaleByte(B: Byte):Word;
   begin
@@ -235,7 +238,7 @@ Var
   function ScaleWord(W: Word):Word;
   begin
     if FMaxVal = 65535 then
-      Result := W
+      Result := BEtoN(W)
     else { Mimic the above with multiplications }
       Result := Int64(W*(FMaxVal+1) + W) * 65535 div Scale;
   end;

packages/fcl-image/src/fpwritepnm.pp

@@ -30,15 +30,21 @@ type
   { TFPWriterPNM }
 
   TFPWriterPNM = class(TFPCustomImageWriter)
-    protected
-      procedure InternalWrite(Stream:TStream;Img:TFPCustomImage);override;
-    public
-      ColorDepth: TPNMColorDepth;
-      BinaryFormat: boolean;
-      function GuessColorDepthOfImage(Img: TFPCustomImage): TPNMColorDepth;
-      function GetColorDepthOfExtension(AExtension: string): TPNMColorDepth;
-      function GetFileExtension(AColorDepth: TPNMColorDepth): string;
-      constructor Create; override;
+  private
+    FFullWidth: Boolean;
+    FColorDepth: TPNMColorDepth;
+    FBinaryFormat: boolean;
+    procedure SetFullWidth(AValue: Boolean);
+  protected
+    procedure InternalWrite(Stream:TStream;Img:TFPCustomImage);override;
+  public
+    Property FullWidth: Boolean Read FFullWidth Write SetFullWidth;
+    function GuessColorDepthOfImage(Img: TFPCustomImage): TPNMColorDepth;
+    function GetColorDepthOfExtension(AExtension: string): TPNMColorDepth;
+    function GetFileExtension(AColorDepth: TPNMColorDepth): string;
+    constructor Create; override;
+    Property BinaryFormat : Boolean Read FBinaryFormat Write FBinaryFormat;
+    Property ColorDepth: TPNMColorDepth Read FColorDepth Write FColorDepth;
   end;
 
   { TFPWriterPBM }
@@ -113,6 +119,14 @@ begin
   BinaryFormat := True;
 end;
 
+procedure TFPWriterPNM.SetFullWidth(AValue: Boolean);
+begin
+  if FFullWidth=AValue then Exit;
+  FFullWidth:=AValue;
+  if FFullWidth then
+    BinaryFormat:=True;
+end;
+
 procedure TFPWriterPNM.InternalWrite(Stream:TStream;Img:TFPCustomImage);
 var useBitMapType: integer;
 
@@ -130,8 +144,9 @@ var useBitMapType: integer;
           Str(Img.Height,StrHeight);
         end;
       PNMInfo:=Concat(MagicWords[useBitMapType],#10,StrWidth,#32,StrHeight,#10);
-      if useBitMapType in [2,3,5,6]
-      then
+      if (useBitMapType in [5,6]) and FullWidth then
+        PNMInfo:=Concat(PNMInfo,'65535'#10)
+      else if (useBitMapType in [2,3,5,6]) then
         PNMInfo:=Concat(PNMInfo,'255'#10);
       stream.seek(0,soFromBeginning);
       stream.Write(PNMInfo[1],Length(PNMInfo));
@@ -141,6 +156,7 @@ var useBitMapType: integer;
     Row,Coulumn,nBpLine,i:Integer;
     aColor:TFPColor;
     aLine:PByte;
+    dLine : PWord;
     strCol:String[3];
     LinuxEndOfLine: char;
     UseColorDepth: TPNMColorDepth;
@@ -160,17 +176,20 @@ var useBitMapType: integer;
       pcdRGB: useBitMapType := 3;
     end;
     if BinaryFormat then inc(useBitMapType,3);
-
+    if FullWidth and Not BinaryFormat then
+      Raise FPImageException.Create('Fullwidth can only be used with binary format');
     SaveHeader(Stream);
     case useBitMapType of
       1:nBpLine:=Img.Width*2;{p p p}
       2:nBpLine:=Img.Width*4;{lll lll lll}
       3:nBpLine:=Img.Width*3*4;{rrr ggg bbb rrr ggg bbb}
       4:nBpLine:=(Img.Width+7) SHR 3;
-      5:nBpLine:=Img.Width;
-      6:nBpLine:=Img.Width*3;
+      5:nBpLine:=Img.Width*(1+Ord(FullWidth));
+      6:nBpLine:=Img.Width*3*(1+Ord(FullWidth));
     end;
+
     GetMem(aLine,nBpLine);//3 extra byte for BMP 4Bytes alignement.
+    dLine:=PWord(aLine);
     for Row:=0 to img.Height-1 do
       begin
         FillChar(aLine^,nBpLine,0);
@@ -214,8 +233,18 @@ var useBitMapType: integer;
                 4:if(Red<=$2F00)or(Green<=$2F00)or(Blue<=$2F00)
                   then
                     aLine[Coulumn shr 3]:=aLine[Coulumn shr 3] or ($80 shr (Coulumn and $07));
-                5:aLine[Coulumn]:=Hi(Word(Round(Red*0.299+Green*0.587+Blue*0.114)));
-                6:begin
+                5: if FullWidth then
+                     dLine[Coulumn]:=Word(Round(Red*0.299+Green*0.587+Blue*0.114))
+                   else
+                     aLine[Coulumn]:=Hi(Word(Round(Red*0.299+Green*0.587+Blue*0.114)));
+                6:if FullWidth then
+                  begin
+                    dLine[3*Coulumn]:=NToBE(Red);
+                    dLine[3*Coulumn+1]:=NToBE(Green);
+                    dLine[3*Coulumn+2]:=NToBE(Blue);
+                  end
+                  else
+                  begin
                     aLine[3*Coulumn]:=Hi(Red);
                     aLine[3*Coulumn+1]:=Hi(Green);
                     aLine[3*Coulumn+2]:=Hi(Blue);