view release on metacpan or  search on metacpan

Scan.pm  view on Meta::CPAN

		  ][]x );
    ($sym, $args, $mline) = ($1, $2, $3);
    $mline .= <$stream> while ($mline =~ s/\\\n/\n/);
    chomp $mline;
#print STDERR "sym: `$sym', args: `$args', mline: `$mline'\n";
    if (defined $args) {
      $macrosargs{$sym} = [ [split /\s*,\s*/, $args], $mline];
    } else {
      $macros{$sym} = $mline;
    }
  }
  # restore the original cppflags
  $Cpp->{'cppstdin'} = $old_cppstdin;
  [\%macros, \%macrosargs];
}

# sub nexttypedef {
#   return unless $_[0] =~ /(\G|^|;)\s*typedef\b/g;
#   my $start = pos($_[0]) - 7;
#   nextsemi($_[0]);
#   my $end = pos $_[0];
#   # warn "Found `", substr($_[0], $start, $end - $start), "'\n" if $debug;
#   return $start, $end;
# }  

# sub nextsemi {
#   my $n = 0;
#   while ($_[0] =~ /([\(\{\[])|([\]\)\}])|(\;)/g) {
#     $n++ if defined $1;
#     $n-- if defined $2;
#     return if defined $3 and $n == 0;
#   }
#   die "No semicolon on the outer level";
# }

sub typedef_texts {
  my ($txt, $chunks) = (shift, shift);
  my ($b, $e, $in, @out);
  my @in = @$chunks;
  while (($b, $e) = splice @in, 0, 2) {
    $in = substr($txt, $b, $e - $b);
    # remove any remaining directives
    $in =~ s/^ ( \s* \# .* ( \\ $ \n .* )* ) / ' ' x length($1)/xgem;
    push @out, $in;
  }
  \@out;
}

sub typedef_hash_old {
  +{ map {($_,1)} map /(\w+)/, @{$_[0]} };
}

sub typedef_hash {
  my ($typedefs, $whited) = (shift,shift);
  my %out;

 loop:
  for my $o (0..$#$typedefs) {
    my $wh = $whited->[$o];
    my $td = $typedefs->[$o];
    if ($wh =~ /,/ or not $wh =~ /\w/) { # Hard case, guessimates ...
      # Determine whether the new thingies are inside parens
      $wh =~ /,/g;
      my $p = pos $wh;
      my ($s, $e);
      if (matchingbrace($wh)) {	# Inside.  Easy part: just split on /,/...
	$e = pos($wh) - 1;
	$s = $e;
	my $d = 0;
	# Skip back
	while (--$s >= 0) {
	  my $c = substr $wh, $s, 1;
	  if ($c =~ /[\(\{\[]/) {
	    $d--;
	  } elsif ($c =~ /[\)\]\}]/) {
	    $d++;
	  }
	  last if $d < 0;
	}
	if ($s < 0) {		# Should not happen
	  warn("panic: could not match braces in\n\t$td\nwhited as\n\t$wh\n");
	  next loop;
	}
	$s++;
      } else {			# We are at toplevel
	# We need to skip back all the modifiers attached to the first thingy
	# Guesstimates: everything after the first '*' (inclusive)
	pos $wh = 0;
	$wh = /(?=\w)/g;
	my $ws = pos $wh;
	my $pre = substr $wh, 0, $ws;
	$s = $ws;
	$s = pos $pre if $pre =~ /(?=\*)/g;
	$e = length $wh;
      }
      # Now: need to split $td based on commas in $wh!
      # And need to split each chunk of $td based on word in the chunk of $wh!
      my $td_decls = substr($td, $s, $e - $s);
      my ($pre, $post) = (substr($td, 0, $s), substr($td, $e));
      my $wh_decls = substr($wh, $s, $e - $s);
      my @wh_decls = split /,/, $wh_decls;
      my $td_s = 0;
      my (@td_decl, @td_pre, @td_post, @td_word);
      for my $wh_d (@wh_decls) {
	my $td_d = substr $td, $td_s, length $wh_d;
	push @td_decl, $td_d;
	$wh_d =~ /(\w+)/g;
	push @td_word, $1;
	push @td_post, substr $td_d, pos($wh_d);
	push @td_pre,  substr $td_d, pos($wh_d) - length $1, length $1;
	$td_s += 1 + length $wh_d; # Skip over ','
      }
      for my $i (0..$#wh_decls) {
	my $p = "$td_post[$i]$post";
	$p = '' unless $p =~ /\S/;
	$out{$td_word[$i]} = ["$pre$td_pre[$i]", $p];
      }
    } else {			# Only one thing defined...
      $wh =~ /(\w+)/g;
      my $e	= pos $wh;
      my $s	= $e - length $1;