Переглянути джерело

--- Merging r21386 into '.':
U rtl/objpas/classes/lists.inc
--- Merging r21436 into '.':
U packages/fcl-process/src/win/process.inc
--- Merging r21437 into '.':
U packages/fcl-process/src/process.pp
--- Merging r21739 into '.':
G packages/fcl-process/src/process.pp

# revisions: 21386,21436,21437,21739
r21386 | michael | 2012-05-24 21:18:44 +0200 (Thu, 24 May 2012) | 1 line
Changed paths:
M /trunk/rtl/objpas/classes/lists.inc

* Patch from Mattias Gaertner to improve quicksort memory use (Bug 22119)
r21436 | marco | 2012-05-30 19:25:20 +0200 (Wed, 30 May 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-process/src/win/process.inc

* if arguments and exename already quoted, then assume the user did it properly. Mantis #22040
r21437 | marco | 2012-05-30 20:07:37 +0200 (Wed, 30 May 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-process/src/process.pp

* A few utility routines that capture program output in a string.
r21739 | marco | 2012-06-30 15:27:20 +0200 (Sat, 30 Jun 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-process/src/process.pp

* (runcommand), fix for corruption of outputstring if command fails with
an exception. Patch by Ludo #22328

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

marco 13 роки тому
батько
коміт
46c235772c

+ 123 - 0
packages/fcl-process/src/process.pp

@@ -169,6 +169,13 @@ Var
   Function DetectXTerm : String;
 {$endif unix}
 
+function RunCommandIndir(const curdir:string;const exename:string;const commands:array of string;var outputstring:string;var exitstatus:integer):integer; 
+function RunCommandIndir(const curdir:string;const exename:string;const commands:array of string;var outputstring:string):boolean; 
+function RunCommandInDir(const curdir,cmdline:string;var outputstring:string):boolean; deprecated;
+
+function RunCommand(const exename:string;const commands:array of string;var outputstring:string):boolean; 
+function RunCommand(const cmdline:string;var outputstring:string):boolean; deprecated;
+
 implementation
 
 {$i process.inc}
@@ -446,4 +453,120 @@ begin
     end;
 end;
 
+Const 
+  READ_BYTES = 65536; // not too small to avoid fragmentation when reading large files.
+
+// helperfunction that does the bulk of the work.
+function internalRuncommand(p:TProcess;var outputstring:string;var exitstatus:integer):integer;
+var
+    numbytes,bytesread : integer;
+begin
+  result:=-1;
+  try
+    try
+    p.Options :=  [poUsePipes];
+    bytesread:=0;
+    p.Execute;
+    while p.Running do
+      begin          
+        Setlength(outputstring,BytesRead + READ_BYTES);
+        NumBytes := p.Output.Read(outputstring[1+bytesread], READ_BYTES);
+        if NumBytes > 0 then 
+          Inc(BytesRead, NumBytes)
+        else 
+          Sleep(100); 
+      end;
+    repeat
+      Setlength(outputstring,BytesRead + READ_BYTES);
+      NumBytes := p.Output.Read(outputstring[1+bytesread], READ_BYTES);
+      if NumBytes > 0 then 
+        Inc(BytesRead, NumBytes);
+    until NumBytes <= 0;
+    setlength(outputstring,BytesRead);
+    exitstatus:=p.exitstatus;	
+    result:=0; // we came to here, document that.
+    except
+      on e : Exception do 
+         begin
+           result:=1;
+           setlength(outputstring,BytesRead);
+         end;
+     end;
+  finally
+    p.free;
+    end;
+end;
+
+function RunCommandIndir(const curdir:string;const exename:string;const commands:array of string;var outputstring:string;var exitstatus:integer):integer; 
+Var
+    p : TProcess;
+    i : integer; 
+begin
+  p:=TProcess.create(nil);
+  p.Executable:=exename; 
+  if curdir<>'' then
+    p.CurrentDirectory:=curdir;
+  if high(commands)>=0 then 
+   for i:=low(commands) to high(commands) do
+     p.Parameters.add(commands[i]);
+  result:=internalruncommand(p,outputstring,exitstatus);
+end;
+
+function RunCommandInDir(const curdir,cmdline:string;var outputstring:string):boolean; deprecated;
+Var
+    p : TProcess;
+    exitstatus : integer; 
+begin
+  p:=TProcess.create(nil);
+  p.commandline:=cmdline;
+  if curdir<>'' then
+    p.CurrentDirectory:=curdir;
+  result:=internalruncommand(p,outputstring,exitstatus)=0;
+  if exitstatus<>0 then result:=false;
+end;
+
+function RunCommandIndir(const curdir:string;const exename:string;const commands:array of string;var outputstring:string):boolean; 
+Var
+    p : TProcess;
+    i,
+    exitstatus : integer; 
+begin
+  p:=TProcess.create(nil);
+  p.Executable:=exename; 
+  if curdir<>'' then
+    p.CurrentDirectory:=curdir;
+  if high(commands)>=0 then 
+   for i:=low(commands) to high(commands) do
+     p.Parameters.add(commands[i]);
+  result:=internalruncommand(p,outputstring,exitstatus)=0;
+  if exitstatus<>0 then result:=false;
+end;
+
+function RunCommand(const cmdline:string;var outputstring:string):boolean; deprecated;
+Var
+    p : TProcess;
+    exitstatus : integer; 
+begin
+  p:=TProcess.create(nil);
+  p.commandline:=cmdline;
+  result:=internalruncommand(p,outputstring,exitstatus)=0;
+  if exitstatus<>0 then result:=false;
+end;
+
+function RunCommand(const exename:string;const commands:array of string;var outputstring:string):boolean; 
+Var
+    p : TProcess;
+    i,
+    exitstatus : integer; 
+begin
+  p:=TProcess.create(nil);
+  p.Executable:=exename; 
+  if high(commands)>=0 then 
+   for i:=low(commands) to high(commands) do
+     p.Parameters.add(commands[i]);
+  result:=internalruncommand(p,outputstring,exitstatus)=0;
+  if exitstatus<>0 then result:=false;
+end;
+
+
 end.

+ 10 - 2
packages/fcl-process/src/win/process.inc

@@ -206,6 +206,14 @@ begin
      Result:=S;
 end;
 
+Function MaybeQuoteIfNotQuoted(Const S : String) : String;
+
+begin
+  If (Pos(' ',S)<>0) and (pos('"',S)=0) then
+    Result:='"'+S+'"'
+  else
+     Result:=S;
+end;
 
 Procedure TProcess.Execute;
 Var
@@ -237,9 +245,9 @@ begin
     PCommandLine:=Pchar(FCommandLine)
   else if (Fexecutable<>'') then
     begin
-    Cmd:=MaybeQuote(Executable);
+    Cmd:=MaybeQuoteIfNotQuoted(Executable);
     For I:=0 to Parameters.Count-1 do
-      Cmd:=Cmd+' '+MaybeQuote(Parameters[i]);
+      Cmd:=Cmd+' '+MaybeQuoteIfNotQuoted(Parameters[i]);
     PCommandLine:=PChar(Cmd);
     end;
   If FCurrentDirectory<>'' then

+ 16 - 4
rtl/objpas/classes/lists.inc

@@ -318,10 +318,22 @@ begin
        J := J - 1;
      end;
    until I > J;
-   if L < J then
-     QuickSort(FList, L, J, Compare);
-   L := I;
- until I >= R;
+   // sort the smaller range recursively
+   // sort the bigger range via the loop
+   // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+   if J - L < R - I then
+   begin
+     if L < J then
+       QuickSort(FList, L, J, Compare);
+     L := I;
+   end
+   else
+   begin
+     if I < R then
+       QuickSort(FList, I, R, Compare);
+     R := J;
+   end;
+ until L >= R;
 end;
 
 procedure TFPList.Sort(Compare: TListSortCompare);