From 0c6cf12fbf24798faccfc2d34004f705c1e974e1 Mon Sep 17 00:00:00 2001 From: florian Date: Thu, 12 Jul 2018 21:39:50 +0000 Subject: [PATCH] + support for the directive $EXCESSPRECISION git-svn-id: trunk@39443 - --- .gitattributes | 3 ++- compiler/globtype.pas | 1 + compiler/nadd.pas | 30 ++++++++++++++++++------------ compiler/scandir.pas | 7 +++++++ tests/tbs/tb0648.pp | 22 ++++++++++++++++++++++ 5 files changed, 50 insertions(+), 13 deletions(-) create mode 100644 tests/tbs/tb0648.pp diff --git a/.gitattributes b/.gitattributes index 1712f2883a..dad4295cc3 100644 --- a/.gitattributes +++ b/.gitattributes @@ -462,7 +462,7 @@ compiler/msg/errorru.msg svneol=native#text/plain compiler/msg/errorues.msg svneol=native#text/plain compiler/msgidx.inc svneol=native#text/plain compiler/msgtxt.inc svneol=native#text/plain -compiler/nadd.pas -text svneol=native#text/plain +compiler/nadd.pas svneol=native#text/plain compiler/nbas.pas svneol=native#text/plain compiler/ncal.pas svneol=native#text/plain compiler/ncgadd.pas svneol=native#text/plain @@ -11577,6 +11577,7 @@ tests/tbs/tb0645b.pp svneol=native#text/pascal tests/tbs/tb0645c.pp svneol=native#text/pascal tests/tbs/tb0646a.pp svneol=native#text/pascal tests/tbs/tb0646b.pp svneol=native#text/pascal +tests/tbs/tb0648.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 diff --git a/compiler/globtype.pas b/compiler/globtype.pas index 5d58319450..7d23464d57 100644 --- a/compiler/globtype.pas +++ b/compiler/globtype.pas @@ -148,6 +148,7 @@ interface cs_full_boolean_eval,cs_typed_const_writable,cs_allow_enum_calc, cs_do_inline,cs_fpu_fwait,cs_ieee_errors, cs_check_low_addr_load,cs_imported_data, + cs_excessprecision, { mmx } cs_mmx,cs_mmx_saturation, { parser } diff --git a/compiler/nadd.pas b/compiler/nadd.pas index 3c1cc4ddc5..fd80ae6302 100644 --- a/compiler/nadd.pas +++ b/compiler/nadd.pas @@ -127,7 +127,7 @@ implementation {$ENDIF} globtype,systems,constexp,compinnr, cutils,verbose,globals,widestr, - tokens, + tokens, symconst,symdef,symsym,symcpu,symtable,defutil,defcmp, cgbase, htypechk,pass_1, @@ -157,7 +157,8 @@ implementation { when a comp or currency is used, use always the best float type to calculate the result } if (tfloatdef(t2).floattype in [s64comp,s64currency]) or - (tfloatdef(t2).floattype in [s64comp,s64currency]) then + (tfloatdef(t2).floattype in [s64comp,s64currency]) or + (cs_excessprecision in current_settings.localswitches) then result:=pbestrealtype^ else if floatweight[tfloatdef(t2).floattype]>floatweight[tfloatdef(t1).floattype] then @@ -1317,14 +1318,14 @@ implementation { allow operator overloading } hp:=self; - - if is_dynamic_array(left.resultdef) and is_dynamic_array(right.resultdef) and - (nodetype=addn) and - (m_array_operators in current_settings.modeswitches) and - isbinaryoverloaded(hp,[ocf_check_non_overloadable,ocf_check_only]) then - message3(parser_w_operator_overloaded_hidden_3,left.resultdef.typename,arraytokeninfo[_PLUS].str,right.resultdef.typename); - - if isbinaryoverloaded(hp,[]) then + + if is_dynamic_array(left.resultdef) and is_dynamic_array(right.resultdef) and + (nodetype=addn) and + (m_array_operators in current_settings.modeswitches) and + isbinaryoverloaded(hp,[ocf_check_non_overloadable,ocf_check_only]) then + message3(parser_w_operator_overloaded_hidden_3,left.resultdef.typename,arraytokeninfo[_PLUS].str,right.resultdef.typename); + + if isbinaryoverloaded(hp,[]) then begin result:=hp; exit; @@ -1384,7 +1385,12 @@ implementation if (right.resultdef.typ=floatdef) and (left.resultdef.typ=floatdef) and (tfloatdef(left.resultdef).floattype=tfloatdef(right.resultdef).floattype) then - resultrealdef:=left.resultdef + begin + if cs_excessprecision in current_settings.localswitches then + resultrealdef:=pbestrealtype^ + else + resultrealdef:=left.resultdef + end { when there is a currency type then use currency, but only when currency is defined as float } else @@ -3444,7 +3450,7 @@ implementation { Can we optimize multiple dyn. array additions into a single call? This need to be done on a complete tree to detect the multiple add nodes and is therefor done before the subtrees are processed } - if (m_array_operators in current_settings.modeswitches) and canbemultidynarrayadd(self) then + if (m_array_operators in current_settings.modeswitches) and canbemultidynarrayadd(self) then begin result:=genmultidynarrayadd(self); exit; diff --git a/compiler/scandir.pas b/compiler/scandir.pas index e816af8db8..a30f7a13cd 100644 --- a/compiler/scandir.pas +++ b/compiler/scandir.pas @@ -430,6 +430,12 @@ unit scandir; end; + procedure dir_excessprecision; + begin + do_localswitch(cs_excessprecision); + end; + + procedure dir_objectchecks; begin do_localswitch(cs_check_object); @@ -1909,6 +1915,7 @@ unit scandir; AddDirective('ENDREGION',directive_all, @dir_endregion); AddDirective('ERROR',directive_all, @dir_error); AddDirective('ERRORC',directive_mac, @dir_error); + AddDirective('EXCESSPRECISION',directive_all, @dir_excessprecision); AddDirective('EXTENDEDSYNTAX',directive_all, @dir_extendedsyntax); AddDirective('EXTERNALSYM',directive_all, @dir_externalsym); AddDirective('F',directive_all, @dir_forcefarcalls); diff --git a/tests/tbs/tb0648.pp b/tests/tbs/tb0648.pp new file mode 100644 index 0000000000..cc0106e66c --- /dev/null +++ b/tests/tbs/tb0648.pp @@ -0,0 +1,22 @@ +{$excessprecision on} +const + d1: double = 1.0/3.0; + d2: double = 1/3; + x1: extended = 1.0/3.0; + x2: extended = 1/3; + s1: single = 1.0/3.0; + s2: single = 1/3; +begin + writeln(s1:30:10, s2:30:10); + if s1<>s2 then + halt(1); + writeln(d1:30:16, d2:30:16); + if d1<>d2 then + halt(1); +{$ifdef FPUX87} + writeln(x1:30:24, x2:30:24); + if x1<>x2 then + halt(1); +{$endif FPUX87} + writeln('ok'); +end.