-- This is version 0.93 of a specification compliance test suite for the -- Generic Elementary Functions. 15-FEB-1991 -- For ISO-IEC/JTC1/SC22/WG9 (Ada) Numerics Rapporteur Group -- Draft 1.2, 12 December 1990 -- -- This test is for special cases and a few mid range accuracy checks. -- This test is NOT an extensive numerical accuracy test. -- No accuracy figure of merit is computed. Just PASSED or FAILED. -- ( Peter Tang's work will provide accurate measurements of accuracy. ) -- The ACVC Ada Compiler Validation Capability philosophy is intended to -- be used. e.g. This is a test against a specification on a specific -- implementation. A specific implementation means the combination of three -- items : 1) a specific Ada compilation system, 2) a specific hardware -- configuration and 3) a specific Generic Elementary Functions -- implementation. The specification is interpreted by the NRG -- the same way ANSI/MIL-STD-1815A is interpreted by the ARG. -- Note to implementors: Once an initial release of this test suite is -- released, there may be periodic updates. There is no guarantee that -- passing any particular version implies passing another version. -- This is the same philosophy as for ACVC. -- Explicit assumptions : ( These probably will be NRG work items ) -- -- When the specification says a relative error is -- abs((F(x)-f(x))/f(x)) <= 2.0*FLOAT_TYPE'BASE'EPSILON then -- an implementation must meet the specification implemented in -- Ada code for all cases including: -- x given as a long named number, -- f(x) given as a long named number, -- using conversions and "<=" as provided by the specific implementation. -- Note that later improvements to the validation suite may cause -- implementations that have previously passed, to fail future -- validation suites. -- When the specification says "=" in an accuracy section, then: -- Results that should be model numbers are compared in the -- test suite as an Ada test for equality or inequality. -- Results that are definitely not model numbers are compared in the -- test suite as a relative error of one FLOAT_TYPE'BASE'EPSILON. -- When the specification says the domain is unbounded, then the test -- suite checks for no exceptions being raised of FLOAT_TYPE'BASE'LAST, -- 'FIRST, 'SMALL and possibly other values. Similarly for a domain of -- X>0 or X>=0 'LAST and 'SMALL are used. When there is a note about -- "restricted domain" then the check for no exceptions is made by -- replacing 'SAFE_LARGE by 'LAST reduced by twice the relative -- error. This is based on the intuitive notion that functions like -- SQRT, LOG, ARCTAN and others that are reduction functions should -- not produce any surprises for casual users. Accuracy tests are -- restricted to the positive and negative 'SAFE_SMALL through -- 'SAFE_LARGE magnitudes. -- Please report problems or suggested additions to Jon Squire -- Net mail squire@tron.bwi.wec.com , phone (301)765-3748 with TEXT_IO; use TEXT_IO; with GENERIC_ELEMENTARY_FUNCTIONS; generic type FLOAT_TYPE is digits <>; procedure TEST_GENERIC_ELEMENTARY_FUNCTIONS_2; procedure TEST_GENERIC_ELEMENTARY_FUNCTIONS_2 is subtype REAL is FLOAT_TYPE; -- run for each hardware type package GEF is new GENERIC_ELEMENTARY_FUNCTIONS(REAL); use GEF; -- package being tested package REAL_IO is new TEXT_IO.FLOAT_IO(REAL); use REAL_IO; -- only used if failure, only in CHECK -- some attributes used below EPSILON : constant REAL := REAL'EPSILON; LAST : constant REAL := REAL'LAST; FIRST : constant REAL := REAL'FIRST; SMALL : constant REAL := REAL'SMALL; SAFE_LARGE : constant REAL := REAL'SAFE_LARGE; -- constants used in tests SIN_0 : constant := 0.0 ; SIN_15 : constant := 0.25881_90451_02520_76234_88988_37624_04832_83490 ; SIN_30 : constant := 0.5 ; SIN_45 : constant := 0.70710_67811_86547_52440_08443_62104_84903_92848 ; SIN_60 : constant := 0.86602_54037_84438_64676_37231_70752_93618_34714 ; SIN_75 : constant := 0.96592_58262_89068_28674_97431_99728_89736_76339 ; SIN_90 : constant := 1.0 ; TAN_15 : constant := 0.26794_91924_31122_70647_25536_58494_12763_30572 ; TAN_30 : constant := 0.57735_02691_89625_76450_91487_80501_95745_56476 ; TAN_60 : constant := 1.73205_08075_68877_29352_74463_41505_87236_69428 ; TAN_75 : constant := 3.73205_08075_68877_29352_74463_41505_87236_69428 ; SQRT_2 : constant := 1.41421_35623_73095_04880_16887_24209_69807_85696 ; SQRT_3 : constant := 1.73205_08075_68877_29352_74463_41505_87236_69428 ; TWELVTH_PI : constant := 0.26179_93877_99149_43653_85536_15273_29190_70164 ; SIXTH_PI : constant := 0.52359_87755_98298_87307_71072_30546_58381_40329 ; FOURTH_PI : constant := 0.78539_81633_97448_30961_56608_45819_87572_10492 ; THIRD_PI : constant := 1.04719_75511_96597_74615_42144_61093_16762_80657 ; F5_12_PI : constant := 1.30899_69389_95747_18269_27680_76366_45953_50822 ; HALF_PI : constant := 1.57079_63267_94896_61923_13216_91639_75144_20985 ; F7_12_PI : constant := 1.83259_57145_94046_05576_98753_06913_04334_91150 ; F2_3_PI : constant := 2.09439_51023_93195_49230_84289_22186_33525_61314 ; F3_4_PI : constant := 2.35619_44901_92344_92884_69825_37459_62716_31479 ; F5_6_PI : constant := 2.61799_38779_91494_36538_55361_52732_91907_01643 ; F11_12_PI : constant := 2.87979_32657_90643_80192_40897_68006_21097_71807 ; PI : constant := 3.14159_26535_89793_23846_26433_83279_50288_41971 ; TWO_PI : constant := 6.28318_53071_79586_47692_52867_66559_00576_83943 ; SQRT_PI : constant := 1.77245_38509_05516_02729_81674_83341_14518_27975 ; LN_PI : constant := 1.14472_98858_49400_17414_34273_51353_05871_16472 ; EXP_PI : constant :=23.14069_26327_79269_00572_90863_67948_54738_02661 ; E : constant := 2.71828_18284_59045_23536_02874_71352_66249_77572 ; SQRT_E : constant := 1.64872_12707_00128_14684_86507_87814_16357_16537 ; E_SQR : constant := 7.38905_60989_30650_22723_04274_60575_00781_31803 ; INV_E_SQR : constant := 0.13533_52832_36612_69189_39994_94972_48440_34076 ; INV_E : constant := 0.36787_94411_71442_32159_55237_70161_46086_74458 ; LN_10 : constant := 2.30258_50929_94045_68401_79914_54684_36420_76011 ; LN_2 : constant := 0.69314_71805_59945_30941_72321_21458_17656_80755 ; INV_1024 : constant := 0.00097_65625 ; INV_4096 : constant := 0.00024_41406_25 ; INV_2_20 : constant := 0.00000_09536_74316_40625 ; F11_12 : constant := 0.91666_66666_66666_66666_66666_66666_66666_66667 ; SINH_10 : constant := 11013.23287_47033_93377_23652_45548_46364_40290 ; COSH_10 : constant := 11013.23292_01033_23139_72137_60904_37879_96345 ; TANH_10 : constant := 0.99999_99958_77692_76361_95928_37138_27574_10508 ; COTH_10 : constant := 1.00000_00041_22307_25337_38241_84028_08031_24602 ; SINH_PI : constant :=11.54873_93572_57748_37797_73343_15388_40968_44952 ; COSH_PI : constant :=11.59195_32755_21520_62775_17520_52560_13769_57709 ; TANH_PI : constant := 0.99627_20762_20749_94426_46905_80012_53671_18969 ; COTH_PI : constant := 1.00374_18731_97321_28820_15526_91194_80001_74625 ; ARCSINH_11000 : constant := 9.99879_77344_06568_60160_92377_91803_75106_32941; ARCCOSH_11000 : constant := 9.99879_77302_74337_19665_05600_47053_97012_62185; ONE_M_2_20 : constant := 0.99999_90463_25683_59375 ; ARCTANH_2_20 : constant := 7.27804_51574_60789_80388_15064_24625_54153_35227; ONE_P_2_20 : constant := 0.10000_00953_67431_64062_5 ; ARCCOTH_2_20 : constant := 7.27804_56342_97948_00704_26464_97041_72994_50370; -- computed values for checking exceptions ONE_PLUS : REAL := 1.0 + EPSILON ; ONE_MINUS : REAL := 1.0 - EPSILON ; -- variables used in tests Y : REAL; X : REAL := 0.0; ANY_FAIL : BOOLEAN := FALSE; procedure PASSED is begin null; end PASSED; procedure FAILED ( MESSAGE : STRING ) is begin ANY_FAIL := TRUE; PUT_LINE("FAILED " & MESSAGE); end FAILED; procedure CHECK ( COMPUTED , EXPECTED , EPSILONS : REAL ) is begin if abs((EXPECTED-COMPUTED)/EXPECTED) > EPSILONS * EPSILON then FAILED("accuracy check"); PUT(COMPUTED); PUT(" computed, vs expected of "); PUT(EXPECTED); NEW_LINE; else PASSED; end if ; exception when others => PUT_LINE("exception during checking"); end CHECK ; begin PUT_LINE("Beginning test of Generic Elementary Functions"); DEFAULT_AFT := REAL'DIGITS + 1; -- put(epsilon); put_line(" is one epsilon per FLOAT_TYPE'BASE'EPSILON"); -- SQRT -- Declaration: -- function SQRT (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("SQRT testing"); begin -- test for ARGUMENT_ERROR on negative Y := SQRT ( -1.0 ) ; FAILED("ARGUMENT_ERROR not raised SQRT(-1.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on negative Y := SQRT ( FIRST ) ; FAILED("ARGUMENT_ERROR not raised SQRT(FIRST)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on negative Y := SQRT ( -SMALL ) ; FAILED("ARGUMENT_ERROR not raised SQRT(-SMALL)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for exact on 0.0 and -0.0 Y := SQRT ( 0.0 ) ; if Y = 0.0 then PASSED; else FAILED("SQRT(0.0) = 0.0"); end if; Y := SQRT ( -0.0 ) ; -- how do we get a portable negative zero ? if Y = -0.0 then PASSED; else FAILED("SQRT(-0.0) = -0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last Y := SQRT ( LAST ) ; PASSED; exception when others => FAILED("unexpected exception on SQRT(LAST)"); end; begin -- test for no exceptions on small Y := SQRT ( SMALL ) ; PASSED; exception when others => FAILED("unexpected exception on SQRT(SMALL)"); end; begin -- a few tests to see that it is working CHECK( SQRT ( 0.000001 ) , 0.001 , 2.0 ) ; CHECK( SQRT ( 0.0625 ) , 0.25 , 2.0 ) ; CHECK( SQRT ( 2.0 ) , SQRT_2 , 2.0 ) ; CHECK( SQRT ( E ) , SQRT_E , 2.0 ) ; CHECK( SQRT ( 3.0 ) , SQRT_3 , 2.0 ) ; CHECK( SQRT ( PI ) , SQRT_PI , 2.0 ) ; CHECK( SQRT ( 4096.0 ) , 64.0 , 2.0 ) ; CHECK( SQRT ( 1_000_000.0 ) , 1_000.0 , 2.0 ) ; exception when others => FAILED("unexpected exception on SQRT(X)"); end; -- LOG (natural base) -- Declaration: -- function LOG (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("LOG (natural base) testing"); begin -- test for ARGUMENT_ERROR on negative Y := LOG ( -1.0 ) ; FAILED("ARGUMENT_ERROR not raised LOG(-1.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on negative Y := LOG ( FIRST ) ; FAILED("ARGUMENT_ERROR not raised LOG(FIRST)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on negative Y := LOG ( -SMALL ) ; FAILED("ARGUMENT_ERROR not raised LOG(-SMALL)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for CONSTRAINT_ERROR on zero Y := LOG ( 0.0 ) ; FAILED("CONSTRAINT_ERROR not raised LOG(0.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last Y := LOG ( LAST ) ; PASSED; exception when others => FAILED("unexpected exception on LOG(LAST)"); end; begin -- test for no exceptions on small Y := LOG ( SMALL ) ; PASSED; exception when others => FAILED("unexpected exception on LOG(SMALL)"); end; begin -- LOG ( 1.0 ) = 0.0 Y := LOG ( 1.0 ) ; if Y = 0.0 then PASSED; else FAILED("LOG(1.0) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working CHECK( LOG ( 0.1 ) , -LN_10 , 4.0 ) ; CHECK( LOG ( INV_E_SQR ) , -2.0 , 4.0 ) ; CHECK( LOG ( INV_E ) , -1.0 , 4.0 ) ; CHECK( LOG ( 0.5 ) , -LN_2 , 4.0 ) ; CHECK( LOG ( 2.0 ) , LN_2 , 4.0 ) ; CHECK( LOG ( E ) , 1.0 , 4.0 ) ; CHECK( LOG ( PI ) , LN_PI , 4.0 ) ; CHECK( LOG ( E_SQR ) , 2.0 , 4.0 ) ; CHECK( LOG ( 10.0 ) , LN_10 , 4.0 ) ; exception when others => FAILED("unexpected exception on LOG(X)"); end; -- LOG (arbitrary base) -- Declaration: -- function LOG (X, BASE : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("LOG (arbitrary base) testing"); begin -- test for ARGUMENT_ERROR on negative Y := LOG ( -1.0 , E ) ; FAILED("ARGUMENT_ERROR not raised LOG(-1.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on negative Y := LOG ( FIRST , PI ) ; FAILED("ARGUMENT_ERROR not raised LOG(FIRST,Pi)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on negative base Y := LOG ( 2.0 , -SMALL ) ; FAILED("ARGUMENT_ERROR not raised LOG(2.0,-SMALL)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for CONSTRAINT_ERROR on zero Y := LOG ( 0.0 , 2.0 ) ; FAILED("CONSTRAINT_ERROR not raised LOG(0.0,2.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on zero base Y := LOG ( 2.0 , 0.0 ) ; FAILED("ARGUMENT_ERROR not raised LOG(2.0,0.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on BASE=1.0 Y := LOG ( 2.0 , 1.0 ) ; FAILED("ARGUMENT_ERROR not raised LOG(2.0,1.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last Y := LOG ( LAST , PI ) ; PASSED; exception when others => FAILED("unexpected exception on LOG(LAST)"); end; begin -- test for no exceptions on small Y := LOG ( SMALL , PI ) ; PASSED; exception when others => FAILED("unexpected exception on LOG(SMALL)"); end; begin -- LOG ( 1.0 , BASE ) = 0.0 Y := LOG ( 1.0 , 2.0 ) ; if Y = 0.0 then PASSED; else FAILED("LOG(1.0,BASE) = 0.0"); end if; Y := LOG ( 1.0 , 0.5 ) ; if Y = 0.0 then PASSED; else FAILED("LOG(1.0,BASE) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working CHECK( LOG ( 0.0625 , 2.0 ) , -4.0 , 4.0 ) ; CHECK( LOG ( 0.001 , 10.0 ) , -3.0 , 4.0 ) ; CHECK( LOG ( PI , PI ) , 1.0 , 4.0 ) ; CHECK( LOG ( E_SQR , E ) , 2.0 , 4.0 ) ; CHECK( LOG ( 1000.0 , 10.0 ) , 3.0 , 4.0 ) ; CHECK( LOG ( 27.0 , 3.0 ) , 3.0 , 4.0 ) ; CHECK( LOG ( INV_4096 , 0.5 ) , 12.0 , 4.0 ) ; CHECK( LOG ( 4096.0 , 2.0 ) , 12.0 , 4.0 ) ; exception when others => FAILED("unexpected exception on LOG(X)"); end; -- EXP -- Declaration: -- function EXP (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("EXP testing"); begin -- test for CONSTRAINT_ERROR on last Y := EXP ( LAST ) ; FAILED("CONSTRAINT_ERROR not raised EXP(last)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; declare -- test for CONSTRAINT_ERROR on big BIG : REAL; begin BIG := LOG(LAST) * ( 1.0+4.0*EPSILON ); Y := EXP ( BIG ) ; FAILED("CONSTRAINT_ERROR not raised EXP(big)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; declare -- test for no exceptions on so_so SO_SO : REAL ; begin SO_SO := LOG(REAL'SAFE_LARGE)*(1.0-4.0*EPSILON); Y := EXP ( SO_SO ) ; PASSED; exception when others => FAILED("unexpected exception on EXP(SO_SO)"); end; begin -- test for no exceptions on first Y := EXP ( FIRST ) ; PASSED; exception when others => FAILED("unexpected exception on EXP(first)"); end; begin -- EXP ( 0.0 ) = 1.0 Y := EXP ( 0.0 ) ; if Y = 1.0 then PASSED; else FAILED("EXP(0.0) = 1.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working CHECK( EXP ( -LN_10 ) , 0.1 , 4.0 ) ; CHECK( EXP ( -2.0 ) , INV_E_SQR , 4.0 ) ; CHECK( EXP ( LN_2 ) , 2.0 , 4.0 ) ; CHECK( EXP ( 1.0 ) , E , 4.0 ) ; CHECK( EXP ( LN_PI ) , PI , 4.0 ) ; CHECK( EXP ( 2.0 ) , E_SQR , 4.0 ) ; CHECK( EXP ( LN_10 ) , 10.0 , 4.0 ) ; CHECK( EXP ( PI ) , EXP_PI , 4.0 ) ; exception when others => FAILED("unexpected exception on EXP(X)"); end; -- "**" -- Declaration: -- function "**" (X, Y : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("** testing"); begin -- test for ARGUMENT_ERROR on negative X Y := (-1.0) ** 1.0 ; FAILED("ARGUMENT_ERROR not raised (-1.0) ** 1.0"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception (-1.0) ** 1"); end; begin -- test for ARGUMENT_ERROR on negative X Y := FIRST ** 0.0 ; FAILED("ARGUMENT_ERROR not raised first ** 0.0 "); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception first ** 0"); end; begin -- test for ARGUMENT_ERROR on negative Y := ( -SMALL ) ** SMALL ; FAILED("ARGUMENT_ERROR not raised (-SMALL) ** SMALL"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception (-small) ** small"); end; begin -- test for CONSTRAINT_ERROR on last Y := LAST ** LAST ; FAILED("CONSTRAINT_ERROR not raised last ** last)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception last ** last"); end; begin -- test for CONSTRAINT_ERROR on 0 ** -1 Y := 0.0 ** (-1.0); FAILED("CONSTRAINT_ERROR not raised 0.0 ** (-1.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception 0.0 ** (-1.0)"); end; begin -- a few tests to see that it is working -- the accuracy is multiplied by FLOAT_TYPE'BASE'EPSILON and thus -- there is no problem with allowable errors in computed LOG's. CHECK( 10.0 ** ( -4.0 ) , 0.0001 , 4.0+abs(-4.0*LOG(10.0))/32.0 ) ; CHECK( SQRT_2 ** (-20.0) , INV_1024 , 4.0+abs(-11.0*LOG(1.0/SQRT_2))/32.0 ) ; CHECK( 2.0 ** 0.5 , SQRT_2 , 4.0+abs(0.5*LOG(2.0))/32.0 ) ; CHECK( 3.0 ** 0.5 , SQRT_3 , 4.0+abs(0.5*LOG(3.0))/32.0 ) ; CHECK( E ** PI , EXP_PI , 4.0+abs(PI*LOG(E))/32.0 ) ; CHECK( SQRT_2 ** 20.0 , 1_024.0 , 4.0+abs(11.0*LOG(SQRT_2))/32.0 ) ; CHECK( 10.0 ** 4.0 , 10_000.0 , 4.0+abs(4.0*LOG(10.0))/32.0 ) ; CHECK( 2.0 ** 15.0 , 32_768.0 , 4.0+abs(15.0*LOG(2.0))/32.0 ) ; exception when others => FAILED("unexpected exception on X**Y"); end; -- SIN (natural cycle) -- Declaration: -- function SIN (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("SIN (natural cycle) testing"); begin -- test for exact on 0.0 Y := SIN ( 0.0 ) ; if Y = 0.0 then PASSED; else FAILED("SIN(0.0) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last Y := SIN ( LAST ) ; PASSED; exception when others => FAILED("unexpected exception on SIN(LAST)"); end; begin -- test for no exceptions on first Y := SIN ( FIRST ) ; PASSED; exception when others => FAILED("unexpected exception on SIN(FIRST)"); end; begin -- a few tests to see that it is working CHECK( SIN ( -TWELVTH_PI ) , -SIN_15 , 2.0 ) ; CHECK( SIN ( -SIXTH_PI ) , -SIN_30 , 2.0 ) ; CHECK( SIN ( -FOURTH_PI ) , -SIN_45 , 2.0 ) ; CHECK( SIN ( -THIRD_PI ) , -SIN_60 , 2.0 ) ; CHECK( SIN ( -F5_12_PI ) , -SIN_75 , 2.0 ) ; CHECK( SIN ( -HALF_PI ) , -1.0 , 2.0 ) ; CHECK( SIN ( -F7_12_PI ) , -SIN_75 , 2.0 ) ; CHECK( SIN ( -F2_3_PI ) , -SIN_60 , 2.0 ) ; CHECK( SIN ( -F3_4_PI ) , -SIN_45 , 2.0 ) ; CHECK( SIN ( -F5_6_PI) , -SIN_30 , 2.0 ) ; CHECK( SIN ( -F11_12_PI ) , -SIN_15 , 2.0 ) ; CHECK( SIN ( TWELVTH_PI ) , SIN_15 , 2.0 ) ; CHECK( SIN ( REAL(15.0 * HALF_PI) ) , -1.0 , 2.0 ) ; CHECK( SIN ( SIXTH_PI ) , SIN_30 , 2.0 ) ; CHECK( SIN ( FOURTH_PI ) , SIN_45 , 2.0 ) ; CHECK( SIN ( THIRD_PI ) , SIN_60 , 2.0 ) ; CHECK( SIN ( F5_12_PI ) , SIN_75 , 2.0 ) ; CHECK( SIN ( HALF_PI ) , 1.0 , 2.0 ) ; CHECK( SIN ( F7_12_PI ) , SIN_75 , 2.0 ) ; CHECK( SIN ( F2_3_PI ) , SIN_60 , 2.0 ) ; CHECK( SIN ( F3_4_PI ) , SIN_45 , 2.0 ) ; CHECK( SIN ( F5_6_PI ) , SIN_30 , 2.0 ) ; CHECK( SIN ( F11_12_PI ) , SIN_15 , 2.0 ) ; CHECK( SIN ( REAL(17.0 * HALF_PI) ) , 1.0 , 2.0 ) ; exception when others => FAILED("unexpected exception on SIN(X)"); end; -- SIN (arbitrary cycle) -- Declaration: -- function SIN (X, CYCLE : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("SIN (arbitrary cycle) testing"); begin -- test for ARGUMENT_ERROR on negative CYCLE Y := SIN ( 1.0 , -1.0 ) ; FAILED("ARGUMENT_ERROR not raised SIN(1.0,-1.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on zero CYCLE Y := SIN ( 1.0 , 0.0 ) ; FAILED("ARGUMENT_ERROR not raised SIN(1.0,0.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for exact on 0.0 Y := SIN ( 0.0 , E ) ; if Y = 0.0 then PASSED; else FAILED("SIN(0.0,e) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last Y := SIN ( LAST , E ) ; PASSED; exception when others => FAILED("unexpected exception on SIN(LAST,E)"); end; begin -- test for no exceptions on first Y := SIN ( FIRST , E ) ; PASSED; exception when others => FAILED("unexpected exception on SIN(FIRST,E)"); end; begin -- a few tests to see that it is working CHECK( SIN ( -15.0 , 360.0 ) , -SIN_15 , 2.0 ) ; CHECK( SIN ( -30.0 , 360.0 ) , -SIN_30 , 2.0 ) ; CHECK( SIN ( -0.125 , 1.0 ) , -SIN_45 , 2.0 ) ; CHECK( SIN ( -60.0 , 360.0 ) , -SIN_60 , 2.0 ) ; CHECK( SIN ( -150.0 , 720.0 ) , -SIN_75 , 2.0 ) ; CHECK( SIN ( -0.5 , 2.0 ) , -1.0 , 2.0 ) ; CHECK( SIN ( -105.0 , 360.0 ) , -SIN_75 , 2.0 ) ; CHECK( SIN ( -120.0 , 360.0 ) , -SIN_60 , 2.0 ) ; CHECK( SIN ( -0.75 , 2.0 ) , -SIN_45 , 2.0 ) ; CHECK( SIN ( -150.0 , 360.0 ) , -SIN_30 , 2.0 ) ; CHECK( SIN ( F11_12 , 2.0 ) , SIN_15 , 2.0 ) ; CHECK( SIN ( 15.0 , 360.0 ) , SIN_15 , 2.0 ) ; CHECK( SIN ( 30.0 , 360.0 ) , SIN_30 , 2.0 ) ; CHECK( SIN ( 0.125 , 1.0 ) , SIN_45 , 2.0 ) ; CHECK( SIN ( 60.0 , 360.0 ) , SIN_60 , 2.0 ) ; CHECK( SIN ( 75.0 , 360.0 ) , SIN_75 , 2.0 ) ; CHECK( SIN ( E , REAL(4.0*E) ) , 1.0 , 2.0 ) ; CHECK( SIN ( 105.0 , 360.0 ) , SIN_75 , 2.0 ) ; CHECK( SIN ( 120.0 , 360.0 ) , SIN_60 , 2.0 ) ; CHECK( SIN ( 135.0 , 360.0 ) , SIN_45 , 2.0 ) ; CHECK( SIN ( 150.0 , 360.0 ) , SIN_30 , 2.0 ) ; CHECK( SIN ( 165.0 , 360.0 ) , SIN_15 , 2.0 ) ; CHECK( SIN ( -180.0 , 720.0 ) , -1.0 , 2.0 ) ; CHECK( SIN ( -0.25 , 1.0 ) , -1.0 , 2.0 ) ; CHECK( SIN ( 17.0 , 4.0 ) , 1.0 , 2.0 ) ; exception when others => FAILED("unexpected exception on SIN(X,CYCLE)"); end; -- COS (natural cycle) -- Declaration: -- function COS (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("COS (natural cycle) testing"); begin -- test for exact on 0.0 Y := COS ( 0.0 ) ; if Y = 1.0 then PASSED; else FAILED("COS(0.0) = 1.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last Y := COS ( LAST ) ; PASSED; exception when others => FAILED("unexpected exception on COS(LAST)"); end; begin -- test for no exceptions on first Y := COS ( FIRST ) ; PASSED; exception when others => FAILED("unexpected exception on COS(FIRST)"); end; begin -- a few tests to see that it is working CHECK( COS ( -TWELVTH_PI ) , SIN_75 , 2.0 ) ; CHECK( COS ( 0.0 ) , 1.0 , 2.0 ) ; CHECK( COS ( TWELVTH_PI ) , SIN_75 , 2.0 ) ; CHECK( COS ( SIXTH_PI ) , SIN_60 , 2.0 ) ; CHECK( COS ( FOURTH_PI ) , SIN_45 , 2.0 ) ; CHECK( COS ( THIRD_PI ) , SIN_30 , 2.0 ) ; CHECK( COS ( F5_12_PI ) , SIN_15 , 2.0 ) ; CHECK( COS ( F7_12_PI ) , -SIN_15 , 2.0 ) ; CHECK( COS ( F2_3_PI ) , -SIN_30 , 2.0 ) ; CHECK( COS ( F3_4_PI ) , -SIN_45 , 2.0 ) ; CHECK( COS ( F5_6_PI ) , -SIN_60 , 2.0 ) ; CHECK( COS ( F11_12_PI ) , -SIN_75 , 2.0 ) ; CHECK( COS ( PI ) , -1.0 , 2.0 ) ; CHECK( COS ( REAL(PI+TWELVTH_PI) ) , -SIN_75 , 2.0 ) ; CHECK( COS ( REAL(PI+SIXTH_PI) ) , -SIN_60 , 2.0 ) ; CHECK( COS ( REAL(PI+FOURTH_PI) ) , -SIN_45 , 2.0 ) ; CHECK( COS ( REAL(PI+THIRD_PI) ) , -SIN_30 , 2.0 ) ; CHECK( COS ( REAL(PI+F5_12_PI) ) , -SIN_15 , 2.0 ) ; exception when others => FAILED("unexpected exception on COS(X)"); end; -- COS (arbitrary cycle) -- Declaration: -- function COS (X, CYCLE : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("COS (arbitrary cycle) testing"); begin -- test for ARGUMENT_ERROR on negative CYCLE Y := COS ( 1.0 , -1.0 ) ; FAILED("ARGUMENT_ERROR not raised COS(1.0,-1.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on zero CYCLE Y := COS ( 1.0 , 0.0 ) ; FAILED("ARGUMENT_ERROR not raised COS(1.0,0.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for exact on 0.0 Y := COS ( 0.0 , E ) ; if Y = 1.0 then PASSED; else FAILED("COS(0.0,e) = 1.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last Y := COS ( LAST , E ) ; PASSED; exception when others => FAILED("unexpected exception on COS(LAST,E)"); end; begin -- test for no exceptions on first Y := COS ( FIRST , E ) ; PASSED; exception when others => FAILED("unexpected exception on COS(FIRST,E)"); end; begin -- a few tests to see that it is working CHECK( COS ( -15.0 , 360.0 ) , SIN_75 , 2.0 ) ; CHECK( COS ( -30.0 , 360.0 ) , SIN_60 , 2.0 ) ; CHECK( COS ( -0.125 , 1.0 ) , SIN_45 , 2.0 ) ; CHECK( COS ( -60.0 , 360.0 ) , SIN_30 , 2.0 ) ; CHECK( COS ( -150.0 , 720.0 ) , SIN_15 , 2.0 ) ; CHECK( COS ( -105.0 , 360.0 ) , -SIN_15 , 2.0 ) ; CHECK( COS ( -120.0 , 360.0 ) , -SIN_30 , 2.0 ) ; CHECK( COS ( -0.75 , 2.0 ) , -SIN_45 , 2.0 ) ; CHECK( COS ( -150.0 , 360.0 ) , -SIN_60 , 2.0 ) ; CHECK( COS ( F11_12 , 2.0 ) , -SIN_75 , 2.0 ) ; CHECK( COS ( E , REAL(2.0*E) ) , -1.0 , 2.0 ) ; CHECK( COS ( 15.0 , 360.0 ) , SIN_75 , 2.0 ) ; CHECK( COS ( 30.0 , 360.0 ) , SIN_60 , 2.0 ) ; CHECK( COS ( 0.125 , 1.0 ) , SIN_45 , 2.0 ) ; CHECK( COS ( 60.0 , 360.0 ) , SIN_30 , 2.0 ) ; CHECK( COS ( 75.0 , 360.0 ) , SIN_15 , 2.0 ) ; CHECK( COS ( 105.0 , 360.0 ) , -SIN_15 , 2.0 ) ; CHECK( COS ( 120.0 , 360.0 ) , -SIN_30 , 2.0 ) ; CHECK( COS ( 135.0 , 360.0 ) , -SIN_45 , 2.0 ) ; CHECK( COS ( 150.0 , 360.0 ) , -SIN_60 , 2.0 ) ; CHECK( COS ( 165.0 , 360.0 ) , -SIN_75 , 2.0 ) ; CHECK( COS ( -180.0 , 360.0 ) , -1.0 , 2.0 ) ; CHECK( COS ( -0.5 , 1.0 ) , -1.0 , 2.0 ) ; CHECK( COS ( 16.0 , 1.0 ) , 1.0 , 2.0 ) ; exception when others => FAILED("unexpected exception on COS(X,CYCLE)"); end; -- TAN (natural cycle) -- Declaration: -- function TAN (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("TAN (natural cycle) testing"); begin -- test for no exceptions on last Y := TAN ( LAST ) ; PASSED; exception when others => FAILED("unexpected exception on TAN(LAST)"); end; begin -- test for no exceptions on first Y := TAN ( FIRST ) ; PASSED; exception when others => FAILED("unexpected exception on TAN(FIRST)"); end; begin -- test for no exceptions on small Y := TAN ( SMALL ) ; CHECK( Y , SMALL , 4.0 ) ; exception when others => FAILED("unexpected exception on TAN(SMALL)"); end; begin -- test for no exceptions on -small Y := TAN ( -SMALL ) ; CHECK( Y , -SMALL , 4.0 ) ; exception when others => FAILED("unexpected exception on TAN(-small)"); end; begin -- test for no exceptions on +/- HALF_PI Y := TAN ( HALF_PI ) ; PASSED; Y := TAN ( -HALF_PI ) ; PASSED; exception when others => FAILED("unexpected exception on TAN(+/- HALF_PI)"); end; begin -- test for +/- PI Y := TAN ( PI ) ; if abs Y < EPSILON then PASSED ; else FAILED("TAN(PI) about zero"); end if ; Y := TAN ( -PI ) ; if abs Y < EPSILON then PASSED ; else FAILED("TAN(-PI) about zero"); end if ; exception when others => FAILED("unexpected exception on TAN(+/- PI)"); end; begin -- a few tests to see that it is working CHECK( TAN ( TWELVTH_PI ) , TAN_15 , 4.0 ) ; CHECK( TAN ( SIXTH_PI ) , TAN_30 , 4.0 ) ; CHECK( TAN ( FOURTH_PI ) , 1.0 , 4.0 ) ; CHECK( TAN ( THIRD_PI ) , TAN_60 , 4.0 ) ; CHECK( TAN ( F5_12_PI ) , TAN_75 , 4.0 ) ; CHECK( TAN ( F7_12_PI ) , -TAN_75 , 4.0 ) ; CHECK( TAN ( F2_3_PI ) , -TAN_60 , 4.0 ) ; CHECK( TAN ( F3_4_PI ) , -1.0 , 4.0 ) ; CHECK( TAN ( F5_6_PI ) , -TAN_30 , 4.0 ) ; CHECK( TAN ( F11_12_PI ) , -TAN_15 , 4.0 ) ; CHECK( TAN ( -TWELVTH_PI ) , -TAN_15 , 4.0 ) ; CHECK( TAN ( -SIXTH_PI ) , -TAN_30 , 4.0 ) ; CHECK( TAN ( -FOURTH_PI ) , -1.0 , 4.0 ) ; CHECK( TAN ( -THIRD_PI ) , -TAN_60 , 4.0 ) ; CHECK( TAN ( -F5_12_PI ) , -TAN_75 , 4.0 ) ; CHECK( TAN ( -F7_12_PI ) , TAN_75 , 4.0 ) ; CHECK( TAN ( -F2_3_PI ) , TAN_60 , 4.0 ) ; CHECK( TAN ( -F3_4_PI ) , 1.0 , 4.0 ) ; CHECK( TAN ( -F5_6_PI ) , TAN_30 , 4.0 ) ; CHECK( TAN ( -F11_12_PI ) , TAN_15 , 4.0 ) ; exception when others => FAILED("unexpected exception on TAN(X)"); end; -- TAN (arbitrary cycle) -- Declaration: -- function TAN (X, CYCLE : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("TAN (arbitrary cycle) testing"); begin -- test for CONSTRAINT_ERROR on (2k+1)CYCLE/4 Y := TAN ( 5.0 , 4.0 ) ; FAILED("CONSTRAINT_ERROR not raised TAN(5.0,4.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception TAN(5.0,4.0)"); end; begin -- test for ARGUMENT_ERROR on negative CYCLE Y := TAN ( 1.0 , -1.0 ) ; FAILED("ARGUMENT_ERROR not raised TAN(1.0,-1.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on zero CYCLE Y := TAN ( 1.0 , 0.0 ) ; FAILED("ARGUMENT_ERROR not raised TAN(1.0,0.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for exact on 0.0 Y := TAN ( 0.0 , E ) ; if Y = 0.0 then PASSED; else FAILED("TAN(0.0,e) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last Y := TAN ( LAST , E ) ; PASSED; exception when others => FAILED("unexpected exception on TAN(LAST,E)"); end; begin -- test for no exceptions on first Y := TAN ( FIRST , E ) ; PASSED; exception when others => FAILED("unexpected exception on TAN(FIRST,E)"); end; begin -- a few tests to see that it is working CHECK( TAN ( -15.0 , 360.0 ) , -TAN_15 , 4.0 ) ; CHECK( TAN ( -30.0 , 360.0 ) , -TAN_30 , 4.0 ) ; CHECK( TAN ( -0.125 , 1.0 ) , -1.0 , 4.0 ) ; CHECK( TAN ( -60.0 , 360.0 ) , -TAN_60 , 4.0 ) ; CHECK( TAN ( -150.0 , 720.0 ) , -TAN_75 , 4.0 ) ; CHECK( TAN ( -105.0 , 360.0 ) , TAN_75 , 4.0 ) ; CHECK( TAN ( -120.0 , 360.0 ) , TAN_60 , 4.0 ) ; CHECK( TAN ( -0.75 , 2.0 ) , 1.0 , 4.0 ) ; CHECK( TAN ( -150.0 , 360.0 ) , TAN_30 , 4.0 ) ; CHECK( TAN ( -F11_12 , 2.0 ) , TAN_15 , 4.0 ) ; CHECK( TAN ( 15.0 , 360.0 ) , TAN_15 , 4.0 ) ; CHECK( TAN ( 30.0 , 360.0 ) , TAN_30 , 4.0 ) ; CHECK( TAN ( 0.125 , 1.0 ) , 1.0 , 4.0 ) ; CHECK( TAN ( 60.0 , 360.0 ) , TAN_60 , 4.0 ) ; CHECK( TAN ( 75.0 , 360.0 ) , TAN_75 , 4.0 ) ; CHECK( TAN ( 105.0 , 360.0 ) , -TAN_75 , 4.0 ) ; CHECK( TAN ( 120.0 , 360.0 ) , -TAN_60 , 4.0 ) ; CHECK( TAN ( 135.0 , 360.0 ) , -1.0 , 4.0 ) ; CHECK( TAN ( 150.0 , 360.0 ) , -TAN_30 , 4.0 ) ; CHECK( TAN ( 165.0 , 360.0 ) , -TAN_15 , 4.0 ) ; CHECK( TAN ( 36045.0 , 360.0 ) , 1.0 , 4.0 ) ; CHECK( TAN ( -36045.0 , 360.0 ) , -1.0 , 4.0 ) ; CHECK( TAN ( 35955.0 , 360.0 ) , -1.0 , 4.0 ) ; CHECK( TAN ( -35955.0 , 360.0 ) , 1.0 , 4.0 ) ; exception when others => FAILED("unexpected exception on TAN(X,CYCLE)"); end; -- COT (natural cycle) -- Declaration: -- function COT (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("COT (natural cycle) testing"); begin -- test for CONSTRAINT_ERROR on 0.0 Y := COT ( 0.0 ) ; FAILED("CONSTRAINT_ERROR not raised COT(0.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last Y := COT ( LAST ) ; PASSED; exception when others => FAILED("unexpected exception on COT(LAST)"); end; begin -- test for no exceptions on first Y := COT ( FIRST ) ; PASSED; exception when others => FAILED("unexpected exception on COT(FIRST)"); end; begin -- test for no exceptions on small Y := COT ( SMALL ) ; PASSED; exception when others => FAILED("unexpected exception on COT(SMALL)"); end; begin -- test for no exceptions on -small Y := COT ( -SMALL ) ; PASSED; exception when others => FAILED("unexpected exception on COT(-SMALL)"); end; begin -- test for no exceptions on PI Y := COT ( PI ) ; PASSED; exception when others => FAILED("unexpected exception on COT(PI)"); end; begin -- test for HALF_PI Y := COT ( HALF_PI ) ; if abs Y < EPSILON then PASSED ; else FAILED("COT(HALF_PI) about zero"); end if ; exception when others => FAILED("unexpected exception on COT(HALF_PI)"); end; begin -- a few tests to see that it is working CHECK( COT ( -TWELVTH_PI ) , -TAN_75 , 4.0 ) ; CHECK( COT ( -SIXTH_PI ) , -TAN_60 , 4.0 ) ; CHECK( COT ( -FOURTH_PI ) , -1.0 , 4.0 ) ; CHECK( COT ( -THIRD_PI ) , -TAN_30 , 4.0 ) ; CHECK( COT ( -F5_12_PI ) , -TAN_15 , 4.0 ) ; CHECK( COT ( -F7_12_PI ) , TAN_15 , 4.0 ) ; CHECK( COT ( -F2_3_PI ) , TAN_30 , 4.0 ) ; CHECK( COT ( -F3_4_PI ) , 1.0 , 4.0 ) ; CHECK( COT ( -F5_6_PI ) , TAN_60 , 4.0 ) ; CHECK( COT ( -F11_12_PI ) , TAN_75 , 4.0 ) ; CHECK( COT ( TWELVTH_PI ) , TAN_75 , 4.0 ) ; CHECK( COT ( SIXTH_PI ) , TAN_60 , 4.0 ) ; CHECK( COT ( FOURTH_PI ) , 1.0 , 4.0 ) ; CHECK( COT ( THIRD_PI ) , TAN_30 , 4.0 ) ; CHECK( COT ( F5_12_PI ) , TAN_15 , 4.0 ) ; CHECK( COT ( F7_12_PI ) , -TAN_15 , 4.0 ) ; CHECK( COT ( F2_3_PI ) , -TAN_30 , 4.0 ) ; CHECK( COT ( F3_4_PI ) , -1.0 , 4.0 ) ; CHECK( COT ( F5_6_PI ) , -TAN_60 , 4.0 ) ; CHECK( COT ( F11_12_PI ) , -TAN_75 , 4.0 ) ; exception when others => FAILED("unexpected exception on COT(X)"); end; -- COT (arbitrary cycle) -- Declaration: -- function COT (X, CYCLE : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("COT (arbitrary cycle) testing"); begin -- test for ARGUMENT_ERROR on negative cycle Y := COT ( 1.0 , -1.0 ) ; FAILED("ARGUMENT_ERROR not raised COT(1.0,-1.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on zero cycle Y := COT ( 1.0 , 0.0 ) ; FAILED("ARGUMENT_ERROR not raised COT(1.0,0.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for CONSTRAINT_ERROR on zero Y := COT ( 0.0 , 1.0 ) ; FAILED("CONSTRAINT_ERROR not raised COT(0.0,1.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for CONSTRAINT_ERROR on k * CYCLE/2 Y := COT ( 1.0 , 2.0 ) ; FAILED("CONSTRAINT_ERROR not raised COT(1.0,2.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for CONSTRAINT_ERROR on k * CYCLE/2 Y := COT ( 4.0 , 2.0 ) ; FAILED("CONSTRAINT_ERROR not raised COT(4.0,2.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for CONSTRAINT_ERROR on k * CYCLE/2 Y := COT ( 4096.0 , 2.0 ) ; FAILED("CONSTRAINT_ERROR not raised COT(4096.0,2.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last Y := COT ( LAST , E ) ; PASSED; exception when others => FAILED("unexpected exception on COT(LAST,E)"); end; begin -- test for no exceptions on first Y := COT ( FIRST , E ) ; PASSED; exception when others => FAILED("unexpected exception on COT(FIRST,E)"); end; begin -- a few tests to see that it is working CHECK( COT ( -15.0 , 360.0 ) , -TAN_75 , 4.0 ) ; CHECK( COT ( -30.0 , 360.0 ) , -TAN_60 , 4.0 ) ; CHECK( COT ( -0.125 , 1.0 ) , -1.0 , 4.0 ) ; CHECK( COT ( -60.0 , 360.0 ) , -TAN_30 , 4.0 ) ; CHECK( COT ( -150.0 , 720.0 ) , -TAN_15 , 4.0 ) ; CHECK( COT ( -105.0 , 360.0 ) , TAN_15 , 4.0 ) ; CHECK( COT ( -120.0 , 360.0 ) , TAN_30 , 4.0 ) ; CHECK( COT ( -0.75 , 2.0 ) , 1.0 , 4.0 ) ; CHECK( COT ( -150.0 , 360.0 ) , TAN_60 , 4.0 ) ; CHECK( COT ( -F11_12 , 2.0 ) , TAN_75 , 4.0 ) ; CHECK( COT ( 15.0 , 360.0 ) , TAN_75 , 4.0 ) ; CHECK( COT ( 30.0 , 360.0 ) , TAN_60 , 4.0 ) ; CHECK( COT ( 0.125 , 1.0 ) , 1.0 , 4.0 ) ; CHECK( COT ( 60.0 , 360.0 ) , TAN_30 , 4.0 ) ; CHECK( COT ( 75.0 , 360.0 ) , TAN_15 , 4.0 ) ; CHECK( COT ( 105.0 , 360.0 ) , -TAN_15 , 4.0 ) ; CHECK( COT ( 120.0 , 360.0 ) , -TAN_30 , 4.0 ) ; CHECK( COT ( 135.0 , 360.0 ) , -1.0 , 4.0 ) ; CHECK( COT ( 150.0 , 360.0 ) , -TAN_60 , 4.0 ) ; CHECK( COT ( 165.0 , 360.0 ) , -TAN_75 , 4.0 ) ; exception when others => FAILED("unexpected exception on COT(X,CYCLE)"); end; -- ARCSIN (natural cycle) -- Declaration: -- function ARCSIN (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("ARCSIN (natural cycle) testing"); begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCSIN ( ONE_PLUS ) ; FAILED("ARGUMENT_ERROR not raised ARCSIN(1.0+EPSILON)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCSIN ( -ONE_PLUS ) ; FAILED("ARGUMENT_ERROR not raised ARCSIN(-1.0-EPSILON)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCSIN ( FIRST ) ; FAILED("ARGUMENT_ERROR not raised ARCSIN(FIRST)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCSIN ( LAST ) ; FAILED("ARGUMENT_ERROR not raised ARCSIN(LAST)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for exact on 0.0 Y := ARCSIN ( 0.0 ) ; if Y = 0.0 then PASSED; else FAILED("ARCSIN(0.0) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working CHECK( ARCSIN ( -SIN_15 ) , -TWELVTH_PI , 4.0 ) ; CHECK( ARCSIN ( -SIN_30 ) , -SIXTH_PI , 4.0 ) ; CHECK( ARCSIN ( -SIN_45 ) , -FOURTH_PI , 4.0 ) ; CHECK( ARCSIN ( -SIN_60 ) , -THIRD_PI , 4.0 ) ; CHECK( ARCSIN ( -SIN_75 ) , -F5_12_PI , 4.0 ) ; CHECK( ARCSIN ( -1.0 ) , -HALF_PI , 4.0 ) ; CHECK( ARCSIN ( SIN_15 ) , TWELVTH_PI , 4.0 ) ; CHECK( ARCSIN ( SIN_30 ) , SIXTH_PI , 4.0 ) ; CHECK( ARCSIN ( SIN_45 ) , FOURTH_PI , 4.0 ) ; CHECK( ARCSIN ( SIN_60 ) , THIRD_PI , 4.0 ) ; CHECK( ARCSIN ( SIN_75 ) , F5_12_PI , 4.0 ) ; CHECK( ARCSIN ( 1.0 ) , HALF_PI , 4.0 ) ; exception when others => FAILED("unexpected exception on ARCSIN(X)"); end; -- ARCSIN (arbitrary cycle) -- Declaration: -- function ARCSIN (X, CYCLE : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("ARCSIN (arbitrary cycle) testing"); begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCSIN ( 1.0 + EPSILON , E ) ; FAILED("ARGUMENT_ERROR not raised ARCSIN(1.0+EPSILON,E)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCSIN ( -(1.0+EPSILON) , E ) ; FAILED("ARGUMENT_ERROR not raised ARCSIN(-1.0-EPSILON,E)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCSIN ( FIRST , E ) ; FAILED("ARGUMENT_ERROR not raised ARCSIN(FIRST,E)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCSIN ( LAST , E ) ; FAILED("ARGUMENT_ERROR not raised ARCSIN(LAST,E)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for exact on 0.0 Y := ARCSIN ( 0.0 , E ) ; if Y = 0.0 then PASSED; else FAILED("ARCSIN(0.0,E) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working -- special case accuracy checks CHECK( ARCSIN ( -1.0 , 100.0 ) , -25.0 , 1.0 ) ; CHECK( ARCSIN ( 1.0 , 100.0 ) , 25.0 , 1.0 ) ; CHECK( ARCSIN ( 1.0 , 1_000_000.0 ) , 250_000.0 , 1.0 ) ; -- general case accuracy checks CHECK( ARCSIN ( -SIN_15 , 360.0 ) , -15.0 , 4.0 ) ; CHECK( ARCSIN ( -SIN_30 , TWO_PI ) , -SIXTH_PI , 4.0 ) ; CHECK( ARCSIN ( -SIN_45 , 2.0 ) , -0.25 , 4.0 ) ; CHECK( ARCSIN ( -SIN_60 , 300.0 ) , -50.0 , 4.0 ) ; CHECK( ARCSIN ( -SIN_75 , TWO_PI ) , -F5_12_PI , 4.0 ) ; CHECK( ARCSIN ( SIN_15 , 360.0 ) , 15.0 , 4.0 ) ; CHECK( ARCSIN ( SIN_30 , 360.0 ) , 30.0 , 4.0 ) ; CHECK( ARCSIN ( SIN_45 , 1.0 ) , 0.125 , 4.0 ) ; CHECK( ARCSIN ( SIN_60 , 720.0 ) , 120.0 , 4.0 ) ; CHECK( ARCSIN ( SIN_75 , TWO_PI ) , F5_12_PI , 4.0 ) ; CHECK( ARCSIN ( SIN_15 , 36000.0 ) , 1500.0 , 4.0 ) ; exception when others => FAILED("unexpected exception on ARCSIN(X,CYCLE)"); end; -- ARCCOS (natural cycle) -- Declaration: -- function ARCCOS (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("ARCCOS (natural cycle) testing"); begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCCOS ( 1.0 + EPSILON ) ; FAILED("ARGUMENT_ERROR not raised ARCCOS(1.0+EPSILON)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCCOS ( -(1.0+EPSILON) ) ; FAILED("ARGUMENT_ERROR not raised ARCCOS(-1.0-EPSILON)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCCOS ( FIRST ) ; FAILED("ARGUMENT_ERROR not raised ARCCOS(FIRST)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCCOS ( LAST ) ; FAILED("ARGUMENT_ERROR not raised ARCCOS(LAST)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for exact on 1.0 Y := ARCCOS ( 1.0 ) ; if Y = 0.0 then PASSED; else FAILED("ARCCOS(1.0) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working CHECK( ARCCOS ( -1.0 ) , PI , 4.0 ) ; CHECK( ARCCOS ( -SIN_75 ) , F11_12_PI, 4.0 ) ; CHECK( ARCCOS ( -SIN_60 ) , F5_6_PI , 4.0 ) ; CHECK( ARCCOS ( -SIN_45 ) , F3_4_PI , 4.0 ) ; CHECK( ARCCOS ( -SIN_30 ) , F2_3_PI , 4.0 ) ; CHECK( ARCCOS ( -SIN_15 ) , F7_12_PI, 4.0 ) ; CHECK( ARCCOS ( 0.0 ) , HALF_PI , 4.0 ) ; CHECK( ARCCOS ( SIN_15 ) , F5_12_PI , 4.0 ) ; CHECK( ARCCOS ( SIN_30 ) , THIRD_PI , 4.0 ) ; CHECK( ARCCOS ( SIN_45 ) , FOURTH_PI , 4.0 ) ; CHECK( ARCCOS ( SIN_60 ) , SIXTH_PI , 4.0 ) ; CHECK( ARCCOS ( SIN_75 ) , TWELVTH_PI , 4.0 ) ; exception when others => FAILED("unexpected exception on ARCCOS(X)"); end; -- ARCCOS (arbitrary cycle) -- Declaration: -- function ARCCOS (X, CYCLE : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("ARCCOS (arbitrary cycle) testing"); begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCCOS ( 1.0 + EPSILON , E ) ; FAILED("ARGUMENT_ERROR not raised ARCCOS(1.0+EPSILON,E)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCCOS ( -(1.0+EPSILON) , E ) ; FAILED("ARGUMENT_ERROR not raised ARCCOS(-1.0-EPSILON,E)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCCOS ( FIRST , E ) ; FAILED("ARGUMENT_ERROR not raised ARCCOS(FIRST,E)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCCOS ( LAST , E ) ; FAILED("ARGUMENT_ERROR not raised ARCCOS(LAST,E)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for exact on 1.0 Y := ARCCOS ( 1.0 , E ) ; if Y = 0.0 then PASSED; else FAILED("ARCCOS(1.0,E) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- test for exact on 0.0 Y := ARCCOS ( 0.0 , 1.0 ) ; if Y = 0.25 then PASSED; else FAILED("ARCCOS(0.0,1.0) = 0.25"); end if; exception when others => FAILED("unexpected exception"); end; begin -- test for exact on -1.0 Y := ARCCOS ( -1.0 , 1.0 ) ; if Y = 0.5 then PASSED; else FAILED("ARCCOS(-1.0,1.0) = 0.5"); end if; exception when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working -- special case accuracy checks CHECK( ARCCOS ( -1.0 , 2.0 ) , 1.0 , 1.0 ) ; CHECK( ARCCOS ( 0.0 , 2.0 ) , 0.5 , 1.0 ) ; -- general case accuracy checks CHECK( ARCCOS ( -SIN_75 , 360.0 ) , 165.0 , 4.0 ) ; CHECK( ARCCOS ( -SIN_60 , 360.0 ) , 150.0 , 4.0 ) ; CHECK( ARCCOS ( -SIN_45 , 1.0 ) , 0.375 , 4.0 ) ; CHECK( ARCCOS ( -SIN_30 , 360.0 ) , 120.0 , 4.0 ) ; CHECK( ARCCOS ( -SIN_15 , TWO_PI ) , F7_12_PI, 4.0 ) ; CHECK( ARCCOS ( SIN_15 , TWO_PI ) , F5_12_PI , 4.0 ) ; CHECK( ARCCOS ( SIN_30 , 360.0 ) , 60.0 , 4.0 ) ; CHECK( ARCCOS ( SIN_45 , 360.0 ) , 45.0 , 4.0 ) ; CHECK( ARCCOS ( SIN_60 , 720.0 ) , 60.0 , 4.0 ) ; CHECK( ARCCOS ( SIN_75 , 360.0 ) , 15.0 , 4.0 ) ; exception when others => FAILED("unexpected exception on ARCCOS(X)"); end; -- ARCTAN (natural cycle) -- Declaration: -- function ARCTAN (Y : FLOAT_TYPE; -- X : FLOAT_TYPE := 1.0) return FLOAT_TYPE; PUT_LINE("ARCTAN (natural cycle) testing"); begin -- test for ARGUMENT_ERROR on 0.0,0.0 Y := ARCTAN ( 0.0 , 0.0 ) ; FAILED("ARGUMENT_ERROR not raised ARCTAN(0.0,0.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last, first and small Y := ARCTAN ( LAST ) ; CHECK( Y , HALF_PI , 4.0 ) ; Y := ARCTAN ( FIRST ) ; CHECK( Y , -HALF_PI , 4.0 ) ; Y := ARCTAN ( SMALL ) ; CHECK( Y , SMALL , 4.0 ) ; Y := ARCTAN ( -SMALL ) ; CHECK( Y , -SMALL , 4.0 ) ; exception when others => FAILED("unexpected exception on ARCTAN(LAST,FIRST,SMALL combinations)"); end; begin -- test for exact on 0.0 Y := ARCTAN ( 0.0 ) ; if Y = 0.0 then PASSED; else FAILED("ARCTAN(0.0)=0.0"); end if; exception when others => FAILED("unexpected exception on ARCTAN(0.0)"); end; begin -- test for exact on 0.0,X Y := ARCTAN ( 0.0 , E ) ; if Y = 0.0 then PASSED; else FAILED("ARCTAN(0.0,e)=0.0"); end if; exception when others => FAILED("unexpected exception on ARCTAN(0.0,e)"); end; begin -- test for almost exact on 0.0,-X Y,0.0 -Y,0.0 Y := ARCTAN ( 0.0 , -E ) ; CHECK( Y , PI , 1.0 ) ; Y := ARCTAN ( E , 0.0 ) ; CHECK( Y , HALF_PI , 1.0 ) ; Y := ARCTAN ( -E , 0.0 ) ; CHECK( Y , -HALF_PI , 1.0 ) ; exception when others => FAILED("unexpected exception on ARCTAN(0.0,E) and others"); end; begin -- a few tests to see that it is working CHECK( ARCTAN ( SIN_15 , SIN_75 ) , TWELVTH_PI , 4.0 ) ; CHECK( ARCTAN ( SIN_30 , SIN_60 ) , SIXTH_PI , 4.0 ) ; CHECK( ARCTAN ( SIN_45 , SIN_45 ) , FOURTH_PI , 4.0 ) ; CHECK( ARCTAN ( SIN_60 , SIN_30 ) , THIRD_PI , 4.0 ) ; CHECK( ARCTAN ( SIN_75 , SIN_15 ) , F5_12_PI , 4.0 ) ; CHECK( ARCTAN ( 1.0 , 0.0 ) , HALF_PI , 4.0 ) ; CHECK( ARCTAN ( SIN_75 , -SIN_15 ) , F7_12_PI , 4.0 ) ; CHECK( ARCTAN ( SIN_60 , -SIN_30 ) , F2_3_PI , 4.0 ) ; CHECK( ARCTAN ( SIN_45 , -SIN_45 ) , F3_4_PI , 4.0 ) ; CHECK( ARCTAN ( SIN_30 , -SIN_60 ) , F5_6_PI , 4.0 ) ; CHECK( ARCTAN ( SIN_15 , -SIN_75 ) , F11_12_PI , 4.0 ) ; CHECK( ARCTAN ( -SIN_15 , SIN_75 ) , -TWELVTH_PI , 4.0 ) ; CHECK( ARCTAN ( -SIN_30 , SIN_60 ) , -SIXTH_PI , 4.0 ) ; CHECK( ARCTAN ( -SIN_45 , SIN_45 ) , -FOURTH_PI , 4.0 ) ; CHECK( ARCTAN ( -SIN_60 , SIN_30 ) , -THIRD_PI , 4.0 ) ; CHECK( ARCTAN ( -SIN_75 , SIN_15 ) , -F5_12_PI , 4.0 ) ; CHECK( ARCTAN ( -1.0 , 0.0 ) , -HALF_PI , 4.0 ) ; CHECK( ARCTAN ( -SIN_75 , -SIN_15 ) , -F7_12_PI , 4.0 ) ; CHECK( ARCTAN ( -SIN_60 , -SIN_30 ) , -F2_3_PI , 4.0 ) ; CHECK( ARCTAN ( -SIN_45 , -SIN_45 ) , -F3_4_PI , 4.0 ) ; CHECK( ARCTAN ( -SIN_30 , -SIN_60 ) , -F5_6_PI , 4.0 ) ; CHECK( ARCTAN ( -SIN_15 , -SIN_75 ) , -F11_12_PI , 4.0 ) ; exception when others => FAILED("unexpected exception on ARCTAN(X)"); end; -- ARCTAN (arbitrary cycle) -- Declaration: -- function ARCTAN (Y : FLOAT_TYPE; -- X : FLOAT_TYPE := 1.0; -- CYCLE : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("ARCTAN (arbitrary cycle) testing"); begin -- test for ARGUMENT_ERROR on 0.0,0.0 Y := ARCTAN ( 0.0 , 0.0 , E ) ; FAILED("ARGUMENT_ERROR not raised ARCTAN(0.0,0.0,E)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last, first and small Y := ARCTAN ( LAST , LAST , 360.0 ) ; CHECK( Y , 45.0 , 4.0 ) ; Y := ARCTAN ( LAST , SMALL , E ) ; Y := ARCTAN ( LAST , FIRST , E ) ; Y := ARCTAN ( FIRST , FIRST , 360.0 ) ; CHECK( Y , -135.0 , 4.0 ) ; Y := ARCTAN ( FIRST , LAST , E ) ; Y := ARCTAN ( FIRST , SMALL , E ) ; Y := ARCTAN ( SMALL , SMALL , 360.0 ) ; CHECK( Y , 45.0 , 4.0 ) ; Y := ARCTAN ( SMALL , LAST , E ) ; Y := ARCTAN ( SMALL , FIRST , E ) ; exception when others => FAILED("unexpected exception on ARCTAN(LAST,FIRST,SMALL combinations)"); end; begin -- test for exact on 0.0,X Y := ARCTAN ( 0.0 , E , 360.0 ) ; if Y = 0.0 then PASSED; else FAILED("ARCTAN(0.0,e,360.0)=0.0"); end if; exception when others => FAILED("unexpected exception on ARCTAN(0.0,e)"); end; begin -- test for almost exact on 0.0,-X Y,0.0 -Y,0.0 Y := ARCTAN ( 0.0 , -E , 360.0 ) ; CHECK( Y , 180.0 , 1.0 ) ; Y := ARCTAN ( E , 0.0 , 360.0 ) ; CHECK( Y , 90.0 , 1.0 ) ; Y := ARCTAN ( -E , 0.0 , 360.0 ) ; CHECK( Y , -90.0 , 1.0 ) ; exception when others => FAILED("unexpected exception on ARCTAN(0.0,E,CYCLE) and others"); end; begin -- a few tests to see that it is working CHECK( ARCTAN ( SIN_15 , SIN_75 , 360.0 ) , 15.0 , 4.0 ) ; CHECK( ARCTAN ( SIN_30 , SIN_60 , 360.0 ) , 30.0 , 4.0 ) ; CHECK( ARCTAN ( SIN_45 , SIN_45 , 1.0 ) , 0.125 , 4.0 ) ; CHECK( ARCTAN ( SIN_60 , SIN_30 , TWO_PI ) , THIRD_PI , 4.0 ) ; CHECK( ARCTAN ( SIN_75 , SIN_15 , TWO_PI ) , F5_12_PI , 4.0 ) ; CHECK( ARCTAN ( 1.0 , 0.0 , 1.0) , 0.25 , 4.0 ) ; CHECK( ARCTAN ( SIN_75 , -SIN_15 , 360.0 ) , 105.0 , 4.0 ) ; CHECK( ARCTAN ( SIN_60 , -SIN_30 , 360.0 ) , 120.0 , 4.0 ) ; CHECK( ARCTAN ( SMALL , -SMALL , 80.0 ) , 30.0 , 4.0 ) ; CHECK( ARCTAN ( SIN_30 , -SIN_60 , 360.0 ) , 150.0 , 4.0 ) ; CHECK( ARCTAN ( SIN_15 , -SIN_75 , 360.0 ) , 165.0 , 4.0 ) ; CHECK( ARCTAN ( -SIN_15 , SIN_75 , TWO_PI ) , -TWELVTH_PI , 4.0 ) ; CHECK( ARCTAN ( -SIN_30 , SIN_60 , 360.0 ) , -30.0 , 4.0 ) ; CHECK( ARCTAN ( -100.0 , 100.0 , 100.0 ) , -12.5 , 4.0 ) ; CHECK( ARCTAN ( -SIN_60 , SIN_30 , 360.0 ) , -60.0 , 4.0 ) ; CHECK( ARCTAN ( -SIN_75 , SIN_15 , 360.0 ) , -75.0 , 4.0 ) ; CHECK( ARCTAN ( -1.0 , 0.0 , 1.0 ) , -0.25 , 4.0 ) ; CHECK( ARCTAN ( -SIN_75 , -SIN_15 , 360.0 ) , -105.0 , 4.0 ) ; CHECK( ARCTAN ( -SIN_60 , -SIN_30 , 360.0 ) , -120.0 , 4.0 ) ; CHECK( ARCTAN ( -1000.0 , -1000.0 , 1.0 ) , -0.375 , 4.0 ) ; CHECK( ARCTAN ( -SIN_30 , -SIN_60 , TWO_PI ) , -F5_6_PI , 4.0 ) ; CHECK( ARCTAN ( -SIN_15 , -SIN_75 ,360.0 ) , -165.0 , 4.0 ) ; exception when others => FAILED("unexpected exception on ARCTAN(X,CYCLE)"); end; -- ARCCOT (natural cycle) -- Declaration: -- function ARCCOT (X : FLOAT_TYPE; -- Y : FLOAT_TYPE := 1.0) return FLOAT_TYPE; PUT_LINE("ARCCOT (natural cycle) testing"); begin -- test for ARGUMENT_ERROR on 0.0,0.0 Y := ARCCOT ( 0.0 , 0.0 ) ; FAILED("ARGUMENT_ERROR not raised ARCCOT(0.0,0.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last, first and small Y := ARCCOT ( LAST ) ; if Y >= 0.0 and Y < 4.0 * EPSILON then PASSED; else FAILED("ARCCOT(LAST)"); end if; Y := ARCCOT ( FIRST ) ; CHECK( Y , PI , 4.0 ) ; Y := ARCCOT ( SMALL ) ; CHECK( Y , HALF_PI , 4.0 ) ; Y := ARCCOT ( -SMALL ) ; CHECK( Y , HALF_PI , 4.0 ) ; exception when others => FAILED("unexpected exception on ARCCOT(LAST,FIRST,SMALL combinations)"); end; begin -- test for exact on 0.0 Y := ARCCOT ( 0.0 ) ; CHECK( Y , HALF_PI , 1.0 ); exception when others => FAILED("unexpected exception on ARCCOT(0.0)"); end; begin -- test for almost exact on 0.0,Y 0.0,-Y X,0.0 -X,0.0 Y := ARCCOT ( 0.0 , E ) ; CHECK( Y , HALF_PI , 1.0 ); Y := ARCCOT ( 0.0 , -E ) ; CHECK( Y , -HALF_PI , 1.0 ) ; Y := ARCCOT ( E , 0.0 ) ; if Y >= 0.0 and Y < 4.0 * EPSILON then PASSED; else FAILED("ARCCOT(LAST)"); end if; Y := ARCCOT ( -E , 0.0 ) ; CHECK( Y , PI , 1.0 ) ; exception when others => FAILED("unexpected exception on ARCCOT(0.0,E) and others"); end; begin -- a few tests to see that it is working CHECK( ARCCOT ( SIN_75 , SIN_15 ) , TWELVTH_PI , 4.0 ) ; CHECK( ARCCOT ( SIN_60 , SIN_30 ) , SIXTH_PI , 4.0 ) ; CHECK( ARCCOT ( SIN_45 , SIN_45 ) , FOURTH_PI , 4.0 ) ; CHECK( ARCCOT ( SIN_30 , SIN_60 ) , THIRD_PI , 4.0 ) ; CHECK( ARCCOT ( SIN_15 , SIN_75 ) , F5_12_PI , 4.0 ) ; CHECK( ARCCOT ( 0.0 , 1.0 ) , HALF_PI , 4.0 ) ; CHECK( ARCCOT ( -SIN_15 , SIN_75 ) , F7_12_PI , 4.0 ) ; CHECK( ARCCOT ( -SIN_30 , SIN_60 ) , F2_3_PI , 4.0 ) ; CHECK( ARCCOT ( -SIN_45 , SIN_45 ) , F3_4_PI , 4.0 ) ; CHECK( ARCCOT ( -SIN_60 , SIN_30 ) , F5_6_PI , 4.0 ) ; CHECK( ARCCOT ( -SIN_75 , SIN_15 ) , F11_12_PI , 4.0 ) ; CHECK( ARCCOT ( SIN_75 , -SIN_15 ) , -TWELVTH_PI , 4.0 ) ; CHECK( ARCCOT ( SIN_60 , -SIN_30 ) , -SIXTH_PI , 4.0 ) ; CHECK( ARCCOT ( SIN_45 , -SIN_45 ) , -FOURTH_PI , 4.0 ) ; CHECK( ARCCOT ( SIN_30 , -SIN_60 ) , -THIRD_PI , 4.0 ) ; CHECK( ARCCOT ( SIN_15 , -SIN_75 ) , -F5_12_PI , 4.0 ) ; CHECK( ARCCOT ( 0.0 , -1.0 ) , -HALF_PI , 4.0 ) ; CHECK( ARCCOT ( -SIN_15 , -SIN_75 ) , -F7_12_PI , 4.0 ) ; CHECK( ARCCOT ( -SIN_30 , -SIN_60 ) , -F2_3_PI , 4.0 ) ; CHECK( ARCCOT ( -SIN_45 , -SIN_45 ) , -F3_4_PI , 4.0 ) ; CHECK( ARCCOT ( -SIN_60 , -SIN_30 ) , -F5_6_PI , 4.0 ) ; CHECK( ARCCOT ( -SIN_75 , -SIN_15 ) , -F11_12_PI , 4.0 ) ; exception when others => FAILED("unexpected exception on ARCCOT(X)"); end; -- ARCCOT (arbitrary cycle) -- Declaration: -- function ARCCOT (X : FLOAT_TYPE; -- Y : FLOAT_TYPE := 1.0; -- CYCLE : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("ARCCOT (arbitrary cycle) testing"); begin -- test for ARGUMENT_ERROR on 0.0,0.0 Y := ARCCOT ( 0.0 , 0.0 , E ) ; FAILED("ARGUMENT_ERROR not raised ARCCOT(0.0,0.0,E)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for no exceptions on last, first and small Y := ARCCOT ( LAST , 1.0 , E ) ; if Y >= 0.0 and Y < 4.0 * EPSILON then PASSED; else FAILED("ARCCOT(LAST,1,E)"); end if; Y := ARCCOT ( FIRST , 1.0 , 360.0 ) ; CHECK( Y , 180.0 , 4.0 ) ; Y := ARCCOT ( SMALL , 1.0 , 360.0 ) ; CHECK( Y , 90.0 , 4.0 ) ; Y := ARCCOT ( -SMALL , 1.0 , 360.0 ) ; CHECK( Y , 90.0 , 4.0 ) ; exception when others => FAILED("unexpected exception on ARCCOT(LAST,FIRST,SMALL combinations)"); end; begin -- test for almost exact on 0.0,Y 0.0,-Y X,0.0 -X,0.0 Y := ARCCOT ( 0.0 , E , TWO_PI ) ; CHECK( Y , HALF_PI , 1.0 ); Y := ARCCOT ( 0.0 , -E , 360.0 ) ; CHECK( Y , -90.0 , 1.0 ) ; Y := ARCCOT ( E , 0.0 , E ) ; if Y >= 0.0 and Y < 4.0 * EPSILON then PASSED; else FAILED("ARCCOT(E,0,E)"); end if; Y := ARCCOT ( -E , 0.0 , 360.0 ) ; CHECK( Y , 180.0 , 1.0 ) ; exception when others => FAILED("unexpected exception on ARCCOT(0.0,E) and others"); end; begin -- a few tests to see that it is working CHECK( ARCCOT ( SIN_75 , SIN_15 , 360.0 ) , 15.0 , 4.0 ) ; CHECK( ARCCOT ( SIN_60 , SIN_30 , 360.0 ) , 30.0 , 4.0 ) ; CHECK( ARCCOT ( SIN_45 , SIN_45 , 1.0 ) , 0.125 , 4.0 ) ; CHECK( ARCCOT ( SIN_30 , SIN_60 , 360.0 ) , 60.0 , 4.0 ) ; CHECK( ARCCOT ( SIN_15 , SIN_75 , TWO_PI ) , F5_12_PI , 4.0 ) ; CHECK( ARCCOT ( 0.0 , 1.0 , 1.0 ) , 0.25 , 4.0 ) ; CHECK( ARCCOT ( -SIN_15 , SIN_75 , 360.0 ) , 105.0 , 4.0 ) ; CHECK( ARCCOT ( -SIN_30 , SIN_60 , 360.0 ) , 120.0 , 4.0 ) ; CHECK( ARCCOT ( -SIN_45 , SIN_45 , 360.0 ) , 135.0 , 4.0 ) ; CHECK( ARCCOT ( -SIN_60 , SIN_30 , 360.0 ) , 150.0 , 4.0 ) ; CHECK( ARCCOT ( -SIN_75 , SIN_15 , 360.0 ) , 165.0 , 4.0 ) ; CHECK( ARCCOT ( SIN_75 , -SIN_15 , TWO_PI ) , -TWELVTH_PI , 4.0 ) ; CHECK( ARCCOT ( SIN_60 , -SIN_30 , 720.0 ) , -60.0 , 4.0 ) ; CHECK( ARCCOT ( SIN_45 , -SIN_45 , 1.0 ) , -0.125 , 4.0 ) ; CHECK( ARCCOT ( SIN_30 , -SIN_60 , 360.0 ) , -60.0 , 4.0 ) ; CHECK( ARCCOT ( SIN_15 , -SIN_75 , 360.0 ) , -75.0 , 4.0 ) ; CHECK( ARCCOT ( 0.0 , -1.0 , 360.0 ) , -90.0 , 4.0 ) ; CHECK( ARCCOT ( -SIN_15 , -SIN_75 , 360.0 ) , -105.0 , 4.0 ) ; CHECK( ARCCOT ( -SIN_30 , -SIN_60 , 360.0 ) , -120.0 , 4.0 ) ; CHECK( ARCCOT ( -SIN_45 , -SIN_45 , 360.0 ) , -135.0 , 4.0 ) ; CHECK( ARCCOT ( -SIN_60 , -SIN_30 , 360.0 ) , -150.0 , 4.0 ) ; CHECK( ARCCOT ( -SIN_75 , -SIN_15 , 360.0 ) , -165.0 , 4.0 ) ; exception when others => FAILED("unexpected exception on ARCCOT(X,Y,CYCLE)"); end; -- SINH -- Declaration: -- function SINH (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("SINH testing"); begin -- SINH ( 0.0 ) = 0.0 Y := SINH ( 0.0 ) ; if Y = 0.0 then PASSED; else FAILED("SINH(0.0) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working CHECK( SINH ( PI ) , SINH_PI , 8.0 ) ; CHECK( SINH ( 10.0 ) , SINH_10 , 8.0 ) ; CHECK( SINH ( -PI ) , -SINH_PI , 8.0 ) ; CHECK( SINH ( -10.0 ) , -SINH_10 , 8.0 ) ; exception when others => FAILED("unexpected exception on SINH(X)"); end; -- COSH -- Declaration: -- function COSH (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("COSH testing"); begin -- COSH ( 0.0 ) = 1.0 Y := COSH ( 0.0 ) ; if Y = 1.0 then PASSED; else FAILED("COSH(0.0) = 1.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working CHECK( COSH ( PI ) , COSH_PI , 8.0 ) ; CHECK( COSH ( 10.0 ) , COSH_10 , 8.0 ) ; CHECK( COSH ( -PI ) , COSH_PI , 8.0 ) ; CHECK( COSH ( -10.0 ) , COSH_10 , 8.0 ) ; exception when others => FAILED("unexpected exception on COSH(X)"); end; -- TANH -- Declaration: -- function TANH (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("TANH testing"); begin -- TANH ( 0.0 ) = 0.0 Y := TANH ( 0.0 ) ; if Y = 0.0 then PASSED; else FAILED("TANH(0.0) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working CHECK( TANH ( PI ) , TANH_PI , 8.0 ) ; CHECK( TANH ( 10.0 ) , TANH_10 , 8.0 ) ; CHECK( TANH ( -PI ) , -TANH_PI , 8.0 ) ; CHECK( TANH ( -10.0 ) , -TANH_10 , 8.0 ) ; exception when others => FAILED("unexpected exception on TANH(X)"); end; -- COTH -- Declaration: -- function COTH (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("COTH testing"); begin -- test for CONSTRAINT_ERROR on COTH(0.0) Y := COTH ( 0.0 ) ; FAILED("CONSTRAINT_ERROR not raised COTH(0.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working CHECK( COTH ( PI ) , COTH_PI , 8.0 ) ; CHECK( COTH ( 10.0 ) , COTH_10 , 8.0 ) ; CHECK( COTH ( -PI ) , -COTH_PI , 8.0 ) ; CHECK( COTH ( -10.0 ) , -COTH_10 , 8.0 ) ; exception when others => FAILED("unexpected exception on COTH(X)"); end; -- ARCSINH -- Declaration: -- function ARCSINH (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("ARCSINH testing"); begin -- ARCSINH ( 0.0 ) = 0.0 Y := ARCSINH ( 0.0 ) ; if Y = 0.0 then PASSED; else FAILED("ARCSINH(0.0) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working CHECK( ARCSINH ( SINH_PI ) , PI , 8.0 ) ; CHECK( ARCSINH ( 11000.0 ) , ARCSINH_11000 , 8.0 ) ; CHECK( ARCSINH ( -SINH_PI ) , -PI , 8.0 ) ; CHECK( ARCSINH ( -11000.0 ) , -ARCSINH_11000 , 8.0 ) ; exception when others => FAILED("unexpected exception on ARCSINH(X)"); end; -- ARCCOSH -- Declaration: -- function ARCCOSH (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("ARCCOSH testing"); begin -- test for ARGUMENT_ERROR on X<1.0 Y := ARCCOSH ( 1.0-EPSILON ) ; FAILED("ARGUMENT_ERROR not raised ARCCOSH(1.0-EPSILON)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on X<1.0 Y := ARCCOSH ( FIRST ) ; FAILED("ARGUMENT_ERROR not raised ARCCOSH(first)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on X<1.0 Y := ARCCOSH ( 0.0 ) ; FAILED("ARGUMENT_ERROR not raised ARCCOSH(0.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- ARCCOSH ( 1.0 ) = 0.0 Y := ARCCOSH ( 1.0 ) ; if Y = 0.0 then PASSED; else FAILED("ARCCOSH(1.0) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working CHECK( ARCCOSH ( COSH_PI ) , PI , 8.0 ) ; CHECK( ARCCOSH ( 11000.0 ) , ARCCOSH_11000 , 8.0 ) ; exception when others => FAILED("unexpected exception on ARCCOSH(X)"); end; -- ARCTANH -- Declaration: -- function ARCTANH (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("ARCTANH testing"); begin -- test for CONSTRAINT_ERROR on |X|=1.0 Y := ARCTANH ( 1.0 ) ; FAILED("CONSTRAINT_ERROR not raised ARCTANH(1.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for CONSTRAINT_ERROR on |X|=1.0 Y := ARCTANH ( -1.0 ) ; FAILED("CONSTRAINT_ERROR not raised ARCTANH(-1.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCTANH ( ONE_PLUS ) ; FAILED("ARGUMENT_ERROR not raised ARCTANH(1.0+epsilon)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>1.0 Y := ARCTANH ( -ONE_PLUS ) ; FAILED("ARGUMENT_ERROR not raised ARCTANH(-1.0-epsilon)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>=1.0 Y := ARCTANH ( FIRST ) ; FAILED("ARGUMENT_ERROR not raised ARCTANH(FIRST)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|>=1.0 Y := ARCTANH ( LAST ) ; FAILED("ARGUMENT_ERROR not raised ARCTANH(LAST)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- ARCTANH ( 0.0 ) = 0.0 Y := ARCTANH ( 0.0 ) ; if Y = 0.0 then PASSED; else FAILED("ARCTANH(0.0) = 0.0"); end if; exception when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working CHECK( ARCTANH ( TANH_PI ) , PI , 8.0 ) ; if REAL(ONE_M_2_20) < 1.0 then -- may truncate to 1.0 on low precision CHECK( ARCTANH ( ONE_M_2_20 ) , ARCTANH_2_20 , 8.0 ) ; end if; CHECK( ARCTANH ( -TANH_PI ) , -PI , 8.0 ) ; if REAL(-ONE_M_2_20 ) > -1.0 then -- may truncate to -1.0 on low precision CHECK( ARCTANH ( -ONE_M_2_20 ) , -ARCTANH_2_20 , 8.0 ) ; end if; exception when others => FAILED("unexpected exception on ARCTANH(X)"); end; -- ARCCOTH -- Declaration: -- function ARCCOTH (X : FLOAT_TYPE) return FLOAT_TYPE; PUT_LINE("ARCCOTH testing"); begin -- test for CONSTRAINT_ERROR on |X|=1.0 Y := ARCCOTH ( 1.0 ) ; FAILED("CONSTRAINT_ERROR not raised ARCCOTH(1.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for CONSTRAINT_ERROR on |X|=1.0 Y := ARCCOTH ( -1.0 ) ; FAILED("CONSTRAINT_ERROR not raised ARCCOTH(-1.0)"); exception when CONSTRAINT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|<1.0 Y := ARCCOTH ( ONE_MINUS ) ; FAILED("ARGUMENT_ERROR not raised ARCCOTH(1.0-epsilon)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|<1.0 Y := ARCCOTH ( -ONE_MINUS ) ; FAILED("ARGUMENT_ERROR not raised ARCCOTH(-1.0-epsilon)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|<=1.0 Y := ARCCOTH ( 0.0 ) ; FAILED("ARGUMENT_ERROR not raised ARCCOTH(0.0)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- test for ARGUMENT_ERROR on |X|<=1.0 Y := ARCCOTH ( 0.5 ) ; FAILED("ARGUMENT_ERROR not raised ARCCOTH(0.5)"); exception when ARGUMENT_ERROR => PASSED; when others => FAILED("unexpected exception"); end; begin -- a few tests to see that it is working CHECK( ARCCOTH ( COTH_PI ) , PI , 8.0 ) ; if REAL(ONE_P_2_20) > 1.0 then -- may truncate to 1.0 on low precision CHECK( ARCCOTH ( ONE_P_2_20 ) , ARCCOTH_2_20 , 8.0 ) ; end if; CHECK( ARCCOTH ( -COTH_PI ) , -PI , 8.0 ) ; if REAL(-ONE_P_2_20) < -1.0 then -- may truncate to -1.0 on low precision CHECK( ARCCOTH ( -ONE_P_2_20 ) , -ARCCOTH_2_20 , 8.0 ) ; end if; exception when others => FAILED("unexpected exception on ARCCOTH(X)"); end; NEW_LINE; PUT("Generic Elementary Functions specification compliance test "); if ANY_FAIL then PUT_LINE("FAILED"); else PUT_LINE("PASSED"); end if; NEW_LINE; end TEST_GENERIC_ELEMENTARY_FUNCTIONS_2 ; -- Even if some of these compilation units fail, others will compile. -- The compliance test must be run on all that compile. with TEST_GENERIC_ELEMENTARY_FUNCTIONS_2; procedure TEST_ELEMENTARY_FUNCTIONS_2 is new TEST_GENERIC_ELEMENTARY_FUNCTIONS_2 ( FLOAT ) ; with TEST_GENERIC_ELEMENTARY_FUNCTIONS_2; procedure TEST_LONG_ELEMENTARY_FUNCTIONS_2 is new TEST_GENERIC_ELEMENTARY_FUNCTIONS_2 ( LONG_FLOAT ) ;