--- Merging r19138 into '.':

U    rtl/wince/system.pp
--- Merging r19177 into '.':
U    utils/fpdoc/dw_ipflin.pas
--- Merging r19178 into '.':
U    rtl/unix/oscdeclh.inc
U    rtl/unix/bunxh.inc
U    rtl/bsd/bunxsysc.inc
U    rtl/freebsd/sysnr.inc
U    rtl/linux/bunxsysc.inc
--- Merging r19220 into '.':
U    rtl/objpas/fmtbcd.pp
A    tests/test/units/fmtbcd
A    tests/test/units/fmtbcd/tfmtbcd.pp

# revisions: 19138,19177,19178,19220
------------------------------------------------------------------------
r19138 | marco | 2011-09-18 12:53:48 +0200 (Sun, 18 Sep 2011) | 3 lines
Changed paths:
   M /trunk/rtl/wince/system.pp

 * Patch to fix createevent call on wince if the last param
   is nil. (last param contains security settings not   available on wince?). Patch
   by Fabio, Mantis #20280
------------------------------------------------------------------------
------------------------------------------------------------------------
r19177 | michael | 2011-09-22 14:05:05 +0200 (Thu, 22 Sep 2011) | 1 line
Changed paths:
   M /trunk/utils/fpdoc/dw_ipflin.pas

