# revisions: 45573,45790,45793

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

packages/fpmkunit/src/fpmkunit.pp

@@ -1682,8 +1682,6 @@ ResourceString
   SWarnStartCompilingPackage = 'Start compiling package %s for target %s.';
   SWarnCompilingPackagecompleteProgress = '[%3.0f%%] Compiled package %s';
   SWarnCompilingPackagecomplete = 'Compiled package %s';
-  SWarnSkipPackageTargetProgress = '[%3.0f%%] Skipped package %s which has been disabled for target %s';
-  SWarnSkipPackageTarget = 'Skipped package %s which has been disabled for target %s';
   SWarnInstallationPackagecomplete = 'Installation package %s for target %s succeeded';
   SWarnCanNotGetAccessRights = 'Warning: Failed to copy access-rights from file %s';
   SWarnCanNotSetAccessRights = 'Warning: Failed to copy access-rights to file %s';
@@ -1699,6 +1697,8 @@ ResourceString
   SWarnRemovedNonEmptyDirectory = 'Warning: Removed non empty directory "%s"';
 
   SInfoPackageAlreadyProcessed = 'Package %s is already processed';
+  SInfoSkipPackageTargetProgress = '[%3.0f%%] Skipped package %s which has been disabled for target %s';
+  SInfoSkipPackageTarget = 'Skipped package %s which has been disabled for target %s';
   SInfoCompilingTarget    = 'Compiling target %s';
   SInfoExecutingCommand   = 'Executing command "%s %s"';
   SInfoCreatingOutputDir  = 'Creating output dir "%s"';
@@ -8158,7 +8158,7 @@ procedure TBuildEngine.Compile(Packages: TPackages);
         else
           begin
             inc(FProgressCount);
-            log(vlWarning,SWarnSkipPackageTargetProgress,[(FProgressCount)/FProgressMax * 100, APackage.Name, Defaults.Target]);
+            log(vlInfo,SInfoSkipPackageTargetProgress,[(FProgressCount)/FProgressMax * 100, APackage.Name, Defaults.Target]);
             APackage.FTargetState:=tsNoCompile;
           end;
       end;
@@ -8167,7 +8167,7 @@ procedure TBuildEngine.Compile(Packages: TPackages);
 Var
   I : integer;
 {$ifndef NO_THREADING}
-  Thr : Integer;
+  Thr, ThreadCount : Integer;
   Finished : boolean;
   ErrorState: boolean;
   ErrorMessage: string;
@@ -8197,7 +8197,7 @@ Var
             else // A problem occurred, stop the compilation
               begin
               ErrorState:=true;
-              ErrorMessage:=AThread.ErrorMessage;
+              ErrorMessage:='Error inside worker thread for package '+Athread.APackage.Name+': '+AThread.ErrorMessage;
               Finished:=true;
               end;
             AThread.APackage := nil;
@@ -8251,7 +8251,7 @@ begin
           else
             begin
             inc(FProgressCount);
-            log(vlWarning,SWarnSkipPackageTargetProgress,[(FProgressCount)/FProgressMax * 100, P.Name, Defaults.Target]);
+            log(vlInfo,SInfoSkipPackageTargetProgress,[(FProgressCount)/FProgressMax * 100, P.Name, Defaults.Target]);
             end;
         end;
     end
@@ -8262,34 +8262,71 @@ begin
       ErrorState := False;
       Finished := False;
       I := 0;
+      ThreadCount:=0;
       // This event is set by the worker-threads to notify the main/this thread
       // that a package finished it's task.
       NotifyThreadWaiting := RTLEventCreate;
       SetLength(Threads,Defaults.ThreadsAmount);
