paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 13:38:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* allow an integer expression for SetPeFlags and SetPeOptFlags (Delphi compatible)

Browse Source 
* adjusted test to check that as well

git-svn-id: trunk@47602 -
This commit is contained in:
svenbarth 2020-11-26 20:13:40 +00:00
parent a8d316d187
commit 903486642e
2 changed files with 22 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
compiler/scandir.pas
View File

@ -1339,30 +1339,32 @@ unit scandir;
procedure dir_setpeflags;
var
ident : string;
flags : int64;
begin
if not (target_info.system in (systems_all_windows)) then
Message(scan_w_setpeflags_not_support);
current_scanner.skipspace;
ident:=current_scanner.readid;
if ident<>'' then
peflags:=peflags or get_peflag_const(ident,scan_e_illegal_peflag)
else
peflags:=peflags or current_scanner.readval;
if current_scanner.readpreprocint(flags,'SETPEFLAGS') then
begin
if flags>$ffff then
message(scan_e_illegal_peflag);
peflags:=peflags or uint16(flags);
end;
SetPEFlagsSetExplicity:=true;
end;
procedure dir_setpeoptflags;
var
ident : string;
flags : int64;
begin
if not (target_info.system in (systems_all_windows)) then
Message(scan_w_setpeoptflags_not_support);
current_scanner.skipspace;
ident:=current_scanner.readid;
if ident<>'' then
peoptflags:=peoptflags or get_peflag_const(ident,scan_e_illegal_peoptflag)
else
peoptflags:=peoptflags or current_scanner.readval;
if current_scanner.readpreprocint(flags,'SETPEOPTFLAGS') then
begin
if flags>$ffff then
message(scan_e_illegal_peoptflag);
peoptflags:=peoptflags or uint16(flags);
end;
SetPEOptFlagsSetExplicity:=true;
end;

8
tests/tbs/tb0596.pp
View File

@ -5,13 +5,21 @@ program tb0596;
const
IMAGE_FILE_LARGE_ADDRESS_AWARE = $0020;
IMAGE_REMOVABLE_RUN_FROM_SWAP = $0400;
IMAGE_NET_RUN_FROM_SWAP = $0800;
IMAGE_DLLCHARACTERISTICS_NO_ISOLATION = $0200;
IMAGE_DLLCHARACTERISTICS_APPCONTAINER = $1000;
IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000;
{$setpeflags IMAGE_FILE_LARGE_ADDRESS_AWARE}
{$setpeflags $0800}
{$setpeflags IMAGE_REMOVABLE_RUN_FROM_SWAP or IMAGE_NET_RUN_FROM_SWAP}
{$setpeflags $0008 or $0004}
{$setpeoptflags IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE}
{$setpeoptflags $0040}
{$setpeoptflags IMAGE_DLLCHARACTERISTICS_APPCONTAINER or IMAGE_DLLCHARACTERISTICS_NO_ISOLATION}
{$setpeoptflags $0008 or $0004}
begin