Browse Source

* changed $ifdefs to %target
* removed obsolete dpmiexcp unit for go32v2

peter 22 years ago
parent
commit
06c7671945

+ 0 - 5
tests/tbf/tb0044.pp

@@ -2,11 +2,6 @@
 { Old file: tbf0230.pp }
 { several strange happen on the ln function: ln(0): no FPE and writeln can't write non numeric values Gives out an exception on compiling because of zero div OK 0.99.11 (PM) }
 
-{$ifdef go32v2}
-uses
-   dpmiexcp;
-{$endif}
-
 var
    e : extended;
 

+ 0 - 5
tests/tbf/tb0056.pp

@@ -4,11 +4,6 @@
 
 program test_loc_mem;
 
-{$ifdef go32v2}
-  uses
-    dpmiexcp;
-{$endif go32v2}
-
 var l1,l2 : longint;
 begin
   l1+l2:=l1+l2;

+ 0 - 6
tests/tbs/tb0014.pp

@@ -1,12 +1,6 @@
 { Old file: tbs0017.pp }
 {  }
 
-
-{$ifdef go32v2}
-   uses dpmiexcp;
-
-{$endif go32v2}
-
 const
       nextoptpass : longint = 0;
   procedure init;

+ 1 - 15
tests/tbs/tb0032.pp

@@ -1,29 +1,17 @@
 { %GRAPH }
+{ %TARGET=go32v2,win32,linux }
 
 { Old file: tbs0037.pp }
 {  tests missing graph.setgraphmode                    OK RTL (FK) }
 
-{$ifdef go32v2}
-{$define OK}
-{$endif}
-{$ifdef Unix}
-{$define OK}
-{$endif}
-{$ifdef win32}
-{$define OK}
-{$endif}
-
-{$ifdef OK}
 uses
    graph,
    crt;
 
 var
    gd,gm,res : integer;
-{$endif OK}
 
 begin
-{$ifdef OK}
    gd:=detect;
    initgraph(gd,gm,'');
    res := graphresult;
@@ -49,6 +37,4 @@ begin
    {readkey;}
    delay(1000);
    closegraph;
-{$endif OK}
 end.
-

+ 2 - 0
tests/tbs/tb0038.pp

@@ -1,5 +1,7 @@
 { %CPU=i386 }
+{ %TARGET=go32v2,win32,linux }
 { %NOTE=This test requires an installed Nasm }
+
 { Old file: tbs0043.pp }
 {  shows assembler nasm output fpu opcodes problem     OK 0.99.6 (PFV) }
 

+ 0 - 7
tests/tbs/tb0041.pp

@@ -5,13 +5,6 @@ program test;
 
 {$R-}
 
-{$ifdef fpc}
-{$ifdef go32v2}
-uses
-   dpmiexcp;
-{$endif}
-{$endif}
-
 type byteset = set of byte;
      bl = record i,j : longint;
           end;

+ 1 - 14
tests/tbs/tb0043.pp

@@ -1,19 +1,9 @@
 { %GRAPH }
+{ %TARGET=go32v2,win32,linux }
 
 { Old file: tbs0048.pp }
 {  shows a problem with putimage on some computers       OK 0.99.13 (JM) }
 
-{$ifdef go32v2}
-{$define OK}
-{$endif}
-{$ifdef Unix}
-{$define OK}
-{$endif}
-{$ifdef win32}
-{$define OK}
-{$endif}
-
-{$ifdef OK}
 uses
    graph,crt;
 
@@ -21,10 +11,8 @@ var
    gd,gm : integer;
    i,size : longint;
    p : pointer;
-{$endif OK}
 
 begin
-{$ifdef OK}
    gd:=detect;
    initgraph(gd,gm,'');
    setcolor(brown);
@@ -45,5 +33,4 @@ begin
      end;
    {readkey;}delay(1000);
    closegraph;
-{$endif OK}
 end.

+ 1 - 21
tests/tbs/tb0045.pp

@@ -1,4 +1,5 @@
 { %GRAPH }
+{ %TARGET=go32v2,win32,linux }
 
 { Old file: tbs0051.pp }
 {  Graph, shows a problem with putpixel                 OK 0.99.9 (PM) }
@@ -7,14 +8,6 @@
   {define has_colors_equal}
 {$endif go32v2}
 
-{$ifdef go32v2}
-{$define OK}
-{$endif}
-{$ifdef Unix}
-{$define OK}
-{$endif}
-
-{$ifdef OK}
 uses  crt,graph;
 
 {$ifndef has_colors_equal}
@@ -32,9 +25,7 @@ var   gd,gm,gError,yi,i : integer;
       col: longint;
       error : word;
 
-{$endif OK}
 BEGIN
-{$ifdef OK}
   if paramcount=0 then
     gm:=$111   {640x480/64K  HiColor}
   else
@@ -70,15 +61,4 @@ BEGIN
   {readkey;}delay(1000);
 
   closegraph;
-{$endif OK}
 END.
-
-{
-  $Log$
-  Revision 1.3  2002-09-07 15:40:43  peter
-    * old logs removed and tabs fixed
-
-  Revision 1.2  2002/06/01 19:08:52  marco
-   * Renamefest
-
-}

+ 1 - 14
tests/tbs/tb0046.pp

@@ -1,19 +1,9 @@
 { %GRAPH }
+{ %TARGET=go32v2,win32,linux}
 
 { Old file: tbs0052.pp }
 {  Graph, collects missing graph unit routines          OK 0.99.9 (PM) }
 
-{$ifdef go32v2}
-{$define OK}
-{$endif}
-{$ifdef Unix}
-{$define OK}
-{$endif}
-{$ifdef win32}
-{$define OK}
-{$endif}
-
-{$ifdef OK}
 uses
   crt,graph;
 
@@ -26,9 +16,7 @@ const
     (X: 275; Y: 150), (X: 280; Y : 50), (X:295; Y : 80) );
 
 var Gd, Gm: Integer;
