Ada语言中Unchecked_Access的实现及自动扩展矩形二维数组的问题排查与解决

问题原因分析 #

你的代码触发PROGRAM_ERROR的核心原因是Ada的可访问性规则：

• 泛型包Rectangular中的Item是包级的access Matrix变量，而Matrix是泛型包的私有类型。
• 当你在块内实例化Rect时，这个实例的私有类型Matrix的生命周期仅限于当前块，但包级变量Item的可访问性范围超出了块的生命周期。Ada的类型系统会阻止这种“长生命周期访问类型引用短生命周期对象”的情况，避免悬空引用，因此触发了可访问性检查失败。

另外，你的Adjust_Bounds过程还有一个关键逻辑错误：计算新边界时错误地使用了Integer'Min来处理上限（Rowmax/Colmax），这会导致数组根本无法向更大的索引扩展，必须改成Integer'Max。

解决方案 #

我们需要做两个关键修改：

1. 使用堆分配的访问类型配合Ada.Unchecked_Deallocation来管理内存，这是符合Ada规则的合法方式，而非滥用Unchecked_Access。
2. 添加显式的内存释放过程，确保不再使用的数组内存被回收。

可运行的修正代码 #

Rectangular.ads

with Ada.Unchecked_Deallocation;

generic
   type Value_Type is private;
package Rectangular is
   function Get (Row, Col : Integer) return Value_Type;
   procedure Set (Row, Col : Integer; Value : Value_Type);
   procedure Destroy; -- 用于释放包级数组的内存
private
   type Matrix is array (Integer range <>, Integer range <>) of Value_Type;
   type Matrix_Access is access Matrix;
   procedure Deallocate is new Ada.Unchecked_Deallocation (Matrix, Matrix_Access);
   Item : Matrix_Access;
end Rectangular;

Rectangular.adb

package body Rectangular is
   function Create (Rowmin, Rowmax, Colmin, Colmax : Integer) return Matrix_Access is
   begin
      return new Matrix (Rowmin .. Rowmax, Colmin .. Colmax);
   end Create;

   procedure Adjust_Bounds (Row, Col : Integer) is
      Rowmin, Rowmax, Colmin, Colmax : Integer;
      Newitem : Matrix_Access;
   begin
      -- 检查当前索引是否在现有范围内，无需扩展
      if Item /= null and then
         Row >= Item'First (1) and Row <= Item'Last (1) and
         Col >= Item'First (2) and Col <= Item'Last (2) then
         return;
      end if;

      -- 计算新的边界：包含原有范围和目标索引
      if Item = null then
         -- 初始状态，直接用目标索引作为初始范围
         Rowmin := Row;
         Rowmax := Row;
         Colmin := Col;
         Colmax := Col;
      else
         Rowmin := Integer'Min (Item'First (1), Row);
         Rowmax := Integer'Max (Item'Last (1), Row); -- 修正为Max，实现向上扩展
         Colmin := Integer'Min (Item'First (2), Col);
         Colmax := Integer'Max (Item'Last (2), Col); -- 修正为Max，实现向上扩展
      end if;

      -- 创建新数组
      Newitem := Create (Rowmin, Rowmax, Colmin, Colmax);

      -- 复制旧数组内容到新数组
      if Item /= null then
         for R in Item'Range (1) loop
            for C in Item'Range (2) loop
               Newitem (R, C) := Item (R, C);
            end loop;
         end loop;
         -- 释放旧数组内存
         Deallocate (Item);
      end if;

      -- 更新为新数组
      Item := Newitem;
   end Adjust_Bounds;

   function Get (Row, Col : Integer) return Value_Type is
   begin
      Adjust_Bounds (Row, Col);
      return Item (Row, Col);
   end Get;

   procedure Set (Row, Col : Integer; Value : Value_Type) is
   begin
      Adjust_Bounds (Row, Col);
      Item (Row, Col) := Value;
   end Set;

   procedure Destroy is
   begin
      if Item /= null then
         Deallocate (Item);
         Item := null;
      end if;
   end Destroy;

begin
   -- 初始化为空，第一次访问时再创建数组
   Item := null;
end Rectangular;

main.adb

with Ada.Text_IO; use Ada.Text_IO;
with Rectangular;
procedure Main is
begin
   declare
      package Rect is new Rectangular (Value_Type => Integer);
      X : Integer;
   begin
      -- 初始状态为空，第一次Set会创建数组
      Rect.Set (0, 0, 2);
      X := Rect.Get (0, 0);
      Put_Line (X'Image);

      -- 扩展数组到(1,1)
      Rect.Set (1, 1, 42);
      X := Rect.Get (1, 1);
      Put_Line (X'Image);

      -- 测试向负索引扩展
      Rect.Set (-1, -2, 99);
      X := Rect.Get (-1, -2);
      Put_Line (X'Image);

      -- 释放内存，避免泄漏
      Rect.Destroy;
   end;
end Main;

关键修改说明 #

1. 可访问性问题解决：
   • 我们定义了Matrix_Access作为明确的堆访问类型，并通过Ada.Unchecked_Deallocation创建Deallocate过程。堆分配的对象的可访问性不受局部作用域限制，完全符合Ada的类型安全规则，因此不会触发可访问性检查错误。
2. 边界计算修正：
   • 将Rowmax和Colmax的计算从Integer'Min改为Integer'Max，确保新数组的范围包含目标索引，真正实现数组的自动扩展（包括向正索引和负索引两个方向）。
3. 内存管理：
   • 添加了Destroy过程，用于显式释放包级的Item内存。在实例的作用域结束前调用它，可以避免内存泄漏。
   • 在Adjust_Bounds中，每次创建新数组后都会释放旧数组的内存，确保不会出现内存泄漏。

关于Unchecked_Access的说明 #

不建议使用Unchecked_Access来规避这个问题，因为它会绕过Ada的可访问性检查，可能导致悬空引用和未定义行为。我们上面的方案是符合Ada内存管理规则的正确做法，既解决了问题又保证了类型安全。

内容的提问来源于stack exchange，提问作者Maurice Calvert