-      // Create all worker-threads
-      for Thr:=0 to Defaults.ThreadsAmount-1 do
-        Threads[Thr] := TCompileWorkerThread.Create(self,NotifyThreadWaiting);
-      try
-        // When a thread notifies this thread that it is ready, loop on all
-        // threads to check their state and if possible assign a new package
-        // to them to compile.
-        while not Finished do
-          begin
-            RTLeventWaitFor(NotifyThreadWaiting);
-            for Thr:=0 to Defaults.ThreadsAmount-1 do if not Finished then
-              ProcessThreadResult(Threads[Thr]);
-          end;
-        // Compilation finished or aborted. Wait for all threads to end.
-        for thr:=0 to Defaults.ThreadsAmount-1 do
-          begin
-            Threads[Thr].Terminate;
-            RTLeventSetEvent(Threads[Thr].NotifyStartTask);
-            Threads[Thr].WaitFor;
-          end;
+      try 
+        // Create all worker-threads
+        try
+          for Thr:=0 to Defaults.ThreadsAmount-1 do
+            begin
+              Threads[Thr] := TCompileWorkerThread.Create(self,NotifyThreadWaiting);
+              if assigned(Threads[Thr]) then
+                inc(ThreadCount);
+            end;
+        except
+          on E: Exception do
+            begin
+              ErrorMessage := E.Message;
+              ErrorState:=true;
+            end;
+        end;
+        try
+          // When a thread notifies this thread that it is ready, loop on all
+          // threads to check their state and if possible assign a new package
+          // to them to compile.
+          while not Finished do
+            begin
+              RTLeventWaitFor(NotifyThreadWaiting);
+              for Thr:=0 to Defaults.ThreadsAmount-1 do
+                if assigned(Threads[Thr]) and not Finished then
+                  ProcessThreadResult(Threads[Thr]);
+            end;
+        except
+          on E: Exception do
+            begin
+              if not ErrorState then
+                ErrorMessage := E.Message;
+              ErrorState:=true;
+            end;
+        end;
+        try
+          // Compilation finished or aborted. Wait for all threads to end.
+          for thr:=0 to Defaults.ThreadsAmount-1 do
+            if assigned(Threads[Thr]) then
+              begin
+                Threads[Thr].Terminate;
+                RTLeventSetEvent(Threads[Thr].NotifyStartTask);
+                Threads[Thr].WaitFor;
+              end;
+        except
+          on E: Exception do
+            begin
+              if not ErrorState then
+                ErrorMessage := E.Message;
+              ErrorState:=true;
+            end;
+        end;
       finally
         RTLeventdestroy(NotifyThreadWaiting);
         for thr:=0 to Defaults.ThreadsAmount-1 do
-          Threads[Thr].Free;
+          if assigned(Threads[Thr]) then
+            begin
+              Threads[Thr].Free;
+              dec(ThreadCount);
+            end;
       end;
     if ErrorState then
       raise Exception.Create(ErrorMessage);
@@ -8314,7 +8351,7 @@ begin
           log(vlWarning, SWarnInstallationPackagecomplete, [P.Name, Defaults.Target]);
         end
       else
-        log(vlWarning,SWarnSkipPackageTarget,[P.Name, Defaults.Target]);
+        log(vlInfo,SInfoSkipPackageTarget,[P.Name, Defaults.Target]);
     end;
   NotifyEventCollection.CallEvents(neaAfterInstall, Self);
 end;
@@ -8343,7 +8380,7 @@ begin
             log(vlWarning, SWarnInstallationPackagecomplete, [P.Name, Defaults.Target]);
           end
         else
-          log(vlWarning,SWarnSkipPackageTarget,[P.Name, Defaults.Target]);
+          log(vlInfo,SInfoSkipPackageTarget,[P.Name, Defaults.Target]);
       end;
   finally
     FinishArchive(P);

packages/rtl-objpas/src/inc/dateutil.inc

@@ -1390,9 +1390,11 @@ end;
 
 Function DaysBetween(const ANow, AThen: TDateTime): Integer;
 begin
-  Result:=Trunc(Abs(DateTimeDiff(ANow,AThen))+HalfMilliSecond);
-end;
-
+  if anow>athen then
+    Result:=Trunc(Abs(DateTimeDiff(ANow,AThen))+HalfMilliSecond)
+  else
+    Result:=Trunc(Abs(DateTimeDiff(AThen,ANow))+HalfMilliSecond); // bug 37361
+end;            
 
 Function HoursBetween(const ANow, AThen: TDateTime): Int64;
 begin

rtl/i386/cpu.pp

@@ -35,6 +35,7 @@ unit cpu;
     function AVXSupport: boolean;inline;
     function AVX2Support: boolean;inline;
     function FMASupport: boolean;inline;
+    function POPCNTSupport: boolean;inline;
 
     var
       is_sse3_cpu : boolean = false;
@@ -48,7 +49,8 @@ unit cpu;
       _AVXSupport,
       _AVX2Support,
       _AESSupport,
-      _FMASupport : boolean;
+      _FMASupport,
+      _POPCNTSupport : boolean;
 
 
     function InterlockedCompareExchange128(var Target: Int128Rec; NewValue: Int128Rec; Comperand: Int128Rec): Int128Rec;
@@ -123,6 +125,7 @@ unit cpu;
                  popl %ebx
               end;
               _AESSupport:=(_ecx and $2000000)<>0;
+              _POPCNTSupport:=(_ecx and $800000)<>0;
 
               _AVXSupport:=
                 { XGETBV suspport? }
@@ -179,6 +182,12 @@ unit cpu;
         result:=_FMASupport;
       end;
 
+
+    function POPCNTSupport: boolean;inline;
+      begin
+        result:=_POPCNTSupport;
+      end;
+
 begin
   SetupSupport;
 end.

rtl/inc/varianth.inc

