(* Copyright (C) 2009 Free Software Foundation, Inc. *) (* This file is part of GNU Modula-2. GNU Modula-2 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, or (at your option) any later version. GNU Modula-2 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 gm2; see the file COPYING. If not, write to the Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) MODULE longstr ; FROM DynamicStrings IMPORT String, EqualArray, KillString, InitString ; FROM ConvStringLong IMPORT RealToFloatString, RealToEngString, RealToFixedString ; FROM StrIO IMPORT WriteString, WriteLn ; FROM NumberIO IMPORT WriteInt ; FROM FIO IMPORT StdOut, FlushBuffer ; FROM SFIO IMPORT WriteS ; FROM libc IMPORT exit ; TYPE floatTests = RECORD f: INTEGER ; r: LONGREAL ; i, o: ARRAY [0..maxString] OF CHAR ; k: kind ; END ; realArray = ARRAY [0..49] OF floatTests ; kind = (fixed, float, eng) ; kindArray = ARRAY kind OF BOOLEAN ; CONST maxString = 80 ; VAR j: CARDINAL ; s: String ; a: realArray ; t: kindArray ; m: kind ; e: INTEGER ; BEGIN e := 0 ; a := realArray{floatTests{ 3, 12.3456789 , "12.3456789" , "12.346" , fixed}, floatTests{ 3, 123.456789 , "123.456789" , "123.457" , fixed}, floatTests{ 3, 1234.56789 , "1234.56789" , "1234.568" , fixed}, floatTests{-3, 1234.56789 , "1234.56789" , "1200" , fixed}, floatTests{-2, 1234.56789 , "1234.56789" , "1230" , fixed}, floatTests{-1, 1234.56789 , "1234.56789" , "1235" , fixed}, floatTests{ 0, 1234.56789 , "1234.56789" , "1235." , fixed}, floatTests{ 1, 1234.56789 , "1234.56789" , "1234.6" , fixed}, floatTests{ 2, 1234.56789 , "1234.56789" , "1234.57" , fixed}, floatTests{ 3, 12.3456789 , "12.3456789" , "12.3" , eng}, floatTests{ 3, 123.456789 , "123.456789" , "123" , eng}, floatTests{ 3, 1234.56789 , "1234.56789" , "1.23E+3" , eng}, floatTests{ 3, 12345.6789 , "12345.6789" , "12.3E+3" , eng}, floatTests{ 3, 1234.56789 , "1234.56789" , "1.23E+3" , float}, (* * the following examples are from P445 of the * ISO standard. *) floatTests{ 1, 3923009.0 , "3923009.0" , "4E+6" , float}, floatTests{ 2, 3923009.0 , "3923009.0" , "3.9E+6" , float}, floatTests{ 5, 3923009.0 , "3923009.0" , "3.9230E+6" , float}, floatTests{ 1, 39.23009 , "39.23009" , "4E+1" , float}, floatTests{ 2, 39.23009 , "39.23009" , "3.9E+1" , float}, floatTests{ 5, 39.23009 , "39.23009" , "3.9230E+1" , float}, floatTests{ 1, 0.0003923009, "0.0003923009", "4E-4" , float}, floatTests{ 2, 0.0003923009, "0.0003923009", "3.9E-4" , float}, floatTests{ 5, 0.0003923009, "0.0003923009", "3.9230E-4" , float}, (* * the following examples are from P446 of the * ISO standard. *) floatTests{ 1, 3923009.0 , "3923009.0" , "4E+6" , eng}, floatTests{ 2, 3923009.0 , "3923009.0" , "3.9E+6" , eng}, floatTests{ 5, 3923009.0 , "3923009.0" , "3.9230E+6" , eng}, floatTests{ 1, 39.23009 , "39.23009" , "40" , eng}, floatTests{ 2, 39.23009 , "39.23009" , "39" , eng}, floatTests{ 5, 39.23009 , "39.23009" , "39.230" , eng}, floatTests{ 1, 0.0003923009, "0.0003923009", "400E-6" , eng}, floatTests{ 2, 0.0003923009, "0.0003923009", "390E-6" , eng}, floatTests{ 5, 0.0003923009, "0.0003923009", "392.30E-6" , eng}, (* * the following examples are from P446 of the * ISO standard. *) floatTests{-5, 3923009.0 , "3923009.0" , "3920000" , fixed}, floatTests{-2, 3923009.0 , "3923009.0" , "3923010" , fixed}, floatTests{-1, 3923009.0 , "3923009.0" , "3923009" , fixed}, floatTests{ 0, 3923009.0 , "3923009.0" , "3923009." , fixed}, floatTests{ 1, 3923009.0 , "3923009.0" , "3923009.0" , fixed}, floatTests{ 4, 3923009.0 , "3923009.0" , "3923009.0000", fixed}, floatTests{-5, 39.23009 , "39.23009" , "0" , fixed}, floatTests{-2, 39.23009 , "39.23009" , "40" , fixed}, floatTests{-1, 39.23009 , "39.23009" , "39" , fixed}, floatTests{ 0, 39.23009 , "39.23009" , "39." , fixed}, floatTests{ 1, 39.23009 , "39.23009" , "39.2" , fixed}, floatTests{ 4, 39.23009 , "39.23009" , "39.2301" , fixed}, floatTests{-5, 0.0003923009, "0.0003923009", "0" , fixed}, floatTests{-2, 0.0003923009, "0.0003923009", "0" , fixed}, floatTests{-1, 0.0003923009, "0.0003923009", "0" , fixed}, floatTests{ 0, 0.0003923009, "0.0003923009", "0." , fixed}, floatTests{ 1, 0.0003923009, "0.0003923009", "0.0" , fixed}, floatTests{ 4, 0.0003923009, "0.0003923009", "0.0004" , fixed}} ; t := kindArray{TRUE, TRUE, TRUE} ; FOR j := 0 TO HIGH(a) DO WITH a[j] DO CASE k OF fixed: s := RealToFixedString(r, f) | eng : s := RealToEngString(r, f) | float: s := RealToFloatString(r, f) END ; IF EqualArray(s, o) THEN WriteString(' passed ') ELSE WriteString('**failed**') ; t[k] := FALSE END ; WriteString(' performing a ') ; CASE k OF fixed: WriteString('RealToFixedString') | eng : WriteString('RealToEngString') | float: WriteString('RealToFloatString') END ; WriteString('(') ; WriteString(i) ; WriteString(', ') ; WriteInt(f, 2) ; WriteString(') -> ') ; IF EqualArray(s, o) THEN WriteString(o) ELSE e := 1 ; (* failure code *) s := WriteS(StdOut, s) ; WriteString(' (it should be: ') ; WriteString(o) ; WriteString(')') END ; WriteLn ; s := KillString(s) END END ; WriteLn ; WriteString('Summary') ; WriteLn ; WriteString('=======') ; WriteLn ; FOR m := MIN(kind) TO MAX(kind) DO WriteString('The ') ; CASE m OF fixed: WriteString('fixed') | float: WriteString('float') | eng : WriteString('engineering') END ; WriteString(' tests ') ; IF t[m] THEN WriteString('passed') ELSE WriteString('failed') END ; WriteLn END ; FlushBuffer(StdOut) ; exit(e) END longstr.