* Test programs for crashing IPC server

git-svn-id: trunk@33698 -

.gitattributes

@@ -2603,6 +2603,8 @@ packages/fcl-pdf/utils/ttfdump.lpr svneol=native#text/plain
 packages/fcl-process/Makefile svneol=native#text/plain
 packages/fcl-process/Makefile.fpc svneol=native#text/plain
 packages/fcl-process/Makefile.fpc.fpcmake svneol=native#text/plain
+packages/fcl-process/examples/checkipcserver.lpi svneol=native#text/plain
+packages/fcl-process/examples/checkipcserver.lpr svneol=native#text/plain
 packages/fcl-process/examples/demoproject.ico -text
 packages/fcl-process/examples/demoproject.lpi svneol=native#text/plain
 packages/fcl-process/examples/demoproject.pp svneol=native#text/plain
@@ -2616,6 +2618,8 @@ packages/fcl-process/examples/ipcclient.lpi svneol=native#text/plain
 packages/fcl-process/examples/ipcclient.pp svneol=native#text/plain
 packages/fcl-process/examples/ipcserver.lpi svneol=native#text/plain
 packages/fcl-process/examples/ipcserver.pp svneol=native#text/plain
+packages/fcl-process/examples/simpleipcserver.lpi svneol=native#text/plain
+packages/fcl-process/examples/simpleipcserver.lpr svneol=native#text/plain
 packages/fcl-process/examples/waitonexit.pp svneol=native#text/pascal
 packages/fcl-process/fpmake.pp svneol=native#text/plain
 packages/fcl-process/src/amicommon/pipes.inc svneol=native#text/plain

packages/fcl-process/examples/checkipcserver.lpi

@@ -0,0 +1,59 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="IPC Client"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="checkipcserver.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="checkipcserver"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-process/examples/checkipcserver.lpr

@@ -0,0 +1,55 @@
+program checkipcserver;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils, CustApp, simpleipc
+  { you can add units after this };
+
+type
+
+  { TSimpleIPCClientApp }
+
+  TSimpleIPCClientApp = class(TCustomApplication)
+  protected
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+  end;
+
+{ TSimpleIPCClientApp }
+
+procedure TSimpleIPCClientApp.DoRun;
+var
+  IPCClient: TSimpleIPCClient;
+begin
+  IPCClient := TSimpleIPCClient.Create(nil);
+  IPCClient.ServerID:= 'ipc_test_crash';
+
+  if IPCClient.ServerRunning then
+    WriteLn('Server is runnning')
+  else
+    WriteLn('Server is NOT runnning');
+
+  IPCClient.Destroy;
+  Terminate;
+end;
+
+constructor TSimpleIPCClientApp.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+end;
+
+var
+  Application: TSimpleIPCClientApp;
+begin
+  Application:=TSimpleIPCClientApp.Create(nil);
+  Application.Title:='IPC Client';
+  Application.Run;
+  Application.Free;
+end.
+

packages/fcl-process/examples/simpleipcserver.lpi

@@ -0,0 +1,59 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="IPC Server"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="simpleipcserver.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="simpleipcserver"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-process/examples/simpleipcserver.lpr

@@ -0,0 +1,81 @@
+program simpleipcserver;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  BaseUnix,
+  {$ENDIF}
+  {$IFDEF windows}
+  Windows,
+  {$ENDIF}
+  Classes, SysUtils, CustApp, simpleipc, Crt;
+
+type
+
+  { TSimpleIPCServerApp }
+
+  TSimpleIPCServerApp = class(TCustomApplication)
+  protected
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+  end;
+
+{ TSimpleIPCServerApp }
+
+procedure TSimpleIPCServerApp.DoRun;
+var
+  IPCServer: TSimpleIPCServer;
+  Key: Char;
+  NullObj: TObject;
+begin
+  IPCServer := TSimpleIPCServer.Create(nil);
+  IPCServer.ServerID:='ipc_test_crash';
+  IPCServer.Global:=True;
+  IPCServer.StartServer;
+  NullObj := nil;
+
+  WriteLn('Server started');
+  WriteLn('  Press e to finish with an exception');
+  WriteLn('  Press t to terminate through OS api - ', {$IFDEF UNIX}'Kill'{$ELSE}'TerminateProcess'{$ENDIF});
+  WriteLn('  Press any other key to finish normally');
+  Key := ReadKey;
+
+  case Key of
+    'e':
+      begin
+        NullObj.AfterConstruction;
+      end;
+    't':
+      begin
+        {$ifdef unix}
+        FpKill(FpGetpid, 9);
+        {$endif}
+        {$ifdef windows}
+        TerminateProcess(GetCurrentProcess, 0);
+        {$endif}
+      end;
+  end;
+
+  IPCServer.Active:=False;
+  WriteLn('Server stopped');
+  IPCServer.Destroy;
+  Terminate;
+end;
+
+constructor TSimpleIPCServerApp.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+end;
+
+var
+  Application: TSimpleIPCServerApp;
+begin
+  Application:=TSimpleIPCServerApp.Create(nil);
+  Application.Title:='IPC Server';
+  Application.Run;
+  Application.Free;
+end.
+