Mercurial > vim

comparison src/libvterm/t/run-test.pl @ 20482:dc88c690f19b v8.2.0795

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
patch 8.2.0795: libvterm code lags behind the upstream version Commit: https://github.com/vim/vim/commit/88d68de95da70d0f89a5246f58355d72e9c17db4 Author: Bram Moolenaar <Bram@vim.org> Date: Mon May 18 21:51:01 2020 +0200 patch 8.2.0795: libvterm code lags behind the upstream version Problem: Libvterm code lags behind the upstream version. Solution: Include revisions 748 - 754.
author Bram Moolenaar <Bram@vim.org>
date Mon, 18 May 2020 22:00:03 +0200
parents d0bf39eb2b07
children 1d595fada804
comparison
equal deleted inserted replaced
20481:ee70957e66ea 20482:dc88c690f19b
26 my $exitcode = 0; 26 my $exitcode = 0;
27 27
28 my $command; 28 my $command;
29 my @expect; 29 my @expect;
30 30
31 my $linenum = 0;
32
31 sub do_onetest 33 sub do_onetest
32 { 34 {
33 $hin->print( "$command\n" ); 35 $hin->print( "$command\n" );
34 undef $command; 36 undef $command;
35 37
39 last if $outline eq "DONE\n" or $outline eq "?\n"; 41 last if $outline eq "DONE\n" or $outline eq "?\n";
40 42
41 chomp $outline; 43 chomp $outline;
42 44
43 if( !@expect ) { 45 if( !@expect ) {
44 print "# Test failed\n" unless $fail_printed++; 46 print "# line $linenum: Test failed\n" unless $fail_printed++;
45 print "# expected nothing more\n" . 47 print "# expected nothing more\n" .
46 "# Actual: $outline\n"; 48 "# Actual: $outline\n";
47 next; 49 next;
48 } 50 }
49 51
50 my $expectation = shift @expect; 52 my $expectation = shift @expect;
51 53
52 next if $expectation eq $outline; 54 next if $expectation eq $outline;
53 55
54 print "# Test failed\n" unless $fail_printed++; 56 print "# line $linenum: Test failed\n" unless $fail_printed++;
55 print "# Expected: $expectation\n" . 57 print "# Expected: $expectation\n" .
56 "# Actual: $outline\n"; 58 "# Actual: $outline\n";
57 } 59 }
58 60
59 if( @expect ) { 61 if( @expect ) {
60 print "# Test failed\n" unless $fail_printed++; 62 print "# line $linenum: Test failed\n" unless $fail_printed++;
61 print "# Expected: $_\n" . 63 print "# Expected: $_\n" .
62 "# didn't happen\n" for @expect; 64 "# didn't happen\n" for @expect;
63 } 65 }
64 66
65 $exitcode = 1 if $fail_printed; 67 $exitcode = 1 if $fail_printed;
131 my $response = <$hout>; 133 my $response = <$hout>;
132 chomp $response; 134 chomp $response;
133 135
134 $response = pack "C*", map hex, split m/,/, $response; 136 $response = pack "C*", map hex, split m/,/, $response;
135 if( $response ne $want ) { 137 if( $response ne $want ) {
136 print "# Assert ?screen_row $row failed:\n" . 138 print "# line $linenum: Assert ?screen_row $row failed:\n" .
137 "# Expected: $want\n" . 139 "# Expected: $want\n" .
138 "# Actual: $response\n"; 140 "# Actual: $response\n";
139 $exitcode = 1; 141 $exitcode = 1;
140 } 142 }
141 } 143 }
142 # Assertions start with '?' 144 # Assertions start with '?'
143 elsif( $line =~ s/^\?([a-z]+.*?=)\s*// ) { 145 elsif( $line =~ s/^\?([a-z]+.*?=)\s*// ) {
144 do_onetest if defined $command; 146 do_onetest if defined $command;
145 147
146 my ( $assertion ) = $1 =~ m/^(.*)\s+=/; 148 my ( $assertion ) = $1 =~ m/^(.*)\s+=/;
149 my $expectation = $line;
147 150
148 $hin->print( "\?$assertion\n" ); 151 $hin->print( "\?$assertion\n" );
149 my $response = <$hout>; defined $response or wait, die "Test harness failed - $?\n"; 152 my $response = <$hout>; defined $response or wait, die "Test harness failed - $?\n";
150 chomp $response; $response =~ s/^\s+|\s+$//g; 153 chomp $response; $response =~ s/^\s+|\s+$//g;
151 154
152 if( $response ne $line ) { 155 # Some convenience formatting
153 print "# Assert $assertion failed:\n" . 156 if( $assertion =~ m/^screen_chars/ and $expectation =~ m/^"/ ) {
154 "# Expected: $line\n" . 157 $expectation = join ",", map sprintf("0x%02x", ord $_), split m//, eval($expectation);
158 }
159
160 if( $response ne $expectation ) {
161 print "# line $linenum: Assert $assertion failed:\n" .
162 "# Expected: $expectation\n" .
155 "# Actual: $response\n"; 163 "# Actual: $response\n";
156 $exitcode = 1; 164 $exitcode = 1;
157 } 165 }
158 } 166 }
159 # Test controls start with '$' 167 # Test controls start with '$'
174 } 182 }
175 183
176 open my $test, "<", $ARGV[0] or die "Cannot open test script $ARGV[0] - $!"; 184 open my $test, "<", $ARGV[0] or die "Cannot open test script $ARGV[0] - $!";
177 185
178 while( my $line = <$test> ) { 186 while( my $line = <$test> ) {
187 $linenum++;
179 $line =~ s/^\s+//; 188 $line =~ s/^\s+//;
180 chomp $line; 189 chomp $line;
181 190
182 next if $line =~ m/^(?:#|$)/; 191 next if $line =~ m/^(?:#|$)/;
183 last if $line eq "__END__"; 192 last if $line eq "__END__";