From f5de7e34d39820003af7d4835fd7140930b8b09e Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sun, 26 Aug 2012 21:04:46 +0000
Subject: [PATCH]   * only remove the calculation of unused parameters of
 inline routines if     they don't have explicit side-effects, and if
 -Oodeadvalues (part of -O4)     is active (because it can result in the
 removal of range check errors,     segmentation faults, etc)

git-svn-id: trunk@22254 -
---
 .gitattributes        |  2 ++
 compiler/globtype.pas | 14 +++++++++++---
 compiler/ncal.pas     |  5 ++++-
 tests/tbs/tb0583.pp   | 17 +++++++++++++++++
 tests/tbs/tb0583a.pp  | 24 ++++++++++++++++++++++++
 5 files changed, 58 insertions(+), 4 deletions(-)
 create mode 100644 tests/tbs/tb0583.pp
 create mode 100644 tests/tbs/tb0583a.pp

diff --git a/.gitattributes b/.gitattributes
index fda6ddfa87..a8835104a8 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -9610,6 +9610,8 @@ tests/tbs/tb0579.pp svneol=native#text/pascal
 tests/tbs/tb0580.pp svneol=native#text/pascal
 tests/tbs/tb0581.pp svneol=native#text/plain
 tests/tbs/tb0582.pp svneol=native#text/pascal
+tests/tbs/tb0583.pp svneol=native#text/plain
+tests/tbs/tb0583a.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
diff --git a/compiler/globtype.pas b/compiler/globtype.pas
index c71d4ac679..549227046d 100644
--- a/compiler/globtype.pas
+++ b/compiler/globtype.pas
@@ -244,7 +244,15 @@ interface
          cs_opt_regvar,cs_opt_uncertain,cs_opt_size,cs_opt_stackframe,
          cs_opt_peephole,cs_opt_asmcse,cs_opt_loopunroll,cs_opt_tailrecursion,cs_opt_nodecse,
          cs_opt_nodedfa,cs_opt_loopstrength,cs_opt_scheduler,cs_opt_autoinline,cs_useebp,
-         cs_opt_reorder_fields,cs_opt_fastmath
+         cs_opt_reorder_fields,cs_opt_fastmath,
+         { Allow removing expressions whose result is not used, even when this
+           can change program behaviour (range check errors disappear,
+           access violations due to invalid pointer derefences disappear, ...).
+           Note: it does not (and must not) remove expressions that have
+             explicit side-effects, only implicit side-effects (like the ones
+             mentioned before) can disappear.
+         }
+         cs_opt_dead_values
        );
        toptimizerswitches = set of toptimizerswitch;
 
@@ -269,7 +277,7 @@ interface
          'REGVAR','UNCERTAIN','SIZE','STACKFRAME',
          'PEEPHOLE','ASMCSE','LOOPUNROLL','TAILREC','CSE',
          'DFA','STRENGTH','SCHEDULE','AUTOINLINE','USEEBP',
-         'ORDERFIELDS','FASTMATH'
+         'ORDERFIELDS','FASTMATH','DEADVALUES'
        );
        WPOptimizerSwitchStr : array [twpoptimizerswitch] of string[14] = (
          'DEVIRTCALLS','OPTVMTS','SYMBOLLIVENESS'
@@ -287,7 +295,7 @@ interface
        genericlevel1optimizerswitches = [cs_opt_level1];
        genericlevel2optimizerswitches = [cs_opt_level2];
        genericlevel3optimizerswitches = [cs_opt_level3];
-       genericlevel4optimizerswitches = [cs_opt_reorder_fields];
+       genericlevel4optimizerswitches = [cs_opt_reorder_fields,cs_opt_dead_values];
 
        { whole program optimizations whose information generation requires
          information from all loaded units
diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index 95c2c4fa31..6a437e6963 100644
--- a/compiler/ncal.pas
+++ b/compiler/ncal.pas
@@ -3717,7 +3717,10 @@ implementation
         para := tcallparanode(left);
         while assigned(para) do
           begin
-            if (para.parasym.typ = paravarsym) and (para.parasym.refs>0) then
+            if (para.parasym.typ = paravarsym) and
+               ((para.parasym.refs>0) or
+                not(cs_opt_dead_values in current_settings.optimizerswitches) or
+                might_have_sideeffects(para.left)) then
               begin
                 { must take copy of para.left, because if it contains a       }
                 { temprefn pointing to a copied temp (e.g. methodpointer),    }
diff --git a/tests/tbs/tb0583.pp b/tests/tbs/tb0583.pp
new file mode 100644
index 0000000000..c4a88a6b57
--- /dev/null
+++ b/tests/tbs/tb0583.pp
@@ -0,0 +1,17 @@
+{ %opt=-O-3 }
+{ %result=201 }
+
+{$inline on}
+{$r+}
+
+procedure test(l: longint); inline;
+begin
+end;
+
+var
+  a: array[0..0] of byte;
+  i: longint;
+begin
+  i:=1345;
+  test(a[i]);
+end.
diff --git a/tests/tbs/tb0583a.pp b/tests/tbs/tb0583a.pp
new file mode 100644
index 0000000000..fc4e97f6e0
--- /dev/null
+++ b/tests/tbs/tb0583a.pp
@@ -0,0 +1,24 @@
+{ %opt=-O-4 }
+{ %result=201 }
+
+{$inline on}
+{$r+}
+
+var
+  l: longint;
+
+function f: longint;
+begin
+  l:=5;
+  f:=2;
+end;
+
+procedure test(l: longint); inline;
+begin
+end;
+
+var
+  a: array[0..0] of byte;
+begin
+  test(a[f]);
+end.