* TCriticalSection.Tryenter support (Mantis 15928) + short test/demo

    tested on FreeBSD (general Unix) and Windows. Note that Haiku seems 
    to have a native threadmgr rather than the Unix one. Will notify 
    maintainer (Olivier)


git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@15026 3ad0048d-3df7-0310-abae-a5850022a9f2

2 files changed, 52 insertions, 0 deletions

diff --git a/packages/fcl-base/examples/crittest.pp b/packages/fcl-base/examples/crittest.pp
new file mode 100644
index 0000000000..ceb8f00cf9
--- /dev/null
+++ b/packages/fcl-base/examples/crittest.pp
@@ -0,0 +1,47 @@
+program crittest;
+// originally a test to test .tryenter.
+// A thread holds a lock for 5sec, while the main thread tries to lock
+// it.  
+
+{$mode Delphi}
+
+Uses {$ifdef unix}cthreads,{$endif} syncobjs,sysutils,classes;
+
+type TTestthread = class(tthread)
+	    	     procedure execute; override;
+                    end;
+
+var crit : TCriticalSection;
+
+procedure TTestThread.Execute;
+
+begin
+ crit.acquire;
+ sleep(5000);
+ crit.release;
+end;
+
+
+var thr : TTestthread;  
+    I : integer;
+
+begin
+ crit:=TCriticalsection.create;
+ thr :=TTestthread.Create(false);
+
+ sleep(500);  // give thread time to start.
+
+ writeln('tryenter');
+ 
+ i:=0;
+ while not(crit.tryenter) do
+  begin
+    writeln('tryenter attempt ',i);
+    inc(i);
+    sleep(100);
+  end;
+ writeln('lock acquired in mainthread!');
+ writeln('no payload, so releasing');
+ crit.release;
+ thr.waitfor;
+end.
\ No newline at end of file
diff --git a/packages/fcl-base/src/syncobjs.pp b/packages/fcl-base/src/syncobjs.pp
index 6bca77b364..baf9b442c0 100644
--- a/packages/fcl-base/src/syncobjs.pp
+++ b/packages/fcl-base/src/syncobjs.pp
@@ -42,6 +42,7 @@ type
       procedure Acquire;override;
       procedure Release;override;
       procedure Enter;
+      function  TryEnter:boolean;
       procedure Leave;
       constructor Create;
       destructor Destroy;override;
@@ -100,6 +101,10 @@ begin
   Release;
 end;
 
+function  TCriticalSection.TryEnter:boolean;
+begin
+  result:=TryEnterCriticalSection(CriticalSection)<>0;
+end;
 
 procedure TCriticalSection.Acquire;