Portability fixes

1 files changed, 49 insertions, 37 deletions

diff --git a/UCoreUtils.pas b/UCoreUtils.pas
index ed43589..0bccb8b 100644
--- a/UCoreUtils.pas
+++ b/UCoreUtils.pas
@@ -112,10 +112,7 @@ procedure SetupColors;
 function ConstructURI(HidePasswd: boolean; Protocol, Server, Username, Password, Dir: string): string;
 function URIHidePassword(const SrcURI: string): string;
 
-{$IFDEF __FPC__}
-function StrToDateDef(const S: string; const Default: TDateTime): TDateTime;
-function UnixToDateTime(const AValue: Int64): TDateTime;
-{$ENDIF}
+function StrTotimetDef(const S: string; const Default: time_t): time_t;
 
 procedure SaveItemToHistory(s: string; History: TStringList);
 
@@ -1053,6 +1050,9 @@ begin
           vtCurrency:   Write(ErrOutput, CurrToStr(VCurrency^));
           vtVariant:    Write(ErrOutput, string(VVariant^));
           vtInt64:      Write(ErrOutput, IntToStr(VInt64^));
+{$IFDEF FPC}
+          vtQWord:      Write(ErrOutput, IntToStr(VQWord^));
+{$ENDIF}
       end;
     WriteLn(ErrOutput);
   end;
@@ -1061,9 +1061,8 @@ end;
 (********************************************************************************************************************************)
 function SpawnProcess(const AppPath: string; var Running: boolean; const Parameters: array of string): Cardinal;
 var child_pid: __pid_t;
-    args_list: System.PPChar;
+    args_list: PPChar;
     i: integer;
-    Temp: string;
     sv: sigval_t;
 begin
   Result := 0;
@@ -1073,16 +1072,12 @@ begin
   //  Make the args_list array
   args_list := nil;
   if Length(Parameters) > 0 then begin
-    args_list := malloc((Length(Parameters) + 1) * SizeOf(PChar));
-    memset(args_list, 0, (Length(Parameters) + 1) * SizeOf(PChar));
+    args_list := malloc((Length(Parameters) + 1) * sizeof(PChar));
+    memset(args_list, 0, (Length(Parameters) + 1) * sizeof(PChar));
     for I := 0 to Length(Parameters) - 1 do
     begin
-      Temp := Parameters[i];
       {$R-}
-//      PCharArray(args_list^)[I] := malloc(Length(Temp)+1);
-//      memset(PCharArray(args_list^)[I], 0, Length(Temp)+1);
-//      StrCopy(PCharArray(args_list^)[I], PChar(Temp));
-        PCharArray(args_list^)[I] := strdup(PChar(Temp));
+        PCharArray(args_list^)[I] := strdup(PChar(Parameters[i]));
       {$R+}
     end;
     {$R-}
@@ -1095,6 +1090,11 @@ begin
   if child_pid <> 0 then begin
     Result := child_pid;
     Sleep(100);
+    //*  FIXME: strange behaviour when freed
+{    for i := 0 to Length(Parameters) - 1 do
+      if PCharArray(args_list^)[i] <> nil then
+        libc_free(PCharArray(args_list^)[i]); }
+    if args_list <> nil then libc_free(args_list);
     Application.ProcessMessages;
     Running := ChildExitStatus < 0;
     if not Running then Result := 0;
@@ -1211,7 +1211,7 @@ end;
 
 (********************************************************************************************************************************)
 function IsItX11App(const Application: string): boolean;
-const BSize = 32768;
+const BSize = 65536;
       What = 'libX11.so';
 var stream: PFILE;
     Buffer: Pointer;
@@ -1242,6 +1242,8 @@ begin
         end;
       end;
       pclose(stream);
+      libc_free(Buffer);
+      SetLength(str, 0);
     end;
 //    unsetenv('LD_TRACE_LOADED_OBJECTS');
   
@@ -1252,7 +1254,7 @@ begin
 end;
 
 function HandleSystemCommand(const Command, ErrorText: string): boolean;
-const BSize = 32768;
+const BSize = 65536;
 var stream: PFILE;
     Buffer: Pointer;
     i, NumRead: integer;
@@ -1277,9 +1279,9 @@ begin
       libc_close(fds[1]);
       stream := fdopen(fds[0], 'r');
       Buffer := malloc(BSize);
-      DebugMsg(['x0']);
+//      DebugMsg(['x0']);
       memset(Buffer, 0, BSize);
-      DebugMsg(['x1']);
+//      DebugMsg(['x1']);
       if buffer = nil then Writeln('buffer nil: ', integer(errno));
       if stream = nil then Writeln('stream nil');   
 
@@ -1293,12 +1295,12 @@ begin
         end;
       end;
       libc_close(fds[0]);
