如何测试调用Ada.Real_Time的Ada程序？寻求替代运行时方案

问题背景 #

在Ubuntu/Debian环境下测试调用Ada.Real_Time和Ada.Real_Time.Delays的Ada程序时，希望控制Clock返回值和Delay_Until执行逻辑，尝试修改运行时源码构建自定义运行时遇到以下错误：

1. s-fatgen.adb中pragma Import (Intrinsic, Is_Negative);无法识别内在函数
2. 替换后出现a-nuelfu.ads:18:01: error: file s-exnflt.ads not found

需要两种方案：无需重写完整运行时的简便方法，或重写运行时的详细指南。

方案一：无需重写运行时的包覆盖法 #

通过编译路径优先级，用自定义的Ada.Real_Time和Ada.Real_Time.Delays包覆盖系统运行时的包，无需修改原有被测代码。

步骤1：创建自定义时间包 #

在单独目录（如./custom_rt）下创建以下文件：

Ada.Real_Time.ads

package Ada.Real_Time is
   type Time is private;
   type Time_Span is private;

   function Clock return Time;
   procedure Set_Clock (New_Time : Time); -- 新增控制时钟的过程
   function Seconds (S : Integer) return Time_Span;
   function "+" (Left : Time; Right : Time_Span) return Time;
   function "<" (Left, Right : Time) return Boolean;
   function "-" (Left : Time; Right : Time_Span) return Time;
   function Tick return Time_Span;

private
   type Time is new Integer;
   type Time_Span is new Integer;
   Current_Time : Time := 0;
   Tick_Value : Time_Span := 1; -- 可自定义Tick的模拟值
end Ada.Real_Time;

Ada.Real_Time.adb

package body Ada.Real_Time is
   function Clock return Time is
   begin
      return Current_Time;
   end Clock;

   procedure Set_Clock (New_Time : Time) is
   begin
      Current_Time := New_Time;
   end Set_Clock;

   function Seconds (S : Integer) return Time_Span is
   begin
      return Time_Span(S * 1000); -- 模拟1秒对应1000个Tick
   end Seconds;

   function "+" (Left : Time; Right : Time_Span) return Time is
   begin
      return Left + Time(Right);
   end "+";

   function "<" (Left, Right : Time) return Boolean is
   begin
      return Left < Right;
   end "<";

   function "-" (Left : Time; Right : Time_Span) return Time is
   begin
      return Left - Time(Right);
   end "-";

   function Tick return Time_Span is
   begin
      return Tick_Value;
   end Tick;
end Ada.Real_Time;

Ada/Real_Time/Delays.ads

package Ada.Real_Time.Delays is
   procedure Delay_Until (T : Time);
end Ada.Real_Time.Delays;

Ada/Real_Time/Delays.adb

package body Ada.Real_Time.Delays is
   procedure Delay_Until (T : Time) is
   begin
      -- 模拟时间推进，无需实际等待
      while Ada.Real_Time.Clock < T loop
         Ada.Real_Time.Set_Clock (Ada.Real_Time.Clock + Ada.Real_Time.Tick);
      end loop;
   end Delay_Until;
end Ada.Real_Time.Delays;

步骤2：编译测试程序 #

编译时将自定义包目录放在搜索路径最前面，让GNAT优先使用自定义包：

gnatmake -I./custom_rt my_test_program.adb

测试示例 #

对于被测函数My_Function_To_Test，测试代码中可直接调用Ada.Real_Time.Set_Clock控制时钟：

with Ada.Real_Time; use Ada.Real_Time;
with My_Package; use My_Package;
with Ada.Text_IO; use Ada.Text_IO;

procedure Test_My_Function is
   MY_TIME_CONSTANT : constant Time := Time(1000);
begin
   -- 测试Clock < MY_TIME_CONSTANT的情况
   Set_Clock(MY_TIME_CONSTANT - 1);
   Put_Line("Result when Clock < CONSTANT: " & Boolean'Image(My_Function_To_Test));

   -- 测试Clock = MY_TIME_CONSTANT的情况
   Set_Clock(MY_TIME_CONSTANT);
   Put_Line("Result when Clock = CONSTANT: " & Boolean'Image(My_Function_To_Test));

   -- 测试Clock > MY_TIME_CONSTANT的情况
   Set_Clock(MY_TIME_CONSTANT + 1);
   Put_Line("Result when Clock > CONSTANT: " & Boolean'Image(My_Function_To_Test));
end Test_My_Function;

方案二：重写GNAT运行时指南 #

如果必须修改原生运行时，按以下步骤操作：

步骤1：获取运行时源码 #

Ubuntu/Debian下安装GNAT源码包：

sudo apt install gnat-src

找到源码路径（以GNAT 12为例）：/usr/share/gnat/12/src/

步骤2：复制并修改运行时源码 #

复制整个源码目录到本地工作区：

cp -r /usr/share/gnat/12/src/ ./test_runtime

• 修改test_runtime/Ada/Real_Time.ads，添加Set_Clock过程
• 修改test_runtime/Ada/Real_Time/Delays.adb，替换Delay_Until的实现为自定义逻辑
• 修复s-fatgen.adb的Is_Negative错误：删除pragma Import (Intrinsic, Is_Negative);，替换为自定义函数：

  function Is_Negative (Value : Float) return Boolean is
  begin
     return Value < 0.0;
  end Is_Negative;
  

• 解决s-exnflt.ads缺失问题：从系统源码目录复制该文件到test_runtime/目录

步骤3：编译自定义运行时 #

进入自定义运行时目录，编译生成库文件：

cd test_runtime
# 编译所有源文件
gnatmake -c -gnatpg *.adb *.ads
# 打包成静态库
ar cru libgnat_test.a *.o
ranlib libgnat_test.a

步骤4：链接自定义运行时编译测试程序 #

gnatmake my_test_program.adb -L./test_runtime -lgnat_test

内容的提问来源于stack exchange，提问作者Léo Statkus