Commit | Line | Data |
---|---|---|
1479465f GJ |
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 => 16830; | |
20 | ||
21 | use_ok('Dpkg::Arch', qw(debarch_to_debtuple debarch_to_multiarch | |
22 | debarch_eq debarch_is debarch_is_wildcard | |
23 | debarch_is_illegal | |
24 | debarch_to_cpuattrs | |
25 | debarch_list_parse | |
26 | debtuple_to_debarch gnutriplet_to_debarch | |
27 | get_host_gnu_type | |
28 | get_valid_arches)); | |
29 | ||
30 | sub get_valid_wildcards | |
31 | { | |
32 | my %wildcards; | |
33 | my @wildcards_base = qw( | |
34 | any | |
35 | any-any | |
36 | any-any-any | |
37 | any-any-any-any | |
38 | ); | |
39 | ||
40 | foreach my $archname (get_valid_arches()) { | |
41 | my @tuple = debarch_to_debtuple($archname); | |
42 | ||
43 | my @wildcards_arch = ( | |
44 | # Two element tuples. | |
45 | "$tuple[2]-any", | |
46 | "any-$tuple[3]", | |
47 | ||
48 | # Three element tuples. | |
49 | "$tuple[1]-$tuple[2]-any", | |
50 | "$tuple[1]-any-$tuple[3]", | |
51 | "$tuple[1]-any-any", | |
52 | "any-$tuple[2]-$tuple[3]", | |
53 | "any-$tuple[2]-any", | |
54 | "any-any-$tuple[3]", | |
55 | ||
56 | # Four element tuples. | |
57 | "$tuple[0]-$tuple[1]-$tuple[2]-any", | |
58 | "$tuple[0]-$tuple[1]-any-$tuple[3]", | |
59 | "$tuple[0]-$tuple[1]-any-any", | |
60 | "$tuple[0]-any-$tuple[2]-$tuple[3]", | |
61 | "$tuple[0]-any-$tuple[2]-any", | |
62 | "$tuple[0]-any-any-$tuple[3]", | |
63 | "$tuple[0]-any-any-any", | |
64 | "any-$tuple[1]-$tuple[2]-$tuple[3]", | |
65 | "any-$tuple[1]-$tuple[2]-any", | |
66 | "any-$tuple[1]-any-$tuple[3]", | |
67 | "any-$tuple[1]-any-any", | |
68 | "any-any-$tuple[2]-$tuple[3]", | |
69 | "any-any-$tuple[2]-any", | |
70 | "any-any-any-$tuple[3]", | |
71 | ); | |
72 | ||
73 | foreach my $wildcard ((@wildcards_base, @wildcards_arch)) { | |
74 | push @{$wildcards{$wildcard}}, $archname; | |
75 | } | |
76 | } | |
77 | ||
78 | return \%wildcards; | |
79 | } | |
80 | ||
81 | my @tuple_new; | |
82 | my @tuple_ref; | |
83 | ||
84 | @tuple_new = debarch_to_debtuple('unknown'); | |
85 | is_deeply(\@tuple_new, [], 'unknown tuple'); | |
86 | ||
87 | @tuple_ref = qw(base gnu linux amd64); | |
88 | @tuple_new = debarch_to_debtuple('amd64'); | |
89 | is_deeply(\@tuple_new, \@tuple_ref, 'valid tuple'); | |
90 | ||
91 | @tuple_ref = qw(base gnu linux amd64); | |
92 | @tuple_new = debarch_to_debtuple('amd64'); | |
93 | is_deeply(\@tuple_new, \@tuple_ref, 'valid tuple'); | |
94 | @tuple_new = debarch_to_debtuple('linux-amd64'); | |
95 | is_deeply(\@tuple_new, \@tuple_ref, 'valid tuple'); | |
96 | ||
97 | is(debarch_to_multiarch('i386'), 'i386-linux-gnu', | |
98 | 'normalized i386 multiarch triplet'); | |
99 | is(debarch_to_multiarch('amd64'), 'x86_64-linux-gnu', | |
100 | 'normalized amd64 multiarch triplet'); | |
101 | ||
102 | ok(!debarch_eq('amd64', 'i386'), 'no match, simple arch'); | |
103 | ok(!debarch_eq('', 'amd64'), 'no match, empty first arch'); | |
104 | ok(!debarch_eq('amd64', ''), 'no match, empty second arch'); | |
105 | ok(!debarch_eq('amd64', 'unknown'), 'no match, with first unknown arch'); | |
106 | ok(!debarch_eq('unknown', 'i386'), 'no match, second unknown arch'); | |
107 | ok(debarch_eq('unknown', 'unknown'), 'match equal unknown arch'); | |
108 | ok(debarch_eq('amd64', 'amd64'), 'match equal known arch'); | |
109 | ok(debarch_eq('amd64', 'linux-amd64'), 'match implicit linux arch'); | |
110 | ||
111 | ok(!debarch_is('unknown', 'linux-any'), 'no match unknown on wildcard cpu'); | |
112 | ok(!debarch_is('unknown', 'any-amd64'), 'no match unknown on wildcard os'); | |
113 | ok(!debarch_is('amd64', 'unknown'), 'no match amd64 on unknown wildcard'); | |
114 | ok(!debarch_is('amd64', 'unknown-any'), 'no match amd64 on unknown wildcard'); | |
115 | ok(!debarch_is('amd64', 'any-unknown'), 'no match amd64 on unknown wildcard'); | |
116 | ok(debarch_is('unknown', 'any'), 'match unknown on global wildcard'); | |
117 | ok(debarch_is('linux-amd64', 'linux-any'), 'match implicit linux-amd64 on wildcard cpu'); | |
118 | ok(debarch_is('linux-amd64', 'any-amd64'), 'match implicit linux-amd64 on wildcard os'); | |
119 | ||
120 | my $wildcards = get_valid_wildcards(); | |
121 | ||
122 | foreach my $wildcard (sort keys %{$wildcards}) { | |
123 | ok(debarch_is_wildcard($wildcard), "$wildcard is a wildcard"); | |
124 | ||
125 | foreach my $arch (sort @{$wildcards->{$wildcard}}) { | |
126 | ok(debarch_is($arch, $wildcard), "wildcard $wildcard matches $arch"); | |
127 | } | |
128 | } | |
129 | ||
130 | ok(!debarch_is_wildcard('unknown'), 'unknown is not a wildcard'); | |
131 | ok(!debarch_is_wildcard('all'), 'all is not a wildcard'); | |
132 | ok(!debarch_is_wildcard('amd64'), '<arch> is not a wildcard'); | |
133 | ||
134 | ok(!debarch_is_illegal('0'), ''); | |
135 | ok(!debarch_is_illegal('a'), ''); | |
136 | ok(!debarch_is_illegal('amd64'), ''); | |
137 | ok(!debarch_is_illegal('!arm64'), ''); | |
138 | ok(!debarch_is_illegal('kfreebsd-any'), ''); | |
139 | ok(debarch_is_illegal('!amd64!arm'), ''); | |
140 | ok(debarch_is_illegal('arch%name'), ''); | |
141 | ok(debarch_is_illegal('-any'), ''); | |
142 | ok(debarch_is_illegal('!'), ''); | |
143 | ||
144 | my @arch_new; | |
145 | my @arch_ref; | |
146 | ||
147 | @arch_ref = qw(amd64 !arm64 linux-i386 !kfreebsd-any); | |
148 | @arch_new = debarch_list_parse('amd64 !arm64 linux-i386 !kfreebsd-any'); | |
149 | is_deeply(\@arch_new, \@arch_ref, 'parse valid arch list'); | |
150 | ||
151 | eval { @arch_new = debarch_list_parse('!amd64!arm64') }; | |
152 | ok($@, 'parse concatenated arches failed'); | |
153 | ||
154 | is(debarch_to_cpuattrs(undef), undef, 'undef cpu attrs'); | |
155 | is_deeply([ debarch_to_cpuattrs('amd64') ], [ qw(64 little) ], 'amd64 cpu attrs'); | |
156 | ||
157 | is(debtuple_to_debarch(undef, undef, undef, undef), undef, 'undef debtuple'); | |
158 | is(debtuple_to_debarch('base', 'gnu', 'linux', 'amd64'), 'amd64', 'known debtuple'); | |
159 | is(debtuple_to_debarch('unknown', 'unknown', 'unknown', 'unknown'), undef, 'unknown debtuple'); | |
160 | ||
161 | is(gnutriplet_to_debarch(undef), undef, 'undef gnutriplet'); | |
162 | is(gnutriplet_to_debarch('unknown-unknown-unknown'), undef, 'unknown gnutriplet'); | |
163 | is(gnutriplet_to_debarch('x86_64-linux-gnu'), 'amd64', 'known gnutriplet'); | |
164 | ||
165 | is(scalar get_valid_arches(), 539, 'expected amount of known architectures'); | |
166 | ||
167 | { | |
168 | local $ENV{CC} = 'false'; | |
169 | is(get_host_gnu_type(), '', 'CC does not support -dumpmachine'); | |
170 | ||
171 | $ENV{CC} = 'echo CC'; | |
172 | is(get_host_gnu_type(), 'CC -dumpmachine', | |
173 | 'CC does not report expected synthetic result for -dumpmachine'); | |
174 | } | |
175 | ||
176 | 1; |