From 1f4bd3e293d6970e808174f83cf512d969e4ca2a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 7 Jul 2010 17:25:32 -0400
Subject: [PATCH 1/2] compiler.tree.propagation.known-words: don't want a type
 function on clone, all the methods are inline and it was wrong (reported by
 Joe Groff)

---
 basis/compiler/tests/optimizer.factor               | 13 ++++++++++++-
 .../tree/propagation/known-words/known-words.factor |  6 ++----
 2 files changed, 14 insertions(+), 5 deletions(-)

diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor
index 606d1a0edf..0d08c592a9 100644
--- a/basis/compiler/tests/optimizer.factor
+++ b/basis/compiler/tests/optimizer.factor
@@ -5,7 +5,7 @@ quotations classes classes.algebra classes.tuple.private
 continuations growable namespaces hints alien.accessors
 compiler.tree.builder compiler.tree.optimizer sequences.deep
 compiler.test definitions generic.single shuffle math.order
-compiler.cfg.debugger ;
+compiler.cfg.debugger classes.struct alien.syntax alien.data ;
 IN: compiler.tests.optimizer
 
 GENERIC: xyz ( obj -- obj )
@@ -447,3 +447,14 @@ TUPLE: grid-mesh-tuple { length read-only } { step read-only } ;
 GENERIC: bad-push-test-case ( a -- b )
 M: object bad-push-test-case "foo" throw ; inline
 [ { 1 } "bar" ] [ { 1 } [ [ [ [ bad-push-test-case ] [ "bar" throw ] recover ] attempt-all f ] [ ] recover ] compile-call ] unit-test
+
+STRUCT: BitmapData { Scan0 void* } ;
+
+[ ALIEN: 123 ] [
+    [
+        { BitmapData }
+        [ BitmapData memory>struct ALIEN: 123 >>Scan0 drop ]
+        [ clone ]
+        with-out-parameters Scan0>>
+    ] compile-call
+] unit-test
diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index 6d2dec1c0d..09750d9d3f 100644
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -288,14 +288,12 @@ generic-comparison-ops [
     literal>> dup tuple-class? [ drop tuple ] unless <class-info>
 ] "outputs" set-word-prop
 
-! the output of clone has the same type as the input
+! the output of (clone) has the same type as the input
 : cloned-value-info ( value-info -- value-info' )
     clone f >>literal f >>literal?
     [ [ dup [ cloned-value-info ] when ] map ] change-slots ;
 
-{ clone (clone) } [
-    [ cloned-value-info ] "outputs" set-word-prop
-] each
+\ (clone) [ cloned-value-info ] "outputs" set-word-prop
 
 \ slot [
     dup literal?>>

From 01d67104f6036c4901ae19d930fa3bbc7947814b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 7 Jul 2010 17:32:30 -0400
Subject: [PATCH 2/2] io.ports: fix stream-seek with seek-relative seek type
 (reported by Joe Groff)

---
 basis/io/ports/ports.factor      | 12 +++++++++++-
 core/io/files/files-tests.factor |  9 +++++++++
 2 files changed, 20 insertions(+), 1 deletion(-)

diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 3864b37e48..8517910b0f 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -4,7 +4,8 @@ USING: math kernel io sequences io.buffers io.timeouts generic
 byte-vectors system io.encodings math.order io.backend
 continuations classes byte-arrays namespaces splitting grouping
 dlists alien alien.c-types assocs io.encodings.binary summary
-accessors destructors combinators fry specialized-arrays ;
+accessors destructors combinators fry specialized-arrays
+locals ;
 SPECIALIZED-ARRAY: uchar
 IN: io.ports
 
@@ -148,12 +149,21 @@ M: output-port stream-tell ( stream -- n )
     [ check-disposed ]
     [ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi + ] bi ;
 
+:: do-seek-relative ( n seek-type stream -- n seek-type stream )
+    ! seek-relative needs special handling here, because of the
+    ! buffer.
+    seek-type seek-relative eq?
+    [ n stream stream-tell + seek-absolute ] [ n seek-type ] if
+    stream ;
+
 M: input-port stream-seek ( n seek-type stream -- )
+    do-seek-relative
     [ check-disposed ]
     [ buffer>> 0 swap buffer-reset ]
     [ handle>> seek-handle ] tri ;
 
 M: output-port stream-seek ( n seek-type stream -- )
+    do-seek-relative
     [ check-disposed ]
     [ stream-flush ]
     [ handle>> seek-handle ] tri ;
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index 4986fedd79..8b578750bc 100644
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -245,6 +245,15 @@ CONSTANT: pt-array-1
     ] with-file-reader
 ] must-fail
 
+[ ] [
+    "resource:misc/icons/Factor_48x48.png" binary [
+        44 read drop
+        tell-input 44 assert=
+        -44 seek-relative seek-input
+        tell-input 0 assert=
+    ] with-file-reader
+] unit-test
+
 [
     "non-string-error" unique-file ascii [
         { } write