-      DebugMsg(['x2']);
+//      DebugMsg(['x2']);
       TrimCRLFESC(s);
-      DebugMsg(['x3']);
+//      DebugMsg(['x3']);
 
-      free(Buffer);
-      DebugMsg(['x4']);
+      libc_free(Buffer);
+//      DebugMsg(['x4']);
     end
 
     //  forked PID
@@ -1338,6 +1340,7 @@ begin
 
     Result := Length(s) = 0;
     if not Result then Application.MessageBox(Format('%s%s', [ErrorText, StrToUTF8(s)]), [mbOK], mbError, mbOK, mbOK);
+    SetLength(s, 0);
   except
     on E: Exception do DebugMsg(['***** function HandleSystemCommand(''', Command, '''):Exception: ', E.Message]);
   end;
@@ -1549,6 +1552,12 @@ begin
   Result := 0;
 end;
 {$ELSE}
+{$IFDEF CPUPOWERPC}
+function CRC32(CRC: LongWord; Data: Pointer; DataSize: LongWord): LongWord;
+begin
+  Result := 0;
+end;
+{$ELSE}
 function CRC32(CRC: LongWord; Data: Pointer; DataSize: LongWord): LongWord; assembler;
 asm
          AND    EDX,EDX
@@ -1639,6 +1648,7 @@ asm
          DD 06E656761h, 064655220h, 06E616D64h, 06FBBA36Eh
 end;
 {$ENDIF}
+{$ENDIF}
 (********************************************************************************************************************************)
 constructor THash_MD5.Create;
 begin
@@ -1738,6 +1748,12 @@ begin
   Result := nil;
 end;
 {$ELSE}
+{$IFDEF CPUPOWERPC}
+function THash_MD5.TestVector: Pointer;
+begin
+  Result := nil;
+end;
+{$ELSE}
 function THash_MD5.TestVector: Pointer;
 asm
          MOV   EAX,OFFSET @Vector
@@ -1746,6 +1762,7 @@ asm
          DB    075h,05Dh,04Bh,0C9h,0FEh,0DCh,0C2h,0C6h
 end;
 {$ENDIF}
+{$ENDIF}
 
 {$Q-}
 procedure THash_MD5.Transform(Buffer: PIntArray);
@@ -1921,12 +1938,15 @@ end;
 
 procedure ReportGTKVersion;
 begin
-  if Application.GTKVersion_2_8_0_Up then DebugMsg(['Using GTK+ version >= 2.8.0']) else
-  if Application.GTKVersion_2_6_0_Up then DebugMsg(['Using GTK+ version >= 2.6.0']) else
-  if Application.GTKVersion_2_4_0_Up then DebugMsg(['Using GTK+ version >= 2.4.0']) else
-  if Application.GTKVersion_2_2_0_Up then DebugMsg(['Using GTK+ version >= 2.2.0']) else
-  if Application.GTKVersion_2_0_5_Up then DebugMsg(['Using GTK+ version >= 2.0.5']) else
-  DebugMsg(['Using GTK+ version < 2.0.5']);
+{$IFDEF FPC}
+  DebugMsg(['Reported GTK version: ', gtk_major_version, '.', gtk_minor_version, '.', gtk_micro_version]);
+{$ENDIF}
+  if Application.GTKVersion_2_8_0_Up then DebugMsg(['Using quirks for GTK+ >= 2.8.0']) else
+  if Application.GTKVersion_2_6_0_Up then DebugMsg(['Using quirks for GTK+ >= 2.6.0']) else
+  if Application.GTKVersion_2_4_0_Up then DebugMsg(['Using quirks for GTK+ >= 2.4.0']) else
+  if Application.GTKVersion_2_2_0_Up then DebugMsg(['Using quirks for GTK+ >= 2.2.0']) else
+  if Application.GTKVersion_2_0_5_Up then DebugMsg(['Using quirks for GTK+ >= 2.0.5']) else
+  DebugMsg(['Using quirks for GTK+ < 2.0.5']);
 end;
 
 
@@ -1980,23 +2000,15 @@ end;
 
 
 (********************************************************************************************************************************)
-{$IFDEF __FPC__}
-function StrToDateDef(const S: string; const Default: TDateTime): TDateTime;
+function StrTotimetDef(const S: string; const Default: time_t): time_t;
 begin
   try
-    Result := StrToDate(S);
+    Result := DateTimeToUnix(StrToDate(S));
   except
     Result := Default;
   end;
 end;
 
-
-function UnixToDateTime(const AValue: Int64): TDateTime;
-begin
-  Result := AValue / SecsPerDay + UnixDateDelta;
-end;
-{$ENDIF}
-
 (********************************************************************************************************************************)
 procedure SaveItemToHistory(s: string; History: TStringList);
 var i: integer;