← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to ide/fpredir.pas

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
ide/fpredir.pas
1
1
{
2
 
    $Id: fpredir.pas,v 1.12 2005/03/07 17:08:14 peter Exp $
3
2
    This file is part of the Free Pascal Test Suite
4
3
    Copyright (c) 1999-2000 by Pierre Muller
5
4
 
34
33
{$ifdef OS2}
35
34
{$define shell_implemented}
36
35
{$endif}
37
 
{$ifdef Win32}
 
36
{$ifdef Windows}
38
37
{$define implemented}
39
38
{$endif}
40
39
{$ifdef linux}
97
96
{$ifdef netware_clib}
98
97
  nwserv,
99
98
{$endif netware_clib}
100
 
{$ifdef win32}
 
99
{$ifdef Windows}
101
100
  windows,
102
 
{$endif win32}
 
101
{$endif Windows}
103
102
{$ifdef unix}
104
103
  {$ifdef ver1_0}
105
104
    linux,
189
188
 
190
189
{$ifdef TP}
191
190
 
192
 
{$ifndef win32}
 
191
{$ifndef Windows}
193
192
const
194
193
  UnusedHandle    = -1;
195
194
  StdInputHandle  = 0;
196
195
  StdOutputHandle = 1;
197
196
  StdErrorHandle  = 2;
198
 
{$endif win32}
 
197
{$endif Windows}
199
198
 
200
199
Type
201
200
  PtrRec = packed record
255
254
      dup2:=false;
256
255
end;
257
256
 
258
 
{$ifndef ver1_0}
259
257
function fpdup(fh:longint):longint;
260
258
begin
261
259
  if not dup(fh,fpdup) then
269
267
  else
270
268
   fpdup2:=-1;
271
269
end;
272
 
{$endif ver1_0}
273
 
 
274
 
 
275
 
Function {$ifdef ver1_0}fdclose{$else}fpclose{$endif} (Handle : Longint) : boolean;
 
270
 
 
271
 
 
272
function fpclose(Handle : Longint) : boolean;
276
273
var Regs: registers;
277
274
begin
278
275
  Regs.Eax := $3e00;
279
276
  Regs.Ebx := Handle;
280
277
  MsDos(Regs);
281
 
  {$ifdef ver1_0}fdclose{$else}fpclose{$endif}:=(Regs.Flags and fCarry)=0;
 
278
  fpclose:=(Regs.Flags and fCarry)=0;
282
279
end;
283
280
 
284
281
{$endif def go32v2}
285
282
 
286
 
{$ifdef win32}
287
 
Function {$ifdef ver1_0}fdclose{$else}fpclose{$endif} (Handle : Longint) : boolean;
 
283
{$ifdef Windows}
 
284
Function fpclose(Handle : Longint) : boolean;
288
285
begin
289
286
  { Do we need this ?? }
290
 
  {$ifdef ver1_0}fdclose{$else}fpclose{$endif}:=true;
 
287
  fpclose:=true;
291
288
end;
292
289
{$endif}
293
290
 
294
291
{$ifdef os2}
295
 
Function {$ifdef ver1_0}fdclose{$else}fpclose{$endif} (Handle : Longint) : boolean;
 
292
Function fpclose (Handle : Longint) : boolean;
296
293
begin
297
294
  { Do we need this ?? }
298
 
  {$ifdef ver1_0}fdclose{$else}fpclose{$endif}:=true;
 
295
  fpclose:=true;
299
296
end;
300
297
{$endif}
301
298
 
303
300
Function {$ifdef ver1_0}fdclose{$else}fpclose{$endif} (Handle : Longint) : boolean;
304
301
begin
305
302
  { if executed as under GO32 this hangs the DOS-prompt }
306
 
  {$ifdef ver1_0}fdclose{$else}fpclose{$endif}:=true;
 
303
  fpclose:=true;
307
304
end;
308
 
 
309
305
{$endif}
310
306
 
311
307
{$I-}
395
391
    ChangeRedirOut:=True;
396
392
    OutRedirDisabled:=False;
397
393
{$else}
398
 
{$ifdef win32}
 
394
{$ifdef Windows}
399
395
    if SetStdHandle(Std_Output_Handle,FileRec(FOUT^).Handle) then
400
 
{$else not win32}
401
 
    {$ifdef ver1_0}
402
 
    dup(StdOutputHandle,TempHOut);
403
 
    dup2(FileRec(FOUT^).Handle,StdOutputHandle);
404
 
    {$else}
 
396
{$else not Windows}
405
397
    TempHOut:=fpdup(StdOutputHandle);
406
398
    fpdup2(FileRec(FOUT^).Handle,StdOutputHandle);
407
 
    {$endif}
408
399
    if (TempHOut<>UnusedHandle) and
409
400
       (StdOutputHandle<>UnusedHandle) then
410
 
{$endif not win32}
 
401
{$endif not Windows}
411
402
      begin
412
403
         ChangeRedirOut:=True;
413
404
         OutRedirDisabled:=False;
433
424
    ChangeRedirIn:=True;
434
425
    InRedirDisabled:=False;
435
426
{$else}
436
 
{$ifdef win32}
 
427
{$ifdef Windows}
437
428
    if SetStdHandle(Std_Input_Handle,FileRec(FIN^).Handle) then
438
 
{$else not win32}
439
 
    {$ifdef ver1_0}
440
 
    dup(StdInputHandle,TempHIn);
441
 
    dup2(FileRec(FIn^).Handle,StdInputHandle);
442
 
    {$else}
 
429
{$else not Windows}
443
430
    TempHIn:=fpdup(StdInputHandle);
444
431
    fpdup2(FileRec(FIn^).Handle,StdInputHandle);
445
 
    {$endif}
446
432
    if (TempHIn<>UnusedHandle) and
447
433
       (StdInputHandle<>UnusedHandle) then
448
 
{$endif not win32}
 
434
{$endif not Windows}
449
435
      begin
450
436
         ChangeRedirIn:=True;
451
437
         InRedirDisabled:=False;
475
461
    ChangeRedirError:=True;
476
462
    ErrorRedirDisabled:=False;
477
463
{$else}
478
 
{$ifdef win32}
 
464
{$ifdef Windows}
479
465
    if SetStdHandle(Std_Error_Handle,FileRec(FERR^).Handle) then
480
 
{$else not win32}
481
 
    {$ifdef ver1_0}
482
 
    dup(StdErrorHandle,TempHError);
483
 
    dup2(FileRec(FERR^).Handle,StdErrorHandle);
484
 
    {$else}
 
466
{$else not Windows}
485
467
    TempHError:=fpdup(StdErrorHandle);
486
468
    fpdup2(FileRec(FERR^).Handle,StdErrorHandle);
487
 
    {$endif}
488
469
    if (TempHError<>UnusedHandle) and
489
470
       (StdErrorHandle<>UnusedHandle) then
490
 
{$endif not win32}
 
471
{$endif not Windows}
491
472
      begin
492
473
         ChangeRedirError:=True;
493
474
         ErrorRedirDisabled:=False;
539
520
    Handles^[StdOutputHandle]:=OldHandleOut;
540
521
    OldHandleOut:=StdOutputHandle;
541
522
{$else}
542
 
{$ifdef win32}
 
523
{$ifdef Windows}
543
524
    SetStdHandle(Std_Output_Handle,StdOutputHandle);
544
 
{$else not win32}
545
 
    {$ifdef ver1_0}dup2{$else}fpdup2{$endif}(TempHOut,StdOutputHandle);
546
 
{$endif not win32}
 
525
{$else not Windows}
 
526
    fpdup2(TempHOut,StdOutputHandle);
 
527
{$endif not Windows}
547
528
{$endif FPC}
548
529
    Close (FOUT^);
549
 
    {$ifdef ver1_0}fdclose{$else}fpclose{$endif}(TempHOut);
 
530
    fpclose(TempHOut);
550
531
    RedirChangedOut:=false;
551
532
  end;
552
533
 
560
541
    Handles^[StdInputHandle]:=OldHandleIn;
561
542
    OldHandleIn:=StdInputHandle;
562
543
{$else}
563
 
{$ifdef win32}
 
544
{$ifdef Windows}
564
545
    SetStdHandle(Std_Input_Handle,StdInputHandle);
565
 
{$else not win32}
566
 
    {$ifdef ver1_0}dup2{$else}fpdup2{$endif}(TempHIn,StdInputHandle);
567
 
{$endif not win32}
 
546
{$else not Windows}
 
547
    fpdup2(TempHIn,StdInputHandle);
 
548
{$endif not Windows}
568
549
{$endif}
569
550
    Close (FIn^);
570
 
    {$ifdef ver1_0}fdclose{$else}fpclose{$endif}(TempHIn);
 
551
    fpclose(TempHIn);
571
552
    RedirChangedIn:=false;
572
553
  end;
573
554
 
581
562
{$ifndef FPC}
582
563
    Handles^[StdInputHandle]:=OldHandleIn;
583
564
{$else}
584
 
{$ifdef win32}
 
565
{$ifdef Windows}
585
566
    SetStdHandle(Std_Input_Handle,StdInputHandle);
586
 
{$else not win32}
587
 
    {$ifdef ver1_0}dup2{$else}fpdup2{$endif}(TempHIn,StdInputHandle);
588
 
{$endif not win32}
 
567
{$else not Windows}
 
568
    fpdup2(TempHIn,StdInputHandle);
 
569
{$endif not Windows}
589
570
{$endif}
590
571
    InRedirDisabled:=True;
591
572
  end;
601
582
    Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
602
583
    Handles^[StdInputHandle]:=Handles^[FileRec (FIn^).Handle];
603
584
{$else}
604
 
{$ifdef win32}
 
585
{$ifdef Windows}
605
586
    SetStdHandle(Std_Input_Handle,FileRec(FIn^).Handle);
606
 
{$else not win32}
607
 
    {$ifdef ver1_0}dup2{$else}fpdup2{$endif}(FileRec(FIn^).Handle,StdInputHandle);
608
 
{$endif not win32}
 
587
{$else not Windows}
 
588
    fpdup2(FileRec(FIn^).Handle,StdInputHandle);
 
589
{$endif not Windows}
609
590
{$endif}
610
591
    InRedirDisabled:=False;
611
592
  end;
620
601
{$ifndef FPC}
621
602
    Handles^[StdOutputHandle]:=OldHandleOut;
622
603
{$else}
623
 
{$ifdef win32}
 
604
{$ifdef Windows}
624
605
    SetStdHandle(Std_Output_Handle,StdOutputHandle);
625
 
{$else not win32}
626
 
    {$ifdef ver1_0}dup2{$else}fpdup2{$endif}(TempHOut,StdOutputHandle);
627
 
{$endif not win32}
 
606
{$else not Windows}
 
607
    fpdup2(TempHOut,StdOutputHandle);
 
608
{$endif not Windows}
628
609
{$endif}
629
610
    OutRedirDisabled:=True;
630
611
  end;
640
621
    Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
641
622
    Handles^[StdOutputHandle]:=Handles^[FileRec (FOut^).Handle];
642
623
{$else}
643
 
{$ifdef win32}
 
624
{$ifdef Windows}
644
625
    SetStdHandle(Std_Output_Handle,FileRec(FOut^).Handle);
645
 
{$else not win32}
646
 
    {$ifdef ver1_0}dup2{$else}fpdup2{$endif}(FileRec(FOut^).Handle,StdOutputHandle);
647
 
{$endif not win32}
 
626
{$else not Windows}
 
627
    fpdup2(FileRec(FOut^).Handle,StdOutputHandle);
 
628
{$endif not Windows}
648
629
{$endif}
649
630
    OutRedirDisabled:=False;
650
631
  end;
659
640
    Handles^[StdErrorHandle]:=OldHandleError;
660
641
    OldHandleError:=StdErrorHandle;
661
642
{$else}
662
 
{$ifdef win32}
 
643
{$ifdef Windows}
663
644
    SetStdHandle(Std_Error_Handle,StdErrorHandle);
664
 
{$else not win32}
665
 
    {$ifdef ver1_0}dup2{$else}fpdup2{$endif}(TempHError,StdErrorHandle);
666
 
{$endif not win32}
 
645
{$else not Windows}
 
646
    fpdup2(TempHError,StdErrorHandle);
 
647
{$endif not Windows}
667
648
{$endif}
668
649
    Close (FERR^);
669
 
    {$ifdef ver1_0}fdclose{$else}fpclose{$endif}(TempHError);
 
650
    fpclose(TempHError);
670
651
    RedirChangedError:=false;
671
652
  end;
672
653
 
680
661
{$ifndef FPC}
681
662
    Handles^[StdErrorHandle]:=OldHandleError;
682
663
{$else}
683
 
{$ifdef win32}
 
664
{$ifdef Windows}
684
665
    SetStdHandle(Std_Error_Handle,StdErrorHandle);
685
 
{$else not win32}
 
666
{$else not Windows}
686
667
    {$ifdef ver1_0}dup2{$else}fpdup2{$endif}(TempHError,StdErrorHandle);
687
 
{$endif not win32}
 
668
{$endif not Windows}
688
669
{$endif}
689
670
    ErrorRedirDisabled:=True;
690
671
  end;
700
681
    Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
701
682
    Handles^[StdErrorHandle]:=Handles^[FileRec (FErr^).Handle];
702
683
{$else}
703
 
{$ifdef win32}
 
684
{$ifdef Windows}
704
685
    SetStdHandle(Std_Error_Handle,FileRec(FErr^).Handle);
705
 
{$else not win32}
 
686
{$else not Windows}
706
687
    {$ifdef ver1_0}dup2{$else}fpdup2{$endif}(FileRec(FERR^).Handle,StdErrorHandle);
707
 
{$endif not win32}
 
688
{$endif not Windows}
708
689
{$endif}
709
690
    ErrorRedirDisabled:=False;
710
691
  end;
712
693
{............................................................................}
713
694
 
714
695
function ExecuteRedir (Const ProgName, ComLine, RedirStdIn, RedirStdOut, RedirStdErr : String) : boolean;
715
 
{$ifdef win32}
 
696
{$ifdef Windows}
716
697
var
717
698
  mode : word;
718
 
{$endif win32}
 
699
{$endif Windows}
719
700
Begin
720
701
  RedirErrorOut:=0; RedirErrorIn:=0; RedirErrorError:=0;
721
702
  ExecuteResult:=0;
733
714
  ExecuteRedir:=(IOStatus=0) and (RedirErrorOut=0) and
734
715
                (RedirErrorIn=0) and (RedirErrorError=0) and
735
716
                (ExecuteResult=0);
736
 
{$ifdef win32}
 
717
{$ifdef Windows}
737
718
  // reenable mouse events
738
719
  GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @mode);
