File: patch.test

package info (click to toggle)
tcllib 1.20%2Bdfsg-1
  • links: PTS
  • area: main
  • in suites: bullseye
  • size: 68,064 kB
  • sloc: tcl: 216,842; ansic: 14,250; sh: 2,846; xml: 1,766; yacc: 1,145; pascal: 881; makefile: 107; perl: 84; f90: 84; python: 33; ruby: 13; php: 11
file content (107 lines) | stat: -rw-r--r-- 2,726 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
# -*- tcl -*-
# patch.test:  tests for application of `diff -ruN` patches.

# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 2

testing {
    useLocal patch.tcl textutil::patch
}

# -------------------------------------------------------------------------
set m {wrong # args: should be "textutil::patch apply dir striplevel patch reportcmd"}

test textutil-patch-1.0 {wrong args, not enough} -body {
    textutil::patch apply
} -returnCodes error -result $m

test textutil-patch-1.1 {wrong args, not enough} -body {
    textutil::patch apply D
} -returnCodes error -result $m

test textutil-patch-1.2 {wrong args, not enough} -body {
    textutil::patch apply D S
} -returnCodes error -result $m

test textutil-patch-1.3 {wrong args, not enough} -body {
    textutil::patch apply D S P
} -returnCodes error -result $m

test textutil-patch-1.4 {wrong args, too many} -body {
    textutil::patch apply D S P R X
} -returnCodes error -result $m

unset m

# -------------------------------------------------------------------------
## Patch application. All ok.

proc setup-scratch {} {
    # Create a temp directory hierarchy where we can perform patch application.
    # scratch
    # \- pkgIndex.tcl

    file mkdir [asset scratch]
    file copy  [asset pkgIndex.tcl] [asset scratch/pkgIndex.tcl]
    set ::trace {}
    return    
}

proc cleanup-scratch {} {
    # Drop scratch area again.
    unset ::trace
    file delete -force [asset scratch]
    return
}

proc record {args} { lappend ::trace $args }

proc recorded {} {
    lappend ::trace === [tcltest::viewFile [asset scratch/pkgIndex.tcl]]
    join $::trace \n
}

foreach {tool striplevel} {
    diff-ruN    1
    git-diff    2
    fossil-diff 2
} {
    incr k
    test textutil-patch-2.$k "apply $tool" -setup {
	setup-scratch
    } -cleanup {
	cleanup-scratch
    } -body {
	# Apply patch `pkgIndex.tcl.<tool>` to `scratch/pkgIndex.tcl`.
	# The result should match `pkgIndex.tcl.patched`.
	textutil::patch apply \
	    [asset scratch] $striplevel \
	    [asset-get pkgIndex.tcl.$tool] \
	    record
	recorded
    } -result [join \
		   [list \
			[list apply [asset scratch/pkgIndex.tcl]] \
			=== \
			[tcltest::viewFile [asset pkgIndex.tcl.patched]]] \
		   \n]
}
unset k

catch { unset trace }
rename setup-scratch {}
rename cleanup-scratch {}

# -------------------------------------------------------------------------
## Patch application. Trigger the various failures. TODO

# -------------------------------------------------------------------------

testsuiteCleanup
return