diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor
index 31eeb4a0e0..fc13c65413 100644
--- a/basis/math/functions/functions-tests.factor
+++ b/basis/math/functions/functions-tests.factor
@@ -159,6 +159,11 @@ CONSTANT: log10-factorial-1000 0x1.40f3593ed6f8ep11
 { -5.0 } [ -4.5 floor ] unit-test
 { -4.0 } [ -4.5 ceiling ] unit-test
 
+{ t } [ -0.3 truncate double>bits -0.0 double>bits = ] unit-test
+{ t } [ -0.3 ceiling double>bits -0.0 double>bits = ] unit-test
+{ t } [ 0.3 floor double>bits 0.0 double>bits = ] unit-test
+{ t } [ 0.3 truncate double>bits 0.0 double>bits = ] unit-test
+
 { -4.0 } [ -4.0 truncate ] unit-test
 { -4.0 } [ -4.0 floor ] unit-test
 { -4.0 } [ -4.0 ceiling ] unit-test
@@ -180,6 +185,9 @@ CONSTANT: log10-factorial-1000 0x1.40f3593ed6f8ep11
 { 1 } [ 1/2 round ] unit-test
 { 1 } [ 3/5 round ] unit-test
 
+{ t } [ -0.3 round double>bits -0.0 double>bits = ] unit-test
+{ t } [ 0.3 round double>bits 0.0 double>bits = ] unit-test
+
 { 6 59967 } [ 3837888 factor-2s ] unit-test
 { 6 -59967 } [ -3837888 factor-2s ] unit-test
 
diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor
index df994dc7b6..e2da5dafd6 100644
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@@ -348,7 +348,10 @@ M: real atan >float atan ; inline
 
 : acot ( x -- y ) recip atan ; inline
 
-: truncate ( x -- y ) dup 1 mod - ; inline
+: truncate ( x -- y ) dup dup 1 mod - over float? [
+    over [ -1.0 > ] [ 0.0 < ] bi and
+    [ swap copysign ] [ nip ] if
+ ] [ nip ] if ; inline
 
 GENERIC: round ( x -- y )