2
0
Эх сурвалжийг харах

--- Merging r43264 into '.':
U compiler/dbgdwarf.pas
--- Recording mergeinfo for merge of r43264 into '.':
U .
--- Merging r45050 into '.':
U compiler/defutil.pas
U compiler/nmat.pas
--- Recording mergeinfo for merge of r45050 into '.':
G .
--- Merging r45051 into '.':
U compiler/scanner.pas
--- Recording mergeinfo for merge of r45051 into '.':
G .
--- Merging r45052 into '.':
G compiler/scanner.pas
--- Recording mergeinfo for merge of r45052 into '.':
G .
--- Merging r45053 into '.':
G compiler/scanner.pas
A tests/tbs/tb0670.pp
--- Recording mergeinfo for merge of r45053 into '.':
G .
--- Merging r47601 into '.':
G compiler/scanner.pas
--- Recording mergeinfo for merge of r47601 into '.':
G .
--- Merging r47602 into '.':
U compiler/scandir.pas
U tests/tbs/tb0596.pp
--- Recording mergeinfo for merge of r47602 into '.':
G .

git-svn-id: branches/fixes_3_2@47804 -

svenbarth 4 жил өмнө
parent
commit
c60ce2af07

+ 1 - 0
.gitattributes

@@ -12933,6 +12933,7 @@ tests/tbs/tb0666b.pp svneol=native#text/pascal
 tests/tbs/tb0668a.pp svneol=native#text/pascal
 tests/tbs/tb0668b.pp svneol=native#text/pascal
 tests/tbs/tb0669.pp svneol=native#text/pascal
+tests/tbs/tb0670.pp svneol=native#text/pascal
 tests/tbs/tb0676.pp svneol=native#text/pascal
 tests/tbs/tb0677.pp svneol=native#text/pascal
 tests/tbs/tb0678.pp svneol=native#text/pascal

+ 1 - 1
compiler/dbgdwarf.pas

@@ -4209,7 +4209,7 @@ implementation
         current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_skip)));
         current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(3));
         { no -> load length }
-        current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizeof(ptrint)));
+        current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizesinttype.size));
         current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus)));
         current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
         append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.rangedef));

+ 57 - 0
compiler/defutil.pas

@@ -343,6 +343,10 @@ interface
         signdness, the result will also get that signdness }
     function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
 
+    { # calculates "not v" based on the provided def; returns true if the def
+        was negatable, false otherwise }
+    function calc_not_ordvalue(var v:Tconstexprint; var def:tdef):boolean;
+
     { # returns whether the type is potentially a valid type of/for an "univ" parameter
         (basically: it must have a compile-time size) }
     function is_valid_univ_para_type(def: tdef): boolean;
@@ -1670,6 +1674,59 @@ implementation
       end;
 
 
+    function calc_not_ordvalue(var v:Tconstexprint;var def:tdef):boolean;
+      begin
+        if not assigned(def) or (def.typ<>orddef) then
+          exit(false);
+        result:=true;
+        case torddef(def).ordtype of
+          pasbool1,
+          pasbool8,
+          pasbool16,
+          pasbool32,
+          pasbool64:
+            v:=byte(not(boolean(int64(v))));
+          bool8bit,
+          bool16bit,
+          bool32bit,
+          bool64bit:
+            begin
+              if v=0 then
+                v:=-1
+              else
+                v:=0;
+            end;
+          uchar,
+          uwidechar,
+          u8bit,
+          s8bit,
+          u16bit,
+          s16bit,
+          s32bit,
+          u32bit,
+          s64bit,
+          u64bit:
+            begin
+              { unsigned, equal or bigger than the native int size? }
+              if (torddef(def).ordtype in [u64bit,u32bit,u16bit,u8bit,uchar,uwidechar]) and
+                 (is_nativeord(def) or is_oversizedord(def)) then
+                begin
+                  { Delphi-compatible: not dword = dword (not word = longint) }
+                  { Extension: not qword = qword                              }
+                  v:=qword(not qword(v));
+                  { will be truncated by the ordconstnode for u32bit }
+                end
+              else
+                begin
+                  v:=int64(not int64(v));
+                  def:=get_common_intdef(torddef(def),torddef(sinttype),false);
+                end;
+            end;
+          else
+            result:=false;
+        end;
+      end;
+
     function is_valid_univ_para_type(def: tdef): boolean;
       begin
         result:=

+ 2 - 46
compiler/nmat.pas

@@ -1172,52 +1172,8 @@ implementation
           begin
              v:=tordconstnode(left).value;
              def:=left.resultdef;
