# revisions: 19182,19243,19244,19249,19266,19268,19279,19280,19315,19381,19383,19439,19508,19518,19533,19611,19613,19620,19630,19632,19634

------------------------------------------------------------------------
r19182 | paul | 2011-09-23 02:07:26 +0200 (Fri, 23 Sep 2011) | 1 line
Changed paths:
   M /trunk/rtl/objpas/sysutils/sysutilh.inc

rtl: add EArgumentException, EArgumentOutOfRangeException classes
------------------------------------------------------------------------
------------------------------------------------------------------------
r19243 | mattias | 2011-09-26 12:38:35 +0200 (Mon, 26 Sep 2011) | 1 line
Changed paths:
   M /trunk/utils/instantfpc/instantfpc.pas

instantfpc: nicer help
------------------------------------------------------------------------
------------------------------------------------------------------------
r19244 | mattias | 2011-09-26 13:09:17 +0200 (Mon, 26 Sep 2011) | 1 line
Changed paths:
   M /trunk/utils/instantfpc/instantfpc.pas

instantfpc: added option --skip-run
------------------------------------------------------------------------
------------------------------------------------------------------------
r19249 | mattias | 2011-09-26 21:38:19 +0200 (Mon, 26 Sep 2011) | 1 line
Changed paths:
   M /trunk/utils/instantfpc/instantfpc.pas

istantfpc: help about -B
------------------------------------------------------------------------
------------------------------------------------------------------------
r19266 | florian | 2011-09-28 17:42:04 +0200 (Wed, 28 Sep 2011) | 1 line
Changed paths:
   M /trunk/packages/hash/src/sha1.pp

* remove spaces at eol
------------------------------------------------------------------------
------------------------------------------------------------------------
r19268 | michael | 2011-09-28 19:44:32 +0200 (Wed, 28 Sep 2011) | 1 line
Changed paths:
   M /trunk/rtl/objpas/classes/lists.inc

* Reverse IndexOf. Increases speed of freeing collection with a factor N^2
------------------------------------------------------------------------
------------------------------------------------------------------------
r19279 | michael | 2011-09-29 09:50:24 +0200 (Thu, 29 Sep 2011) | 1 line
Changed paths:
   M /trunk/rtl/objpas/classes/classesh.inc
   M /trunk/rtl/objpas/classes/lists.inc

* Implemented IndexOfItem, reversed search again in IndexOf
------------------------------------------------------------------------
------------------------------------------------------------------------
r19280 | michael | 2011-09-29 09:59:10 +0200 (Thu, 29 Sep 2011) | 1 line
Changed paths:
   M /trunk/rtl/objpas/classes/collect.inc

* Remove using reverse search, speed up free
------------------------------------------------------------------------
------------------------------------------------------------------------
r19315 | michael | 2011-10-01 16:42:54 +0200 (Sat, 01 Oct 2011) | 1 line
Changed paths:
   M /trunk/rtl/objpas/dateutil.inc
   M /trunk/rtl/objpas/sysconst.pp

* Moved string constant to sysconst
------------------------------------------------------------------------
------------------------------------------------------------------------
r19381 | marco | 2011-10-05 10:23:59 +0200 (Wed, 05 Oct 2011) | 2 lines
Changed paths:
   M /trunk/packages/numlib/src/ipf.pas

 * updated comment as advised in Mantis #20392

------------------------------------------------------------------------
------------------------------------------------------------------------
r19383 | marco | 2011-10-05 10:53:48 +0200 (Wed, 05 Oct 2011) | 2 lines
Changed paths:
   M /trunk/tests/test/units/fmtbcd/tfmtbcd.pp

 * updated test with patch from Lacak2.

------------------------------------------------------------------------
------------------------------------------------------------------------
r19439 | florian | 2011-10-09 19:33:53 +0200 (Sun, 09 Oct 2011) | 1 line
Changed paths:
   M /trunk/packages/winceunits/src/connmgr.pp

*szAdapterName:GUID; -> szAdapterName:PTCHAR; in conmgr.LPCONNMGR_CONNECTION_DETAILED_STATUS, resolves #20440
------------------------------------------------------------------------
------------------------------------------------------------------------
r19508 | marco | 2011-10-18 22:21:34 +0200 (Tue, 18 Oct 2011) | 3 lines
Changed paths:
   M /trunk/rtl/objpas/fmtbcd.pp
   M /trunk/tests/test/units/fmtbcd/tfmtbcd.pp

 * Applied patch from Lacak2 that improved compare() functionality for 
    values with inequal length. Mantis #20505

------------------------------------------------------------------------
------------------------------------------------------------------------
r19518 | marco | 2011-10-19 22:31:20 +0200 (Wed, 19 Oct 2011) | 2 lines
Changed paths:
   M /trunk/packages/Makefile
   M /trunk/packages/Makefile.fpc
   M /trunk/packages/aspell/src/aspell.pp
   M /trunk/packages/aspell/src/aspelldyn.pp

 * aspell enabled for windows, patch from Barlone, Mantis #20521

------------------------------------------------------------------------
------------------------------------------------------------------------
r19533 | florian | 2011-10-23 16:47:15 +0200 (Sun, 23 Oct 2011) | 3 lines
Changed paths:
   M /trunk/packages/winunits-jedi/src/jediapilib.inc
   M /trunk/packages/winunits-jedi/src/jwapsapi.pas
   A /trunk/packages/winunits-jedi/tests
   A /trunk/packages/winunits-jedi/tests/tjwapsapi1.pp

