Changeset 549

Timestamp:

06/17/08 11:52:48 (7 months ago)

Author:

weyrick

Message:

fix detection of references in serialize

Location:

trunk/pcc/runtime

Files:

• ext/standard/php-variable.scm (modified) (5 diffs)
• php-hash.scm (modified) (3 diffs)

trunk/pcc/runtime/ext/standard/php-variable.scm

@@ -163 +163 @@
    (let ((refhash (make-grasstable))
          (varcount 0))
-      (letrec ((fork-it   (lambda (v ref? key?)
+      (letrec ((fork-it   (lambda (v key?)
                              ; handle refs
-                             (let ((ref-loc (grasstable-get refhash v)))
-                                (if (and ref-loc ref?)                                   
+                             (let* ((c? (container? v))
+                                    (ubv (if c? (container-value  v) v))
+                                    (ref-loc (grasstable-get refhash v)))
+                                (if ref-loc
                                     (format "R:~a;" ref-loc)
                                     (begin
@@ -172 +174 @@
                                        (unless key?
                                           (set! varcount (+ varcount 1)))
-                                       (if ref?
+                                       (when (and c? (container-reference? v))
                                           (grasstable-put! refhash v varcount))
                                        (cond
-                                          ((is_bool v) (do-bool v))
-                                          ((is_int v) (do-int v))
-                                          ((is_float v) (do-float v))
-                                          ((is_string v) (do-string v))
-                                          ((is_array v) (do-array v))
-                                          ((is_object v) (do-object v))
-                                          ((is_null v) (do-null v))
+                                          ((is_bool ubv) (do-bool ubv))
+                                          ((is_int ubv) (do-int ubv))
+                                          ((is_float ubv) (do-float ubv))
+                                          ((is_string ubv) (do-string ubv))
+                                          ((is_array ubv) (do-array ubv))
+                                          ((is_object ubv) (do-object ubv))
+                                          ((is_null ubv) (do-null ubv))
                                           (else
                                            ;(php-warning "serialize: unknown type for " v)
@@ -196 +198 @@
                                 (lambda ()
                                    (display (format "a:~a:{" (php-hash-size v)))
-                                   (php-hash-for-each-with-ref-status v
-                                                                      (lambda (ak av r?)
-                                                                         ;(fprint (current-error-port) "doing " ak " => " av)
-                                                                         (display (fork-it ak #f #t))
-                                                                         (display (fork-it av r? #f))))
+                                   (php-hash-for-each-location v
+                                                               (lambda (ak av)
+                                                                  ;(fprint (current-error-port) "doing " ak " => " av)
+                                                                  (display (fork-it ak #t))
+                                                                  (display (fork-it av #f))))
                                    (display "}")))))
                (do-object (lambda (v)
@@ -218 +220 @@
                                                                              (php-hash-size propshash)
                                                                              (php-hash-size ser-vars))))
-                                                 (php-hash-for-each-with-ref-status
+                                                 (php-hash-for-each-location
                                                   propshash
-                                                  (lambda (ak av r?)
+                                                  (lambda (ak av)
                                                      (when (or (eqv? ser-vars 'all)
                                                              (php-hash-in-array? ser-vars ak #f))
-                                                        (display (fork-it ak #f #t))
-                                                        (display (fork-it av r? #f)))))
+                                                        (display (fork-it ak #t))
+                                                        (display (fork-it av #f)))))
                                                  (display "}")))
                                            )))))
@@ -236 +238 @@
                              ;(fprint (current-error-port) "i'm a bool")
                              (if v "b:1;" "b:0;"))))
-         (fork-it var #f #f))))
+         (fork-it var #f))))
 
 ; unserialize --  Creates a PHP value from a stored representation

trunk/pcc/runtime/php-hash.scm

@@ -48 +48 @@
            (php-hash-remove! hash key)
            (php-hash-for-each hash thunk::procedure)
-           (php-hash-for-each-with-ref-status hash thunk::procedure)
+           (php-hash-for-each-with-ref-status hash thunk::procedure)       
+           (php-hash-for-each-location hash thunk::procedure)
            (php-hash-reverse-for-each hash thunk::procedure)
            (php-hash-for-each-ref hash thunk::procedure)
@@ -809 +810 @@
 
 (define (php-hash-for-each-with-ref-status hash thunk::procedure)
-   "Thunk will be called once on each key/value set. ref status is available to thunk"
+   "Thunk will be called once on each key/value set. the value will be the location container"
    (when (custom? hash) (set! hash (custom-read-entire hash)))
    (let loop ((entry (%php-hash-head hash)))
@@ -815 +816 @@
          (thunk (get-key-php-type-friendly entry)
                 (container-value (%entry-value entry))
-                (container-reference? (%entry-value entry)))
+                (container-reference? (%entry-value entry)))
+         ;              (%entry-ref? entry))
+         (loop (%entry-next entry)))))
+
+(define (php-hash-for-each-location hash thunk::procedure)
+   "Thunk will be called once on each key/value set. the value will be the location container"
+   (when (custom? hash) (set! hash (custom-read-entire hash)))
+   (let loop ((entry (%php-hash-head hash)))
+      (unless (sentinel? entry)
+         (thunk (get-key-php-type-friendly entry)
+                (%entry-value entry))
          ;              (%entry-ref? entry))
          (loop (%entry-next entry)))))