Annotation of gforth/test/gforth.fs, revision 1.16
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
1.15 anton 9: \ as published by the Free Software Foundation, either version 3
1.1 anton 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
1.15 anton 18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.1 anton 19:
20: require ./tester.fs
1.9 anton 21: decimal
1.1 anton 22:
23: \ f>str-rdp (then f.rdp and f>buf-rdb should also be ok)
24:
25: { 12.3456789e 7 3 1 f>str-rdp s" 12.346" str= -> true }
26: { 12.3456789e 7 4 1 f>str-rdp s" 12.3457" str= -> true }
27: { -12.3456789e 7 4 1 f>str-rdp s" -1.23E1" str= -> true }
28: { 0.0996e 7 3 1 f>str-rdp s" 0.100" str= -> true }
29: { 0.0996e 7 3 3 f>str-rdp s" 9.96E-2" str= -> true }
30: { 999.9994e 7 3 1 f>str-rdp s" 999.999" str= -> true }
31: { 999.9996e 7 3 1 f>str-rdp s" 1.000E3" str= -> true }
1.2 anton 32: { -1e-20 5 2 1 f>str-rdp s" *****" str= -> true }
1.3 anton 33:
34: \ 0x hex number conversion, or not
35:
36: decimal
37: { 0x10 -> 16 }
38: { 0X10 -> 16 }
39: 36 base !
40: { 0x10 -> x10 }
41: decimal
1.4 anton 42: { 'a' -> 97 }
43: { 'A -> 65 }
1.7 anton 44: { 1. '1 -> 1. 49 }
1.6 anton 45:
1.13 anton 46: \ REPRESENT has no trailing 0s even for inf and nan
1.6 anton 47:
48: { 1e 0e f/ pad 16 represent drop 2drop pad 15 + c@ '0 = -> false }
49: { 0e 0e f/ pad 16 represent drop 2drop pad 15 + c@ '0 = -> false }
50: { -1e 0e f/ pad 16 represent drop 2drop pad 15 + c@ '0 = -> false }
1.13 anton 51:
52: \ TRY and friends
53:
54: : 0<-throw ( n -- )
55: 0< throw ;
56:
57: : try-test1 ( n1 -- n2 )
58: try
59: dup 0<-throw
60: iferror
61: 2drop 25
62: then
63: 1+
64: endtry ;
65:
66: { -5 try-test1 -> 26 }
67: { 5 try-test1 -> 6 }
68:
69: : try-test2 ( n1 -- n2 )
70: try
71: 0
72: restore
73: drop 1+ dup 0<-throw
74: endtry ;
75:
76: { -5 try-test2 -> 0 }
77: { 5 try-test2 -> 6 }
78:
79: : try-test3 ( n1 -- n2 )
80: try
81: dup 0<-throw
82: endtry-iferror
83: 2drop 10
84: else
85: 1+
86: then ;
87:
88: { -5 try-test3 -> 10 }
89: { 5 try-test3 -> 6 }
1.16 ! anton 90:
! 91: \ fcopysign
! 92:
! 93: t{ 5e 1e fcopysign -> 5e }t
! 94: t{ -5e 1e fcopysign -> 5e }t
! 95: t{ 5e -1e fcopysign -> -5e }t
! 96: t{ -5e -1e fcopysign -> -5e }t
! 97: \ tests involving -0e?
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>