scripts/t/Dpkg_BuildFlags.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 => 34;
  20
  21 BEGIN {
  22     $ENV{DEB_BUILD_ARCH} = 'amd64';
  23     $ENV{DEB_HOST_ARCH} = 'amd64';
  24     use_ok('Dpkg::BuildFlags');
  25 }
  26
  27 my $bf = Dpkg::BuildFlags->new();
  28
  29 ok($bf->has('CPPFLAGS'), 'CPPFLAGS is present');
  30 is($bf->get_origin('CPPFLAGS'), 'vendor', 'CPPFLAGS has a vendor origin');
  31
  32 $bf->set('DPKGFLAGS', '-Wflag -On -fsome', 'system');
  33 is($bf->get('DPKGFLAGS'), '-Wflag -On -fsome', 'get flag');
  34 is($bf->get_origin('DPKGFLAGS'), 'system', 'flag has a system origin');
  35 ok(!$bf->is_maintainer_modified('DPKGFLAGS'), 'set marked flag as non-maint modified');
  36
  37 $bf->strip('DPKGFLAGS', '-On', 'user', undef);
  38 is($bf->get('DPKGFLAGS'), '-Wflag -fsome', 'get stripped flag');
  39 is($bf->get_origin('DPKGFLAGS'), 'user', 'flag has a user origin');
  40 ok(!$bf->is_maintainer_modified('DPKGFLAGS'), 'strip marked flag as non-maint modified');
  41
  42 my @strip_tests = (
  43     {
  44         value => '-fsingle',
  45         strip => '-fsingle',
  46         exp => '',
  47     }, {
  48         value => '-fdupe -fdupe',
  49         strip => '-fdupe',
  50         exp => '',
  51     }, {
  52         value => '-Wa -fdupe -fdupe -Wb',
  53         strip => '-fdupe',
  54         exp => '-Wa -Wb',
  55     }, {
  56         value => '-fdupe -Wa -Wb -fdupe',
  57         strip => '-fdupe',
  58         exp => '-Wa -Wb',
  59     }, {
  60         value => '-fdupe -Wa -fdupe -Wb',
  61         strip => '-fdupe',
  62         exp => '-Wa -Wb',
  63     }, {
  64         value => '-Wa -fdupe -Wb -fdupe',
  65         strip => '-fdupe',
  66         exp => '-Wa -Wb',
  67     }
  68 );
  69
  70 foreach my $test (@strip_tests) {
  71     $bf->set('DPKGSTRIPFLAGS', $test->{value}, 'system');
  72     $bf->strip('DPKGSTRIPFLAGS', $test->{strip}, 'user', undef);
  73     is($bf->get('DPKGSTRIPFLAGS'), $test->{exp},
  74         "strip flag '$test->{strip}' from '$test->{value}' to '$test->{exp}'");
  75 }
  76
  77 $bf->append('DPKGFLAGS', '-Wl,other', 'vendor', 0);
  78 is($bf->get('DPKGFLAGS'), '-Wflag -fsome -Wl,other', 'get appended flag');
  79 is($bf->get_origin('DPKGFLAGS'), 'vendor', 'flag has a vendor origin');
  80 ok(!$bf->is_maintainer_modified('DPKGFLAGS'), 'append marked flag as non-maint modified');
  81
  82 $bf->prepend('DPKGFLAGS', '-Idir', 'env', 1);
  83 is($bf->get('DPKGFLAGS'), '-Idir -Wflag -fsome -Wl,other', 'get prepended flag');
  84 is($bf->get_origin('DPKGFLAGS'), 'env', 'flag has an env origin');
  85 ok($bf->is_maintainer_modified('DPKGFLAGS'), 'prepend marked flag as maint modified');
  86
  87 my %known_features = (
  88     future => [ qw(
  89         lfs
  90     ) ],
  91     abi => [ qw(
  92         time64
  93     ) ],
  94     hardening => [ qw(
  95         bindnow
  96         format
  97         fortify
  98         pie
  99         relro
 100         stackprotector
 101         stackprotectorstrong
 102     ) ],
 103     qa => [ qw(
 104         bug
 105         canary
 106     ) ],
 107     reproducible => [ qw(
 108         fixdebugpath
 109         fixfilepath
 110         timeless
 111     ) ],
 112     optimize => [ qw(
 113         lto
 114     ) ],
 115     sanitize => [ qw(
 116         address
 117         leak
 118         thread
 119         undefined
 120     ) ],
 121 );
 122
 123 is_deeply([ sort $bf->get_feature_areas() ], [ sort keys %known_features ],
 124           'supported feature areas');
 125
 126 foreach my $area (sort keys %known_features) {
 127     ok($bf->has_features($area), "has feature area $area");
 128     my %features = $bf->get_features($area);
 129     is_deeply([ sort keys %features ],
 130               $known_features{$area},
 131               "supported features for area $area");
 132 }
 133
 134 # TODO: Add more test cases.