+ add support for $SetPE{OS,SubSys,User}Version directives; Delphi compatible; Note: $SetPEUserVersion takes precedence to $Version

+ added test

git-svn-id: trunk@37364 -

.gitattributes

@@ -11408,6 +11408,7 @@ tests/tbs/tb0629.pp svneol=native#text/pascal
 tests/tbs/tb0630.pp svneol=native#text/pascal
 tests/tbs/tb0631.pp svneol=native#text/pascal
 tests/tbs/tb0632.pp svneol=native#text/pascal
+tests/tbs/tb0633.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain

compiler/globals.pas

@@ -287,6 +287,9 @@ interface
        description   : string;
        SetPEFlagsSetExplicity,
        SetPEOptFlagsSetExplicity,
+       SetPEOSVersionSetExplicitely,
+       SetPESubSysVersionSetExplicitely,
+       SetPEUserVersionSetExplicitely,
        ImageBaseSetExplicity,
        MinStackSizeSetExplicity,
        MaxStackSizeSetExplicity,
@@ -296,6 +299,12 @@ interface
        dllminor,
        dllrevision   : word;  { revision only for netware }
        { win pe  }
+       peosversionminor,
+       peosversionmajor,
+       pesubsysversionminor,
+       pesubsysversionmajor,
+       peuserversionminor,
+       peuserversionmajor : word;
        peoptflags,
        peflags : longint;
        minstacksize,
@@ -1517,6 +1526,9 @@ implementation
         DescriptionSetExplicity:=false;
         SetPEFlagsSetExplicity:=false;
         SetPEOptFlagsSetExplicity:=false;
+        SetPEOSVersionSetExplicitely:=false;
+        SetPESubSysVersionSetExplicitely:=false;
+        SetPEUserVersionSetExplicitely:=false;
         ImageBaseSetExplicity:=false;
         MinStackSizeSetExplicity:=false;
         MaxStackSizeSetExplicity:=false;

compiler/msg/errore.msg

@@ -142,7 +142,7 @@ general_e_exception_raised=01026_E_Compilation raised exception internally
 #
 # Scanner
 #
-# 02101 is the last used one
+# 02104 is the last used one
 #
 % \section{Scanner messages.}
 % This section lists the messages that the scanner emits. The scanner takes
@@ -421,6 +421,12 @@ scan_w_syscall_convention_not_useable_on_target=02100_W_Specified syscall conven
 % is not useable on the current target system.
 scan_w_syscall_convention_invalid=02101_W_Invalid syscall convention specified
 % The compiler did not recognize the syscall convention specified by the \var{\{\$SYSCALL xxx\}} directive.
+scan_w_setpeuserversion_not_support=02102_W_SETPEUSERVERSION is not supported by the target OS
+% The \var{\{\$SETPEUSERVERSION\}} directive is not supported by the target OS.
+scan_w_setpeosversion_not_support=02103_W_SETPEOSVERSION is not supported by the target OS
+% The \var{\{\$SETPEOSVERSION\}} directive is not supported by the target OS.
+scan_w_setpesubsysversion_not_support=02104_W_SETPESUBSYSVERSION is not supported by the target OS
+% The \var{\{\$SETPESUBSYSVERSION\}} directive is not supported by the target OS.
 % \end{description}
 #
 # Parser

compiler/msgidx.inc

@@ -124,6 +124,9 @@ const
   scan_e_illegal_asmcpu_specifier=02099;
   scan_w_syscall_convention_not_useable_on_target=02100;
   scan_w_syscall_convention_invalid=02101;
+  scan_w_setpeuserversion_not_support=02102;
+  scan_w_setpeosversion_not_support=02103;
+  scan_w_setpesubsysversion_not_support=02104;
   parser_e_syntax_error=03000;
   parser_e_dont_nest_interrupt=03004;
   parser_w_proc_directive_ignored=03005;
