1#  Copyright (c) 1997-2021
2#  Ewgenij Gawrilow, Michael Joswig, and the polymake team
3#  Technische Universität Berlin, Germany
4#  https://polymake.org
5#
6#  This program is free software; you can redistribute it and/or modify it
7#  under the terms of the GNU General Public License as published by the
8#  Free Software Foundation; either version 2, or (at your option) any
9#  later version: http://www.gnu.org/licenses/gpl.txt.
10#
11#  This program is distributed in the hope that it will be useful,
12#  but WITHOUT ANY WARRANTY; without even the implied warranty of
13#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14#  GNU General Public License for more details.
15#-------------------------------------------------------------------------------
16
17use strict;
18use namespaces;
19use warnings qw(FATAL void syntax misc);
20
21package Polymake::Test::Output;
22
23use Polymake::Struct(
24   [ '@ISA' => 'Stream' ],
25   [ new => '$$%' ],
26   [ '$name' => '#2' ],
27   [ '$body' => '#1' ],
28   [ '$expected_error' => '#%' ],
29   '$gotten_error',
30);
31
32sub new {
33   my $self = &Case::new;
34   local open STDOUT, ">:utf8", \($self->buffer);
35   $self->run_code;
36   $self;
37}
38
39sub run_code {
40   my ($self) = @_;
41   eval { $self->body->() };
42   if ($@) {
43      $self->gotten_error = neutralized_ERROR();
44      $@ = "";
45   }
46}
47
48sub execute {
49   my ($self) = @_;
50   if (length($self->gotten_error)) {
51      if ($self->expected_error) {
52         $self->buffer .= $self->gotten_error;
53      } else {
54         $self->fail_log="expected: regular return\n".
55                         "     got: EXCEPTION: ".$self->gotten_error;
56         return 0;
57      }
58   } elsif ($self->expected_error) {
59      $self->fail_log="expected: EXCEPTION\n".
60                      "     got: regular return ".
61                      (length($self->buffer) ? "with output\n".$self->buffer : "without any output\n");
62      return 0;
63   }
64   &Stream::execute;
65}
66
671
68
69# Local Variables:
70# cperl-indent-level:3
71# indent-tabs-mode:nil
72# End:
73