-{$endif OK}
 begin
-{$ifdef OK}
   Gd := Detect;
   InitGraph(Gd, Gm, 'c:\bp\bgi');
   if GraphResult <> grOk then
@@ -50,5 +38,4 @@ begin
   graphdefaults;
   {readln;}delay(1000);
   CloseGraph;
-{$endif OK}
 end.

+ 1 - 14
tests/tbs/tb0051.pp

@@ -1,28 +1,16 @@
 { %GRAPH }
+{ %TARGET=go32v2,win32,linux }
 
 { Old file: tbs0057.pp }
 {  Graph, shows a crash with switch graph/text/graph    OK 0.99.9 (PM) }
 
-{$ifdef go32v2}
-{$define OK}
-{$endif}
-{$ifdef Unix}
-{$define OK}
-{$endif}
-{$ifdef win32}
-{$define OK}
-{$endif}
-
-{$ifdef OK}
 uses
    graph,crt;
 
 var
    gd,gm : integer;
 
-{$endif OK}
 begin
-{$ifdef OK}
    gd:=detect;
    gm:=$103;
    initgraph(gd,gm,'');
@@ -34,6 +22,5 @@ begin
    line(100,100,1,100);
    {readkey;}delay(1000);
    closegraph;
-{$endif OK}
    writeln('OK');
 end.

+ 0 - 5
tests/tbs/tb0088.pp