@@ -1080,9 +1083,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 80284;
+  MsgTxtSize = 80461;
 
   MsgIdxMax : array[1..20] of longint=(
-    27,102,347,124,96,58,132,33,221,67,
+    27,105,347,124,96,58,132,33,221,67,
     60,20,30,1,1,1,1,1,1,1
   );

compiler/ogcoff.pas

@@ -2621,15 +2621,39 @@ const pemagic : array[0..3] of byte = (
             peoptheader.ImageBase:=ImageBase;
             peoptheader.SectionAlignment:=SectionMemAlign;
             peoptheader.FileAlignment:=SectionDataAlign;
-            peoptheader.MajorOperatingSystemVersion:=4;
-            peoptheader.MinorOperatingSystemVersion:=0;
-            peoptheader.MajorImageVersion:=dllmajor;
-            peoptheader.MinorImageVersion:=dllminor;
-            if target_info.system in systems_wince then
-              peoptheader.MajorSubsystemVersion:=3
+            if SetPEOSVersionSetExplicitely then
+              begin
+                peoptheader.MajorOperatingSystemVersion:=peosversionmajor;
+                peoptheader.MinorOperatingSystemVersion:=peosversionminor;
+              end
+            else
+              begin
+                peoptheader.MajorOperatingSystemVersion:=10;
+                peoptheader.MinorOperatingSystemVersion:=0;
+              end;
+            if SetPEUserVersionSetExplicitely then
+              begin
+                peoptheader.MajorImageVersion:=peuserversionmajor;
+                peoptheader.MinorImageVersion:=peuserversionminor;
+              end
             else
-              peoptheader.MajorSubsystemVersion:=4;
-            peoptheader.MinorSubsystemVersion:=0;
+              begin
+                peoptheader.MajorImageVersion:=dllmajor;
+                peoptheader.MinorImageVersion:=dllminor;
+              end;
+            if SetPESubSysVersionSetExplicitely then
+              begin
+                peoptheader.MajorSubsystemVersion:=pesubsysversionmajor;
+                peoptheader.MinorSubsystemVersion:=pesubsysversionminor;
+              end
+            else
+              begin
+                if target_info.system in systems_wince then
+                  peoptheader.MajorSubsystemVersion:=3
+                else
+                  peoptheader.MajorSubsystemVersion:=6;
+                peoptheader.MinorSubsystemVersion:=2;
+              end;
             peoptheader.Win32Version:=0;
             peoptheader.SizeOfImage:=Align(CurrMemPos,SectionMemAlign);
             peoptheader.SizeOfHeaders:=textExeSec.DataPos;

compiler/scandir.pas

@@ -140,6 +140,75 @@ unit scandir;
         Message1(w,current_scanner.readcomment);
       end;
 
+
+    procedure do_version(out major, minor, revision: word; out verstr: string; allowrevision: boolean; out isset: boolean);
+      var
+        majorl,
+        minorl,
+        revisionl,
+        error : longint;
+      begin
+        { change description global var in all cases }
+        { it not used but in win32, os2 and netware }
+        current_scanner.skipspace;
+        { we should only accept Major.Minor format for win32 and os2 }
+        current_scanner.readnumber;
+        major:=0;
+        minor:=0;
+        revision:=0;
+        verstr:='';
+        isset:=false;
+        majorl:=0;
+        minorl:=0;
+        revisionl:=0;
+        val(pattern,majorl,error);
+        if (error<>0) or (majorl > high(word)) or (majorl < 0) then
+          begin
+            Message1(scan_w_wrong_version_ignored,pattern);
+            exit;
+          end;
+        isset:=true;
+        if c='.' then
+          begin
+            current_scanner.readchar;
+            current_scanner.readnumber;
+            val(pattern,minorl,error);
+            if (error<>0) or (minorl > high(word)) or (minorl < 0) then
+              begin
+                Message1(scan_w_wrong_version_ignored,tostr(majorl)+'.'+pattern);
+                exit;
+              end;
+            if (c='.') and
+               allowrevision then
+              begin
+                 current_scanner.readchar;
+                 current_scanner.readnumber;
+                 val(pattern,revisionl,error);
+                 if (error<>0) or (revisionl > high(word)) or (revisionl < 0) then
+                   begin
+                      Message1(scan_w_wrong_version_ignored,tostr(majorl)+'.'+tostr(minorl)+'.'+pattern);
+                      exit;
+                   end;
+                 major:=word(majorl);
+                 minor:=word(minorl);
+                 revision:=word(revisionl);
+                 verstr:=tostr(major)+','+tostr(minor)+','+tostr(revision);
+              end
+            else
+              begin
+                 major:=word(majorl);
+                 minor:=word(minorl);
+                 verstr:=tostr(major)+'.'+tostr(minor);
+              end;
+          end
+        else
+          begin
+            major:=word(majorl);
+            verstr:=tostr(major);
+          end;
+      end;
+
+
 {*****************************************************************************
                               Directive Callbacks
 *****************************************************************************}
@@ -1256,6 +1325,45 @@ unit scandir;
         SetPEOptFlagsSetExplicity:=true;
       end;
 
+    procedure dir_setpeuserversion;
+      var
+        dummystr : string;
+        dummyrev : word;
+      begin
+        if not (target_info.system in systems_all_windows) then
+          Message(scan_w_setpeuserversion_not_support);
+        if (compile_level<>1) then
+          Message(scan_n_only_exe_version)
+        else
+          do_version(peuserversionmajor,peuserversionminor,dummyrev,dummystr,false,SetPEUserVersionSetExplicitely);
+      end;
+
+    procedure dir_setpeosversion;
+      var
+        dummystr : string;
+        dummyrev : word;
+      begin
+        if not (target_info.system in systems_all_windows) then
+          Message(scan_w_setpeosversion_not_support);
+        if (compile_level<>1) then
+          Message(scan_n_only_exe_version)
+        else
+          do_version(peosversionmajor,peosversionminor,dummyrev,dummystr,false,SetPEOSVersionSetExplicitely);
+      end;
+
+    procedure dir_setpesubsysversion;
+      var
+        dummystr : string;
+        dummyrev : word;
+      begin
+        if not (target_info.system in systems_all_windows) then
+          Message(scan_w_setpesubsysversion_not_support);
+        if (compile_level<>1) then
+          Message(scan_n_only_exe_version)
+        else
+          do_version(pesubsysversionmajor,pesubsysversionminor,dummyrev,dummystr,false,SetPESubSysVersionSetExplicitely);
+      end;
+
     procedure dir_smartlink;
       begin
         do_moduleswitch(cs_create_smart);
@@ -1855,6 +1963,9 @@ unit scandir;
         AddDirective('SCOPEDENUMS',directive_all, @dir_scopedenums);
         AddDirective('SETPEFLAGS', directive_all, @dir_setpeflags);
         AddDirective('SETPEOPTFLAGS', directive_all, @dir_setpeoptflags);
+        AddDirective('SETPEOSVERSION', directive_all, @dir_setpeosversion);
+        AddDirective('SETPEUSERVERSION', directive_all, @dir_setpeuserversion);
+        AddDirective('SETPESUBSYSVERSION', directive_all, @dir_setpesubsysversion);
         AddDirective('SCREENNAME',directive_all, @dir_screenname);
         AddDirective('SMARTLINK',directive_all, @dir_smartlink);
         AddDirective('STACKFRAMES',directive_all, @dir_stackframes);

tests/tbs/tb0633.pp

@@ -0,0 +1,12 @@
+{ %NORUN }
+{ %TARGET=win32,win64,wince }
+{ %OPT=-Sew }
+
+program tb0633;
+
+{$SetPESubSysVersion 8.3}
+{$SetPEUserVersion 13.6}
+{$SetPEOSVersion 24.8}
+
+begin
+end.