chiark - git - mdw - dpkg/blob - scripts/t/Dpkg_Substvars.t

   1 #!/usr/bin/perl
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  15
  16 use strict;
  17 use warnings;
  18
  19 use Test::More tests => 37;
  20 use Test::Dpkg qw(:paths);
  21
  22 use Dpkg ();
  23 use Dpkg::Arch qw(get_host_arch);
  24
  25 use_ok('Dpkg::Substvars');
  26
  27 my $datadir = test_get_data_path('t/Dpkg_Substvars');
  28
  29 my $expected;
  30
  31 my $s = Dpkg::Substvars->new();
  32
  33 $s->load("$datadir/substvars1");
  34
  35 # simple value tests
  36 is($s->get('var1'), 'Some value', 'var1');
  37 is($s->get('var2'), 'Some other value', 'var2');
  38 is($s->get('var3'), 'Yet another value', 'var3');
  39 is($s->get('var4'), undef, 'no var4');
  40
  41 # Set automatic variable
  42 $s->set_as_auto('var_auto', 'auto');
  43 is($s->get('var_auto'), 'auto', 'get var_auto');
  44
  45 $expected = <<'VARS';
  46 var1=Some value
  47 var2=Some other value
  48 var3=Yet another value
  49 VARS
  50 is($s->output(), $expected, 'No automatic variables output');
  51
  52 # overriding
  53 $s->set('var1', 'New value');
  54 is($s->get('var1'), 'New value', 'var1 updated');
  55
  56 # deleting
  57 $s->delete('var3');
  58 is($s->get('var3'), undef, 'var3 deleted');
  59
  60 # default variables
  61 is($s->get('Newline'), "\n", 'newline');
  62 is($s->get('Space'), ' ', 'space');
  63 is($s->get('Tab'), "\t", 'tab');
  64 is($s->get('dpkg:Version'), $Dpkg::PROGVERSION, 'dpkg version 1');
  65
  66 # special variables
  67 is($s->get('Arch'), undef, 'no arch');
  68 $s->set_arch_substvars();
  69 is($s->get('Arch'), get_host_arch(), 'arch');
  70
  71 is($s->get($_), undef, 'no ' . $_) for qw/binary:Version source:Version source:Upstream-Version/;
  72 $s->set_version_substvars('1:2.3.4~5-6.7.8~nmu9', '1:2.3.4~5-6.7.8~nmu9+bin0');
  73 is($s->get('binary:Version'), '1:2.3.4~5-6.7.8~nmu9+bin0', 'binary:Version');
  74 is($s->get('source:Version'), '1:2.3.4~5-6.7.8~nmu9', 'source:Version');
  75 is($s->get('source:Upstream-Version'), '1:2.3.4~5', 'source:Upstream-Version');
  76 $s->set_version_substvars('2.3.4~5-6.7.8~nmu9+b1', '1:2.3.4~5-6.7.8~nmu9+b1');
  77 is($s->get('binary:Version'), '1:2.3.4~5-6.7.8~nmu9+b1', 'binary:Version');
  78 is($s->get('source:Version'), '2.3.4~5-6.7.8~nmu9', 'source:Version');
  79 is($s->get('source:Upstream-Version'), '2.3.4~5', 'source:Upstream-Version');
  80 $s->set_version_substvars('1:2.3.4~5-6.7.8~nmu9+b0');
  81 is($s->get('binary:Version'), '1:2.3.4~5-6.7.8~nmu9+b0', 'binary:Version');
  82 is($s->get('source:Version'), '1:2.3.4~5-6.7.8~nmu9', 'source:Version');
  83 is($s->get('source:Upstream-Version'), '1:2.3.4~5', 'source:Upstream-Version');
  84
  85 # Replace stuff
  86 is($s->substvars('This is a string ${var1} with variables ${binary:Version}'),
  87                  'This is a string New value with variables 1:2.3.4~5-6.7.8~nmu9+b0',
  88                  'substvars simple');
  89
  90 # Add a test prefix to error and warning messages.
  91 $s->set_msg_prefix('test ');
  92
  93 my $output;
  94 $SIG{__WARN__} = sub { $output .= $_[0] };
  95 is($s->substvars('This is a string with unknown variable ${blubb}'),
  96                  'This is a string with unknown variable ',
  97                  'substvars missing');
  98 delete $SIG{__WARN__};
  99 is($output,
 100    'Dpkg_Substvars.t: warning: test unknown substitution variable ${blubb}' . "\n",
 101    'missing variables warning');
 102
 103 # Recursive replace
 104 $s->set('rvar', 'recursive ${var1}');
 105 is($s->substvars('This is a string with ${rvar}'),
 106                  'This is a string with recursive New value',
 107                  'substvars recursive');
 108
 109 # Strange input
 110 is($s->substvars('Nothing to $ ${substitute  here}, is it ${}?, it ${is'),
 111                  'Nothing to $ ${substitute  here}, is it ${}?, it ${is',
 112                  'substvars strange');
 113
 114 # Warnings about unused variables
 115 $output = '';
 116 $SIG{__WARN__} = sub { $output .= $_[0] };
 117 $s->warn_about_unused();
 118 delete $SIG{__WARN__};
 119 is($output,
 120    'Dpkg_Substvars.t: warning: test unused substitution variable ${var2}' . "\n",
 121    'unused variables warnings');
 122
 123 # Disable warnings for a certain variable
 124 $s->set_as_used('var_used', 'used');
 125 $s->mark_as_used('var2');
 126 $output = '';
 127 $SIG{__WARN__} = sub { $output .= $_[0] };
 128 $s->warn_about_unused();
 129 delete $SIG{__WARN__};
 130 is($output, '', 'disabled unused variables warnings');
 131
 132 $s->delete('var_used');
 133
 134 # Variable filters
 135 my $sf;
 136
 137 $expected = <<'VARS';
 138 name3=Yet another value
 139 name4=Name value
 140 otherprefix:var7=Quux
 141 var1=Some value
 142 var2=Some other value
 143 VARS
 144 $sf = Dpkg::Substvars->new("$datadir/substvars2");
 145 $sf->filter(remove => sub { $_[0] =~ m/^prefix:/ });
 146 is($sf->output(), $expected, 'Filter remove variables');
 147
 148 $expected = <<'VARS';
 149 otherprefix:var7=Quux
 150 prefix:var5=Foo
 151 var1=Some value
 152 var2=Some other value
 153 VARS
 154 $sf = Dpkg::Substvars->new("$datadir/substvars2");
 155 $sf->filter(keep => sub { $_[0] =~ m/var/ });
 156 is($sf->output(), $expected, 'Filter keep variables');
 157
 158 $expected = <<'VARS';
 159 prefix:name6=Bar
 160 VARS
 161 $sf = Dpkg::Substvars->new("$datadir/substvars2");
 162 $sf->filter(remove => sub { $_[0] =~ m/var/ },
 163             keep => sub { $_[0] =~ m/^prefix:/ });
 164 is($sf->output(), $expected, 'Filter keep and remove variables');