Browse Source

* range check error checking for floats refactored
* never throw range/overflow check errors for floats in delphi mode, resolves #7584

git-svn-id: trunk@10940 -

florian 17 năm trước cách đây
mục cha
commit
0a4314206f

+ 2 - 0
.gitattributes

@@ -8055,6 +8055,8 @@ tests/webtbs/tw0751.pp svneol=native#text/plain
 tests/webtbs/tw0753.pp svneol=native#text/plain
 tests/webtbs/tw0753.pp svneol=native#text/plain
 tests/webtbs/tw0754.pp svneol=native#text/plain
 tests/webtbs/tw0754.pp svneol=native#text/plain
 tests/webtbs/tw0755.pp svneol=native#text/plain
 tests/webtbs/tw0755.pp svneol=native#text/plain
+tests/webtbs/tw07584.pp svneol=native#text/plain
+tests/webtbs/tw07584a.pp svneol=native#text/plain
 tests/webtbs/tw0760.pp svneol=native#text/plain
 tests/webtbs/tw0760.pp svneol=native#text/plain
 tests/webtbs/tw0761.pp svneol=native#text/plain
 tests/webtbs/tw0761.pp svneol=native#text/plain
 tests/webtbs/tw0769.pp svneol=native#text/plain
 tests/webtbs/tw0769.pp svneol=native#text/plain

+ 9 - 0
compiler/globals.pas

@@ -350,6 +350,7 @@ interface
 {$ifdef ARM}
 {$ifdef ARM}
     function is_double_hilo_swapped: boolean;{$ifdef USEINLINE}inline;{$endif}
     function is_double_hilo_swapped: boolean;{$ifdef USEINLINE}inline;{$endif}
 {$endif ARM}
 {$endif ARM}
+    function floating_point_range_check_error : boolean;
 
 
 implementation
 implementation
 
 
@@ -1104,6 +1105,14 @@ implementation
       end;
       end;
 {$endif ARM}
 {$endif ARM}
 
 
+
+    function floating_point_range_check_error : boolean;
+      begin
+        result:=((([cs_check_range,cs_check_overflow]*current_settings.localswitches)<>[]) and not
+                   (m_delphi in current_settings.modeswitches)
+                ); // or (cs_ieee_errors in current_settings.localswitches);
+      end;
+
 {****************************************************************************
 {****************************************************************************
                                     Init
                                     Init
 ****************************************************************************}
 ****************************************************************************}

+ 1 - 2
compiler/nadd.pas

@@ -168,8 +168,7 @@ implementation
             ((rt = realconstn) and
             ((rt = realconstn) and
              (trealconstnode(right).value_real = 0.0))) then
              (trealconstnode(right).value_real = 0.0))) then
           begin
           begin
-            if (cs_check_range in current_settings.localswitches) or
-               (cs_check_overflow in current_settings.localswitches) then
+            if floating_point_range_check_error then
                begin
                begin
                  result:=crealconstnode.create(1,pbestrealtype^);
                  result:=crealconstnode.create(1,pbestrealtype^);
                  Message(parser_e_division_by_zero);
                  Message(parser_e_division_by_zero);

+ 4 - 8
compiler/ncgcon.pas

@@ -174,8 +174,7 @@ implementation
                       begin
                       begin
                         current_asmdata.asmlists[al_typedconsts].concat(Tai_real_32bit.Create(ts32real(value_real)));
                         current_asmdata.asmlists[al_typedconsts].concat(Tai_real_32bit.Create(ts32real(value_real)));
                         { range checking? }
                         { range checking? }