* Fix IPF output for topics (Fix by Graeme, bug #20318)
------------------------------------------------------------------------
------------------------------------------------------------------------
r19178 | marco | 2011-09-22 15:21:38 +0200 (Thu, 22 Sep 2011) | 2 lines
Changed paths:
   M /trunk/rtl/bsd/bunxsysc.inc
   M /trunk/rtl/freebsd/sysnr.inc
   M /trunk/rtl/linux/bunxsysc.inc
   M /trunk/rtl/unix/bunxh.inc
   M /trunk/rtl/unix/oscdeclh.inc

 * fpgetsid, Mantis #20329

------------------------------------------------------------------------
------------------------------------------------------------------------
r19220 | marco | 2011-09-24 23:34:39 +0200 (Sat, 24 Sep 2011) | 2 lines
Changed paths:
   M /trunk/rtl/objpas/fmtbcd.pp
   A /trunk/tests/test/units/fmtbcd
   A /trunk/tests/test/units/fmtbcd/tfmtbcd.pp

 * fmtbcd divide fix (and others), Mantis #19636, fix by Lacak2. + Test

------------------------------------------------------------------------

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

.gitattributes

@@ -10545,6 +10545,7 @@ tests/test/units/dos/tidos.pp svneol=native#text/plain
 tests/test/units/dos/tidos2.pp svneol=native#text/plain
 tests/test/units/dos/tverify.pp svneol=native#text/plain
 tests/test/units/dos/tversion.pp svneol=native#text/plain
+tests/test/units/fmtbcd/tfmtbcd.pp svneol=native#text/plain
 tests/test/units/fpcunit/fplists.pp svneol=native#text/plain
 tests/test/units/fpcunit/gencomptest.dpr svneol=native#text/plain
 tests/test/units/fpcunit/lists.pp svneol=native#text/plain

rtl/bsd/bunxsysc.inc

@@ -306,6 +306,12 @@ begin
  FPsetsid:=do_syscall(syscall_nr_setsid);
 end;
 
+function fpgetsid (pid:TPid): pid_t;
+
+begin
+ fpgetsid:=do_syscall(syscall_nr_getsid,TSysParam(pid));
+end;
+
 Function FPumask(cmask:mode_t):mode_t;
 {
   Sets file creation mask to (Mask and 0777 (octal) ), and returns the

rtl/freebsd/sysnr.inc

@@ -127,5 +127,6 @@ const
  syscall_nr_kse_switchin                = 440;
  syscall_nr_getrlimit                   = 194;
  syscall_nr_setrlimit                   = 195;
+ syscall_nr_getsid			= 310;
 
 

rtl/linux/bunxsysc.inc

@@ -306,6 +306,12 @@ begin
  fpsetsid:=do_syscall(syscall_nr_setsid);
 end;
 
+function fpgetsid (pid:TPid): pid_t;
+
+begin
+ fpgetsid:=do_syscall(syscall_nr_getsid,pid);
+end;
+
 Function fpumask(cmask:mode_t):mode_t;
 {
   Sets file creation mask to (Mask and 0777 (octal) ), and returns the

rtl/objpas/fmtbcd.pp

@@ -1079,15 +1079,16 @@ IMPLEMENTATION
       WITH BCD,
            bh do
         begin
-          lnzf := FDig < 0;
-          while lnzf do
+          lnzf := FDig <= 0;
+          while lnzf do // skip leading 0
             if Singles[FDig] = 0
               then begin
                 Inc ( FDig );
-                if FDig = 0
+                if FDig > 0
                   then lnzf := False;
                end
               else lnzf := False;
+          if FDig > 1 then FDig := 1;
           pre := LDig - FDig + 1;
           fra := Plac;
           doround := False;
@@ -1144,7 +1145,7 @@ IMPLEMENTATION
 
           lnzf := False;
           i := LDig;
-          while ( i >= FDig ) AND ( NOT lnzf ) do
+          while ( i >= FDig ) AND ( NOT lnzf ) do // skip trailing 0
             begin
               if Singles[i] <> 0
                 then begin
@@ -1412,7 +1413,7 @@ IMPLEMENTATION
           WITH lvars,
                bh do
             begin
-              while ( pfnb < lav ) AND ( NOT nbf ) do
+              while ( pfnb < lav ) AND ( NOT nbf ) do // skip leading spaces
                 begin
                   Inc ( pfnb );
                   nbf := aValue[pfnb] <> ' ';
@@ -1421,7 +1422,7 @@ IMPLEMENTATION
                 then begin
                   if aValue[pfnb] IN [ '+', '-' ]
                     then begin
-                      ps := pfnb;
+                      ps := pfnb; // position of sign
                       Inc ( pfnb );
                      end;
                   inife := low ( inife );
@@ -1461,7 +1462,7 @@ IMPLEMENTATION
                                else inife := inexp;
                         '+',
                         '-': if ( inife = inexp ) AND ( fp[inexp] = 0 )
-                               then pse := i
+                               then pse := i // position of exponent sign
                                else result := False;
                         else begin
                           result := False;
@@ -1472,7 +1473,7 @@ IMPLEMENTATION
                   if not result
                     then begin
                       result := True;
-                      for i := errp TO lav do
+                      for i := errp TO lav do // skip trailing spaces
                         if aValue[i] <> ' '
                           then result := False;
                      end;
@@ -2205,9 +2206,7 @@ writeln;
               bh1[True] := null_.bh;
               FlipFlop := False;
               fdset := p > 0;
-              if fdset
-                then bh.FDig := 0;
-              add := 0;
+              Add := 0;
               nz := True;
               while nz do
                 WITH bh1[FlipFlop] do
@@ -2284,9 +2283,6 @@ if p > 3 then halt;
                                 nLDig := 0;
                                 ue := 0;
                                 dd := Singles[lFDig] DIV ( bh2.Singles[lFDig - p] + 1 );
-{
-                                dd := 1;
-}
                                 if dd < 1
                                   then dd := 1;
 {
@@ -2316,21 +2312,10 @@ writeln ( 'p=', p, ' dd=', dd, ' lFdig=', lfdig, ' lldig=', lldig );
                                        end;
 }
                                    end;
-                                            sf := False;
-                                nfdig := lfdig;
-                                nldig := lldig;
+                                sf := False;
+                                nFDig := lFDig;
+                                nLDig := lLDig;
                                 Inc ( Add, dd );
-                                if NOT fdset
-                                  then begin
-                                    bh.FDig := p;
-                                    fdset := True;
-                                   end;
-                                if bh.LDig < p
-                                  then begin
-                                    bh.LDig := p;
-                                    if ( bh.LDig - bh.FDig ) > Succ ( MaxFmtBCDFractionSize )
-                                      then nz := False;
-                                   end;
                                 if sf
                                   then nz := False
                                   else begin
@@ -2344,8 +2329,22 @@ writeln ( 'p=', p, ' dd=', dd, ' lFdig=', lfdig, ' lldig=', lldig );
                                    end;
                                end;
                            end;
+
                         if Add <> 0
                           then begin
+
+                            if NOT fdset
+                              then begin
+                                bh.FDig := p;
+                                fdset := True;
+                               end;
+                            if bh.LDig < p
+                              then begin
+                                bh.LDig := p;
+                                if ( bh.LDig - bh.FDig ) > Succ ( MaxFmtBCDFractionSize )
+                                  then nz := False;
+                               end;
+
                             i4 := p;
                             while ( Add <> 0 ) AND ( i4 >= bh.FDig ) do
                               begin

rtl/unix/bunxh.inc

@@ -52,6 +52,7 @@ Type TGrpArr = Array [0..0] of TGid;            { C style array workarounds}
     Function  FpGetgroups (gidsetsize : cInt; var grouplist : tgrparr): cInt;
     Function  FpGetpgrp : TPid;
     Function  FpSetsid  : TPid;
+    Function  FpGetsid (pid:TPid)  : TPid;
     Function  FpFcntl      (fildes : cInt; cmd : cInt): cInt;
     Function  FpFcntl      (fildes : cInt; cmd : cInt; arg : cInt): cInt;
     Function  FpFcntl      (fildes : cInt; cmd : cInt; var arg : flock): cInt;

rtl/unix/oscdeclh.inc

@@ -107,6 +107,8 @@ const
     Function  FpGetgroups  (gidsetsize : cInt; var grouplist : tgrparr):cint; cdecl;external clib name 'getgroups';
     Function  FpGetpgrp : TPid;  cdecl;external clib name 'getpgrp';
     Function  FpSetsid  : TPid; cdecl;external clib name 'setsid';
+    Function  FpGetsid (pid:TPid)  : TPid; cdecl; external clib name 'getsid';
+
     Function  FpPipe       (var fildes : tfildes):cInt; cdecl;external clib name 'pipe';
     { The libc version has "..." as third parameter -> wrap for }
     { interface compatibility with syscalls                     }

rtl/wince/system.pp

@@ -506,8 +506,12 @@ function CreateEvent(lpEventAttributes:pointer;bManualReset:longbool;bInitialSta
 var
   buf: array[0..MaxPathLen] of WideChar;
 begin
-  AnsiToWideBuf(lpName, -1, buf, SizeOf(buf));
-  CreateEvent := CreateEventW(lpEventAttributes, bManualReset, bInitialState, buf);
+  if lpName=nil then
+    CreateEvent := CreateEventW(lpEventAttributes, bManualReset, bInitialState, nil)
+  else begin
+    AnsiToWideBuf(lpName, -1, buf, SizeOf(buf));
+    CreateEvent := CreateEventW(lpEventAttributes, bManualReset, bInitialState, buf);
+  end;
 end;
 
 function EventModify(h: THandle; func: DWORD): LONGBOOL;

tests/test/units/fmtbcd/tfmtbcd.pp

@@ -0,0 +1,116 @@
+// A basic tests for FmtBCD unit
+
+{$ifdef fpc}{$mode objfpc}{$h+}{$endif}
+
+uses SysUtils, FmtBCD;
+
+var
+  ErrorCount: integer;
+  FS, DFS: TFormatSettings;
+  bcd: TBCD;
+
+procedure testBCDMultiply(bcd1,bcd2,bcd3: TBCD);
+var bcdmul: TBCD;
+begin
+  BCDMultiply(bcd1,bcd2,bcdmul);
+  if (BCDCompare(bcd3,bcdmul) <> 0) or
+     (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);
+    inc(ErrorCount);
+  end;
+end;
+
+procedure testBCDDivide(bcd1,bcd2,bcd3: TBCD);
+var bcddiv: TBCD;
+begin
+  BCDDivide(bcd1,bcd2,bcddiv);
+  if (BCDCompare(bcd3,bcddiv) <> 0) or
+     (bcdtostr(bcd3) <> bcdtostr(bcddiv)) then
+  begin
+    writeln(bcdtostr(bcd1), ' / ', bcdtostr(bcd2), ' = ', bcdtostr(bcddiv), ' but expected ', bcdtostr(bcd3));
+    //writeln('Expected: ', bcd3.Precision,',',bcd3.SignSpecialPlaces, ' but calculated: ', bcddiv.Precision,',',bcddiv.SignSpecialPlaces);
+    inc(ErrorCount);
+  end;
+end;
+
+procedure testBCDToStrF(const s1, s2: string);
+begin
+  if s1 <> s2 then
+  begin
+    writeln('BCDToStrF: ', s1, ' Expected: ', s2);
+    inc(ErrorCount);
+  end;
+end;
+
+procedure testBCDPrecScale(const s: string; const prec,scale: integer);
+var bcd: TBCD;
+begin
+  bcd := strtobcd(s);
+  if (bcd.Precision <> prec) or (BCDScale(bcd) <> scale) then
+  begin
+    writeln('StrToBcd: ', bcdtostr(bcd), ' (', s, ') Precision:', bcd.Precision, ' Scale: ', BCDScale(bcd));
+    inc(ErrorCount);
+  end;
+end;
+
+begin
+  ErrorCount := 0;
+
+  // test BCDToStrF:
+  DFS:=DefaultFormatSettings;
+
+  FS.DecimalSeparator:=',';
+  FS.ThousandSeparator:=' ';
+  FS.CurrencyDecimals:=2;
+  FS.CurrencyString:='$';
+  FS.CurrencyFormat:=3;
+  DefaultFormatSettings:=FS;
+  bcd:=strtobcd('123456789123456789,12345');
+  testBCDToStrF(bcdtostrf(bcd, ffFixed, 30, 4), '123456789123456789,1235'); //no thousand separators
+  testBCDToStrF(bcdtostrf(bcd, ffNumber, 30, 5), '123 456 789 123 456 789,12345'); //with thousand separators
+  testBCDToStrF(bcdtostrf(bcd, ffCurrency, 30, 2), '123 456 789 123 456 789,12 $'); //with thousand separators
+
+  FS.DecimalSeparator:='.';
+  FS.ThousandSeparator:=',';
+  FS.CurrencyFormat:=0;
+  DefaultFormatSettings:=FS;
+  bcd:=strtobcd('123456789123456789.12345');
+  testBCDToStrF(bcdtostr(bcd), '123456789123456789.12345');
+  testBCDToStrF(bcdtostrf(bcd, ffFixed, 30, 3), '123456789123456789.123'); //no thousand separators
+  testBCDToStrF(bcdtostrf(bcd, ffNumber, 30, 6), '123,456,789,123,456,789.123450'); //with thousand separators
+  testBCDToStrF(bcdtostrf(bcd, ffCurrency, 30, 5), '$123,456,789,123,456,789.12345'); //with thousand separators
+
+  // test StrToBCD:
+  testBCDPrecScale(' 1.0000000000000000E-0003 ', 3, 3);
+  testBCDPrecScale('0.001', 3, 3);
+  testBCDPrecScale('1.001', 4, 3);
+  testBCDPrecScale('1001', 4, 0);
+  testBCDPrecScale('1001.1001', 8, 4);
+
+  DefaultFormatSettings := DFS;
+
+  // test BCDMultiply:
+  FS.DecimalSeparator:='.';
+  FS.ThousandSeparator:=#0;
+  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));
+
+  // test BCDDivide:
+  testBCDDivide(1000, 1000, 1);
+  testBCDDivide(1000, -100, -10);
+  testBCDDivide(-1000, 10, -100);
+  testBCDDivide(-1000, -1, 1000);
+  testBCDDivide(11000, 11, 1000);
+  testBCDDivide(11, 11000, 0.001);
+
+  testBCDDivide(100, -2, -50);
+  testBCDDivide(1007, 5, 201.4);
+
+
+  if ErrorCount<>0 then writeln('FmtBCD test program found ', ErrorCount, ' errors!');
+  Halt(ErrorCount);
+end.

utils/fpdoc/dw_ipflin.pas

@@ -747,6 +747,7 @@ begin
   begin
     FInHeadingText := ':h3%s. ' + SectionName;
 //    Writeln(':h3.' + SectionName);
+    InPackageOverview := False;
   end;
 //  Writeln('');
 end;