Annotation of gforth/test/gforth.fs, revision 1.14
1.1 anton 1: \ test some gforth extension words
2:
1.14 ! anton 3: \ Copyright (C) 2003,2004,2005,2006,2007 Free Software Foundation, Inc.
1.1 anton 4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation; either version 2
10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program; if not, write to the Free Software
19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
20:
21: require ./tester.fs
1.9 anton 22: decimal
1.1 anton 23:
24: \ f>str-rdp (then f.rdp and f>buf-rdb should also be ok)
25:
26: { 12.3456789e 7 3 1 f>str-rdp s" 12.346" str= -> true }
27: { 12.3456789e 7 4 1 f>str-rdp s" 12.3457" str= -> true }
28: { -12.3456789e 7 4 1 f>str-rdp s" -1.23E1" str= -> true }
29: { 0.0996e 7 3 1 f>str-rdp s" 0.100" str= -> true }
30: { 0.0996e 7 3 3 f>str-rdp s" 9.96E-2" str= -> true }
31: { 999.9994e 7 3 1 f>str-rdp s" 999.999" str= -> true }
32: { 999.9996e 7 3 1 f>str-rdp s" 1.000E3" str= -> true }
1.2 anton 33: { -1e-20 5 2 1 f>str-rdp s" *****" str= -> true }
1.3 anton 34:
35: \ 0x hex number conversion, or not
36:
37: decimal
38: { 0x10 -> 16 }
39: { 0X10 -> 16 }
40: 36 base !
41: { 0x10 -> x10 }
42: decimal
1.4 anton 43: { 'a' -> 97 }
44: { 'A -> 65 }
1.7 anton 45: { 1. '1 -> 1. 49 }
1.6 anton 46:
1.13 anton 47: \ REPRESENT has no trailing 0s even for inf and nan
1.6 anton 48:
49: { 1e 0e f/ pad 16 represent drop 2drop pad 15 + c@ '0 = -> false }
50: { 0e 0e f/ pad 16 represent drop 2drop pad 15 + c@ '0 = -> false }
51: { -1e 0e f/ pad 16 represent drop 2drop pad 15 + c@ '0 = -> false }
1.13 anton 52:
53: \ TRY and friends
54:
55: : 0<-throw ( n -- )
56: 0< throw ;
57:
58: : try-test1 ( n1 -- n2 )
59: try
60: dup 0<-throw
61: iferror
62: 2drop 25
63: then
64: 1+
65: endtry ;
66:
67: { -5 try-test1 -> 26 }
68: { 5 try-test1 -> 6 }
69:
70: : try-test2 ( n1 -- n2 )
71: try
72: 0
73: restore
74: drop 1+ dup 0<-throw
75: endtry ;
76:
77: { -5 try-test2 -> 0 }
78: { 5 try-test2 -> 6 }
79:
80: : try-test3 ( n1 -- n2 )
81: try
82: dup 0<-throw
83: endtry-iferror
84: 2drop 10
85: else
86: 1+
87: then ;
88:
89: { -5 try-test3 -> 10 }
90: { 5 try-test3 -> 6 }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>