@@ -17,52 +17,52 @@
 { Variant types. Changes to these consts must be synchronized with
   similar list in compiler code, in implementation part of symdef.pas }
 const
-   varempty = 0;
-   varnull = 1;
-   varsmallint = 2;
-   varinteger = 3;
+   varEmpty = 0;
+   varNull = 1;
+   varSmallInt = 2;
+   varInteger = 3;
 {$ifndef FPUNONE}
-   varsingle = 4;
-   vardouble = 5;
-   vardate = 7;
+   varSingle = 4;
+   varDouble = 5;
+   varDate = 7;
 {$endif}
-   varcurrency = 6;
-   varolestr = 8;
-   vardispatch = 9;
-   varerror = 10;
-   varboolean = 11;
-   varvariant = 12;
-   varunknown = 13;
-   vardecimal = 14;
-   varshortint = 16;
-   varbyte = 17;
-   varword = 18;
-   varlongword = 19;
-   varint64 = 20;
-   varqword = 21;
-
-   varrecord = 36;
+   varCurrency = 6;
+   varOleStr = 8;
+   varDispatch = 9;
+   varError = 10;
+   varBoolean = 11;
+   varVariant = 12;
+   varUnknown = 13;
+   varDecimal = 14;
+   varShortInt = 16;
+   varByte = 17;
+   varWord = 18;
+   varLongWord = 19;
+   varInt64 = 20;
+   varQWord = 21;
+
+   varRecord = 36;
 
    { The following values never appear as TVarData.VType, but are used in
      TCallDesc.Args[] as aliases for compiler-specific types.
      (since it provides only 1 byte per element, actual values won't fit)
      The choice of values is pretty much arbitrary. }
 
-   varstrarg = $48;         { maps to varstring }
-   varustrarg = $49;        { maps to varustring }
+   varStrArg = $48;         { maps to varstring }
+   varUStrArg = $49;        { maps to varustring }
 
    { Compiler-specific variant types (not known to COM) are kept in
     'pseudo-custom' range of $100-$10E. Real custom types start with $10F. }
 
-   varstring = $100;
-   varany = $101;
-   varustring = $102;
-   vartypemask = $fff;
-   vararray = $2000;
-   varbyref = $4000;
+   varString = $100;
+   varAny = $101;
+   varUString = $102;
+   varTypeMask = $fff;
+   varArray = $2000;
+   varByRef = $4000;
 
-   varword64 = varqword;
-   varuint64 = varqword; // Delphi alias
+   varWord64 = varQWord;
+   varUInt64 = varQWord; // Delphi alias
 
 type
    tvartype = word;

rtl/objpas/classes/stringl.inc

@@ -249,7 +249,7 @@ begin
       Result:=Result+Delimiter;
     end;
   // Quote empty string:
-  If (Length(Result)=0) and (Count=1) then
+  If (Length(Result)=0) and (Count=1) and (QuoteChar<>#0) then
     Result:=QuoteChar+QuoteChar;
 end;
 

rtl/objpas/sysutils/filutilh.inc

@@ -162,7 +162,7 @@ Const
   fsFromEnd       = 2;
 
   { File errors }
-  feInvalidHandle : THandle = THandle(-1);  //return value on FileOpen error
+  feInvalidHandle = THandle(-1);  //return value on FileOpen error
 
 Type
   TFileSearchOption = (sfoImplicitCurrentDir,sfoStripQuotes);

rtl/x86_64/cpu.pp

@@ -33,6 +33,7 @@ unit cpu;
     function AVXSupport : boolean;inline;
     function AVX2Support: boolean;inline;
     function FMASupport: boolean;inline;
+    function POPCNTSupport: boolean;inline;
 
     var
       is_sse3_cpu : boolean = false;
@@ -48,7 +49,8 @@ unit cpu;
       _AVXSupport,
       _InterlockedCompareExchange128Support,
       _AVX2Support,
-      _FMASupport : boolean;
+      _FMASupport,
+      _POPCNTSupport: boolean;
 
     function InterlockedCompareExchange128(var Target: Int128Rec; NewValue: Int128Rec; Comperand: Int128Rec): Int128Rec; assembler;
      {
@@ -141,6 +143,7 @@ unit cpu;
         end ['rax','rbx','rcx','rdx'];
         _InterlockedCompareExchange128Support:=(_ecx and $2000)<>0;
         _AESSupport:=(_ecx and $2000000)<>0;
+        _POPCNTSupport:=(_ecx and $800000)<>0;
 
         _AVXSupport:=
           { XGETBV suspport? }
@@ -194,6 +197,11 @@ unit cpu;
       end;
 
 
+    function POPCNTSupport: boolean;inline;
+      begin
+        result:=_POPCNTSupport;
+      end;
+
 begin
   SetupSupport;
 end.