view release on metacpan or  search on metacpan

lib/XS/Install/FrozenShit/ParseXS.pm  view on Meta::CPAN

  # More overload stuff

  if (keys %{ $self->{map_overloaded_package_to_C_package} }) {
    # Emit just once if any overloads:
    # Before 5.10, PL_amagic_generation used to need setting to at least a
    # non-zero value to tell perl that any overloading was present.
    print Q(<<"EOF");
      |    /* register the overloading (type 'A') magic */
      |#if PERL_VERSION_LE(5, 8, 999) /* PERL_VERSION_LT is 5.33+ */
      |    PL_amagic_generation++;
      |#endif
EOF

    for my $package (sort keys %{ $self->{map_overloaded_package_to_C_package} }) {
      # Emit once for each package with overloads:
      # Set ${'Foo::()'} to the fallback value for each overloaded
      # package 'Foo' (or undef if not specified).
      # But see the 'XXX' comments above about fallback and $().
      my $fallback =     $self->{map_package_to_fallback_string}->{$package}
                     || "&PL_sv_undef";
      print Q(<<"EOF");
        |    /* The magic for overload gets a GV* via gv_fetchmeth as */
        |    /* mentioned above, and looks in the SV* slot of it for */
        |    /* the "fallback" status. */
        |    sv_setsv(
        |        get_sv( "${package}::()", TRUE ),
        |        $fallback
        |    );
EOF

    }
  }

  # Emit any boot code associated with newXS().

  print @{ $self->{bootcode_early} };

  # Emit closing scope for the 'CV *cv' declaration

  if (   defined $self->{xsub_map_alias_name_to_value}
      or defined $self->{seen_INTERFACE_or_MACRO})
  {
    print Q(<<"EOF");
      |    ]]
EOF
  }

  # Emit any lines derived from BOOT: sections. By putting the lines back
  # into  $self->{line} and passing them through print_section(),
  # a trailing '#line' may be emitted to effect the change back to the
  # current foo.c line from the foo.xs part where the BOOT: code was.

  if (@{ $self->{bootcode_later} }) {
    print "\n    /* Initialisation Section */\n\n";
    print @{$self->{bootcode_later}};
    print 'XS::Install::FrozenShit::ParseXS::CountLines'->end_marker, "\n"
      if $self->{config_WantLineNumbers};
    print "\n    /* End of Initialisation Section */\n\n";
  }

  # Emit code to call any UNITCHECK blocks and return true. Since 5.22,
  # this is been put into a separate function.
  print Q(<<'EOF');
    |#if PERL_VERSION_LE(5, 21, 5)
    |#  if PERL_VERSION_GE(5, 9, 0)
    |    if (PL_unitcheckav)
    |        call_list(PL_scopestack_ix, PL_unitcheckav);
    |#  endif
    |    XSRETURN_YES;
    |#else
    |    Perl_xs_boot_epilog(aTHX_ ax);
    |#endif
    |]]
    |
    |#ifdef __cplusplus
    |]]
    |#endif
EOF

  warn("Please specify prototyping behavior for $self->{in_filename} (see perlxs manual)\n")
    unless $self->{proto_behaviour_specified};

  chdir($orig_cwd);
  select($orig_fh);
  untie *PSEUDO_STDOUT if tied *PSEUDO_STDOUT;
  close $self->{in_fh};

  return 1;
}


sub report_error_count {
  if (@_) {
    return $_[0]->{error_count}||0;
  }
  else {
    return $Singleton->{error_count}||0;
  }
}
*errors = \&report_error_count;


# $self->check_keyword("FOO|BAR")
#
# Return a keyword if the next non-blank line matches one of the passed
# keywords, or return undef otherwise.
#
# Expects $_ to be set to the current line. Skip any initial blank lines,
# (consuming @{$self->{line}} and updating $_).
#
# Then if it matches FOO: etc, strip the keyword and any comment from the
# line (leaving any argument in $_) and return the keyword. Return false
# otherwise.

sub check_keyword {
  my XS::Install::FrozenShit::ParseXS $self = shift;
  # skip blank lines
  $_ = shift(@{ $self->{line} }) while !/\S/ && @{ $self->{line} };

  s/^(\s*)($_[0])\s*:\s*(?:#.*)?/$1/s && $2;
}