File: 54_graph_attributes.t

package info (click to toggle)
libgraph-perl 1%3A0.96-2
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 1,316 kB
  • ctags: 938
  • sloc: perl: 6,094; sh: 8; makefile: 2
file content (131 lines) | stat: -rw-r--r-- 3,820 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
use Test::More tests => 70;

use Graph;
my $g = Graph->new;

ok( !$g->has_graph_attributes() );
ok( !$g->has_graph_attributes() );

ok( $g->set_graph_attribute("color", "red") );

ok(  $g->has_graph_attribute("color") );
ok(  $g->has_graph_attribute("color") );

ok( $g->has_graph_attributes() );
ok( $g->has_graph_attributes() );

is( $g->get_graph_attribute("color"),  "red" );
is( $g->get_graph_attribute("color"),  "red" );

is( $g->get_graph_attribute("colour"), undef );
is( $g->get_graph_attribute("colour"), undef );

ok( $g->set_graph_attribute("color", "green") );

ok( $g->has_graph_attributes() );
ok( $g->has_graph_attributes() );

is( $g->get_graph_attribute("color"),  "green" );
is( $g->get_graph_attribute("color"),  "green" );

my $attr = $g->get_graph_attributes();
my @name = $g->get_graph_attribute_names();
my @val  = $g->get_graph_attribute_values();

is( scalar keys %$attr, 1 );
is( scalar @name,       1 );
is( scalar @val,        1 );

is( $attr->{color}, "green" );
is( $name[0],       "color" );
is( $val[0],        "green" );

ok( $g->set_graph_attribute("taste", "rhubarb") );

ok( $g->has_graph_attributes() );
ok( $g->has_graph_attributes() );

is( $g->get_graph_attribute("taste"),  "rhubarb" );
is( $g->get_graph_attribute("taste"),  "rhubarb" );

is( $g->get_graph_attribute("color"),  "green" );
is( $g->get_graph_attribute("taste"),  "rhubarb" );

$attr = $g->get_graph_attributes();
@name = sort $g->get_graph_attribute_names();
@val  = sort $g->get_graph_attribute_values();

is( scalar keys %$attr, 2 );
is( scalar @name,       2 );
is( scalar @val,        2 );

is( $attr->{color}, "green" );
is( $attr->{taste}, "rhubarb" );
is( $name[0],       "color" );
is( $val[0],        "green" );
is( $name[1],       "taste" );
is( $val[1],        "rhubarb" );

ok( $g->delete_graph_attribute("color" ) );

ok( !$g->has_graph_attribute("color" ) );
ok(  $g->has_graph_attributes() );
is(  $g->get_graph_attribute("taste"),  "rhubarb" );

ok(  $g->delete_graph_attributes() );
ok( !$g->has_graph_attributes() );
is(  $g->get_graph_attribute("taste"),  undef );

ok( !$g->delete_graph_attribute("taste" ) );
ok( !$g->delete_graph_attributes() );

$attr = $g->get_graph_attributes();
@name = $g->get_graph_attribute_names();
@val  = $g->get_graph_attribute_values();

is( scalar keys %$attr, 0 );
is( scalar @name,       0 );
is( scalar @val,        0 );

ok($g->set_graph_attributes({ 'color' => 'pearl', 'weight' => 'heavy' }));
$attr = $g->get_graph_attributes();
is(scalar keys %$attr, 2);
is($attr->{color},  'pearl');
is($attr->{weight}, 'heavy');

{
    use Graph::Directed;
    use Graph::Undirected;

    my $g1a = Graph::Directed->new;
    my $g1b = Graph::Undirected->new;

    $g1a->add_edge(qw(a b));
    $g1a->add_edge(qw(b c));
    $g1a->add_edge(qw(b d));

    $g1b->add_edge(qw(a b));
    $g1b->add_edge(qw(b c));
    $g1b->add_edge(qw(b d));
    
    $g1a->set_graph_attribute('color', 'electric blue');
    $g1b->set_graph_attribute('color', 'firetruck red');

    is("@{[sort $g1a->successors('a')]}",   "b");
    is("@{[sort $g1a->successors('b')]}",   "c d");
    is("@{[sort $g1a->successors('c')]}",   "");
    is("@{[sort $g1a->successors('d')]}",   "");
    is("@{[sort $g1a->predecessors('a')]}", "");
    is("@{[sort $g1a->predecessors('b')]}", "a");
    is("@{[sort $g1a->predecessors('c')]}", "b");
    is("@{[sort $g1a->predecessors('d')]}", "b");

    is("@{[sort $g1b->successors('a')]}",   "b");
    is("@{[sort $g1b->successors('b')]}",   "a c d");
    is("@{[sort $g1b->successors('c')]}",   "b");
    is("@{[sort $g1b->successors('d')]}",   "b");
    is("@{[sort $g1b->predecessors('a')]}", "b");
    is("@{[sort $g1b->predecessors('b')]}", "a c d");
    is("@{[sort $g1b->predecessors('c')]}", "b");
    is("@{[sort $g1b->predecessors('d')]}", "b");
}