-                        if ((cs_check_range in current_settings.localswitches) or
-                          (cs_check_overflow in current_settings.localswitches)) and
+                        if floating_point_range_check_error and
                           (tai_real_32bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
                           (tai_real_32bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
                           Message(parser_e_range_check_error);
                           Message(parser_e_range_check_error);
                       end;
                       end;
@@ -190,8 +189,7 @@ implementation
                           current_asmdata.asmlists[al_typedconsts].concat(Tai_real_64bit.Create(ts64real(value_real)));
                           current_asmdata.asmlists[al_typedconsts].concat(Tai_real_64bit.Create(ts64real(value_real)));
 
 
                         { range checking? }
                         { range checking? }
-                        if ((cs_check_range in current_settings.localswitches) or
-                          (cs_check_overflow in current_settings.localswitches)) and
+                        if floating_point_range_check_error and
                           (tai_real_64bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
                           (tai_real_64bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
                           Message(parser_e_range_check_error);
                           Message(parser_e_range_check_error);
                      end;
                      end;
@@ -201,8 +199,7 @@ implementation
                         current_asmdata.asmlists[al_typedconsts].concat(Tai_real_80bit.Create(value_real));
                         current_asmdata.asmlists[al_typedconsts].concat(Tai_real_80bit.Create(value_real));
 
 
                         { range checking? }
                         { range checking? }
-                        if ((cs_check_range in current_settings.localswitches) or
-                          (cs_check_overflow in current_settings.localswitches)) and
+                        if floating_point_range_check_error and
                           (tai_real_80bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
                           (tai_real_80bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
                           Message(parser_e_range_check_error);
                           Message(parser_e_range_check_error);
                       end;
                       end;
@@ -212,8 +209,7 @@ implementation
                         current_asmdata.asmlists[al_typedconsts].concat(Tai_real_128bit.Create(value_real));
                         current_asmdata.asmlists[al_typedconsts].concat(Tai_real_128bit.Create(value_real));
 
 
                         { range checking? }
                         { range checking? }
-                        if ((cs_check_range in current_settings.localswitches) or
-                          (cs_check_overflow in current_settings.localswitches)) and
+                        if floating_point_range_check_error and
                           (tai_real_128bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
                           (tai_real_128bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
                           Message(parser_e_range_check_error);
                           Message(parser_e_range_check_error);
                       end;
                       end;

+ 5 - 8
compiler/ninl.pas

@@ -1260,7 +1260,7 @@ implementation
           The implicit conversion is avoided for enums because implicit conversion between
           The implicit conversion is avoided for enums because implicit conversion between
           longint (which is what fpc_val_enum_shortstr returns) and enumerations is not
           longint (which is what fpc_val_enum_shortstr returns) and enumerations is not
           possible. (DM).
           possible. (DM).
-          
+
           The implicit conversion is also avoided for COMP type if it is handled by FPU (x86)
           The implicit conversion is also avoided for COMP type if it is handled by FPU (x86)
           to prevent warning about automatic type conversion. }
           to prevent warning about automatic type conversion. }
         if (destpara.resultdef.typ=enumdef) or
         if (destpara.resultdef.typ=enumdef) or
@@ -1374,8 +1374,7 @@ implementation
       function handle_ln_const(r : bestreal) : tnode;
       function handle_ln_const(r : bestreal) : tnode;
         begin
         begin
           if r<=0.0 then
           if r<=0.0 then
-            if (cs_check_range in current_settings.localswitches) or
-               (cs_check_overflow in current_settings.localswitches) then
+            if floating_point_range_check_error then
                begin
                begin
                  result:=crealconstnode.create(0,pbestrealtype^);
                  result:=crealconstnode.create(0,pbestrealtype^);
                  CGMessage(type_e_wrong_math_argument)
                  CGMessage(type_e_wrong_math_argument)
@@ -1395,8 +1394,7 @@ implementation
       function handle_sqrt_const(r : bestreal) : tnode;
       function handle_sqrt_const(r : bestreal) : tnode;
         begin
         begin
           if r<0.0 then
           if r<0.0 then
-            if (cs_check_range in current_settings.localswitches) or
-               (cs_check_overflow in current_settings.localswitches) then
+            if floating_point_range_check_error then
                begin
                begin
                  result:=crealconstnode.create(0,pbestrealtype^);
                  result:=crealconstnode.create(0,pbestrealtype^);
                  CGMessage(type_e_wrong_math_argument)
                  CGMessage(type_e_wrong_math_argument)
@@ -1636,7 +1634,7 @@ implementation
                 begin
                 begin
                   { only perform range checking if the result is an enum }
                   { only perform range checking if the result is an enum }
                   checkrange:=(resultdef.typ=enumdef);
                   checkrange:=(resultdef.typ=enumdef);
-   
+
                   if (left.nodetype=ordconstn) then
                   if (left.nodetype=ordconstn) then
                    begin
                    begin
                      if (inlinenumber=in_succ_x) then
                      if (inlinenumber=in_succ_x) then
@@ -1689,8 +1687,7 @@ implementation
                     begin
                     begin
                       result:=crealconstnode.create(exp(getconstrealvalue),pbestrealtype^);
                       result:=crealconstnode.create(exp(getconstrealvalue),pbestrealtype^);
                       if (trealconstnode(result).value_real=MathInf.Value) and
                       if (trealconstnode(result).value_real=MathInf.Value) and
-                         ((cs_check_range in current_settings.localswitches) or
-                          (cs_check_overflow in current_settings.localswitches)) then
+                         floating_point_range_check_error then
                         begin
                         begin
                           result:=crealconstnode.create(0,pbestrealtype^);
                           result:=crealconstnode.create(0,pbestrealtype^);
                           CGMessage(parser_e_range_check_error);
                           CGMessage(parser_e_range_check_error);

+ 13 - 0
tests/webtbs/tw07584.pp

@@ -0,0 +1,13 @@
+program bug;
+
+{$mode delphi}
+
+uses
+  math;
+
+{$Q+}
+{$R+}
+
+begin
+  Writeln(Math.Infinity);
+end.

+ 11 - 0
tests/webtbs/tw07584a.pp

@@ -0,0 +1,11 @@
+program bug;
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+const
+  Inf = 1.0 / 0.0;
+
+begin
+end.