diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 50f93830b4911ae77c1593343a50a01d60a3e56d..30d1e26b151b5d9833b1dfef5eacb999d461b1f4 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,8 @@
+2010-11-16  Eric Botcazou  <ebotcazou@adacore.com>
+
+	PR rtl-optimization/46490
+	* combine.c (expand_compound_operation): Fix thinko.
+
 2010-11-16  Richard Henderson  <rth@redhat.com>
 
 	PR target/46470
diff --git a/gcc/combine.c b/gcc/combine.c
index ee26c905d4613540bec49d53b93a2ae0da6ad424..d55ce3127d809048e5f6f28c21bbcabef840aba0 100644
--- a/gcc/combine.c
+++ b/gcc/combine.c
@@ -6761,11 +6761,11 @@ expand_compound_operation (rtx x)
      count.  This can happen in a case like (x >> 31) & 255 on machines
      that can't shift by a constant.  On those machines, we would first
      combine the shift with the AND to produce a variable-position
-     extraction.  Then the constant of 31 would be substituted in to produce
-     a such a position.  */
+     extraction.  Then the constant of 31 would be substituted in
+     to produce such a position.  */
 
   modewidth = GET_MODE_BITSIZE (GET_MODE (x));
-  if (modewidth + len >= pos)
+  if (modewidth >= pos + len)
     {
       enum machine_mode mode = GET_MODE (x);
       tem = gen_lowpart (mode, XEXP (x, 0));
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index afb99ff8f853f9cec0ec736e6179b5277512daf9..10a7c3e61d87a0b901097d17f39d5f2ba8d60d63 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-11-16  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/opt12.adb: New test.
+	* gnat.dg/opt12_pkg.ad[sb]: New helper.
+
 2010-11-16  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc.target/rx/pack.c: New test.
diff --git a/gcc/testsuite/gnat.dg/opt12.adb b/gcc/testsuite/gnat.dg/opt12.adb
new file mode 100644
index 0000000000000000000000000000000000000000..e8b5c4787c624b3dcb5b05ad2fc5ab435f902161
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt12.adb
@@ -0,0 +1,18 @@
+-- { dg-do run }
+-- { dg-options "-O2" }
+
+with Opt12_Pkg; use Opt12_Pkg;
+
+procedure Opt12 is
+
+   Static_Target : Static_Integer_Subtype;
+
+begin
+
+   Static_Target := Static_Integer_Subtype(Fix_Half);
+
+   if not Equal(Static_Target, 1) then
+     raise Program_Error;
+   end if;
+
+end Opt12;
diff --git a/gcc/testsuite/gnat.dg/opt12_pkg.adb b/gcc/testsuite/gnat.dg/opt12_pkg.adb
new file mode 100644
index 0000000000000000000000000000000000000000..646c8734c70fe4e0a982331ba77c83e9e1002165
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt12_pkg.adb
@@ -0,0 +1,8 @@
+package body Opt12_Pkg is
+
+   function Equal (L, R: Static_Integer_Subtype) return Boolean is
+   begin
+      return (L = R);
+   end;
+
+end Opt12_Pkg;
diff --git a/gcc/testsuite/gnat.dg/opt12_pkg.ads b/gcc/testsuite/gnat.dg/opt12_pkg.ads
new file mode 100644
index 0000000000000000000000000000000000000000..4defe2b77c7c772d75508631672d1c9287a003cb
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt12_pkg.ads
@@ -0,0 +1,11 @@
+package Opt12_Pkg is
+
+   type Static_Integer_Subtype is range -32_000 .. 32_000;
+
+   function Equal (L, R: Static_Integer_Subtype) return Boolean;
+
+   type My_Fixed is delta 0.1 range -5.0 .. 5.0;
+
+   Fix_Half : My_Fixed := 0.5;
+
+end Opt12_Pkg;