paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-19 07:49:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

* changed $ifdefs to %target

Browse Source 
* removed obsolete dpmiexcp unit for go32v2
This commit is contained in:
peter 2002-12-24 22:31:26 +00:00
parent 93115c82d7
commit 06c7671945
39 changed files with 47 additions and 274 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
tests/tbf/tb0044.pp
View File

@ -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;

5
tests/tbf/tb0056.pp
View File

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

6
tests/tbs/tb0014.pp
View File

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

16
tests/tbs/tb0032.pp
View File

@ -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
tests/tbs/tb0038.pp
View File

@ -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) }

7
tests/tbs/tb0041.pp
View File

@ -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;

15
tests/tbs/tb0043.pp
View File

@ -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.

22
tests/tbs/tb0045.pp
View File

@ -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
}

15
tests/tbs/tb0046.pp
View File

@ -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.

15
tests/tbs/tb0051.pp
View File

@ -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.

5
tests/tbs/tb0088.pp
View File

@ -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;

14
tests/tbs/tb0089.pp
View File

@ -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.

5
tests/tbs/tb0091.pp
View File

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

20
tests/tbs/tb0164.pp
View File

@ -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.

4
tests/tbs/tb0182.pp
View File

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

4
tests/tbs/tb0203.pp
View File

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

14
tests/tbs/tb0205.pp
View File

@ -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.

13
tests/tbs/tb0225.pp
View File

@ -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}

5
tests/tbs/tb0240.pp
View File

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

5
tests/tbs/tb0257.pp
View File

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

9
tests/tbs/tb0262.pp
View File

@ -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

3
tests/tbs/tb0304.pp
View File

@ -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.

8
tests/tbs/tb0359.pp
View File

@ -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
tests/webtbs/tw0711.pp
View File

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

4
tests/webtbs/tw0753.pp
View File

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

2
tests/webtbs/tw0812.pp
View File

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

2
tests/webtbs/tw0813.pp
View File

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

5
tests/webtbs/tw0922.pp
View File

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

12
tests/webtbs/tw0925.pp
View File

@ -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);

13
tests/webtbs/tw0966.pp
View File

@ -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.

10
tests/webtbs/tw1375.pp
View File

@ -1,20 +1,18 @@
{ %target=win32 }
{ Source provided for Free Pascal Bug Report 1375 }
{ Submitted by "Bill Rayer" on 2001-02-01 }
{ e-mail: lingolanguage@hotmail.com }
(*
{
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.

7
tests/webtbs/tw1398.pp
View File

@ -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.

6
tests/webtbs/tw1696.pp
View File

@ -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.

9
tests/webtbs/tw1779.pp
View File

@ -1,16 +1,14 @@
{ %target=win32 }
{ Source provided for Free Pascal Bug Report 1779 }
{ Submitted by "Pierre" on 2002-01-25 }
{ e-mail: pierre@freepascal.org }
{$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}

8
tests/webtbs/tw1808.pp
View File

@ -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.

9
tests/webtbs/tw1820.pp
View File

@ -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.

8
tests/webtbs/tw1873.pp
View File

@ -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.

6
tests/webtbs/tw1964.pp
View File

@ -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
tests/webtbs/tw2046.pp
View File

@ -1,3 +1,5 @@
{ %skiptarget=go32v2 }
{ Source provided for Free Pascal Bug Report 2046 }
{ Submitted by "Mattias Gaertner" on 2002-07-17 }
{ e-mail: nc-gaertnma@netcologne.de }