Ada-在过程中引发的可访问性检查

我之前问过一个关于Ada中提出的可访问性检查的问题，@Brian Drummond对awnser非常友好。可访问性检查在一个函数中，现在我在一个过程中遇到了一个类似的问题；如果您能提供任何有关这一点的指导，我们将不胜感激

我正在编写的代码取自此处：

以下主文件中的代码来自简单的正弦示例，可在此处找到：

我的主文件如下所示：

with Write_To_Stdout;
with Command; use Command;
with Effects; use Effects;
with Sound_Gen_Interfaces; use Sound_Gen_Interfaces;
with Utils; use Utils;

procedure main is
   pragma Suppress (Accessibility_Check);
   BPM   : Natural := 15;
   Notes : Notes_Array :=
     To_Seq_Notes ((C, G, F, G, C, G, F, A, C, G, F, G, C, G, F, G), 400, 4);

   function Simple_Synth
     (S    : access Simple_Sequencer; Tune : Integer := 0; Decay : Integer)
      return access Mixer
   is
     (Create_Mixer
        ((0 => (Create_Sine (Create_Pitch_Gen (Tune, S)), 0.5)),
         Env => Create_ADSR (5, 50, Decay, 0.5, S)));

   Volume     : Float   := 0.9;
   Decay      : Integer := 800;
   Seq        : access Simple_Sequencer;
   Sine_Gen   : access Mixer;
   Main       : constant access Mixer := Create_Mixer (No_Generators);
begin
   for I in -3 .. 1 loop
      Seq      := Create_Sequencer (16, BPM, 1, Notes);
      Sine_Gen := Simple_Synth (Seq, I * 12, Decay);
      Main.Add_Generator (Sine_Gen, Volume);
      BPM    := BPM * 2;
      Volume := Volume / 1.8;
      Decay  := Decay / 2;
   end loop;

   Write_To_Stdout (Main);
end main;

引发的错误如下：

引发的程序错误：声音生成接口。adb:20辅助功能检查失败