- remove packed directive from jwapsapi.pas, partly resolves #20525
+ test from bug report
- remove $A+ from jedi include header: $A+ makes no sense for api headers, the records should be layouted with $packrecords c, second part to resolve #20525
------------------------------------------------------------------------
------------------------------------------------------------------------
r19611 | jonas | 2011-11-08 22:44:49 +0100 (Tue, 08 Nov 2011) | 3 lines
Changed paths:
   M /trunk/rtl/bsd/ostypes.inc

  * fixed file descriptor control and locking flags (patch by Barlone,
    bug #20617)

------------------------------------------------------------------------
------------------------------------------------------------------------
r19613 | jonas | 2011-11-09 00:13:16 +0100 (Wed, 09 Nov 2011) | 2 lines
Changed paths:
   M /trunk/rtl/linux/gpm.pp
   M /trunk/rtl/linux/linux.pp
   M /trunk/rtl/linux/ossysc.inc
   M /trunk/rtl/linux/ostypes.inc
   M /trunk/rtl/linux/ptypes.inc
   M /trunk/rtl/linux/termios.inc

  - removed "packed" from record types that should/need not be packed

------------------------------------------------------------------------
------------------------------------------------------------------------
r19620 | marco | 2011-11-11 10:32:46 +0100 (Fri, 11 Nov 2011) | 2 lines
Changed paths:
   M /trunk/rtl/objpas/types.pp

 * const added to size (record) Mantis #20653

------------------------------------------------------------------------
------------------------------------------------------------------------
r19627 | michael | 2011-11-11 18:27:37 +0100 (Fri, 11 Nov 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-process/src/unix/simpleipc.inc

* Modify file permissions when global socket
------------------------------------------------------------------------
------------------------------------------------------------------------
r19630 | michael | 2011-11-12 13:55:40 +0100 (Sat, 12 Nov 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/eventlog.pp

* Implemented Pause/Resume, paused
------------------------------------------------------------------------
------------------------------------------------------------------------
r19632 | michael | 2011-11-12 15:45:16 +0100 (Sat, 12 Nov 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-process/src/simpleipc.pp
   M /trunk/packages/fcl-process/src/unix/simpleipc.inc

* Added cleanup of stale socket files (bug 17248)
------------------------------------------------------------------------
------------------------------------------------------------------------
r19634 | michael | 2011-11-13 18:08:29 +0100 (Sun, 13 Nov 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-process/src/unix/simpleipc.inc

* Fixed so it compiles also in pipesipc
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@20004 -

.gitattributes

@@ -6742,6 +6742,7 @@ packages/winunits-jedi/src/jwawsrm.pas svneol=native#text/plain
 packages/winunits-jedi/src/jwawsvns.pas svneol=native#text/plain
 packages/winunits-jedi/src/jwawtsapi32.pas svneol=native#text/plain
 packages/winunits-jedi/src/jwazmouse.pas svneol=native#text/plain
+packages/winunits-jedi/tests/tjwapsapi1.pp svneol=native#text/pascal
 packages/x11/Makefile svneol=native#text/plain
 packages/x11/Makefile.fpc svneol=native#text/plain
 packages/x11/fpmake.pp svneol=native#text/plain

packages/Makefile

@@ -293,7 +293,7 @@ ifeq ($(FULL_TARGET),i386-go32v2)
 override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes fppkg  fv graph unzip gdbint
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes fppkg  fv winunits-base winunits-jedi fcl-web fastcgi ibase mysql zlib oracle odbc postgres sqlite imagemagick gdbint libpng mad tcl opengl gtk1 gtk2 librsvg a52 cdrom fpgtk openal fftw lua fcl-extra zorba oggvorbis sdl openssl graph pcap  httpd22 pxlib numlib winceunits cairo libxml gmp opencl libsee nvapi ptc
+override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes fppkg  fv winunits-base winunits-jedi fcl-web fastcgi ibase mysql zlib oracle odbc postgres sqlite imagemagick gdbint libpng mad tcl opengl gtk1 gtk2 librsvg a52 cdrom fpgtk openal fftw lua fcl-extra zorba oggvorbis sdl openssl graph pcap  httpd22 pxlib numlib winceunits cairo libxml gmp opencl libsee nvapi ptc aspell
 endif
 ifeq ($(FULL_TARGET),i386-os2)
 override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes fppkg  fv zlib libpng x11 tcl fpgtk rexx os2units gtk1 imlib
@@ -1610,6 +1610,7 @@ TARGET_DIRS_OPENCL=1
 TARGET_DIRS_LIBSEE=1
 TARGET_DIRS_NVAPI=1
 TARGET_DIRS_PTC=1
+TARGET_DIRS_ASPELL=1
 endif
 ifeq ($(FULL_TARGET),i386-os2)
 TARGET_DIRS_HASH=1

packages/Makefile.fpc

@@ -52,7 +52,7 @@ dirs_linux=fv fcl-web fastcgi fcl-async ibase mysql ncurses unzip zlib oracle db
 dirs_win32=fv winunits-base winunits-jedi fcl-web fastcgi ibase mysql zlib oracle odbc postgres sqlite imagemagick \
                gdbint libpng mad tcl opengl gtk1 gtk2 librsvg a52 cdrom fpgtk openal fftw lua fcl-extra zorba \
                oggvorbis sdl openssl graph pcap  httpd22 pxlib numlib winceunits cairo libxml \
-               gmp opencl libsee nvapi ptc
+               gmp opencl libsee nvapi ptc aspell
 dirs_win64=fv winunits-base winunits-jedi fcl-web fastcgi ibase mysql zlib oracle odbc postgres sqlite imagemagick gdbint \
                 tcl opengl gtk1 fpgtk fftw sdl openssl cdrom  httpd22 numlib fcl-extra opencl nvapi ptc graph
 dirs_wince=winceunits httpd22 fcl-web fastcgi tcl fftw unzip zlib sqlite mysql ibase postgres oracle odbc sdl openssl oggvorbis numlib

packages/aspell/src/aspell.pp

@@ -17,9 +17,12 @@ uses
 
 {$IFDEF UNIX}
   const libaspell = 'aspell';
-{$ELSE} // windows
-  // TODO: figure this out
-  const libaspell = 'aspell-%s.dll';
+{$ELSE} 
+ {$IFDEF WINDOWS}
+  const libaspell = 'aspell-15.dll';
+ {$ELSE} 
+  {$MESSAGE ERROR Target not supported'}
+ {$ENDIF}
 {$ENDIF}
 
   {$i aspelltypes.inc}

packages/aspell/src/aspelldyn.pp

@@ -23,8 +23,12 @@ uses
   {WARNING Is it possible to omit the path?}
   const libaspell = 'libaspell.dylib';
   {$ENDIF}
-{$ELSE} // windows
-  const libaspell = 'aspell-%s.dll';
+{$ELSE} 
+ {$IFDEF WINDOWS}
+  const libaspell = 'aspell-15.dll';
+ {$ELSE} 
+  {$MESSAGE ERROR Target not supported'}
+ {$ENDIF}
 {$ENDIF}
 
   {$i aspelltypes.inc}

packages/fcl-base/src/eventlog.pp

@@ -44,6 +44,7 @@ Type
     FOnGetCustomCategory : TLogCategoryEvent;
     FOnGetCustomEventID : TLogCodeEvent;
     FOnGetCustomEvent : TLogCodeEvent;
+    FPaused : Boolean;
     procedure SetActive(const Value: Boolean);
     procedure SetIdentification(const Value: String);
     procedure SetlogType(const Value: TLogType);
@@ -72,6 +73,8 @@ Type
     Function EventTypeToString(E : TEventType) : String;
     Function RegisterMessageFile(AFileName : String) : Boolean; virtual;
     Function UnRegisterMessageFile : Boolean; virtual;
+    Procedure Pause;
+    Procedure Resume;
     Procedure Log (EventType : TEventType; const Msg : String); {$ifndef fpc }Overload;{$endif}
     Procedure Log (EventType : TEventType; const Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif}
     Procedure Log (const Msg : String); {$ifndef fpc }Overload;{$endif}
@@ -98,6 +101,7 @@ Type
     Property OnGetCustomCategory : TLogCategoryEvent Read FOnGetCustomCategory Write FOnGetCustomCategory;
     Property OnGetCustomEventID : TLogCodeEvent Read FOnGetCustomEventID Write FOnGetCustomEventID;
     Property OnGetCustomEvent : TLogCodeEvent Read FOnGetCustomEvent Write FOnGetCustomEvent;
+    Property Paused : Boolean Read FPaused Write FPaused;
   End;
 
   ELogError = Class(Exception);
@@ -144,6 +148,20 @@ begin
     Active:=True;
 end;
 
+
+Procedure TEventLog.Pause;
+
+begin
+  Paused:=True;
+end;
+
+
+Procedure TEventLog.Resume;
+begin
+  Paused:=False;
+end;
+
+
 procedure TEventLog.Error(const Fmt: String; Args: array of const);
 begin
   Error(Format(Fmt,Args));
@@ -177,6 +195,8 @@ end;
 
 procedure TEventLog.Log(EventType: TEventType; const Msg: String);
 begin
+  If Paused then 
+    exit;
   EnsureActive;
   Case FlogType of
     ltFile   : WriteFileLog(EventType,Msg);

packages/fcl-process/src/simpleipc.pp

@@ -177,7 +177,11 @@ implementation
   as well as the communication class itself.
   
   This comes first, to allow the uses clause to be set.
+  If the include file defines OSNEEDIPCINITDONE then the unit will
+  call IPCInit and IPCDone in the initialization/finalization code.
+  
   --------------------------------------------------------------------- }
+{$UNDEFINE OSNEEDIPCINITDONE}
 
 {$i simpleipc.inc}
 
@@ -482,5 +486,11 @@ begin
   SendStringMessage(MsgType, Format(Msg,Args));
 end;
 
+{$IFDEF OSNEEDIPCINITDONE}
+initialization
+  IPCInit;
+finalization
+  IPCDone;
+{$ENDIF}  
 end.
 

packages/fcl-process/src/unix/simpleipc.inc

@@ -24,9 +24,11 @@ uses sysutils, classes, simpleipc, baseunix;
 {$else}
 
 uses baseunix;
-
 {$endif}
 
+{$DEFINE OSNEEDIPCINITDONE}
+
+
 
 
 ResourceString
@@ -56,6 +58,55 @@ Type
 implementation
 {$endif}
 
+Var
+  SocketFiles : TStringList;
+
+Procedure IPCInit;
+
+begin
+end;
+
+Procedure IPCDone;
+
+Var
+  I : integer;
+  
+begin
+  if Assigned(SocketFiles) then
+    try
+      For I:=0 to SocketFiles.Count-1 do
+        DeleteFile(SocketFiles[i]);
+    finally  
+      FreeAndNil(SocketFiles);  
+    end;  
+end;
+
+
+Procedure RegisterSocketFile(Const AFileName : String);
+
+begin
+  If Not Assigned(SocketFiles) then
+    begin
+    SocketFiles:=TStringList.Create;
+    SocketFiles.Sorted:=True;
+    end;
+  SocketFiles.Add(AFileName);  
+end;
+
+Procedure UnRegisterSocketFile(Const AFileName : String);
+
+Var
+  I : Integer;
+begin
+  If Assigned(SocketFiles) then
+    begin
+    I:=SocketFiles.IndexOf(AFileName);  
+    If (I<>-1) then
+      SocketFiles.Delete(I);
+    If (SocketFiles.Count=0) then
+      FreeAndNil(SocketFiles);
+    end;
+end;
 
 
 constructor TPipeClientComm.Create(AOWner: TSimpleIPCClient);
@@ -145,15 +196,23 @@ end;
 
 
 procedure TPipeServerComm.StartServer;
+
+const
+  PrivateRights = S_IRUSR or S_IWUSR;
+  GlobalRights  = PrivateRights or S_IRGRP or S_IWGRP or S_IROTH or S_IWOTH;
+  Rights : Array [Boolean] of Integer = (PrivateRights,GlobalRights);  
+    
 begin
   If not FileExists(FFileName) then
     If (fpmkFifo(FFileName,438)<>0) then
       DoError(SErrFailedToCreatePipe,[FFileName]);
-  FStream:=TFileStream.Create(FFileName,fmOpenReadWrite+fmShareDenyNone);
+  FStream:=TFileStream.Create(FFileName,fmOpenReadWrite+fmShareDenyNone,Rights[Owner.Global]);
+  RegisterSocketFile(FFileName);
 end;
 
 procedure TPipeServerComm.StopServer;
 begin
+  UnregisterSocketFile(FFileName);
   FreeAndNil(FStream);
   if Not DeleteFile(FFileName) then
     DoError(SErrFailedtoRemovePipe,[FFileName]);
@@ -217,5 +276,10 @@ begin
 end;
 
 {$else ipcunit}
+initialization
+  IPCInit;
+  
+Finalization
+  IPCDone;  
 end.
 {$endif}

packages/hash/src/sha1.pp

@@ -20,7 +20,7 @@ interface
 
 type
   TSHA1Digest = array[0..19] of Byte;
-  
+
   TSHA1Context = record
     State: array[0..4] of Cardinal;
     Buffer: array[0..63] of Byte;
@@ -28,7 +28,7 @@ type
     Length: QWord;     { total count of bytes processed }
   end;
 
-{ core }  
+{ core }
 procedure SHA1Init(out ctx: TSHA1Context);
 procedure SHA1Update(var ctx: TSHA1Context; const Buf; BufLen: PtrUInt);
 procedure SHA1Final(var ctx: TSHA1Context; out Digest: TSHA1Digest);
@@ -76,7 +76,7 @@ const
   K40 = $6ED9EBA1;
   K60 = $8F1BBCDC;
   K80 = $CA62C1D6;
-  
+
 procedure SHA1Transform(var ctx: TSHA1Context; Buf: Pointer);
 var
   A, B, C, D, E, T: Cardinal;
@@ -102,7 +102,7 @@ begin
     Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
     Inc(i);
   until i > 19;
-  
+
   repeat
     T := (B xor C xor D) + K40 + E;
     E := D;
@@ -113,7 +113,7 @@ begin
     Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
     Inc(i);
   until i > 39;
-  
+
   repeat
     T := (B and C) or (B and D) or (C and D) + K60 + E;
     E := D;
@@ -123,8 +123,8 @@ begin
     A := T + roldword(A, 5) + Data[i and 15];
     Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
     Inc(i);
-  until i > 59;  
-  
+  until i > 59;
+
   repeat
     T := (B xor C xor D) + K80 + E;
     E := D;
@@ -134,7 +134,7 @@ begin
     A := T + roldword(A, 5) + Data[i and 15];
     Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
     Inc(i);
-  until i > 79;  
+  until i > 79;
 
   Inc(ctx.State[0], A);
   Inc(ctx.State[1], B);
@@ -194,7 +194,7 @@ begin
 end;
 
 const
-  PADDING: array[0..63] of Byte = 
+  PADDING: array[0..63] of Byte =
     ($80,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
        0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
        0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
@@ -222,7 +222,7 @@ begin
 
   // 4. Invert state to digest
   Invert(@ctx.State, @Digest, 20);
-  FillChar(ctx, sizeof(TSHA1Context), 0);  
+  FillChar(ctx, sizeof(TSHA1Context), 0);
 end;
 
 function SHA1String(const S: String): TSHA1Digest;
@@ -303,3 +303,4 @@ begin
 end;
 
 end.
+k

packages/numlib/src/ipf.pas

@@ -47,7 +47,7 @@ s calculated from x,y, with e.g. ipfisn}
 function  ipfspn(n: ArbInt; var x, y, d2s: ArbFloat; t: ArbFloat;
                  var term: ArbInt): ArbFloat;
 
-{Calculate n-degree polynomal b for dataset (x,y) with n elements
+{Calculate n-degree polynomal b for dataset (x,y) with m elements
  using the least squares method.}
 procedure ipfpol(m, n: ArbInt; var x, y, b: ArbFloat; var term: ArbInt);
 

packages/winceunits/src/connmgr.pp

@@ -209,7 +209,7 @@ type
        guidSourceNet:GUID;         // @field GUID of source network.
 
        szDescription:PTCHAR;       // @field Name of connection, 0-terminated string or NULL if N/A.
-       szAdapterName:GUID;       // @field Name of adapter, 0-terminated or NULL if N/A.
+       szAdapterName:PTCHAR;       // @field Name of adapter, 0-terminated or NULL if N/A.
 
        dwConnectionStatus:DWORD;   // @field One of CONNMGR_STATUS_*.
        LastConnectTime:SYSTEMTIME; // @field Time connection was last established.

packages/winunits-jedi/src/jediapilib.inc

@@ -35,7 +35,7 @@
 { For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html }
 {                                                                              }
 {******************************************************************************}
-{$A+,Z4}
+{$Z4}
 
 // This file is intended for C header conversions.
 // It defines several mutually exclusive IFDEFs which determine
@@ -329,4 +329,4 @@ Standalone compiling would be useless!
  {$DEFINE HTMLHELP11_UP}
 {$ENDIF HTMLHELP11}
 
-{$ENDIF ~JEDIAPILIB_INC}
+{$ENDIF ~JEDIAPILIB_INC}

packages/winunits-jedi/src/jwapsapi.pas

@@ -92,7 +92,7 @@ function GetModuleFileNameEx(hProcess: HANDLE; hModule: HMODULE; lpFilename: LPT
 type
   LPMODULEINFO = ^MODULEINFO;
   {$EXTERNALSYM LPMODULEINFO}
-  _MODULEINFO = packed record
+  _MODULEINFO = record
     lpBaseOfDll: LPVOID;
     SizeOfImage: DWORD;
     EntryPoint: LPVOID;
@@ -119,7 +119,7 @@ function InitializeProcessForWsWatch(hProcess: HANDLE): BOOL; stdcall;
 type
   PPSAPI_WS_WATCH_INFORMATION = ^PSAPI_WS_WATCH_INFORMATION;
   {$EXTERNALSYM PPSAPI_WS_WATCH_INFORMATION}
-  _PSAPI_WS_WATCH_INFORMATION = packed record
+  _PSAPI_WS_WATCH_INFORMATION = record
     FaultingPc: LPVOID;
     FaultingVa: LPVOID;
   end;
@@ -171,7 +171,7 @@ function GetDeviceDriverFileName(ImageBase: LPVOID; lpFilename: LPTSTR;
 type
   PPROCESS_MEMORY_COUNTERS = ^PROCESS_MEMORY_COUNTERS;
   {$EXTERNALSYM PPROCESS_MEMORY_COUNTERS}
-  _PROCESS_MEMORY_COUNTERS = packed record
+  _PROCESS_MEMORY_COUNTERS = record
     cb: DWORD;
     PageFaultCount: DWORD;
     PeakWorkingSetSize: SIZE_T;

packages/winunits-jedi/tests/tjwapsapi1.pp

@@ -0,0 +1,80 @@
+program winmoduleinfo_test;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils,
+  Classes,
+  windows,
+  jwapsapi;
+
+  function GetModuleName(
+    const pHandle : HANDLE;
+    const mHandle : HMODULE)
+    : string;
+  var
+    name : array [0..1023] of char;
+  begin
+    result := 'ERROR';
+    if GetModuleFileNameEx(pHandle,mHandle,LPTSTR(@name[0]),sizeof(name)) > 0 then begin
+      result := name;
+    end;
+  end;
+
+  procedure WriteModuleInfo(
+    const pHandle : HANDLE;
+    const mHandle : HANDLE);
+  var
+    moduleHandle : HANDLE;
+    modInfo: MODULEINFO;
+    moduleName : string;
+    tmpBeginning : ptruint;
+    tmpEnding : ptruint;
+    success : boolean;
+    lastError : DWORD;
+  begin
+    moduleHandle := mHandle;
+
+    success := (GetModuleInformation(pHandle,moduleHandle,modInfo,sizeof(MODULEINFO)) = WINBOOL(true));
+    if success then begin
+      lastError := 0;
+    end else begin
+      lastError := GetLastError();
+      modInfo.lpBaseOfDll := nil;
+      modInfo.SizeOfImage := 0;
+    end;
+
+    tmpBeginning := ptruint(modInfo.lpBaseOfDll);
+    tmpEnding := tmpBeginning + modInfo.SizeOfImage;
+    moduleName := GetModuleName(pHandle,mHandle);
+    writeln(ExtractFileName(moduleName), ' error=', lastError,
+            '; from 0x', IntToHex(tmpBeginning, sizeof(tmpBeginning)*2),
+            ' to 0x', IntToHex(tmpBeginning, sizeof(tmpEnding)*2));
+    if lastError<>0 then
+      halt(1);
+  end;
+
+var
+  pHandle : HANDLE;
+  mHandles : array [0..1023] of HMODULE;
+  cbNeeded : DWORD;
+  n : integer;
+  i : integer;
+begin
+  pHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
+                         WINBOOL(false),
+                         GetCurrentProcessID);
+  if pHandle <> 0 then begin
+    try
+      if EnumProcessModules(pHandle,@mHandles[0],sizeof(mHandles),cbNeeded) = WINBOOL(true) then begin
+        n := cbNeeded div sizeof(HMODULE);
+        for i := 0 to n-1 do begin
+          WriteModuleInfo(pHandle, mHandles[i]);
+        end;
+      end;
+    finally
+      CloseHandle(pHandle);
+    end;
+  end;
+  writeln('ok');
+end.

rtl/bsd/ostypes.inc

@@ -232,15 +232,64 @@ CONST
 
 
   { For File control mechanism }
-  F_GetFd  = 1;
-  F_SetFd  = 2;
-  F_GetFl  = 3;
-  F_SetFl  = 4;
-  F_GetLk  = 5;
-  F_SetLk  = 6;
-  F_SetLkW = 7;
-  F_SetOwn = 8;
-  F_GetOwn = 9;
+  F_DupFd          = 0;           { duplicate file descriptor }
+  F_GetFd          = 1;           { get file descriptor flags }
+  F_SetFd          = 2;           { set file descriptor flags }
+  F_GetFl          = 3;           { get file status flags }
+  F_SetFl          = 4;           { set file status flags }
+  F_GetOwn         = 5;           { get SIGIO/SIGURG proc/pgrp }
+  F_SetOwn         = 6;           { set SIGIO/SIGURG proc/pgrp }
+{$ifdef freebsd}
+  F_OGetLk         = 7;           { get record locking information }
+  F_OSetLk         = 8;           { set record locking information }
+  F_OSetLkW        = 9;           { F_SETLK; wait if blocked }
+  F_Dup2Fd         = 10;          { duplicate file descriptor to arg }
+  F_GetLk          = 11;          { get record locking information}
+  F_SetLk          = 12;          { set record locking information }
+  F_SetLkW         = 13;          { F_SETLK; wait if blocked }
+  F_SetLkRemote    = 14;          { debugging support for remote locks }
+{$endif}
+{$ifdef netbsd}
+  F_GetLk          = 7;           { get record locking information}
+  F_SetLk          = 8;           { set record locking information }
+  F_SetLkW         = 9;           { F_SETLK; wait if blocked }
+  F_CloseM	   = 10;	  { close all fds >= to the one given }
+  F_MaxFd          = 11;	  { return the max open fd }
+  F_DupFd_CloExec  = 12;	  { close on exec duplicated fd }
+{$endif}
+{$ifdef openbsd}
+  F_GetLk          = 7;           { get record locking information}
+  F_SetLk          = 8;           { set record locking information }
+  F_SetLkW         = 9;           { F_SETLK; wait if blocked }
+  F_DupFd_CloExec  = 10;	  { duplicate with FD_CLOEXEC set }
+{$endif}
+{$ifdef darwin}
+  F_GetLk          = 7;           { get record locking information}
+  F_SetLk          = 8;           { set record locking information }
+  F_SetLkW         = 9;           { F_SETLK; wait if blocked }
+{$endif}
+
+  { File descriptor flags (F_GETFD, F_SETFD) }
+  FD_CLOEXEC	   = 1;		  { close-on-exec flag }
+
+  { Record locking flags (F_GETLK, F_SETLK, F_SETLKW) }
+  F_RDLCK          = 1;		  { shared or read lock }
+  F_UNLCK          = 2;		  { unlock }
+  F_WRLCK          = 3;		  { exclusive or write lock }
+{$ifdef freebsd}
+  F_UNLCKSYS       = 4;		  { purge locks for a given system ID }
+  F_CANCEL         = 5;		  { cancel an async lock request }
+{$endif}
+{$ifndef darwin}
+  F_WAIT	   = $10;	  { Wait until lock is granted }
+  F_FLOCK          = $20;         { Use flock(2) semantics for lock }
+  F_POSIX          = $40; 	  { Use POSIX semantics for lock }
+{$endif}
+{$ifdef freebsd}
+  F_REMOTE	   = $80;	  { Lock owner is remote NFS client }
+  F_NOINTR	   = $100;        { Ignore signals when waiting }
+{$endif}
+
 {$ifdef darwin}
   F_CHKCLEAN       = 41;          { Used for regression test }
   F_PREALLOCATE    = 42;          { Preallocate storage }

rtl/linux/gpm.pp

@@ -76,7 +76,7 @@ const
 type
 {$PACKRECORDS c}
      Pgpm_event=^Tgpm_event;
-     Tgpm_event=packed record
+     Tgpm_event=record
           buttons : byte;
           modifiers : byte;
           vc : word;
@@ -99,20 +99,20 @@ type
 
   type
      Pgpm_connect = ^TGpm_connect;
-     Tgpm_connect = packed record
+     Tgpm_connect = record
           eventMask : word;
           defaultMask : word;
           minMod : word;
           maxMod : word;
           pid : longint;
           vc : longint;
-       end;
+end;
 
      Pgpmconnect=Pgpm_connect;
      Tgpmconnect=Tgpm_connect;
 
      Pgpm_roi=^Tgpm_roi;
-     Tgpm_roi=packed record
+     Tgpm_roi= record
        xmin,xmax:integer;
        ymin,ymax:integer;
        minmod,maxmod:word;

rtl/linux/linux.pp

@@ -225,8 +225,8 @@ const
   UD_LM                   = $80;
 
 type
-  user_desc = packed record
-    entry_number  : cint;
+  user_desc = record
+    entry_number  : cuint;
     base_addr     : cuint;
     limit         : cuint;
     flags         : cuint;
@@ -269,13 +269,14 @@ function epoll_ctl(epfd, op, fd: cint; event: pepoll_event): cint; {$ifdef FPC_U
 function epoll_wait(epfd: cint; events: pepoll_event; maxevents, timeout: cint): cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'epoll_wait'; {$endif}
 
 type Puser_cap_header=^user_cap_header;
-     user_cap_header=packed record
-       version,pid:cardinal;
+     user_cap_header=record
+       version: cuint32;
+       pid:cint;
      end;
      
      Puser_cap_data=^user_cap_data;
-     user_cap_data=packed record
-        effective,permitted,inheritable:cardinal;
+     user_cap_data=record
+        effective,permitted,inheritable:cuint32;
      end;
 
 {Get a capability.}

rtl/linux/ossysc.inc

@@ -466,7 +466,7 @@ end;
 
 
 type
-  tmmapargs = packed record
+  tmmapargs = record
     address : TSysParam;
     size    : TSysParam;
     prot    : TSysParam;

rtl/linux/ostypes.inc

@@ -90,7 +90,7 @@ type
 
   { directory services }
 
-  Dirent   = packed record
+  Dirent   = record
                 d_fileno      : ino64_t;                        // file number of entry
                 d_off         : off_t;
                 d_reclen      : cushort;                        // length of string in d_name
@@ -174,7 +174,7 @@ type
                End;
 {$endif}
 
-   tms       = packed Record
+   tms       = Record
                 tms_utime  : clock_t;   { User CPU time }
                 tms_stime  : clock_t;   { System CPU time }
                 tms_cutime : clock_t;   { User CPU time of terminated child procs }
@@ -186,7 +186,7 @@ type
  TFDSet    = ARRAY[0..(FD_MAXFDSET div BITSINWORD)-1] of cuLong;
  pFDSet    = ^TFDSet;
 
-  timezone = packed record
+  timezone = record
     tz_minuteswest,tz_dsttime:cint;
   end;
   ptimezone =^timezone;

rtl/linux/ptypes.inc

@@ -127,14 +127,14 @@ Type
     TSockLen = socklen_t;
     pSockLen = ^socklen_t;
 
-  timeval     = packed record
+  timeval     = record
                  tv_sec:time_t;
                  tv_usec:clong;
                 end;
   ptimeval    = ^timeval;
   TTimeVal    = timeval;
 
-  timespec    = packed record
+  timespec    = record
                  tv_sec   : time_t;
                  tv_nsec  : clong;
                 end;
@@ -142,7 +142,7 @@ Type
   TTimeSpec   = timespec;
 
   {$ifdef cpu64}
-  TStatfs = packed record
+  TStatfs = record
     fstype,            { File system type }
     bsize   : clong;    { Optimal block trensfer size }
     blocks,            { Data blocks in system }
@@ -156,7 +156,7 @@ Type
     spare   : array [0..4] of clong; { For later use }
   end;
   {$else}
-  TStatfs = packed record
+  TStatfs = record
     fstype,            { File system type }
     bsize   : cint;    { Optimal block trensfer size }
     blocks,            { Data blocks in system }

rtl/linux/termios.inc

@@ -1223,7 +1223,7 @@ Const
 {$endif cpuarm}
 
 Type
-  winsize = packed record
+  winsize = record
     ws_row,
     ws_col,
     ws_xpixel,

rtl/objpas/classes/classesh.inc

@@ -179,6 +179,11 @@ type
     function MoveNext: Boolean;
     property Current: Pointer read GetCurrent;
   end;
+  
+{$ifdef VER2_4}  
+type
+  TDirection = (FromBeginning, FromEnd);
+{$endif}          
 
   TFPList = class(TObject)
   private
@@ -200,6 +205,10 @@ type
     procedure SetCount(NewCount: Integer);
     Procedure RaiseIndexError(Index: Integer);
   public
+{$IFNDEF VER2_4}  
+    Type
+      TDirection = (FromBeginning, FromEnd);
+{$ENDIF}
     destructor Destroy; override;
     Procedure AddList(AList : TFPList);
     function Add(Item: Pointer): Integer; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
@@ -212,6 +221,7 @@ type
     function First: Pointer;
     function GetEnumerator: TFPListEnumerator;
     function IndexOf(Item: Pointer): Integer;
+    function IndexOfItem(Item: Pointer; Direction: TDirection): Integer;
     procedure Insert(Index: Integer; Item: Pointer); {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
     function Last: Pointer;
     procedure Move(CurIndex, NewIndex: Integer);

rtl/objpas/classes/collect.inc

@@ -215,9 +215,15 @@ end;
 
 
 procedure TCollection.RemoveItem(Item: TCollectionItem);
+
+Var
+  I : Integer;
+
 begin
-        Notify(Item,cnExtracting);
-  FItems.Remove(Pointer(Item));
+  Notify(Item,cnExtracting);
+  I:=FItems.IndexOfItem(Item,fromEnd);
+  If (I<>-1) then
+    FItems.Delete(I);
   Item.FCollection:=Nil;
   Changed;
 end;

rtl/objpas/classes/lists.inc

@@ -197,10 +197,33 @@ begin
 end;
 
 function TFPList.IndexOf(Item: Pointer): Integer;
+
+Var
+  C : Integer;
+
 begin
-  Result := 0;
-  while(Result < FCount) and (Flist^[Result] <> Item) do Result := Result + 1;
-  If Result = FCount  then Result := -1;
+  Result:=0;
+  C:=Count;
+  while (Result<C) and (Flist^[Result]<>Item) do
+    Inc(Result);
+  If Result>=C then
+    Result:=-1;
+end;
+
+function TFPList.IndexOfItem(Item: Pointer; Direction: TDirection): Integer;
+
+Var
+  C : Integer;
+
+begin
+  if Direction=fromBeginning then
+    Result:=IndexOf(Item)
+  else
+    begin
+    Result:=Count-1;
+    while (Result >=0) and (Flist^[Result]<>Item) do
+      Result:=Result - 1;
+    end;      
 end;
 
 procedure TFPList.Insert(Index: Integer; Item: Pointer);

rtl/objpas/dateutil.inc

@@ -1720,7 +1720,7 @@ end;
 function EncodeTimeInterval(Hour, Minute, Second, MilliSecond: word): TDateTime;
 begin
    If not TryEncodeTimeInterval(Hour,Minute,Second,MilliSecond,Result) then
-     Raise EConvertError.CreateFmt('%d:%d:%d.%d is not a valid time specification',
+     Raise EConvertError.CreateFmt(SerrInvalidHourMinuteSecMsec,
                                [Hour,Minute,Second,MilliSecond]);
 end;
 

rtl/objpas/fmtbcd.pp

@@ -1306,17 +1306,11 @@ IMPLEMENTATION
               if pr1 < pr2
                 then pr := pr1
                 else pr := pr2;
+
               res := 0;
               i := __low_Fraction;
               while ( res = 0 ) AND ( i < ( __low_Fraction + ( pr DIV 2 ) ) ) do
                 begin
-{
-                  if BCD1.Fraction[i] < BCD2.Fraction[i]
-                    then res := -1
-                    else
-                      if BCD1.Fraction[i] > BCD2.Fraction[i]
-                        then res := +1;
-}
                   _SELECT
                     _WHEN BCD1.Fraction[i] < BCD2.Fraction[i]
                       _THEN res := -1
@@ -1326,19 +1320,13 @@ IMPLEMENTATION
                    _endSELECT;
                   Inc ( i );
                  end;
+
               if res = 0
                 then begin
                   if Odd ( pr )
                     then begin
                       f1 := BCD1.Fraction[i] AND $f0;
                       f2 := BCD2.Fraction[i] AND $f0;
-{
-                      if f1 < f2
-                        then res := -1
-                        else
-                          if f1 > f2
-                            then res := +1;
-}
                       _SELECT
                         _WHEN f1 < f2
                           _THEN res := -1
@@ -1346,7 +1334,14 @@ IMPLEMENTATION
                           _THEN res := +1;
                       _endSELECT;
                      end;
+
+                  if res = 0 then
+                    if pr1 > pr2 then
+                      res := +1
+                    else if pr1 < pr2 then
+                      res := -1;
                  end;
+
               if neg1
                 then result := 0 - res
                 else result := res;
@@ -3846,6 +3841,8 @@ begin
         varInt64    : Result := vInt64;
         varQword    : Result := vQWord;
         varString   : Result := AnsiString(vString);
+        varOleStr   : Result := WideString(vOleStr);
+        varUString  : Result := UnicodeString(vString);
         else
           if vType=VarFmtBCD then
             Result := TFMTBcdVarData(vPointer).BCD
@@ -3919,8 +3916,10 @@ procedure TFMTBcdFactory.BinaryOp(var Left: TVarData; const Right: TVarData; con
       RaiseInvalidOp;
     end;
 
-    if Left.vType=VarType then
+    if Left.vType = VarType then
       TFMTBcdVarData(Left.VPointer).BCD := l
+    else if Left.vType = varDouble then
+      Left.vDouble := l
     else
       RaiseInvalidOp;
   end;

rtl/objpas/sysconst.pp

@@ -36,6 +36,7 @@ resourcestring
   SDivByZero             = 'Division by zero';
   SEndOfFile             = 'Read past end of file';
   SErrInvalidDateMonthWeek = 'Year %d, month %d, Week %d and day %d is not a valid date.';
+  SerrInvalidHourMinuteSecMsec = '%d:%d:%d.%d is not a valid time specification';
   SErrInvalidDateWeek    = '%d %d %d is not a valid dateweek';
   SErrInvalidDayOfWeek   = '%d is not a valid day of the week';
   SErrInvalidDayOfWeekInMonth = 'Year %d Month %d NDow %d DOW %d is not a valid date';

rtl/objpas/sysutils/sysutilh.inc

@@ -199,6 +199,9 @@ type
    ENoWideStringSupport = Class(Exception);
    ENotImplemented = class(Exception);
 
+   EArgumentException = class(Exception);
+   EArgumentOutOfRangeException = class(EArgumentException);
+
    { Exception handling routines }
    function ExceptObject: TObject;
    function ExceptAddr: Pointer;

rtl/objpas/types.pp

@@ -294,7 +294,7 @@ function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
 function CenterPoint(const Rect: TRect): TPoint;
 function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
 function Size(AWidth, AHeight: Integer): TSize;
-function Size(ARect: TRect): TSize;
+function Size(const ARect: TRect): TSize;
 
 implementation
 
@@ -460,7 +460,7 @@ begin
   Result.cy := AHeight;
 end;
 
-function Size(ARect: TRect): TSize;
+function Size(const ARect: TRect): TSize;
 begin
   Result.cx := ARect.Right - ARect.Left;
   Result.cy := ARect.Bottom - ARect.Top;

tests/test/units/fmtbcd/tfmtbcd.pp

@@ -2,7 +2,7 @@
 
 {$ifdef fpc}{$mode objfpc}{$h+}{$endif}
 
-uses SysUtils, FmtBCD;
+uses SysUtils, FmtBCD, Variants;
 
 var
   ErrorCount: integer;
@@ -17,7 +17,7 @@ begin
      (bcdtostr(bcd3) <> bcdtostr(bcdmul)) then
   begin
     writeln(bcdtostr(bcd1), ' * ', bcdtostr(bcd2), ' = ', bcdtostr(bcdmul), ' but expected ', bcdtostr(bcd3));
-    writeln('Expected: ', bcd3.Precision,',',bcd3.SignSpecialPlaces, ' but calculated: ', bcdmul.Precision,',',bcdmul.SignSpecialPlaces);
+    writeln('Expected: (', bcd3.Precision,',',bcd3.SignSpecialPlaces, ') but calculated: (', bcdmul.Precision,',',bcdmul.SignSpecialPlaces,')');
     inc(ErrorCount);
   end;
 end;
@@ -55,6 +55,57 @@ begin
   end;
 end;
 
+procedure testBCDCompare(bcd1,bcd2: TBCD; res: integer);
+begin
+  if (BCDCompare(bcd1,bcd2) <> res) then
+  begin
+    writeln('BCDCompare failed; bcd1:', bcdtostr(bcd1), ' bcd2:', bcdtostr(bcd2));
+    inc(ErrorCount);
+  end;
+end;
+
+procedure testVariantOp(v1, v2: variant);
+var v: variant;
+    i: integer;
+    d: double;
+    s1: shortstring;
+    s2: ansistring;
+    s3: unicodestring;
+begin
+  //arithmetic op. ... invalid variant operation ?
+  v := v1 + v2;
+  v := v * v2;
+  v := v / v2;
+  v := v - v2;
+  if VarIsFmtBCD(v1) and not VarIsFmtBCD(v) then inc(ErrorCount);
+
+  //compare op.
+  if not(v1=v) or (v1<>v) then
+  begin
+    writeln('Original variant: ', vartostr(v1), 'recomputed variant: ', vartostr(v));
+    inc(ErrorCount);
+  end;
+  v := v + 1;
+  if (v1 >= v) or not(v1 < v) then
+  begin
+    writeln('Compare2 failed; v1: ', vartostr(v1), ' v: ', vartostr(v));
+    inc(ErrorCount);
+  end;
+  v := v - 1.1;
+  if (v1 <= v) or not(v1 > v) then
+  begin
+    writeln('Compare3 failed; v1: ', vartostr(v1), ' v: ', vartostr(v));
+    inc(ErrorCount);
+  end;
+
+  //assign op. ... invalid variant typecast ?
+  //i := v;
+  d := v;
+  //s1 := v;
+  s2 := v;
+  //s3 := v;
+end;
+
 begin
   ErrorCount := 0;
 
@@ -94,8 +145,8 @@ begin
   // test BCDMultiply:
   FS.DecimalSeparator:='.';
   FS.ThousandSeparator:=#0;
-  testBCDMultiply(1000, 1000, 1000000);
-  testBCDMultiply(1000, 0.001, 1);
+  testBCDMultiply(1000, -1000, -1000000);
+  testBCDMultiply(-1000, -0.001, 1);
   testBCDMultiply(1000, 0.0001, 0.1);
   testBCDMultiply(strtobcd('12345678901234567890',FS), strtobcd('0.0000000001',FS), strtobcd('1234567890.123456789',FS));
 
@@ -110,7 +161,25 @@ begin
   testBCDDivide(100, -2, -50);
   testBCDDivide(1007, 5, 201.4);
 
+  // test BCDCompare:
+  testBCDCompare(100, 100, 0);
+  testBCDCompare(-100.1, -100.1, 0);
+  testBCDCompare(-100.1, 100.1, -1);
+  testBCDCompare(-100.1, -100.2, 1);
+  testBCDCompare(100, 100.1, -1);
+
+  // test Variant support:
+  testVariantOp(varFmtBcdCreate(100), varFmtBcdCreate(-100));
+  testVariantOp(double(2.5), varFmtBcdCreate(100)); //double on left side
+  testVariantOp(varFmtBcdCreate(100), integer(-10));
+  testVariantOp(varFmtBcdCreate(-100), shortstring(floattostr(10.2)));
+  testVariantOp(varFmtBcdCreate(-100), ansistring(floattostr(0.2)));
+  testVariantOp(varFmtBcdCreate(-100), unicodestring(floattostr(-0.2)));
+
 
-  if ErrorCount<>0 then writeln('FmtBCD test program found ', ErrorCount, ' errors!');
-  Halt(ErrorCount);
+  if ErrorCount<>0 then
+  begin
+    writeln('FmtBCD test program found ', ErrorCount, ' errors!');
+    Halt(ErrorCount);
+  end;
 end.

utils/instantfpc/instantfpc.pas

@@ -33,8 +33,13 @@ Procedure Usage;
 begin
   writeln('instantfpc '+Version);
   writeln;
+  writeln('Run pascal source files as scripts.');
+  writeln('Normal usage is to add to a program source file a first line');
+  writeln('("shebang") "#!/usr/bin/instantfpc".');
+  writeln('Then you can execute the source directly in the terminal/console.');
+  writeln;
   writeln('instantfpc -h');
-  writeln('      This help message.');
+  writeln('      Print this help message and exit.');
   writeln;
   writeln('instantfpc -v');
   writeln('      Print version and exit.');
@@ -53,22 +58,27 @@ begin
   writeln('      passed to the compiler as first parameters.');
   writeln;
   writeln('instantfpc --get-cache');
-  writeln('      Prints cache directory to stdout.');
+  writeln('      Prints current cache directory and exit.');
+  writeln;
+  writeln('Options:');
   writeln;
-  writeln('instantfpc --set-cache=<path to cache>');
+  writeln('  --set-cache=<path to cache>');
   writeln('      Set the cache to be used. Otherwise using environment variable');
   writeln('      INSTANTFPCCACHE.');
   writeln;
-  writeln('instantfpc --compiler=<path to compiler>');
+  writeln('  --compiler=<path to compiler>');
   writeln('      Normally fpc is searched in PATH and used as compiler.');
   writeln;
-  writeln('Normal usage is to add as first line ("shebang") "#!/usr/bin/instantfpc"');
-  writeln('to a program source file. Then you can execute the source like a script.');
+  writeln('  --skip-run');
+  writeln('      Do not execute the program. Useful to test if script compiles.');
+  writeln('      You probably want to combine it with -B.');
+  writeln;
+  writeln('  -B');
+  writeln('      Always recompile.');
   Halt(0);
 end;
 
 Procedure DisplayCache;
-
 begin
   write(GetCacheDir);
   Halt(0);
@@ -84,11 +94,11 @@ var
   OutputFilename: String;
   ExeExt: String;
   E : String;
+  RunIt: boolean = true;
   
 // Return true if filename found.
   
 Function InterpretParam(p : String) : boolean;
-  
 begin
   Result:=False;
   if (P='') then exit;
@@ -111,7 +121,11 @@ begin
     delete(P,1,12);
     SetCacheDir(p);
     end 
-  else if (P<>'') and (p[1]<>'-') then 
+  else if p='--skip-run' then
+    begin
+    RunIt:=false;
+    end
+  else if (P<>'') and (p[1]<>'-') then
     begin
     Filename:=p;
     Result:=True;
@@ -178,7 +192,8 @@ begin
       Compile(Filename,CacheFilename,OutputFilename);
     end;
     // run
-    Run(OutputFilename);
+    if RunIt then
+      Run(OutputFilename);
   finally
     // memory is freed by OS, but for debugging puposes you can do it manually
     {$IFDEF IFFreeMem}