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