68
68
if (defined $opts {internal } && $opts {internal } > 0) { doInternalMode(); unlink_restore(); }
69
69
if (defined $opts {restore } && $opts {restore } > 0) { doRestoreMode(); unlink_restore(); }
70
70
filterPatterns();
71
- process(0);
71
+ process(0, 0 );
72
72
cleanup();
73
73
unlink_restore();
74
74
displaySummary();
@@ -854,7 +854,7 @@ sub exit_cause {
854
854
}
855
855
856
856
sub process {
857
- my $skip = shift ( @_ ) ;
857
+ my ( $skip , $int_mask ) = @_ ;
858
858
my $pot = " tst-.pot" ;
859
859
my $pot_opt = " " ;
860
860
my $line_num = 0;
@@ -895,6 +895,9 @@ sub process {
895
895
$dict_name = " --incremental=" . substr ($ar [5],10);
896
896
} else {
897
897
$dict_name = " --wordlist=$ar [5].dic" ;
898
+ if ($int_mask ) {
899
+ $dict_name .= " --mask=?w?a" ;
900
+ }
898
901
}
899
902
my $cmd = " $cmd_head $ar [6]" ;
900
903
unless (-e $ar [6]) { next LINE; }
@@ -1300,7 +1303,7 @@ sub is_hash_salted {
1300
1303
return $details [11] > 0;
1301
1304
}
1302
1305
sub build_self_test_files {
1303
- my $type = $_ [0] ;
1306
+ my ( $type , $int_mask ) = @_ ;
1304
1307
my $cnt = 0;
1305
1308
my $mangle = does_hash_split_unifies_case($type );
1306
1309
my $cmd = " $JOHN_EXE -format=$type -list=format-tests $show_pass_thru 2>/dev/null" ;
@@ -1311,24 +1314,34 @@ sub build_self_test_files {
1311
1314
open (FILE2, " > tst-.dic" ) || die " problem creating tst-.dic\n " ;
1312
1315
# output some long format 'tester' input words. We might improve this with time.
1313
1316
# sizes I could see: 55, 56, 64, 65, 80, 81, 119, 120, 125, 126 bytes long.
1314
- print FILE2 " 12345678901234567890123456789012345678901234567890123456789012345678901234567890\n " ;
1315
- print FILE2 " 123456789012345678901234567890123456789012345678901234567\n " ;
1316
- print FILE2 " 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890\n " ;
1317
+ if (!$int_mask ) {
1318
+ print FILE2 " 12345678901234567890123456789012345678901234567890123456789012345678901234567890\n " ;
1319
+ print FILE2 " 123456789012345678901234567890123456789012345678901234567\n " ;
1320
+ print FILE2 " 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890\n " ;
1321
+ }
1317
1322
foreach my $line (@ar1 ) {
1318
1323
my @dtls = split (" \t " , $line );
1319
1324
if (scalar (@dtls ) >= 3) {
1320
1325
if ($dtls [2] !~ m / :/ ) { $dtls [2] = " vec_" . $dtls [1] . " :" . $dtls [2]; }
1321
- print FILE1 $dtls [2]." \n " ;
1322
- if (defined $dtls [3]) { print FILE2 $dtls [3]; }
1326
+ if ($int_mask ) {
1327
+ if (defined $dtls [3] && length ($dtls [3])) {
1328
+ $cnt ++;
1329
+ print FILE1 $dtls [2]." \n " ;
1330
+ print FILE2 substr ($dtls [3], 0, -1);
1331
+ }
1332
+ } else {
1333
+ $cnt ++;
1334
+ print FILE1 $dtls [2]." \n " ;
1335
+ print FILE2 defined $dtls [3] ? $dtls [3] : " " ;
1336
+ }
1323
1337
print FILE2 " \n " ;
1324
- if ($cnt < 3) {
1338
+ if ($cnt < 3 && ! $int_mask ) {
1325
1339
print FILE2 " 1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234\n " ;
1326
1340
}
1327
1341
if (defined $opts {case_mangle } && $opts {case_mangle } > 0) {
1328
1342
print FILE1 PossiblyCaseMangle($dtls [2], " uprcase" , not $mangle );
1329
1343
print FILE1 PossiblyCaseMangle($dtls [2], " lowcase" , not $mangle );
1330
1344
}
1331
- $cnt += 1;
1332
1345
}
1333
1346
}
1334
1347
close (FILE2); close (FILE1);
@@ -1404,8 +1417,10 @@ sub doInternalMode {
1404
1417
if (scalar (@match ) == 0) { $doit = 0; }
1405
1418
1406
1419
if ($doit == 1) {
1420
+ my $int_mask = ` $JOHN_EXE --format=$type $show_pass_thru --list=format-all-details 2>/dev/null | grep "Internal mask generation"` ;
1421
+ $int_mask = (defined $int_mask && $int_mask =~ m / yes/ i ) ? 1 : 0;
1407
1422
# first, build our dictionary/input files
1408
- my $cnt = build_self_test_files($type );
1423
+ my $cnt = build_self_test_files($type , $int_mask );
1409
1424
# build the @tstdata array with 1 element
1410
1425
if (does_hash_split_unifies_case($type )) {
1411
1426
my $cnt3 = $cnt *3;
@@ -1415,7 +1430,7 @@ sub doInternalMode {
1415
1430
}
1416
1431
ScreenOutV(" Preparing to run internal for type: $type \n " );
1417
1432
ScreenOutV(" tstdata = @tstdata \n\n " );
1418
- process(1);
1433
+ process(1, $int_mask );
1419
1434
}
1420
1435
}
1421
1436
0 commit comments