view release on metacpan or  search on metacpan

t/generate/08-codegen-injection.t  view on Meta::CPAN

# --- Hostile specs: injected code must NOT run, for every style -------------
my $i = 0;
for my $name (sort keys %style) {
  my $class = "Injection::Test::" . ucfirst($name) . (++$i);
  my $spec  = hostile_spec($class);

  my $code = eval { $style{$name}->emit($spec) };
  ok defined $code, "$name: emit() produced source for hostile spec"
    or do { diag "emit died: $@"; next };

  my ($ok, $err) = require_generated($code, $name);

  # The generated module may or may not compile cleanly (a poisoned identifier
  # safely embedded as a string literal yields valid Perl; we don't require
  # compilation to fail). What MUST hold: no injected code executed.
  ok !-e $sentinel,
    "$name: hostile identifiers did NOT execute injected code (no sentinel)";

  unlink $sentinel if -e $sentinel;
}

t/generate/08-codegen-injection.t  view on Meta::CPAN

    relationships => [],
    extra_statements => [],
    is_view => 0,
    view_definition => undef,
    result_base_class => 'DBIO::Core',
    components => [],
    additional_classes => [],
  };

  my $code = $style{$name}->emit($spec);
  my ($ok, $err) = require_generated($code, "benign-$name");
  ok $ok, "$name: benign spec compiles cleanly" or diag $err;
  ok !-e $sentinel, "$name: benign spec creates no sentinel";

  unlink $sentinel if -e $sentinel;
}

# --- Package-name validator must croak on a hostile class -------------------
{
  my $evil_class = q{Foo; BEGIN { open my $f,'>',$ENV{DBIO_INJECTION_SENTINEL} } package Bar};
  for my $name (sort keys %style) {