paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-03 13:11:24 +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; procedure dir_setpeflags;
var var
ident : string; ident : string;
flags : int64;
begin begin
if not (target_info.system in (systems_all_windows)) then if not (target_info.system in (systems_all_windows)) then
Message(scan_w_setpeflags_not_support); Message(scan_w_setpeflags_not_support);
current_scanner.skipspace; if current_scanner.readpreprocint(flags,'SETPEFLAGS') then
ident:=current_scanner.readid; begin
if ident<>'' then if flags>$ffff then
peflags:=peflags or get_peflag_const(ident,scan_e_illegal_peflag) message(scan_e_illegal_peflag);
else peflags:=peflags or uint16(flags);
peflags:=peflags or current_scanner.readval; end;
SetPEFlagsSetExplicity:=true; SetPEFlagsSetExplicity:=true;
end; end;
procedure dir_setpeoptflags; procedure dir_setpeoptflags;
var var
ident : string; ident : string;
flags : int64;
begin begin
if not (target_info.system in (systems_all_windows)) then if not (target_info.system in (systems_all_windows)) then
Message(scan_w_setpeoptflags_not_support); Message(scan_w_setpeoptflags_not_support);
current_scanner.skipspace; if current_scanner.readpreprocint(flags,'SETPEOPTFLAGS') then
ident:=current_scanner.readid; begin
if ident<>'' then if flags>$ffff then
peoptflags:=peoptflags or get_peflag_const(ident,scan_e_illegal_peoptflag) message(scan_e_illegal_peoptflag);
else peoptflags:=peoptflags or uint16(flags);
peoptflags:=peoptflags or current_scanner.readval; end;
SetPEOptFlagsSetExplicity:=true; SetPEOptFlagsSetExplicity:=true;
end; end;

8
tests/tbs/tb0596.pp
View File

@ -5,13 +5,21 @@ program tb0596;
const const
IMAGE_FILE_LARGE_ADDRESS_AWARE = $0020; 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; IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000;
{$setpeflags IMAGE_FILE_LARGE_ADDRESS_AWARE} {$setpeflags IMAGE_FILE_LARGE_ADDRESS_AWARE}
{$setpeflags $0800} {$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 IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE}
{$setpeoptflags $0040} {$setpeoptflags $0040}
{$setpeoptflags IMAGE_DLLCHARACTERISTICS_APPCONTAINER or IMAGE_DLLCHARACTERISTICS_NO_ISOLATION}
{$setpeoptflags $0008 or $0004}
begin begin