URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [tests/] [canvPs.test] - Blame information for rev 1765

Details | Compare with Previous | View Log


# This file is a Tcl script to test out procedures to write postscript
# for canvases to files and channels. It exercises the procedure
# TkCanvPostscriptCmd in generic/tkCanvPs.c
#
# Copyright (c) 1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: canvPs.test,v 1.1.1.1 2002-01-16 10:25:58 markom Exp $
 
if {[info procs test] != "test"} {
    source defs
}
 
foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
 
canvas .c -width 400 -height 300 -bd 2 -relief sunken
.c create rectangle 20 20 80 80 -fill red
pack .c
update
 
test canvPs-1.1 {test writing to a file} {unixOrPc} {
    removeFile foo.ps
    .c postscript -file foo.ps
    file exists foo.ps
} 1
test canvPs-1.2 {test writing to a file, idempotency} {unixOrPc} {
    removeFile foo.ps
    removeFile bar.ps
    .c postscript -file foo.ps
    .c postscript -file bar.ps
    set status ok
    if {[file size bar.ps] != [file size foo.ps]} {
        set status broken
    }
    set status
} ok
 
test canvPs-2.1 {test writing to a channel} {unixOrPc} {
    removeFile foo.ps
    set chan [open foo.ps w]
    fconfigure $chan -translation lf
    .c postscript -channel $chan
    close $chan
    file exists foo.ps
} 1
test canvPs-2.2 {test writing to channel, idempotency} {unixOrPc} {
    removeFile foo.ps
    removeFile bar.ps
    set c1 [open foo.ps w]
    set c2 [open bar.ps w]
    fconfigure $c1 -translation lf
    fconfigure $c2 -translation lf
    .c postscript -channel $c1
    .c postscript -channel $c2
    close $c1
    close $c2
    set status ok
    if {[file size bar.ps] != [file size foo.ps]} {
        set status broken
    }
    set status
} ok
test canvPs-2.3 {test writing to channel and file, same output} {unixOnly} {
    removeFile foo.ps
    removeFile bar.ps
    set c1 [open foo.ps w]
    fconfigure $c1 -translation lf
    .c postscript -channel $c1
    close $c1
    .c postscript -file bar.ps
    set status ok
    if {[file size foo.ps] != [file size bar.ps]} {
        set status broken
    }
    set status
} ok
test canvPs-2.4 {test writing to channel and file, same output} {pcOnly} {
    removeFile foo.ps
    removeFile bar.ps
    set c1 [open foo.ps w]
    fconfigure $c1 -translation crlf
    .c postscript -channel $c1
    close $c1
    .c postscript -file bar.ps
    set status ok
    if {[file size foo.ps] != [file size bar.ps]} {
        set status broken
    }
    set status
} ok
 
# Clean-up
 
removeFile foo.ps
removeFile bar.ps
 
foreach i [winfo children .] {
    destroy $i
}

Line No.	Rev	Author	Line
1	578	markom	`# This file is a Tcl script to test out procedures to write postscript`
2			`# for canvases to files and channels. It exercises the procedure`
3			`# TkCanvPostscriptCmd in generic/tkCanvPs.c`
4			`#`
5			`# Copyright (c) 1995 Sun Microsystems, Inc.`
6			`#`
7			`# See the file "license.terms" for information on usage and redistribution`
8			`# of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
9			`#`
10			`# RCS: @(#) $Id: canvPs.test,v 1.1.1.1 2002-01-16 10:25:58 markom Exp $`
11
12			`if {[info procs test] != "test"} {`
13			`source defs`
14			`}`
15
16			`foreach i [winfo children .] {`
17			`destroy $i`
18			`}`
19			`wm geometry . {}`
20			`raise .`
21
22			`canvas .c -width 400 -height 300 -bd 2 -relief sunken`
23			`.c create rectangle 20 20 80 80 -fill red`
24			`pack .c`
25			`update`
26
27			`test canvPs-1.1 {test writing to a file} {unixOrPc} {`
28			`removeFile foo.ps`
29			`.c postscript -file foo.ps`
30			`file exists foo.ps`
31			`} 1`
32			`test canvPs-1.2 {test writing to a file, idempotency} {unixOrPc} {`
33			`removeFile foo.ps`
34			`removeFile bar.ps`
35			`.c postscript -file foo.ps`
36			`.c postscript -file bar.ps`
37			`set status ok`
38			`if {[file size bar.ps] != [file size foo.ps]} {`
39			`set status broken`
40			`}`
41			`set status`
42			`} ok`
43
44			`test canvPs-2.1 {test writing to a channel} {unixOrPc} {`
45			`removeFile foo.ps`
46			`set chan [open foo.ps w]`
47			`fconfigure $chan -translation lf`
48			`.c postscript -channel $chan`
49			`close $chan`
50			`file exists foo.ps`
51			`} 1`
52			`test canvPs-2.2 {test writing to channel, idempotency} {unixOrPc} {`
53			`removeFile foo.ps`
54			`removeFile bar.ps`
55			`set c1 [open foo.ps w]`
56			`set c2 [open bar.ps w]`
57			`fconfigure $c1 -translation lf`
58			`fconfigure $c2 -translation lf`
59			`.c postscript -channel $c1`
60			`.c postscript -channel $c2`
61			`close $c1`
62			`close $c2`
63			`set status ok`
64			`if {[file size bar.ps] != [file size foo.ps]} {`
65			`set status broken`
66			`}`
67			`set status`
68			`} ok`
69			`test canvPs-2.3 {test writing to channel and file, same output} {unixOnly} {`
70			`removeFile foo.ps`
71			`removeFile bar.ps`
72			`set c1 [open foo.ps w]`
73			`fconfigure $c1 -translation lf`
74			`.c postscript -channel $c1`
75			`close $c1`
76			`.c postscript -file bar.ps`
77			`set status ok`
78			`if {[file size foo.ps] != [file size bar.ps]} {`
79			`set status broken`
80			`}`
81			`set status`
82			`} ok`
83			`test canvPs-2.4 {test writing to channel and file, same output} {pcOnly} {`
84			`removeFile foo.ps`
85			`removeFile bar.ps`
86			`set c1 [open foo.ps w]`
87			`fconfigure $c1 -translation crlf`
88			`.c postscript -channel $c1`
89			`close $c1`
90			`.c postscript -file bar.ps`
91			`set status ok`
92			`if {[file size foo.ps] != [file size bar.ps]} {`
93			`set status broken`
94			`}`
95			`set status`
96			`} ok`
97
98			`# Clean-up`
99
100			`removeFile foo.ps`
101			`removeFile bar.ps`
102
103			`foreach i [winfo children .] {`
104			`destroy $i`
105			`}`

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [tests/] [canvPs.test] - Blame information for rev 1765