cxb3007.a

来自「用于进行gcc测试」· A 代码 · 共 409 行 · 第 1/2 页

      TC_wchar_array := (others => wchar_t'First);
      begin
         To_C("A string too long",
              TC_wchar_array,
              TC_size_t_Count,
              Append_Nul => True);

         Report.Failed("Constraint_Error not raised when the Target "    &
                       "parameter of Procedure To_C is not long enough " &
                       "to hold the converted Wide_String");
         Report.Comment
           (To_Character(wchar_t_to_Wide_Character(TC_wchar_array(0))) &
            " printed to defeat optimization");
      exception
         when Constraint_Error => null;  -- OK, expected exception.
         when others           =>
            Report.Failed("Incorrect exception raised by Procedure "    &
                          "To_C when the Target parameter is not long " &
                          "enough to contain the wchar_array result");
      end;



      -- Check that the procedure To_Ada converts wchar_t elements of the
      -- wchar_array parameter Item to the corresponding Wide_Character
      -- elements of Wide_String out parameter Target, with result wide
      -- string length based on the Trim_Nul parameter.
      --
      -- Case of appended wide_nul wchar_t on the wchar_array In parameter.

      TC_wchar_array :=
        To_C ("ACVC-95", Append_Nul => True); -- 8 total chars.

      To_Ada (Item     => TC_wchar_array,
              Target   => TC_Wide_String,
              Count    => TC_Natural_Count,
              Trim_Nul => False);

      if TC_Natural_Count /= 8 then
         Report.Failed("Incorrect value returned in out parameter Count " &
                       "by Procedure To_Ada, case of Trim_Nul => False");
      end if;

      for i in 1..TC_Natural_Count loop
         if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
            TC_wchar_array(size_t(i-1))
         then
            Report.Failed("Incorrect result from Procedure To_Ada when "   &
                          "checking individual wchar_t values, case of "   &
                          "Trim_Nul => False, when a wide_nul is present " &
                          "in the wchar_array input parameter; "           &
                          "position = " & Integer'Image(Integer(i)));
         end if;
      end loop;

      if TC_Wide_String(TC_Natural_Count) /= To_Wide_Character(Latin_1.Nul)
      then
         Report.Failed("Last Wide_Character of Wide_String result of "      &
                       "Procedure To_Ada is not Nul, even though a "        &
                       "wide_nul was present in the wchar_array argument, " &
                       "and the Trim_Nul parameter was set to False");
      end if;


      TC_Wide_String       := (others => Wide_Character'First);
      TC_wchar_array(0..3) := To_C ("XYz", Append_Nul => True); -- 4 chars.

      To_Ada (Item     => TC_wchar_array,
              Target   => TC_Wide_String,
              Count    => TC_Natural_Count,
              Trim_Nul => True);

      if TC_Natural_Count /= 3 then
         Report.Failed("Incorrect value returned in out parameter Count " &
                       "by Procedure To_Ada, case of Trim_Nul => True");
      end if;

      for i in 1..TC_Natural_Count loop
         if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
            TC_wchar_array(size_t(i-1))
         then
            Report.Failed("Incorrect result from Procedure To_Ada when "  &
                          "checking individual wchar_t values, case of "  &
                          "Trim_Nul => True, when a wide_nul is present " &
                          "in the wchar_array input parameter; "          &
                          "position = " & Integer'Image(Integer(i)));
         end if;
      end loop;

      if TC_Wide_String(TC_Natural_Count) = To_Wide_Character(Latin_1.Nul)
      then
         Report.Failed("Last Wide_Character of Wide_String result of " &
                       "Procedure To_Ada is  Nul, even though the "    &
                       "Trim_Nul parameter was set to True");
      end if;

      if TC_Wide_String(TC_Natural_Count+1) /= Wide_Character'First then
         Report.Failed("Incorrect replacement from To_Ada");
      end if;


      -- Case of no wide_nul wchar_t present in the wchar_array argument.

      TC_Wide_String := (others => Wide_Character'First);
      TC_wchar_array := To_C ("ABCDWXYZ", Append_Nul => False);

      To_Ada (Item     => TC_wchar_array,
              Target   => TC_Wide_String,
              Count    => TC_Natural_Count,
              Trim_Nul => False);

      if TC_Natural_Count /= 8 then
         Report.Failed("Incorrect value returned in out parameter Count "   &
                       "by Procedure To_Ada, case of Trim_Nul => False, "   &
                       "with no wide_nul wchar_t present in the parameter " &
                       "Item");
      end if;

      for i in 1..TC_Natural_Count loop
         if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
            TC_wchar_array(size_t(i-1))
         then
            Report.Failed("Incorrect result from Procedure To_Ada when " &
                          "checking individual wchar_t values, case of " &
                          "Trim_Nul => False, when a wide_nul is not "   &
                          "present in the wchar_array input parameter; " &
                          "position = " & Integer'Image(Integer(i)));
         end if;
      end loop;

      if TC_Wide_String(TC_Natural_Count) = To_Wide_Character(Latin_1.Nul)
      then
         Report.Failed("Last Wide_Character of Wide_String result of "      &
                       "Procedure To_Ada is Nul, even though the wide_nul " &
                       "wchar_t was not present in the parameter Item, "    &
                       "with the parameter Trim_Nul => False");
      end if;



      -- Check that the Procedure To_Ada raises Terminator_Error if the
      -- parameter Trim_Nul is set to True, but the actual Item parameter
      -- does not contain the wide_nul wchar_t.

      begin
         TC_Wide_String := (others => Wide_Character'First);
         TC_wchar_array := To_C ("ABCDWXYZ", Append_Nul => False);

         To_Ada(TC_wchar_array,
                TC_Wide_String,
                Count    => TC_Natural_Count,
                Trim_Nul => True);

         Report.Failed("Terminator_Error not raised when Item "    &
                       "parameter of To_Ada does not contain the " &
                       "wide_nul wchar_t, but parameter Trim_Nul => True");
         Report.Comment(To_String(TC_Wide_String) &
                        " printed to defeat optimization");
      exception
         when Terminator_Error => null;  -- OK, expected exception.
         when others           =>
            Report.Failed("Incorrect exception raised by Procedure "     &
                          "To_Ada when the Item parameter does not "     &
                          "contain the wide_nul wchar_t, but parameter " &
                          "Trim_Nul => True");
      end;



      -- Check that Constraint_Error is propagated by procedure To_Ada if the
      -- length of Wide_String parameter Target is not long enough to hold the
      -- converted wchar_array value (plus wide_nul if Trim_Nul is False).

      begin
         TC_wchar_array(0..4) := To_C ("ABCD", Append_Nul => True);

         To_Ada(TC_wchar_array(0..4),
                TC_Short_Wide_String, -- Length of 4.
                Count    => TC_Natural_Count,
                Trim_Nul => False);

         Report.Failed("Constraint_Error not raised when Wide_String " &
                       "parameter Target of Procedure To_Ada is not "  &
                       "long enough to hold the converted wchar_ts");
         Report.Comment(To_String(TC_Short_Wide_String) &
                        " printed to defeat optimization");
      exception
         when Constraint_Error => null;  -- OK, expected exception.
         when others           =>
            Report.Failed("Incorrect exception raised by Procedure "      &
                          "To_Ada when Wide_String parameter Target is "  &
                          "not long enough to hold the converted wchar_ts");
      end;

   exception
      when The_Error : others =>
         Report.Failed ("The following exception was raised in the " &
                        "Test_Block: " & Exception_Name(The_Error));
   end Test_Block;

   Report.Result;

end CXB3007;