739
720
  mode:=mode or ENABLE_MOUSE_INPUT;
740
721
  SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), mode);
741
 
{$endif win32}
 
722
{$endif Windows}
742
723
End;
743
724
 
744
725
{............................................................................}
949
930
{............................................................................}
950
931
 
951
932
  procedure DosExecute(ProgName, ComLine : String);
952
 
{$ifdef win32}
 
933
{$ifdef Windows}
953
934
    var
954
935
      StoreInherit : BOOL;
955
 
{$endif win32}
 
936
{$endif Windows}
956
937
 
957
938
  Begin
958
939
{$IfDef MsDos}
963
944
{$ifdef UNIX}
964
945
    IOStatus:=0;
965
946
    ExecuteResult:=Shell(MaybeQuoted(FixPath(Progname))+' '+Comline);
966
 
  {$ifdef ver1_0}
967
 
    { Signal that causes the stop of the shell }
968
 
    IOStatus:=ExecuteResult and $7F;
969
 
    { Exit Code seems to be in the second byte,
970
 
      is this also true for BSD ??
971
 
      $80 bit is a CoreFlag apparently }
972
 
    ExecuteResult:=(ExecuteResult and $ff00) shr 8;
973
 
  {$else}
974
947
    if ExecuteResult<0 then
975
948
      begin
