{ This file is part of FloatView. Copyright (c) 2003-2008, Tom Verhoeff (TU/e). Test driver for the FloatView library. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *********************************************************************} program TestFloatView; uses FloatView; function RightPad ( s: String; width: Integer ): String; begin while Length ( s ) < width do begin s := s + ' ' end { while } ; RightPad := s end; { RightPad } procedure WriteSizes; begin writeln ( 'SizeOf ( Single ) = ', SizeOf ( Single ) ) ; writeln ( 'SizeOf ( ConvertSingle ) = ', SizeOf ( ConvertSingle ) ) ; writeln ; writeln ( 'SizeOf ( Double ) = ', SizeOf ( Double ) ) ; writeln ( 'SizeOf ( ConvertDouble ) = ', SizeOf ( ConvertDouble ) ) ; writeln end; { WriteSizes } procedure WriteSingle ( const x: Single; const msg: String ); begin write ( SingleToStrBits ( x ) ) ; writeln ( ' ' : 5+2, msg ) ; write ( ' ' : 1 + ExpSizeSingle + 2 - 3 ) ; write ( RightPad ( SingleToStrBinary ( x ), 3 + FracSizeSingle + 5 ) ) ; write ( ' ' ) ; writeln ( x : 18 ) end; { WriteSingle } procedure WriteDouble ( const x: Double; const msg: String ); begin write ( DoubleToStrBits ( x ) ) ; writeln ( ' ' : 6+2, msg ) ; write ( ' ' : 1 + ExpSizeDouble + 2 - 3 ) ; write ( RightPad ( DoubleToStrBinary ( x ), 3 + FracSizeDouble + 6 ) ) ; write ( ' ' ) ; writeln ( x : 24 ) end; { WriteDouble } procedure TestSingle; var zero, one, atenth, x, eps, onerep, minNormal, maxSubnormal: Single; i: Integer; { iterator } begin writeln ( 'Testing Single' ) ; zero := 0.0 ; WriteSingle ( zero, 'zero' ) ; WriteSingle ( - zero, 'minus zero' ) ; one := 1.0 ; WriteSingle ( one, 'one' ) ; WriteSingle ( - one, 'minus one' ) ; WriteSingle ( PowerOf2Single ( one, 1 ), 'two' ) ; WriteSingle ( PowerOf2Single ( one, -1 ), 'half' ) ; atenth := one / 10 ; WriteSingle ( atenth, '1/10' ) ; x := zero ; for i := 1 to 10 do x := x + atenth ; WriteSingle ( x, '1/10 + ... + 1/10 (10x)' ) ; eps := PowerOf2Single ( one, - FracSizeSingle ) ; WriteSingle ( eps, 'eps' ) ; WriteSingle ( eps / 2, 'eps/2' ) ; onerep := one - eps / 2 { 0.111... } ; WriteSingle ( onerep, 'one - eps/2' ) ; WriteSingle ( one + eps, 'one + eps' ) ; WriteSingle ( PowerOf2Single ( one, EmaxSingle ), 'largest 2-power' ) ; WriteSingle ( PowerOf2Single ( onerep, EmaxSingle + 1), 'largest number' ) ; minNormal := PowerOf2Single ( one, EminSingle ) ; WriteSingle ( minNormal, 'smallest normalized number' ) ; maxSubnormal := PredSingle ( minNormal ) ; WriteSingle ( maxSubnormal, 'largest subnormal number' ) ; WriteSingle ( PowerOf2Single ( one, EminSingle - 1 ), 'largest subnormal 2-power' ) ; WriteSingle ( PowerOf2Single ( one, EminSingle - FracSizeSingle ), 'smallest subnormal' ) ; writeln end; { TestSingle } procedure TestDouble; var zero, one, atenth, x, eps, onerep, minNormal, maxSubnormal: Double; i: Integer; { iterator } begin writeln ( 'Testing Double' ) ; zero := 0.0 ; WriteDouble ( zero, 'zero' ) ; WriteDouble ( - zero, 'minus zero' ) ; one := 1.0 ; WriteDouble ( one, 'one' ) ; WriteDouble ( - one, 'minus one' ) ; WriteDouble ( PowerOf2Double ( one, 1 ), 'two' ) ; WriteDouble ( PowerOf2Double ( one, -1 ), 'half' ) ; atenth := one / 10 ; WriteDouble ( atenth, '1/10' ) ; x := zero ; for i := 1 to 10 do x := x + atenth ; WriteDouble ( x, '1/10 + ... + 1/10 (10x)' ) ; eps := PowerOf2Double ( one, - FracSizeDouble ) ; WriteDouble ( eps, 'eps' ) ; WriteDouble ( eps / 2, 'eps/2' ) ; onerep := one - eps / 2 { 0.111... } ; WriteDouble ( onerep, 'one - eps/2' ) ; WriteDouble ( one + eps, 'one + eps' ) ; WriteDouble ( PowerOf2Double ( one, EmaxDouble ), 'largest 2-power' ) ; WriteDouble ( PowerOf2Double ( onerep, EmaxDouble + 1), 'largest number' ) ; minNormal := PowerOf2Double ( one, EminDouble ) ; WriteDouble ( minNormal, 'smallest normalized number' ) ; maxSubnormal := PredDouble ( minNormal ) ; WriteDouble ( maxSubnormal, 'largest subnormal number' ) ; WriteDouble ( PowerOf2Double ( one, EminDouble - 1 ), 'largest subnormal 2-power' ) ; WriteDouble ( PowerOf2Double ( one, EminDouble - FracSizeDouble ), 'smallest subnormal' ) ; writeln end; { TestDouble } begin writeln ( 'Test driver for FloatView' ) ; WriteSizes ; TestSingle ; TestDouble ; write ( 'Type to exit: ' ) ; readln end.