Fri Feb 03 19:09:56 2012: Request 74578 was acted upon.
Transaction: Correspondence added by DOUGW
       Queue: Win32-API
     Subject: Win32::API::Struct not aligned on 64 bit
   Broken in: 0.64
    Severity: Normal
       Owner: Nobody
  Requestors: do...@cpan.org
      Status: open
 Ticket <URL: https://rt.cpan.org/Ticket/Display.html?id=74578 >


On Fri Feb 03 18:36:54 2012, DOUGW wrote:
> On Fri Feb 03 18:35:45 2012, DOUGW wrote:
> > 
> > That said, Win32::API::getPack() and the calls to it are wrong. It
> 
> I mean Win32::API::Struct::getUnpack. Sorry for the confusion.

I have a patch for this pack/unpack issue (the align is still off). I'm
using the struct as the basis for the unpack via getUnpack() to get the
size and unpack template. Unfortunately, I've switched from AS perl to
Strawberry, and upgraded to 5.14. Now the program works ok, but I get
"Free to wrong pool" when the program exits. I'll try re-installing
Win32::API.

Or I'm going to see what happens when I use AS perl again.


--- Struct_orig.pm      2012-02-03 15:39:35 -0800
+++ Struct.pm   2012-02-03 15:52:38 -0800
@@ -200,9 +200,10 @@
             $packing .= $subpacking;
             $packed_size += $subpacksize;
         } else {
+            my $repeat = 1;
             if($type =~ /\w\*(\d+)/) {
-                my $size = $1;
-                $type = "a$size";
+                $repeat = $1;
+                $type = "a$repeat";
             }
             
             DEBUG "(PM)Struct::getPack($self->{__typedef__}) ++ $type\n"; 
@@ -215,9 +216,9 @@
             }
             push(@recipients, $self);
             $type_size = Win32::API::Type::sizeof($orig);
-            $type_align = (($packed_size + $type_size) % $type_size);
+            $type_align = (($packed_size + ($type_size*$repeat)) % $type_size);
             $packing .= "x" x $type_align . $type;
-            $packed_size += $type_size + $type_align;
+            $packed_size += ($type_size*$repeat) + $type_align;
         }
     }
 
@@ -253,32 +254,33 @@
     foreach my $member (@{ $self->{typedef} }) {
         ($name, $type, $orig) = @$member;
         if($type eq '>') {
-            my($subpacking, @subitems, $subpacksize) = 
$self->{$name}->getUnpack();            
+            my($subpacking, $subpacksize, @subitems) = 
$self->{$name}->getUnpack();            
             DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ 
$subpacking\n";
             $packing .= $subpacking;
             $packed_size += $subpacksize;          
             push(@items, @subitems);
         } else {
+            my $repeat = 1;
             if($type =~ /\w\*(\d+)/) {
-                my $size = $1;
-                $type = "Z$size";
+                my $repeat = $1;
+                $type = "Z$repeat";
             }          
            DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ $type\n";
            $type_size = Win32::API::Type::sizeof($orig);
-           $type_align = (($packed_size + $type_size) % $type_size);
+           $type_align = (($packed_size + ( $type_size * $repeat )) % 
$type_size);
            $packing .= "x" x $type_align . $type;
-           $packed_size += $type_size + $type_align;
+           $packed_size += ( $type_size * $repeat ) + $type_align;
 
             push(@items, $name);
         }
     }
     DEBUG "(PM)Struct::getUnpack($self->{__typedef__}): unpack($packing, 
@items)\n";
-    return($packing, @items, $packed_size);
+    return($packing, $packed_size, @items);
 }
 
 sub Unpack {
     my $self = shift;
-    my($packing, @items) = $self->getUnpack();
+    my($packing, undef, @items) = $self->getUnpack();
     my @itemvalue = unpack($packing, $self->{buffer});
     DEBUG "(PM)Struct::Unpack: unpack($packing, buffer) = @itemvalue\n";
     foreach my $i (0..$#items) {

Reply via email to