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

+ chck 1779 bug

Browse Source
This commit is contained in:
pierre 2002-09-03 10:20:05 +00:00
parent 48f8b4cfca
commit 62b9c476c1
1 changed files with 34 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
tests/webtbs/tw1779.pp Normal file
View File

@ -0,0 +1,34 @@
{ 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}
var
c1,c : coord;
y : dword;
begin
{$ifdef win32}
longint(c):=GetStdHandle(STD_OUTPUT_HANDLE);
c1:=GetLargestConsoleWindowSize(GetStdHandle(STD_OUTPUT_HANDLE));
Writeln('Max window size is ',c1.x,'x',c1.y);
y:=GetLargestConsoleWindowSizeAlternate(GetStdHandle(STD_OUTPUT_HANDLE));
c.x := y and $ffff;
c.y:= y shr 16;
Writeln('Max window size is ',c.x,'x',c.y);
if (c.x<>c1.X) or (c.Y<>c1.y) then
begin
Writeln('RTL bug');
Halt(1);
end;
{$else not win32}
Writeln('Bug 1779 is win32 specific');
{$endif win32}
end.