1################################################################################ 2# 3# Copyright (c) 2002-2020 Marcus Holland-Moritz. All rights reserved. 4# This program is free software; you can redistribute it and/or modify 5# it under the same terms as Perl itself. 6# 7################################################################################ 8 9use Test; 10use Convert::Binary::C @ARGV; 11 12$^W = 1; 13 14BEGIN { 15 plan tests => 417; 16} 17 18my $CCCFG = require './tests/include/config.pl'; 19 20%basic = ( char => 1, short => 1, int => 1, 21 long => 1, signed => 1, unsigned => 1, 22 float => 1, double => 1, void => 1 ); 23 24eval { 25 $c = Convert::Binary::C->new( 26 ShortSize => 2, 27 IntSize => 4, 28 LongSize => 4, 29 LongLongSize => 8, 30 EnumSize => 4, 31 PointerSize => 4, 32 Alignment => 4, 33 )->parse( <<ENDC ); 34 35typedef struct { 36 int a; 37 short b[3][1]; 38 long *c; 39 char d; 40 char *e[2]; 41} Typedef, *PTypedef, ATypedef[2][3]; 42 43struct Struct { 44 char *a[2][2]; 45 struct { 46 int a; 47 enum { 48 ENUM 49 } b[2], *c; 50 } b[3], *c[2]; 51}; 52 53union Union { 54 struct { 55 char color[2]; 56 long size; 57 union { 58 struct { 59 char a; 60 } foo; 61 char taste; 62 } stuff; 63 } apple; 64 char grape[3]; 65 struct { 66 union { 67 long weight; 68 short foo; 69 enum { FOO } test; 70 struct { 71 char a; 72 union { 73 short b; 74 char c; 75 }; 76 } compound; 77 }; 78 short price[3]; 79 } melon; 80}; 81 82enum Enum { 83 ZERO 84}; 85 86struct Main { 87 Typedef a[2], *b, *c[3][4]; 88 struct Struct d[1][2], *e, *f[2]; 89 union Union g, *h; 90 enum Enum i, *j, k[3], *l[2][3]; 91 int m, *n, *o[4]; 92 PTypedef p[2], *q, *r[3][4]; 93 ATypedef s[2], *t, *u[3][4]; 94}; 95 96typedef struct { 97 int foo; 98} Array[2]; 99 100typedef struct { 101 Array bar; 102} Type; 103 104ENDC 105}; 106ok($@,'',"failed to create object / parse code"); 107 108@ref = ( 109 { members => [qw(.apple.color[0] .grape[0] .melon.weight .melon.foo .melon.test .melon.compound.a)], 110 types => [qw(char char long short enum char )], }, 111 { members => [qw(.apple.color[1] .grape[1] .melon.weight+1 .melon.foo+1 .melon.test+1 .melon.compound+1)], 112 types => [qw(char char long short enum struct )], }, 113 { members => [qw(.grape[2] .melon.compound.b .melon.compound.c .melon.weight+2 .melon.test+2 .apple+2)], 114 types => [qw(char short char long enum struct )], }, 115 { members => [qw(.melon.weight+3 .melon.test+3 .melon.compound.b+1 .apple+3)], 116 types => [qw(long enum short struct )], }, 117 { members => [qw(.apple.size .melon.price[0])], 118 types => [qw(long short )], }, 119 { members => [qw(.apple.size+1 .melon.price[0]+1)], 120 types => [qw(long short )], }, 121 { members => [qw(.melon.price[1] .apple.size+2)], 122 types => [qw(short long )], }, 123 { members => [qw(.apple.size+3 .melon.price[1]+1)], 124 types => [qw(long short )], }, 125 { members => [qw(.apple.stuff.foo.a .apple.stuff.taste .melon.price[2])], 126 types => [qw(char char short )], }, 127 { members => [qw(.melon.price[2]+1 .apple+9)], 128 types => [qw(short struct )], }, 129 { members => [qw(.apple+10 .melon+10)], 130 types => [qw(struct struct )], }, 131 { members => [qw(.apple+11 .melon+11)], 132 types => [qw(struct struct )], }, 133); 134 135for my $off ( 0 .. $c->sizeof( 'Union' )-1 ) { 136 my @members = eval { $c->member( 'Union', $off ) }; 137 ok( $@, '' ); 138 for( 0 .. $#members ) { 139 my $type = eval { $c->typeof( "Union $members[$_]" ) }; 140 ok( $@, '' ); 141 ok( $members[$_], $ref[$off]{members}[$_] ); 142 ok( $type, $ref[$off]{types}[$_] ); 143 } 144} 145 146run_tests($c); 147 148eval { 149 $c->configure(%$CCCFG)->clean->parse_file( 'tests/include/include.c' ); 150}; 151ok($@,'',"failed to create Convert::Binary::C object"); 152 153run_tests($c); 154 155sub run_tests { 156 my $c = shift; 157 158 for my $mtype ( $c->compound_names ) { 159 my @warn; 160 local $SIG{__WARN__} = sub { push @warn, $_[0] }; 161 my $fail = 0; 162 my $success = 0; 163 my $sizeof = $c->sizeof($mtype); 164 for my $off ( 0 .. $sizeof ) { 165 my @warn; 166 my $member = eval { $c->member( $mtype, $off ) }; 167 if( $off == $sizeof ) { 168 unless( $@ =~ /Offset $off out of range \(0 <= offset < $sizeof\)/ ) { 169 print "# wrong error\n"; 170 $fail++; 171 } 172 else { $success++ } 173 } 174 else { 175 unless( $@ eq '' ) { 176 print "# unexpected error\n"; 177 $fail++; 178 } 179 else { $success++ } 180 my @members = eval { $c->member( $mtype, $off ) }; 181 unless( $@ eq '' ) { 182 print "# unexpected error\n"; 183 $fail++; 184 } 185 else { $success++ } 186 unless( @members > 0 and $members[0] eq $member ) { 187 print "# wrong members in list context\n"; 188 $fail++; 189 } 190 else { $success++ } 191 for $member( @members ) { 192 my $type = eval { $c->typeof( "$mtype $member" ) || '[pad]' }; 193 unless( $@ eq '' ) { 194 print "# unexpected error\n"; 195 $fail++; 196 } 197 else { $success++ } 198 my $offset = eval { $c->offsetof($mtype, $member) }; 199 unless( $@ eq '' ) { 200 print "# unexpected error\n"; 201 $fail++; 202 } 203 else { $success++ } 204 unless( $offset == $off ) { 205 print "# invalid offset\n"; 206 $fail++; 207 } 208 else { $success++ } 209 $member =~ s/\+\d+$//; 210 while( $member ) { 211 my $typeof = eval { $c->typeof("$mtype $member") }; 212 unless( $@ eq '' ) { 213 print "# unexpected error\n"; 214 $fail++; 215 } 216 else { $success++ } 217 unless( defined $typeof ) { 218 print "# undefined type\n"; 219 $fail++; 220 } 221 else { $success++ } 222 $member =~ s/(?:\[\d+\]|\.\w+|^\w+)$//; 223 } 224 } 225 } 226 } 227 for( @warn ) { 228 print "# wrong warning\n"; 229 $fail++; 230 } 231 ok( $fail == 0 ); 232 ok( $success > 0 ); 233 } 234 235 for my $t ( $c->compound_names, $c->typedef_names ) { 236 my %h; 237 my @m; 238 my $fail = 0; 239 my $success = 0; 240 my $meth = $c->def($t) or next; 241 my $def = $c->$meth( $t ); 242 243 $meth eq 'typedef' and $h{$t} = $t; 244 get_types( \%h, \@m, $c, $t, $def ); 245 246 while( my($k,$v) = each %h ) { 247 my $to = $c->typeof($k); 248 unless( $to eq $v ) { 249 print "# typeof mismatch for $meth <$k> ('$to' != '$v')\n"; 250 $fail++; 251 } 252 else { $success++ } 253 } 254 ok( $fail == 0 ); 255 ok( $success > 0 ); 256 257 if( @m >= 2 ) { 258 $fail = $success = 0; 259 my %dup; 260 for my $member ( $c->member($t) ) { 261 my $ref = shift @m; 262 warn "[$t][$member]" unless defined $ref; 263 if( $t.$member ne $ref ) { 264 print "# '$t$member' ne '$ref'\n"; 265 $fail++; 266 } 267 else { $success++ } 268 if( $dup{$member}++ ) { 269 print "# duplicate member '$t$member' (count=$dup{$member})\n"; 270 $fail++; 271 } 272 else { $success++ } 273 } 274 ok( $fail == 0 ); 275 ok( $success > 0 ); 276 } 277 } 278} 279 280 281sub get_types { 282 my($r, $m, $c, $t, $d) = @_; 283 if( exists $d->{declarator} ) { 284 my($p,$n,$a) = $d->{declarator} =~ /^(\*?)(\w+)((?:\[\])?(?:\[\d+\])*)$/ or die "BOO!"; 285 my $dim = [$a =~ /\[(\d+)?\]/g]; 286 get_array($r, $m, $c, $t, $d->{type}, $p, $dim); 287 } 288 elsif( exists $d->{declarations} ) { 289 # it's a compound 290 for my $d1 ( @{$d->{declarations}} ) { 291 if( exists $d1->{declarators} ) { 292 for my $d2 ( @{$d1->{declarators}} ) { 293 my($p,$n,$b,$a) = $d2->{declarator} =~ /^(\*?)(\w*)(:\d+)?((?:\[\])?(?:\[\d+\])*)$/ or die "BOO!"; 294 defined $b and $n eq '' and next; 295 my $dim = [$a =~ /\[(\d+)?\]/g]; 296 get_array($r, $m, $c, "$t.$n", $b ? "$d1->{type} $b" : $d1->{type}, $p, $dim); 297 } 298 } 299 else { 300 get_types($r, $m, $c, $t, $d1->{type}); 301 } 302 } 303 } 304 else { 305 push @$m, $t; 306 } 307} 308 309sub get_array { 310 my($r, $m, $c, $t, $d, $p, $dim) = @_; 311 my $rt; 312 313 if( ref $d ) { 314 if( exists $d->{declarations} ) { 315 $rt = $d->{type}; 316 } 317 elsif( exists $d->{enumerators} ) { 318 $rt = 'enum'; 319 } 320 else { die "BOO!" } 321 } 322 else { $rt = $d } 323 324 my $a = join '', map { defined $_ ? "[$_]" : '[]' } @$dim; 325 326 $p and $rt .= " $p"; 327 $a and $rt .= " $a"; 328 329 $r->{$t} ||= $rt; 330 331 if( @$dim ) { 332 my @dim = @$dim; 333 my $cd = shift @dim; 334 defined $cd or return; # don't add incomplete types 335 for my $i ( 0 .. $cd-1 ) { 336 get_array($r, $m, $c, $t."[$i]", $d, $p, \@dim); 337 } 338 } 339 elsif( !$p ) { 340 if( ref $d ) { 341 get_types($r, $m, $c, $t.$a, $d); 342 } 343 else { 344 if( $d =~ /^(?:struct|union)/ ) { 345 get_types($r, $m, $c, $t.$a, $c->compound($d)); 346 } 347 elsif( $d =~ /^enum\s+\w+/ ) { 348 push @$m, $t; 349 } 350 elsif( $d =~ /^\w+$/ and not exists $basic{$d} ) { 351 get_types($r, $m, $c, $t.$a, $c->typedef($d)); 352 } 353 else { 354 push @$m, $t; 355 } 356 } 357 } 358 else { 359 push @$m, $t; 360 } 361} 362