976
949
        IOStatus:=(-ExecuteResult) and $7f;
977
950
        ExecuteResult:=((-ExecuteResult) and $ff00) shr 8;
978
951
      end;
979
 
  {$endif}
980
952
{$else}
981
 
  {$ifdef win32}
 
953
  {$ifdef Windows}
982
954
    StoreInherit:=ExecInheritsHandles;
983
955
    ExecInheritsHandles:=true;
984
 
  {$endif win32}
 
956
  {$endif Windows}
985
957
    DosError:=0;
986
958
    If UseComSpec then
987
959
      Dos.Exec (Getenv('COMSPEC'),'/C '+MaybeQuoted(FixPath(progname))+' '+Comline)
992
964
        else
993
965
          DosError:=2;
994
966
      end;
995
 
  {$ifdef win32}
 
967
  {$ifdef Windows}
996
968
    ExecInheritsHandles:=StoreInherit;
997
 
  {$endif win32}
 
969
  {$endif Windows}
998
970
    IOStatus:=DosError;
999
971
    ExecuteResult:=DosExitCode;
1000
972
{$endif}
1021
993
finalization
1022
994
  Dispose(FIn); Dispose(FOut); Dispose(FErr);
1023
995
End.
1024
 
{
1025
 
  $Log: fpredir.pas,v $
1026
 
  Revision 1.12  2005/03/07 17:08:14  peter
1027
 
    * add quotes
1028
 
 
1029
 
  Revision 1.11  2005/02/14 17:13:18  peter
1030
 
    * truncate log
1031
 
 
1032
 
}