cxg2016.a

来自「linux下编程用 编译软件」· A 代码 · 共 483 行 · 第 1/2 页

         Model_Expected_High : Real := Expected_High;
      begin
         -- Calculate the first model number nearest to, but below (or equal)
         -- to the expected result:
         while Real'Model (Model_Expected_Low) /= Model_Expected_Low loop
            -- Try the next machine number lower:
            Model_Expected_Low := Real'Adjacent(Model_Expected_Low, 0.0);
         end loop;
         -- Calculate the first model number nearest to, but above (or equal)
         -- to the expected result:
         while Real'Model (Model_Expected_High) /= Model_Expected_High loop
            -- Try the next machine number higher:
            Model_Expected_High := Real'Adjacent(Model_Expected_High, 100.0);
         end loop;

         if Actual < Model_Expected_Low or Actual > Model_Expected_High then
            Accuracy_Error_Reported := True;
            if Actual < Model_Expected_Low then
               Report.Failed (Test_Name &
                              " actual: " & Real'Image (Actual) &
                              " expected low: " & Real'Image (Model_Expected_Low) &
                              " expected high: " & Real'Image (Model_Expected_High) &
                              " difference: " & Real'Image (Actual - Expected_Low));
            else
               Report.Failed (Test_Name &
                              " actual: " & Real'Image (Actual) &
                              " expected low: " & Real'Image (Model_Expected_Low) &
                              " expected high: " & Real'Image (Model_Expected_High) &
                              " difference: " & Real'Image (Expected_High - Actual));
            end if;
         elsif Verbose then
            Report.Comment (Test_Name & "  passed");
         end if;
      end Check_Exact;


      procedure Exact_Result_Test is
      begin
         --  A.5.1(40);6.0
         Check_Exact (Arctan (0.0, 1.0),       0.0, 0.0, "arctan(0,1)");
         Check_Exact (Arctan (0.0, 1.0, 27.0), 0.0, 0.0, "arctan(0,1,27)");

         --  G.2.4(11-13);6.0

         Check_Exact (Arctan (1.0, 0.0), Half_PI_Low, Half_PI_High,
              "arctan(1,0)");
         Check_Exact (Arctan (1.0, 0.0, 360.0), 90.0, 90.0, "arctan(1,0,360)");

         Check_Exact (Arctan (-1.0, 0.0), -Half_PI_High, -Half_PI_Low,
              "arctan(-1,0)");
         Check_Exact (Arctan (-1.0, 0.0, 360.0), -90.0, -90.0,
              "arctan(-1,0,360)");

         if Real'Signed_Zeros then
            Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(+0,-1)");
            Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0,
                  "arctan(+0,-1,360)");
            Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0),
                   -PI_High, -PI_Low, "arctan(-0,-1)");
            Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0,
                   360.0), -180.0, -180.0, "arctan(-0,-1,360)");
         else
            Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(0,-1)");
            Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0,
                   "arctan(0,-1,360)");
         end if;
      exception
         when Constraint_Error =>
            Report.Failed ("Constraint_Error raised in Exact_Result Test");
         when others =>
            Report.Failed ("Exception in Exact_Result Test");
      end Exact_Result_Test;


      procedure Taylor_Series_Test is
      -- This test checks the Arctan by using a taylor series expansion that
      -- will produce a result accurate to 19 decimal digits for
      -- the range under test.
      --
      -- The maximum relative error bound for this test is
      --  4 for the arctan operation and 2 for the Taylor series
      -- for a total of 6 * Model_Epsilon

         A : constant := -1.0/16.0;
         B : constant :=  1.0/16.0;
         X : Real;
         Actual, Expected : Real;
         Sum, Em, X_Squared : Real;
      begin
         if Real'Digits > 19 then
            -- Taylor series calculation produces result accurate to 19
            -- digits.  If type being tested has more digits then set
            -- the error low bound to account for this.
            -- The error low bound is conservatively set to 6*10**-19
            Error_Low_Bound := 0.00000_00000_00000_0006;
            Report.Comment ("arctan accuracy checked to 19 digits");
         end if;

         Accuracy_Error_Reported := False;  -- reset
         for I in 0..Max_Samples loop
            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
            X_Squared := X * X;
            Em := 17.0;
            Sum := X_Squared / Em;

            for II in 1 .. 7 loop
               Em := Em - 2.0;
               Sum := (1.0 / Em - Sum) * X_Squared;
            end loop;
            Sum := -X * Sum;
            Expected := X + Sum;
            Sum := (X - Expected) + Sum;
            if not Real'Machine_Rounds then
               Expected := Expected + (Sum + Sum);
            end if;

            Actual := Arctan (X);

            Check (Actual, Expected,
                   "Taylor_Series_Test " & Integer'Image (I) & ": arctan(" &
                   Real'Image (X) & ") ",
                   6.0);

            if Accuracy_Error_Reported then
              -- only report the first error in this test in order to keep
              -- lots of failures from producing a huge error log
              return;
            end if;

         end loop;
         Error_Low_Bound := 0.0;  -- reset
      exception
         when Constraint_Error =>
            Report.Failed
               ("Constraint_Error raised in Taylor_Series_Test");
         when others =>
            Report.Failed ("exception in Taylor_Series_Test");
      end Taylor_Series_Test;


      procedure Exception_Test is
         X1, X2, X3 : Real := 0.0;
      begin

         begin  -- A.5.1(20);6.0
           X1 := Arctan(0.0, Cycle => 0.0);
           Report.Failed ("no exception for cycle = 0.0");
         exception
            when Ada.Numerics.Argument_Error => null;
            when others =>
               Report.Failed ("wrong exception for cycle = 0.0");
         end;

         begin  -- A.5.1(20);6.0
           X2 := Arctan (0.0, Cycle => -1.0);
           Report.Failed ("no exception for cycle < 0.0");
         exception
            when Ada.Numerics.Argument_Error => null;
            when others =>
               Report.Failed ("wrong exception for cycle < 0.0");
         end;

         begin  -- A.5.1(25);6.0
           X3 := Arctan (0.0, 0.0);
           Report.Failed ("no exception for arctan(0,0)");
         exception
            when Ada.Numerics.Argument_Error => null;
            when others =>
               Report.Failed ("wrong exception for arctan(0,0)");
         end;

         -- optimizer thwarting
         if Report.Ident_Bool (False) then
            Report.Comment (Real'Image (X1 + X2 + X3));
         end if;
      end Exception_Test;


      procedure Do_Test is
      begin
         Special_Value_Test;
         Exact_Result_Test;
         Taylor_Series_Test;
         Exception_Test;
      end Do_Test;
   end Generic_Check;

   -----------------------------------------------------------------------
   -----------------------------------------------------------------------
   -- These expressions must be truly static, which is why we have to do them
   -- outside of the generic, and we use the named numbers. Note that we know
   -- that PI is not a machine number (it is irrational), and it should be
   -- represented to more digits than supported by the target machine.
   Float_Half_PI_Low  : constant := Float'Adjacent(PI/2.0,  0.0);
   Float_Half_PI_High : constant := Float'Adjacent(PI/2.0, 10.0);
   Float_PI_Low       : constant := Float'Adjacent(PI,      0.0);
   Float_PI_High      : constant := Float'Adjacent(PI,     10.0);
   package Float_Check is new Generic_Check (Float,
	Half_PI_Low  => Float_Half_PI_Low,
	Half_PI_High => Float_Half_PI_High,
	PI_Low  => Float_PI_Low,
	PI_High => Float_PI_High);

   -- check the Floating point type with the most digits
   type A_Long_Float is digits System.Max_Digits;
   A_Long_Float_Half_PI_Low  : constant := A_Long_Float'Adjacent(PI/2.0,  0.0);
   A_Long_Float_Half_PI_High : constant := A_Long_Float'Adjacent(PI/2.0, 10.0);
   A_Long_Float_PI_Low       : constant := A_Long_Float'Adjacent(PI,      0.0);
   A_Long_Float_PI_High      : constant := A_Long_Float'Adjacent(PI,     10.0);
   package A_Long_Float_Check is new Generic_Check (A_Long_Float,
	Half_PI_Low  => A_Long_Float_Half_PI_Low,
	Half_PI_High => A_Long_Float_Half_PI_High,
	PI_Low  => A_Long_Float_PI_Low,
	PI_High => A_Long_Float_PI_High);

   -----------------------------------------------------------------------
   -----------------------------------------------------------------------


begin
   Report.Test ("CXG2016",
                "Check the accuracy of the ARCTAN function");

   if Verbose then
      Report.Comment ("checking Standard.Float");
   end if;

   Float_Check.Do_Test;

   if Verbose then
      Report.Comment ("checking a digits" &
                      Integer'Image (System.Max_Digits) &
                      " floating point type");
   end if;

   A_Long_Float_Check.Do_Test;


   Report.Result;
end CXG2016;