Add support for integer constants to SetPEFlags and SetPEOptFlags. This is Delphi compatible.

scandir.pas:
  + add function "get_peflag_const" to retrieve the value of a constant
  * dir_setpeflags & dir_setpeoptflags: first check for an identifier (value is retrieved through "get_peflag_const") and then read a value

+ added messages for illegal parameters for SetPEFlags and SetPEOptFlags respectively
+ added tests

git-svn-id: trunk@24887 -

.gitattributes

@@ -9370,6 +9370,10 @@ tests/tbf/tb0231.pp svneol=native#text/pascal
 tests/tbf/tb0232.pp svneol=native#text/pascal
 tests/tbf/tb0233.pp svneol=native#text/pascal
 tests/tbf/tb0234.pp svneol=native#text/pascal
+tests/tbf/tb0235.pp svneol=native#text/pascal
+tests/tbf/tb0236.pp svneol=native#text/pascal
+tests/tbf/tb0237.pp svneol=native#text/pascal
+tests/tbf/tb0238.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
@@ -9966,6 +9970,7 @@ tests/tbs/tb0592.pp svneol=native#text/plain
 tests/tbs/tb0593.pp svneol=native#text/pascal
 tests/tbs/tb0594.pp svneol=native#text/plain
 tests/tbs/tb0595.pp svneol=native#text/plain
+tests/tbs/tb0596.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tbs0594.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain

compiler/msg/errore.msg

@@ -136,7 +136,7 @@ general_f_oserror=01025_F_Operating system error: $1
 #
 # Scanner
 #
-# 02091 is the last used one
+# 02094 is the last used one
 #
 % \section{Scanner messages.}
 % This section lists the messages that the scanner emits. The scanner takes
@@ -388,6 +388,12 @@ scan_w_unavailable_system_codepage=02091_W_Current system codepage "$1" is not a
 % the compiler with support for this codepage.
 scan_w_setpeoptflags_not_support=02092_W_SETPEOPTFLAGS is not supported by the target OS
 % The \var{\{\$SETPEOPTFLAGS\}} directive is not supported by the target OS.
+scan_e_illegal_peflag=02093_E_Illegal argument for SETPEFLAGS
+% The given argument for SETPEFLAGS is neither a correct named value nor an
+% ordinal value
+scan_e_illegal_peoptflag=02094_E_Illegal argument for SETPEOPTFLAGS
+% The given argument for SETPEOPTFLAGS is neither a correct named value nor an
+% ordinal value
 % \end{description}
 #
 # Parser

compiler/msgidx.inc

@@ -114,6 +114,8 @@ const
   scanner_w_directive_ignored_on_target=02090;
   scan_w_unavailable_system_codepage=02091;
   scan_w_setpeoptflags_not_support=02092;
+  scan_e_illegal_peflag=02093;
+  scan_e_illegal_peoptflag=02094;
   parser_e_syntax_error=03000;
   parser_e_dont_nest_interrupt=03004;
   parser_w_proc_directive_ignored=03005;
@@ -973,9 +975,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 68987;
+  MsgTxtSize = 69070;
 
   MsgIdxMax : array[1..20] of longint=(
-    26,93,334,121,88,56,126,27,202,63,
+    26,95,334,121,88,56,126,27,202,63,
     54,20,1,1,1,1,1,1,1,1
   );

compiler/scandir.pas

@@ -56,7 +56,8 @@ unit scandir;
       verbose,comphook,ppu,
       scanner,switches,
       fmodule,
-      symconst,symtable,
+      defutil,
+      symconst,symtable,symbase,symtype,symsym,
       rabase;
 
 {*****************************************************************************
@@ -1084,21 +1085,54 @@ unit scandir;
         do_localswitch(cs_scopedenums);
       end;
 
+    function get_peflag_const(const ident:string;error:longint):longint;
+      var
+        srsym : tsym;
+        srsymtable : tsymtable;
+      begin
+        result:=0;
+        if searchsym(ident,srsym,srsymtable) then
+          if (srsym.typ=constsym) and
+              (tconstsym(srsym).consttyp=constord) and
+              is_integer(tconstsym(srsym).constdef) then
+            with tconstsym(srsym).value.valueord do
+              if signed then
+                result:=tconstsym(srsym).value.valueord.svalue
+              else
+                result:=tconstsym(srsym).value.valueord.uvalue
+          else
+            message(error)
+        else
+          message1(sym_e_id_not_found,ident);
+      end;
+
     procedure dir_setpeflags;
+      var
+        ident : string;
       begin
         if not (target_info.system in (systems_all_windows)) then
           Message(scan_w_setpeflags_not_support);
         current_scanner.skipspace;
-        peflags:=peflags or current_scanner.readval;
+        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;
         SetPEFlagsSetExplicity:=true;
       end;
 
     procedure dir_setpeoptflags;
+      var
+        ident : string;
       begin
         if not (target_info.system in (systems_all_windows)) then
           Message(scan_w_setpeoptflags_not_support);
         current_scanner.skipspace;
-        peoptflags:=peoptflags or current_scanner.readval;
+        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;
         SetPEOptFlagsSetExplicity:=true;
       end;
 

tests/tbf/tb0235.pp

@@ -0,0 +1,9 @@
+{ %FAIL }
+
+program tb0235;
+
+{$setpeflags unknown}
+
+begin
+
+end.

tests/tbf/tb0236.pp

@@ -0,0 +1,9 @@
+{ %FAIL }
+
+program tb0236;
+
+{$setpeoptflags unknown}
+
+begin
+
+end.

tests/tbf/tb0237.pp

@@ -0,0 +1,12 @@
+{ %FAIL }
+
+program tb0237;
+
+const
+  Invalid = False;
+
+{$setpeflags Invalid}
+
+begin
+
+end.

tests/tbf/tb0238.pp

@@ -0,0 +1,12 @@
+{ %FAIL }
+
+program tb0238;
+
+const
+  Invalid = False;
+
+{$setpeoptflags Invalid}
+
+begin
+
+end.

tests/tbs/tb0596.pp

@@ -0,0 +1,18 @@
+{ %NORUN }
+{ %TARGET=win32,win64,wince }
+
+program tb0596;
+
+const
+  IMAGE_FILE_LARGE_ADDRESS_AWARE = $0020;
+  IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000;
+
+{$setpeflags IMAGE_FILE_LARGE_ADDRESS_AWARE}
+{$setpeflags $0800}
+
+{$setpeoptflags IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE}
+{$setpeoptflags $0040}
+
+begin
+
+end.