-             case torddef(left.resultdef).ordtype of
-               pasbool1,
-               pasbool8,
-               pasbool16,
-               pasbool32,
-               pasbool64:
-                 v:=byte(not(boolean(int64(v))));
-               bool8bit,
-               bool16bit,
-               bool32bit,
-               bool64bit:
-                 begin
-                   if v=0 then
-                     v:=-1
-                   else
-                     v:=0;
-                 end;
-               uchar,
-               uwidechar,
-               u8bit,
-               s8bit,
-               u16bit,
-               s16bit,
-               s32bit,
-               u32bit,
-               s64bit,
-               u64bit:
-                 begin
-                   { unsigned, equal or bigger than the native int size? }
-                   if (torddef(left.resultdef).ordtype in [u64bit,u32bit,u16bit,u8bit,uchar,uwidechar]) and
-                      (is_nativeord(left.resultdef) or is_oversizedord(left.resultdef)) then
-                     begin
-                       { Delphi-compatible: not dword = dword (not word = longint) }
-                       { Extension: not qword = qword                              }
-                       v:=qword(not qword(v));
-                       { will be truncated by the ordconstnode for u32bit }
-                     end
-                   else
-                     begin
-                       v:=int64(not int64(v));
-                       def:=get_common_intdef(torddef(left.resultdef),torddef(sinttype),false);
-                     end;
-                 end;
-               else
-                 CGMessage(type_e_mismatch);
-             end;
+             if not calc_not_ordvalue(v,def) then
+               CGMessage(type_e_mismatch);
              { not-nodes are not range checked by the code generator -> also
                don't range check while inlining; the resultdef is a bit tricky
                though: the node's resultdef gets changed in most cases compared

+ 14 - 12
compiler/scandir.pas

@@ -1328,30 +1328,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;
 

+ 64 - 3
compiler/scanner.pas

@@ -227,6 +227,7 @@ interface
           procedure skipoldtpcomment(read_first_char:boolean);
           procedure readtoken(allowrecordtoken:boolean);
           function  readpreproc:ttoken;
+          function  readpreprocint(var value:int64;const place:string):boolean;
           function  asmgetchar:char;
        end;
 
@@ -276,7 +277,6 @@ interface
     Function SetCompileModeSwitch(s:string; changeInit: boolean):boolean;
     procedure SetAppType(NewAppType:tapptype);
 
-
 implementation
 
     uses
@@ -924,8 +924,10 @@ type
     function evaluate(v:texprvalue;op:ttoken):texprvalue;
     procedure error(expecteddef, place: string);
     function isBoolean: Boolean;
+    function isInt: Boolean;
     function asBool: Boolean;
     function asInt: Integer;
+    function asInt64: Int64;
     function asStr: String;
     destructor destroy; override;
   end;
@@ -1140,6 +1142,12 @@ type
         begin
           if isBoolean then
             result:=texprvalue.create_bool(not asBool)
+          else if is_ordinal(def) then
+            begin
+              result:=texprvalue.create_ord(value.valueord);
+              result.def:=def;
+              calc_not_ordvalue(result.value.valueord,result.def);
+            end
           else
             begin
               error('Boolean', 'NOT');
@@ -1156,6 +1164,14 @@ type
                 v.error('Boolean','OR');
                 result:=texprvalue.create_error;
               end
+          else if is_ordinal(def) then
+            if is_ordinal(v.def) then
+              result:=texprvalue.create_ord(value.valueord or v.value.valueord)
+            else
+              begin
+                v.error('Ordinal','OR');
+                result:=texprvalue.create_error;
+              end
           else
             begin
               error('Boolean','OR');
@@ -1172,6 +1188,14 @@ type
                 v.error('Boolean','XOR');
                 result:=texprvalue.create_error;
               end
+          else if is_ordinal(def) then
+            if is_ordinal(v.def) then
+              result:=texprvalue.create_ord(value.valueord xor v.value.valueord)
+            else
+              begin
+                v.error('Ordinal','XOR');
+                result:=texprvalue.create_error;
+              end
           else
             begin
               error('Boolean','XOR');
@@ -1188,6 +1212,14 @@ type
                 v.error('Boolean','AND');
                 result:=texprvalue.create_error;
               end
+          else if is_ordinal(def) then
+            if is_ordinal(v.def) then
+              result:=texprvalue.create_ord(value.valueord and v.value.valueord)
+            else
+              begin
+                v.error('Ordinal','AND');
+                result:=texprvalue.create_error;
+              end
           else
             begin
               error('Boolean','AND');
@@ -1323,16 +1355,21 @@ type
 
   function texprvalue.isBoolean: Boolean;
     var
-      i: integer;
+      i: int64;
     begin
       result:=is_boolean(def);
       if not result and is_integer(def) then
         begin
-          i:=asInt;
+          i:=asInt64;
           result:=(i=0)or(i=1);
         end;
     end;
 
+  function texprvalue.isInt: Boolean;
+    begin
+      result:=is_integer(def);
+    end;
+
   function texprvalue.asBool: Boolean;
     begin
       result:=value.valueord<>0;
@@ -1343,6 +1380,11 @@ type
       result:=value.valueord.svalue;
     end;
 
+  function texprvalue.asInt64: Int64;
+    begin
+      result:=value.valueord.svalue;
+    end;
+
   function texprvalue.asStr: String;
     var
       b:byte;
@@ -5614,6 +5656,25 @@ exit_label:
       end;
 
 
+    function tscannerfile.readpreprocint(var value:int64;const place:string):boolean;
+      var
+        hs : texprvalue;
+      begin
+        hs:=preproc_comp_expr;
+        if hs.isInt then
+          begin
+            value:=hs.asInt64;
+            result:=true;
+          end
+        else
+          begin
+            hs.error('Integer',place);
+            result:=false;
+          end;
+        hs.free;
+      end;
+
+
     function tscannerfile.asmgetchar : char;
       begin
          readchar;

+ 8 - 0
tests/tbs/tb0596.pp

@@ -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
 

+ 92 - 0
tests/tbs/tb0670.pp

@@ -0,0 +1,92 @@
+{ %NORUN }
+
+program tb0670;
+
+const
+  Value1 = $06;
+  Value2 = $60;
+  Value3 = $6000;
+  Value4 = $60000000;
+  Value5 = $60000000000;
+
+  Value6 = $40;
+  Value7 = $4000;
+  Value8 = $40000000;
+  Value9 = $40000000000;
+
+  ValueNot1 = not Value1;
+  ValueNot2 = not Value2;
+  ValueNot3 = not Value3;
+  ValueNot4 = not Value4;
+  ValueNot5 = not Value5;
+
+  ValueOr1 = Value1 or Value2;
+  ValueOr2 = Value1 or Value3;
+  ValueOr3 = Value1 or Value4;
+  ValueOr4 = Value1 or Value5;
+
+  ValueAnd1 = Value2 and Value6;
+  ValueAnd2 = Value3 and Value7;
+  ValueAnd3 = Value4 and Value8;
+  ValueAnd4 = Value5 and Value9;
+
+{ Test "not X" }
+
+{$if not (not Value1 = ValueNot1)}
+{$error 'not Value1 = ValueNot1'}
+{$endif}
+
+{$if not (not Value2 = ValueNot2)}
+{$error 'not Value2 = ValueNot2'}
+{$endif}
+
+{$if not (not Value3 = ValueNot3)}
+{$error 'not Value3 = ValueNot3'}
+{$endif}
+
+{$if not (not Value4 = ValueNot4)}
+{$error 'not Value4 = ValueNot4'}
+{$endif}
+
+{$if not (not Value5 = ValueNot5)}
+{$error 'not Value5 = ValueNot5'}
+{$endif}
+
+{ Test "X or Y" }
+
+{$if Value1 or Value2 <> ValueOr1}
+{$error 'Value1 or Value2 = ValueOr1'}
+{$endif}
+
+{$if Value1 or Value3 <> ValueOr2}
+{$error 'Value1 or Value3 = ValueOr2'}
+{$endif}
+
+{$if Value1 or Value4 <> ValueOr3}
+{$error 'Value1 or Value4 = ValueOr3'}
+{$endif}
+
+{$if Value1 or Value5 <> ValueOr4}
+{$error 'Value1 or Value5 = ValueOr4'}
+{$endif}
+
+{ Test "X and Y" }
+
+{$if Value2 and Value6 <> ValueAnd1 }
+{$error 'Value2 and Value6 = ValueAnd1' }
+{$endif}
+
+{$if Value3 and Value7 <> ValueAnd2 }
+{$error 'Value3 and Value7 = ValueAnd2' }
+{$endif}
+
+{$if Value4 and Value8 <> ValueAnd3 }
+{$error 'Value4 and Value8 = ValueAnd3' }
+{$endif}
+
+{$if Value5 and Value9 <> ValueAnd4 }
+{$error 'Value5 and Value9 = ValueAnd4' }
+{$endif}
+
+begin
+end.