+ support for the directive $EXCESSPRECISION

git-svn-id: trunk@39443 -

.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

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 }

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;

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);

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.