@@ -1,11 +1,6 @@
 { Old file: tbs0104.pp }
 { cardinal greater than $7fffffff aren't written        OK 0.99.1 (FK) }
 
-{$ifdef go32v2}
-uses
-   dpmiexcp;
-{$endif}
-
 { Two cardinal type bugs }
 var
   c : cardinal;

+ 2 - 12
tests/tbs/tb0089.pp

@@ -1,17 +1,10 @@
+{ %TARGET=go32v2,linux }
+
 { Old file: tbs0105.pp }
 { typecasts are now ignored problem (NOT A bugs)         OK 0.99.1 }
 
-{$ifdef go32v2}
-{$define OK}
-{$endif}
-{$ifdef Unix}
-{$define OK}
-{$endif}
-
 { Win32 signal support is still missing ! }
 
-{$ifdef OK}
-
 {$ifdef go32v2}
  uses dpmiexcp;
 {$endif go32v2}
@@ -34,9 +27,7 @@
 Var
  Sel: Word;
  v: pointer;
-{$endif OK}
 Begin
-{$ifdef OK}
  Signal(SIGSEGV,signalhandler(@our_sig));
  { generate a sigsegv by writing to null-address }
  sel:=0;
@@ -49,5 +40,4 @@ Begin
  { we should not go to here }
  Writeln('Error : signal not called');
  Halt(1);
-{$endif OK}
 end.

+ 0 - 5
tests/tbs/tb0091.pp

@@ -6,11 +6,6 @@
 
 Program Test1;
 
-{$ifdef go32v2}
-uses
-   dpmiexcp;
-{$endif}
-
 type
  myObject = object
    constructor init;

+ 2 - 18
tests/tbs/tb0164.pp

@@ -1,30 +1,15 @@
 { %GRAPH }
+{ %TARGET=go32v2,win32,linux }
 
 { Old file: tbs0195.pp }
 { Problem with Getimage, crash of DOS box, even with dpmiexcp!! (PFV) Not a bugs, you must use p^. }
 
-{$ifdef go32v2}
-{$define OK}
-{$endif}
-{$ifdef Unix}
-{$define OK}
-{$endif}
-{$ifdef win32}
-{$define OK}
-{$endif}
-
-{$ifdef OK}
-uses graph
-{$ifdef go32v2}
-,dpmiexcp
-{$endif go32v2};
+uses graph;
 var
    GDriver, GMode: Integer;
    w:word;
    p:pointer;
-{$endif OK}
 begin
-{$ifdef OK}
    GDriver := $FF;
    GMode := $101;
    InitGraph(GDriver, GMode, '');
@@ -45,5 +30,4 @@ begin
    freemem(p, w);
    closegraph;
    readln;
-{$endif OK}
 end.

+ 0 - 4
tests/tbs/tb0182.pp

@@ -8,10 +8,6 @@
 
 Program X;
 
-{$ifdef go32v2}
-  uses dpmiexcp;
-{$endif go32v2}
-
 Type
    PY=^Y;
    Y=Object

+ 1 - 3
tests/tbs/tb0203.pp

@@ -3,10 +3,8 @@
 
 {$mode delphi}
   uses
-{$ifdef go32v2}
-    dpmiexcp,
-{$endif go32v2}
     sysutils;
+
    type
      ttest=class
      end;

+ 6 - 8
tests/tbs/tb0205.pp

@@ -1,19 +1,17 @@
+{ %TARGET=win32 }
+
 { Old file: tbs0241.pp }
 { Problem with importing function from a DLL with .drv suffix ! OK 0.99.11 (PM) }
 
-{$ifdef win32}
 program test_win32_drv;
 
 procedure printer;external 'winspool.drv' name 'AbortPrinter';
-procedure test;
 
- begin
-   Writeln('Loading of Winspool works ');
- end;
+procedure test;
+begin
+  Writeln('Loading of Winspool works ');
+end;
 
 begin
   test;
-{$else}
-begin
-{$endif}
 end.

+ 2 - 11
tests/tbs/tb0225.pp

@@ -1,14 +1,9 @@
+{ %TARGET=win32,linux }
 { %NORUN }
+
 { Old file: tbs0263.pp }
 { export directive is not necessary in delphi anymore  OK 0.99.13 (PFV) }
 
-{$ifdef Unix}
-  {$define doit}
-{$endif}
-{$ifdef win32}
-  {$define doit}
-{$endif}
-{$ifdef doit}
 library tb0225;
 
 {
@@ -24,7 +19,3 @@ exports
   testp name 'testp';
 
 end.
-{$else}
-begin
-end.
-{$endif}

+ 0 - 5
tests/tbs/tb0240.pp

@@ -6,11 +6,6 @@
 
 program memhole;
 
-{$ifdef go32v2}
-uses
-   dpmiexcp;
-{$endif go32v2}
-
 type
   TMyClass = class
     s: String;

+ 0 - 5
tests/tbs/tb0257.pp

@@ -3,11 +3,6 @@
 
 program test_int;
 
-{$ifdef go32v2}
-  uses
-    dpmiexcp;
-{$endif go32v2}
-
 procedure int;interrupt;
 begin
 end;

+ 2 - 7
tests/tbs/tb0262.pp

@@ -3,13 +3,8 @@
 
 {$mode objfpc}
 uses
-(* sysutils does not work correctly with DPMIEXCP unit
-  anyway, its not needed anymore
-  since the exception handler is now in system unit
-{$ifdef go32v2}
-dpmiexcp,
-{$endif} *)
-sysutils;
+  sysutils;
+
 var i,j,k:real;
 const except_called : boolean = false;
 begin

+ 1 - 2
tests/tbs/tb0304.pp

@@ -1,5 +1,5 @@
+{ %TARGET=win32 }
 { %NORUN }
-{$ifdef win32}
 library test;
 
   procedure exporttest;export;
@@ -8,7 +8,6 @@ library test;
     end;
 
   exports exporttest;
-{$endif}
 
 begin
 end.

+ 1 - 7
tests/tbs/tb0359.pp

@@ -1,6 +1,5 @@
 { %version=1.1 }
-
-{$ifdef unix}
+{ %TARGET=linux }
 
 {$linklib c}
 
@@ -16,9 +15,4 @@ begin
 
   t:=@printf;
   t('Procvar test %d %s %f'#10,2,'test',1234.5678);
-
-{$else}
-begin
-  writeln('Unix only test');
-{$endif}
 end.

+ 1 - 0
tests/webtbs/tw0711.pp

@@ -1,4 +1,5 @@
 { %GRAPH }
+{ %TARGET=go32v2,win32,linux }
 
 program TestGetPutim; {Compiled with the 0.99.13 version under GO32V2!}
 

+ 1 - 3
tests/webtbs/tw0753.pp

@@ -4,10 +4,8 @@
 {$H+}
 program stackcrash;
 uses
-{$ifdef go32v2}
-  dpmiexcp,
-{$endif go32v2}
   sysutils;
+
 type
   TMyClass = class
   public

+ 0 - 2
tests/webtbs/tw0812.pp

@@ -1,7 +1,5 @@
 program TestVm2;
 
-{$IFDEF WIN32}{$APPTYPE CONSOLE}{$ENDIF}
-
 procedure Test;
 var
   P: Pointer;

+ 0 - 2
tests/webtbs/tw0813.pp

@@ -1,7 +1,5 @@
 program TestVm2;
 
-{$IFDEF WIN32}{$APPTYPE CONSOLE}{$ENDIF}
-
 procedure Test;
 var
   P: Pointer;

+ 0 - 5
tests/webtbs/tw0922.pp

@@ -1,10 +1,5 @@
 program test;
 
-{$ifdef win32}
-uses
-  windows;
-{$endif }
-
 procedure write1(  var charbuf:string);
 begin
   Writeln(Charbuf);

+ 1 - 11
tests/webtbs/tw0925.pp

@@ -1,23 +1,13 @@
 { %CPU=i386 }
+
 {$asmmode intel}
 
-{$ifdef go32v2}
   PROCEDURE Cursor(Form: word);assembler;
-  asm
-     mov cx,word ptr[Form]
-     and cx,1F1Fh
-     mov ah,1
-     int 10h
-  end;
-{$else not go32v2}
-  { no interrupt call on other targets }
-  procedure cursor(form : word);assembler;
   asm
      mov cx,word ptr[Form]
      and cx,1F1Fh
      mov ah,1
   end;
-{$endif go32v2}
 
 begin
   Cursor($11F);

+ 1 - 12
tests/webtbs/tw0966.pp

@@ -1,15 +1,8 @@
 { %INTERACTIVE }
+{ %TARGET=win32,linux }
 
 { Source provided for Free Pascal Bug Report 966 }
 {$i-}
-{$ifdef Unix}
-{$define has_sockets}
-{$endif Unix}
-{$ifdef win32}
-{$define has_sockets}
-{$endif win32}
-
-{$ifdef has_sockets}
 uses
 {$ifdef Unix}
   linux,
@@ -77,8 +70,4 @@ begin
   Write(Sout,'QUIT'#10);
   read_to_eof;
   shutdown(s,2); close(sin); close(sout);
-{$else : not has_sockets}
-begin
-  Writeln('No sockets unit for this target');
-{$endif has_sockets}
 end.

+ 4 - 6
tests/webtbs/tw1375.pp

@@ -1,20 +1,18 @@
+{ %target=win32 }
+
 { Source provided for Free Pascal Bug Report 1375 }
 { Submitted by "Bill Rayer" on  2001-02-01 }
 { e-mail: [email protected] }
-(*
+{
 Should be able to use null ptr as 2nd param of InvalidateRect()
 Compiles in Delphi 4:
   dcc32 fpc1
 Does not compile in FPC:
   ppc386 -Sd fpc1
-*)
+}
 
 program test1;
-{$ifdef win32}
 uses windows;
-{$endif}
 begin
-{$ifdef win32}
   InvalidateRect (HWND(0), pointer(0), TRUE);
-{$endif}
 end.

+ 2 - 5
tests/webtbs/tw1398.pp

@@ -1,4 +1,5 @@
-{$ifdef win32}
+{ %target=win32 }
+
 uses Windows;
 
 function Enum_FindTaskWindow (hWindow:HWND; lpar:LPARAM) : boolean; export; stdcall;
@@ -10,8 +11,4 @@ var dwThread:DWORD;
 begin
   dwThread := GetCurrentThreadId;
   EnumTaskWindows (dwThread, @Enum_FindTaskWindow, LPARAM(NULL));
-
-{$else}
-begin
-{$endif}
 end.

+ 1 - 5
tests/webtbs/tw1696.pp

@@ -1,6 +1,6 @@
 { %version=1.1 }
+{ %target=win32 }
 
-{$ifdef Win32}
 Uses Windows;
 Var Font:HFONT;
 Begin
@@ -19,10 +19,6 @@ Begin
                     PROOF_QUALITY,
                     FF_DONTCARE Or DEFAULT_PITCH,
                     'Verdana');
-{$else}
-begin
-  Writeln('Win32 only');
-{$endif}
 End.
 
 

+ 1 - 8
tests/webtbs/tw1779.pp

@@ -1,16 +1,14 @@
+{ %target=win32 }
 { Source provided for Free Pascal Bug Report 1779 }
 { Submitted by "Pierre" on  2002-01-25 }
 { e-mail: [email protected] }
 
-{$ifdef win32}
 uses
   windows;
 
 function GetLargestConsoleWindowSizeAlternate(h : longint) : dword;
   external 'kernel32' name 'GetLargestConsoleWindowSize';
-{$endif win32}
 
-{$ifdef win32}
 var
   c1,c : coord;
   y : dword;
@@ -27,9 +25,4 @@ begin
       Writeln('RTL bug');
       Halt(1);
     end;
-end.    
-{$else not win32}
-begin
-  Writeln('Bug 1779 is win32 specific');
 end.
-{$endif win32}

+ 2 - 6
tests/webtbs/tw1808.pp

@@ -1,14 +1,10 @@
-{$ifdef win32}
+{ %target=win32 }
+
 uses
   windows;
-{$endif win32}
 
 var
   x : DWORD;
 begin
-{$ifdef win32}
   x:=CommDlgExtendedError;
-{$else not win32}
-  x:=0;
-{$endif win32}
 end.

+ 3 - 6
tests/webtbs/tw1820.pp

@@ -1,11 +1,10 @@
 { %version=1.1 }
+{ %TARGET=win32 }
 unit tw1820;
-
 interface
 
-{$ifdef win32}
-
 {$mode Delphi}
+
 Uses Windows;
 
 type
@@ -17,8 +16,6 @@ type
 const
   IEnumTasks = IEnumWorkItems;
 
-{$endif}
-
-  implementation
+implementation
 
 end.

+ 2 - 6
tests/webtbs/tw1873.pp

@@ -1,13 +1,9 @@
-{$ifdef win32}
+{ %target=win32 }
+
 uses Windows,ub1873;
 var
   s : SC_handle;
   d : dword;
 begin
   GetServiceDisplayNameA(s,nil,nil,d);
-{$else}
-begin
-  writeln('win32 only');
-{$endif}
 end.
-

+ 2 - 4
tests/webtbs/tw1964.pp

@@ -1,3 +1,5 @@
+{ %target=win32 }
+
   uses  DOS;
   var
     error : boolean;
@@ -14,7 +16,6 @@
        error:=true;
     end;
   begin
-{$ifdef Win32}
     Expand('C:\Windows1\System');
     Expand('\\.\C\Windows1\System');
     Expand('C:\Windows1\System');
@@ -23,8 +24,5 @@
        Writeln('ERROR!');
        Halt(1);
      end;
-{$else}
-   Writeln('Win32 only test');
-{$endif}
   end.
 

+ 2 - 0
tests/webtbs/tw2046.pp

@@ -1,3 +1,5 @@
+{ %skiptarget=go32v2 }
+
 { Source provided for Free Pascal Bug Report 2046 }
 { Submitted by "Mattias Gaertner" on  2002-07-17 }
 { e-mail: [email protected] }