在调用此过程时引发：

   -- Register_Note_Generator --
   -----------------------------

   procedure Register_Simulation_Listener
     (N : access I_Simulation_Listener'Class) is
   begin
      Simulation_Listeners (Simulation_Listeners_Nb) := N;
      Simulation_Listeners_Nb := Simulation_Listeners_Nb + 1;
   end Register_Simulation_Listener;

这是下面代码的第20行：

with Ada.Containers.Vectors;

package body Sound_Gen_Interfaces is

   package PA_Vectors
   is new Ada.Containers.Vectors (Natural, Params_Scope);

   Params_Aggregators : PA_Vectors.Vector;

   function Current_FPA return Params_Scope is
     (Params_Aggregators.Last_Element);

   -----------------------------
   -- Register_Note_Generator --
   -----------------------------

   procedure Register_Simulation_Listener
     (N : access I_Simulation_Listener'Class) is
   begin
      Simulation_Listeners (Simulation_Listeners_Nb) := N;
      Simulation_Listeners_Nb := Simulation_Listeners_Nb + 1;
   end Register_Simulation_Listener;

   ---------------
   -- Next_Step --
   ---------------

   procedure Next_Steps is
   begin
      for I in 0 .. Simulation_Listeners_Nb - 1 loop
         Simulation_Listeners (I).Next_Step;
      end loop;
   end Next_Steps;

   ----------------
   -- Base_Reset --
   ----------------

   procedure Base_Reset (Self : in out Generator) is
   begin
      null;
   end Base_Reset;

   --------------------
   -- Reset_Not_Null --
   --------------------

   procedure Reset_Not_Null (Self : Generator_Access) is
   begin
      if Self /= null then
         Self.Reset;
      end if;
   end Reset_Not_Null;

   --------------------
   -- Reset_Not_Null --
   --------------------

   procedure Reset_Not_Null (Self : Note_Generator_Access) is
   begin
      if Self /= null then
         Self.Reset;
      end if;
   end Reset_Not_Null;

   --------------------------
   -- Compute_Fixed_Params --
   --------------------------

   procedure Compute_Params (Self : in out Generator) is

      procedure Internal (Self : in out Generator'Class);
      procedure Internal (Self : in out Generator'Class) is
      begin
         for C of Self.Children loop
            if C /= null then
               if C.Is_Param then
                  Add_To_Current (C);
               end if;
               Internal (C.all);
            end if;
         end loop;
      end Internal;

   begin
      Self.Parameters := new Params_Scope_Type;
      Enter (Self.Parameters);
      Internal (Self);
      Leave (Self.Parameters);
   end Compute_Params;

   -----------
   -- Enter --
   -----------

   procedure Enter (F : Params_Scope) is
   begin
      Params_Aggregators.Append (F);
   end Enter;

   -----------
   -- Leave --
   -----------

   procedure Leave (F : Params_Scope) is
   begin
      pragma Assert (F = Current_FPA);
      Params_Aggregators.Delete_Last;
   end Leave;

   --------------------
   -- Add_To_Current --
   --------------------

   procedure Add_To_Current (G : Generator_Access) is
      use Ada.Containers;
   begin
      if Params_Aggregators.Length > 0 then
         Current_FPA.Generators.Append (G);
      end if;
   end Add_To_Current;

   ------------------
   -- All_Children --
   ------------------

   function All_Children
     (Self : in out Generator) return Generator_Array
   is
      function All_Children_Internal
        (G : Generator_Access) return Generator_Array
      is
        (G.All_Children) with Inline_Always;

      function Is_Null (G : Generator_Access) return Boolean
      is (G /= null) with Inline_Always;

      function Cat_Arrays
      is new Generator_Arrays.Id_Flat_Map_Gen (All_Children_Internal);

      function Filter_Null is new Generator_Arrays.Filter_Gen (Is_Null);

      S : Generator'Class := Self;
      use Generator_Arrays;
   begin
      return Filter_Null (S.Children & Cat_Arrays (Filter_Null (S.Children)));
   end All_Children;

   ----------------
   -- Get_Params --
   ----------------

   function Get_Params
     (Self : in out Generator) return Generator_Arrays.Array_Type
   is
      use Generator_Arrays;

      function Internal
        (G : Generator_Access) return Generator_Arrays.Array_Type
      is
        (if G.Parameters /= null
         then Generator_Arrays.To_Array (G.Parameters.Generators)
         else Generator_Arrays.Empty_Array) with Inline_Always;

      function Cat_Arrays
      is new Generator_Arrays.Id_Flat_Map_Gen (Internal);

   begin
      return Internal (Self'Unrestricted_Access)
        & Cat_Arrays (Self.All_Children);
   end Get_Params;

   ----------------------
   -- Set_Scaled_Value --
   ----------------------

   procedure Set_Scaled_Value
     (Self : in out Generator'Class; I : Natural; Val : Scaled_Value_T)
   is
      V : Float :=
        (if Self.Get_Scale (I) = Exp
         then Exp8_Transfer (Float (Val)) else Float (Val));
      Max : constant Float := Self.Get_Max_Value (I);
      Min : constant Float := Self.Get_Min_Value (I);
   begin
      V := V * (Max - Min) + Min;
      Self.Set_Value (I, V);
   end Set_Scaled_Value;

end Sound_Gen_Interfaces;

任何关于为什么会发生这种情况的帮助都将不胜感激

---

谢谢

您在这里看到的是（过度）使用匿名访问类型的结果（在中讨论，在Ada的维护者中非正式地称为“黑暗之心”）

我不认为有一种简单的方法可以解决这个问题（除了使用

-gnatp

，正如我们前面所发现的那样），来抑制所有检查；不过也许您在

pragma Suppress (Accessibility_Check);

在有问题的单位）

我通过一次相当残酷的黑客攻击，成功地获得了一个没有

程序错误

s的构建，将匿名

access I\u Simulation\u Listener'类

更改为命名的

Simulation\u Listener\u access

，例如

function Create_Simple_Command
  (On_Period, Off_Period : Sample_Period;
   Note : Note_T) return access Simple_Command'Class
is
begin
   return N : constant access Simple_Command'Class
     := new Simple_Command'(Note       => Note,
                            Buffer     => <>,
                            On_Period  => On_Period,
                            Off_Period => Off_Period,
                            Current_P  => 0)
   do
      Register_Simulation_Listener (N);
   end return;
end Create_Simple_Command;

函数创建\u简单\u命令
（开周期、关周期：样本周期；
注意：注意返回访问简单命令类
是
开始
返回N:constant access Simple_命令类
：=新的简单命令“（注意=>注意，
缓冲区=>,，
On_Period=>On_Period，
关闭时间=>关闭时间，
当前（P=>0）
做
寄存器\模拟\侦听器（N）；
末端返回；
结束创建\u简单\u命令；

到

函数创建\u简单\u命令
（开周期、关周期：样本周期；
注意：注意返回访问简单命令类
是
命令：持续模拟\u侦听器\u访问
：=新的简单命令“（注意=>注意，
缓冲区=>,，
On_Period=>On_Period，
关闭时间=>关闭时间，
当前_P=>0）；
开始
寄存器\模拟\侦听器（命令）；
返回简单_命令（Command.all）的访问权限；
结束创建\u简单\u命令；

理想情况下，我会考虑让

Create\u Simple\u命令

也返回一个命名的访问类型

---

您可以看到我的目的。

我猜Main.AddGenerator调用了错误的过程？我仍然建议组合一个最小的可编译测试用例；例如，该软件包中的内容远远超出了需要，而AddGenerator却丢失了。谢谢@Brian，这是一个好消息！我要吃这个。。。谢谢，我无法回答为什么（可能是蚊虫，也可能是合法的，我不知道），但我可以根据您的需要提供一些解决方法。我不确定这是否是您需要的帮助类型。不过，这需要对侦听器做一些不同的处理（对于任何解决方法）。此外，如果您有任何特殊要求（无堆、不受限制等）最好知道如何更好地集中答案。为什么要将主程序的名称从

Simple\u Sine

更改为

main

？GNAT（实际上，任何Ada编译器）可以将任何库级无参数过程作为主程序。非常感谢Simon的详细回复。我无法理解，所以使用了-gnatp。我知道这并不理想。我将尝试您的解决方案，一旦我了解了它，我将回信。谢谢您，Lloyd这可能会有内存风险如果侦听器数组存储在非库级对象中，或者如果存在删除侦听器的操作（这是事件侦听器的常用习惯用法），则会发生泄漏？仅询问一般情况。@Jere侦听器数组位于库级；并且没有更多（也没有更少）与原始版本相比，此版本可能存在内存泄漏。@SimonWright是的，我一般要求查看解决方案在一般意义上的适用性。对于正在学习如何使用访问类型的OP，我认为重要的是强调何时/如何使用，以防他们以后在不再使用访问类型的地方进行更改y级。

function Create_Simple_Command
  (On_Period, Off_Period : Sample_Period;
   Note : Note_T) return access Simple_Command'Class
is
   Command : constant Simulation_Listener_Access
     := new Simple_Command'(Note       => Note,
                            Buffer     => <>,
                            On_Period  => On_Period,
                            Off_Period => Off_Period,
                            Current_P  => 0);
begin
   Register_Simulation_Listener (Command);
   return Simple_Command (Command.all)'Access;
end Create_Simple_Command;