mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 11:49:23 +02:00
+ test for windows which tests if an .rc file can be really compiled into an .res file
git-svn-id: trunk@27042 -
This commit is contained in:
parent
2c5a0ffc89
commit
c9f7c7d88c
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -12334,6 +12334,8 @@ tests/test/units/system/tres3.pp svneol=native#text/plain
|
||||
tests/test/units/system/tres3ext.pp svneol=native#text/plain
|
||||
tests/test/units/system/tres4.pp svneol=native#text/plain
|
||||
tests/test/units/system/tres4.res -text
|
||||
tests/test/units/system/tres5.pp svneol=native#text/plain
|
||||
tests/test/units/system/tres5.rc svneol=native#text/plain
|
||||
tests/test/units/system/tresb.rc svneol=native#text/plain
|
||||
tests/test/units/system/tresb.res -text
|
||||
tests/test/units/system/tresext.pp svneol=native#text/plain
|
||||
|
61
tests/test/units/system/tres5.pp
Normal file
61
tests/test/units/system/tres5.pp
Normal file
@ -0,0 +1,61 @@
|
||||
{ Test for resources support from .rc files. }
|
||||
|
||||
{%TARGET=win32,win64}
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
uses sysutils;
|
||||
|
||||
{$R tres5.rc}
|
||||
|
||||
procedure Fail(const Msg: string);
|
||||
begin
|
||||
writeln(Msg);
|
||||
Halt(1);
|
||||
end;
|
||||
|
||||
function GetResource(ResourceName, ResourceType: PChar; PResSize: PLongInt = nil): pointer;
|
||||
var
|
||||
hRes: TFPResourceHandle;
|
||||
gRes: TFPResourceHGLOBAL;
|
||||
begin
|
||||
hRes:=FindResource(HINSTANCE, ResourceName, ResourceType);
|
||||
if hRes = 0 then
|
||||
Fail('FindResource failed.');
|
||||
gRes:=LoadResource(HINSTANCE, hRes);
|
||||
if gRes = 0 then
|
||||
Fail('LoadResource failed.');
|
||||
if PResSize <> nil then begin
|
||||
PResSize^:=SizeofResource(HINSTANCE, hRes);
|
||||
if PResSize^ = 0 then
|
||||
Fail('SizeofResource failed.');
|
||||
end;
|
||||
Result:=LockResource(gRes);
|
||||
if Result = nil then
|
||||
Fail('LockResource failed.');
|
||||
end;
|
||||
|
||||
procedure DoTest;
|
||||
var
|
||||
s: string;
|
||||
p: PChar;
|
||||
sz: longint;
|
||||
begin
|
||||
p:=GetResource('TestFile', 'FILE', @sz);
|
||||
SetString(s, p, sz);
|
||||
if s <> 'test file.' then
|
||||
Fail('Invalid resource loaded.');
|
||||
writeln(s);
|
||||
|
||||
p:=GetResource('Test', 'TEXT', @sz);
|
||||
SetString(s, p, sz);
|
||||
if s <> 'Another test file.' then
|
||||
Fail('Invalid resource loaded.');
|
||||
writeln(s);
|
||||
end;
|
||||
|
||||
begin
|
||||
writeln('Resources test.');
|
||||
DoTest;
|
||||
writeln('Done.');
|
||||
end.
|
2
tests/test/units/system/tres5.rc
Normal file
2
tests/test/units/system/tres5.rc
Normal file
@ -0,0 +1,2 @@
|
||||
TestFile FILE "tres1.txt"
|
||||
Test TEXT "tres2.txt"
|
Loading…
Reference in New Issue
Block a user