Ada - 提出可访问性检查

Question

我从Github下载了这个程序:https://github.com/raph-amiard/ada-synth-lib

我已经尝试了第一个示例，但出现了异常。如果有人能够让我深入了解这是为什么，我将不胜感激。我已经被这个问题困扰了很长时间，我真的很想让它发挥作用。

我收到的错误是:引发PROGRAM_ERROR:waves.adb:110可访问性检查失败

这是主文件:

with Waves; use Waves;
with Write_To_Stdout; 



procedure Main is



   Sine_Gen : constant access Sine_Generator := Create_Sine (Fixed (440.0));

begin


  Write_To_Stdout (Sine_Gen);


end Main;

这是waves.adb 文件

with Effects; use Effects;
with Interfaces; use Interfaces;

package body Waves is

   function Mod_To_Int (A : Unsigned_32) return Integer_32;

   -------------------
   -- Update_Period --
   -------------------

   procedure Update_Period
     (Self : in out Wave_Generator'Class; Buffer : in out Period_Buffer)
   is
   begin
      Self.Frequency_Provider.Next_Samples (Buffer);
      for I in Buffer'Range loop
         Buffer (I) :=
           Utils.Period_In_Samples
             (Frequency (Buffer (I)));
      end loop;
   end Update_Period;

   ------------
   -- Create --
   ------------

   function Create_Saw
     (Freq_Provider : Generator_Access) return access Saw_Generator
   is
   begin
      return new Saw_Generator'(Frequency_Provider => Freq_Provider,
                                Current => -1.0, others => <>);
   end Create_Saw;

   -----------------
   -- Next_Sample --
   -----------------

   overriding procedure Next_Samples
     (Self : in out Saw_Generator; Buffer : in out Generator_Buffer)
   is
      P_Buffer : Period_Buffer;
   begin
      Update_Period (Self, P_Buffer);
      for I in Buffer'Range loop
         Self.Step := 2.0 / Float (P_Buffer (I));
         Self.Current := Self.Current + Sample (Self.Step);
         if Self.Current > 1.0 then
            Self.Current := Self.Current - 2.0;
         end if;
         Buffer (I) := Self.Current;
      end loop;
   end Next_Samples;

   ------------
   -- Create --
   ------------

   function Create_Square
     (Freq_Provider : access Generator'Class) return access Square_Generator is
   begin
      return new Square_Generator'(Frequency_Provider =>
                                     Generator_Access (Freq_Provider),
                                   Is_High => True,
                                   Current_Sample => 0,
                                   others => <>);
   end Create_Square;

   -----------------
   -- Next_Sample --
   -----------------

   overriding procedure Next_Samples
     (Self : in out Square_Generator; Buffer : in out Generator_Buffer)
   is
      P_Buffer : Period_Buffer;
   begin
      Update_Period (Self, P_Buffer);
      for I in Buffer'Range loop
         Self.Current_Sample := Self.Current_Sample + 1;
         declare
            A : constant Period := Period (Self.Current_Sample)
              / P_Buffer (I);
         begin
            if A >= 1.0 then
               Self.Current_Sample := 0;
               Buffer (I) := 1.0;
            end if;
            Buffer (I) := (if A >= 0.5 then 1.0 else -1.0);
         end;
      end loop;
   end Next_Samples;

   ------------
   -- Create --
   ------------

   function Create_Sine
     (Freq_Provider : access Generator'Class) return access Sine_Generator
   is
      Ret : constant access Sine_Generator :=
        new Sine_Generator'(Frequency_Provider =>
                              Generator_Access (Freq_Provider),
                            Current_Sample => 0,
                            Current_P => 0.0,
                            others => <>);
   begin
      Ret.Current_P := 0.0;
      return Ret;
   end Create_Sine;

   -----------------
   -- Next_Sample --
   -----------------

   overriding procedure Next_Samples
     (Self : in out Sine_Generator; Buffer : in out Generator_Buffer)
   is
      P_Buffer : Period_Buffer;
   begin
      Update_Period (Self, P_Buffer);
      for I in Buffer'Range loop
         Self.Current_Sample := Self.Current_Sample + 1;
         if Period (Self.Current_Sample) >= Self.Current_P then
            Self.Current_P := P_Buffer (I) * 2.0;
            Self.Current_Sample := 0;
         end if;
         Buffer (I) :=
           Sample
             (Sin
                (Float (Self.Current_Sample)
                 / Float (Self.Current_P) * Pi * 2.0));
      end loop;
   end Next_Samples;

   ------------
   -- Create --
   ------------

   function Create_Chain
     (Gen : access Generator'Class;
      Sig_Procs : Signal_Processors
        := No_Signal_Processors) return access Chain
   is
      Ret : constant access Chain :=
        new Chain'(Gen => Generator_Access (Gen), others => <>);
   begin
      for P of Sig_Procs loop
         Ret.Add_Processor (P);
      end loop;
      return Ret;
   end Create_Chain;

   -------------------
   -- Add_Processor --
   -------------------

   procedure Add_Processor
     (Self : in out Chain; P : Signal_Processor_Access) is
   begin
      Self.Processors (Self.Nb_Processors) := P;
      Self.Nb_Processors := Self.Nb_Processors + 1;
   end Add_Processor;

   -----------------
   -- Next_Sample --
   -----------------

   overriding procedure Next_Samples
     (Self : in out Chain; Buffer : in out Generator_Buffer)
   is
      S : Sample;
   begin
      Self.Gen.Next_Samples (Buffer);
      for J in Buffer'Range loop
         S := Buffer (J);
         for I in 0 .. Self.Nb_Processors - 1 loop
            S := Self.Processors (I).Process (S);
         end loop;
         Buffer (J) := S;
      end loop;
   end Next_Samples;

   ---------
   -- LFO --
   ---------

   function LFO (Freq : Frequency; Amplitude : Float) return Generator_Access
   is
      Sin : constant Generator_Access := Create_Sine (Fixed (Freq));
   begin
      return new Attenuator'
        (Level => Amplitude,
         Source => new Transposer'(Source => Sin, others => <>), others => <>);
   end LFO;

   ------------
   -- Create --
   ------------

   function Create_ADSR
     (Attack, Decay, Release : Millisecond; Sustain : Scale;
      Source : access Note_Generator'Class := null) return access ADSR
   is
   begin
      return new ADSR'
        (State     => Off,
         Source    => Source,
         Attack    => Msec_To_Period (Attack),
         Decay     => Msec_To_Period (Decay),
         Release   => Msec_To_Period (Release),
         Sustain   => Sustain,
         Current_P => 0, others => <>);
   end Create_ADSR;

   -----------------
   -- Next_Sample --
   -----------------

   overriding procedure Next_Samples
     (Self : in out ADSR; Buffer : in out Generator_Buffer)
   is
      Ret : Sample;
   begin
      for I in Buffer'Range loop
         case Self.Source.Buffer (I).Kind is
         when On =>
            Self.Current_P := 0;
            Self.State := Running;
         when Off =>
            Self.State := Release;
            Self.Cur_Sustain := Scale (Self.Memo_Sample);
            Self.Current_P := 0;
         when No_Signal => null;
         end case;

         Self.Current_P := Self.Current_P + 1;

         case Self.State is
         when Running =>
            if Self.Current_P in 0 .. Self.Attack then
               Ret := Exp8_Transfer
                 (Sample (Self.Current_P) / Sample (Self.Attack));
            elsif
              Self.Current_P in Self.Attack + 1 .. Self.Attack + Self.Decay
            then
               Ret :=
                 Exp8_Transfer
                   (Float (Self.Decay + Self.Attack - Self.Current_P)
                    / Float (Self.Decay));

               Ret := Ret
               * Sample (1.0 - Self.Sustain)
                 + Sample (Self.Sustain);
            else
               Ret := Sample (Self.Sustain);
            end if;
            Self.Memo_Sample := Ret;
         when Release =>
            if Self.Current_P in 0 .. Self.Release then
               Ret :=
                 Exp8_Transfer
                   (Sample (Self.Release - Self.Current_P)
                    / Sample (Self.Release))
                 * Sample (Self.Cur_Sustain);
            else
               Self.State := Off;
               Ret := 0.0;
            end if;
         when Off  => Ret := 0.0;
         end case;

         Buffer (I) := Ret;
      end loop;
   end Next_Samples;

   ----------------------
   -- Next_Sample --
   ----------------------

   overriding procedure Next_Samples
     (Self : in out Pitch_Gen; Buffer : in out Generator_Buffer)
   is
      Ret : Sample;
   begin
      if Self.Proc /= null then
         Self.Proc.Next_Samples (Buffer);
      end if;

      for I in Buffer'Range loop
         case Self.Source.Buffer (I).Kind is
         when On =>
            Self.Current_Note := Self.Source.Buffer (I).Note;
            Self.Current_Freq :=
              Note_To_Freq (Self.Current_Note, Self.Relative_Pitch);
         when others => null;
         end case;

         Ret := Sample (Self.Current_Freq);

         if Self.Proc /= null then
            Ret := Ret + Buffer (I);
         end if;

         Buffer (I) := Ret;
      end loop;
   end Next_Samples;

   ------------------
   -- Create_Noise --
   ------------------

   function Create_Noise return access Noise_Generator
   is
      N : constant access Noise_Generator := new Noise_Generator;
   begin
      return N;
   end Create_Noise;

   F_Level : constant Sample := 2.0 / Sample (16#FFFFFFFF#);
   G_X1 : Unsigned_32 := 16#67452301#;
   G_X2 : Unsigned_32 := 16#EFCDAB89#;
   Z : constant := 2 ** 31;

   ----------------
   -- Mod_To_Int --
   ----------------

   function Mod_To_Int (A : Unsigned_32) return Integer_32 is
      Res : Integer_32;
   begin
      if A < Z then
         return Integer_32 (A);
      else
         Res := Integer_32 (A - Z);
         Res := Res - (Z - 1) - 1;
         return Res;
      end if;
   end Mod_To_Int;

   ------------------
   -- Next_Samples --
   ------------------

   overriding procedure Next_Samples
     (Self : in out Noise_Generator; Buffer : in out Generator_Buffer)
   is
      pragma Unreferenced (Self);
   begin
      for I in Buffer'Range loop
         G_X1 := G_X1 xor G_X2;
         Buffer (I) := Sample (Mod_To_Int (G_X2)) * F_Level;
         G_X2 := G_X2 + G_X1;
      end loop;
   end Next_Samples;

   ------------------
   -- Next_Samples --
   ------------------

   overriding procedure Next_Samples
     (Self : in out Fixed_Gen; Buffer : in out Generator_Buffer) is
   begin

      if Self.Proc /= null then
         Self.Proc.Next_Samples (Buffer);
         for I in Buffer'Range loop
            Buffer (I) := Self.Val + Buffer (I);
         end loop;
      else
         for I in Buffer'Range loop
            Buffer (I) := Self.Val;
         end loop;
      end if;
   end Next_Samples;

   -----------
   -- Reset --
   -----------

   overriding procedure Reset (Self : in out ADSR) is
   begin
      Base_Reset (Self);
      Reset_Not_Null (Self.Source);
      Self.Memo_Sample := 0.0;
   end Reset;

   -----------
   -- Reset --
   -----------

   overriding procedure Reset (Self : in out Saw_Generator) is
   begin
      Base_Reset (Self);
      Reset_Not_Null (Self.Frequency_Provider);
      Self.Current := -1.0;
   end Reset;

   -----------
   -- Reset --
   -----------

   overriding procedure Reset (Self : in out Square_Generator) is
   begin
      Base_Reset (Self);
      Reset_Not_Null (Self.Frequency_Provider);
      Self.Current_Sample := 0;
      Self.Is_High := True;


   end Reset;

   -----------
   -- Reset --
   -----------

   overriding procedure Reset (Self : in out Sine_Generator) is
   begin
      Base_Reset (Self);
      Reset_Not_Null (Self.Frequency_Provider);
      Self.Current_Sample := 0;
   end Reset;

   -----------
   -- Reset --
   -----------

   overriding procedure Reset (Self : in out Noise_Generator) is
   begin
      Base_Reset (Self);
      Reset_Not_Null (Self.Frequency_Provider);
   end Reset;

   -----------
   -- Reset --
   -----------

   overriding procedure Reset (Self : in out Pitch_Gen) is
   begin
      Base_Reset (Self);
      Reset_Not_Null (Self.Source);
      Reset_Not_Null (Self.Proc);
   end Reset;

   -----------
   -- Reset --
   -----------

   overriding procedure Reset (Self : in out Fixed_Gen) is
   begin
      Base_Reset (Self);
      Reset_Not_Null (Self.Proc);
   end Reset;

   -----------
   -- Reset --
   -----------

   overriding procedure Reset (Self : in out Chain) is
   begin
      Base_Reset (Self);
      Reset_Not_Null (Self.Gen);
   end Reset;

   -----------
   -- Fixed --
   -----------

   function Fixed
     (Freq        : Frequency;
      Modulator   : Generator_Access := null;
      Name        : String := "";
      Min         : Float := 0.0;
      Max         : Float := 5_000.0;
      Param_Scale : Param_Scale_T := Linear)
      return access Fixed_Gen
   is
   begin
      return new
        Fixed_Gen'
          (Val         => Sample (Freq),
           Proc        => Modulator,
           Name        => To_Unbounded_String (Name),
           Min         => Min,
           Max         => Max,
           Param_Scale => Param_Scale,
           others      => <>);
   end Fixed;

   ---------------
   -- Set_Value --
   ---------------

   overriding procedure Set_Value
     (Self : in out Fixed_Gen; I : Natural; Val : Float)
   is
      pragma Unreferenced (I);
   begin
      Self.Val := Sample (Val);
   end Set_Value;

   ---------------
   -- Set_Value --
   ---------------

   overriding procedure Set_Value
     (Self : in out ADSR; I : Natural; Val : Float)
   is
   begin
      case I is
         when 0 => Self.Attack := Sec_To_Period (Val);
         when 1 => Self.Decay :=  Sec_To_Period (Val);
         when 2 => Self.Sustain := Scale (Val);
         when 3 => Self.Release := Sec_To_Period (Val);
         when others => raise Constraint_Error;
      end case;
   end Set_Value;

end Waves;

最后，write_to_stdout.adb 文件

with Utils; use Utils;
with GNAT.OS_Lib;

procedure Write_To_Stdout (G : access Generator'Class)
is
   function Sample_To_Int16 is new Sample_To_Int (Short_Integer);
   Int_Smp : Short_Integer := 0;
   Ignore  : Integer;
   Buffer  : Generator_Buffer;
begin

   loop
      Next_Steps;
      G.Next_Samples (Buffer);

      for I in Buffer'Range loop
         Int_Smp := Sample_To_Int16 (Buffer (I));
         Ignore := GNAT.OS_Lib.Write
           (GNAT.OS_Lib.Standout, Int_Smp'Address, Int_Smp'Size / 8);
      end loop;

      exit when Sample_Nb > 10_000_000;
      Sample_Nb := Sample_Nb + Generator_Buffer_Length;
   end loop;

end Write_To_Stdout;

感谢您的阅读，非常感谢您提供解决此问题的任何指导。

干杯，

劳埃德

Answer 1

有问题的函数:

   function Create_Sine
     (Freq_Provider : access Generator'Class) return access Sine_Generator
   is
      Ret : constant access Sine_Generator :=
        new Sine_Generator'(Frequency_Provider =>
                              Generator_Access (Freq_Provider),
                            Current_Sample => 0,
                            Current_P => 0.0,
                            others => <>);
   begin
      Ret.Current_P := 0.0;
      return Ret;
   end Create_Sine;

创建一个新对象，由其本地范围内的访问类型访问并返回访问的副本。在这种情况下，它可能没问题，但也有可能出现类似的情况，即当函数返回时对象本身超出范围，留下悬空访问。

在这种情况下，它可能过于谨慎，因为对对象的唯一引用是返回的，但可访问性检查禁止整个类可能存在错误的构造。我说“可能”是因为理论上该对象可以由某些编译器分配在堆栈上，或者分配在本地拥有的存储池中，而不是“堆”中，以实现更可靠的对象生命周期管理。

有一个解决方案:在返回的对象中创建访问，而不是在立即丢弃的本地对象中。 Ada-2005 及更高版本提供了“扩展返回”结构来实现此目的。它看起来像:

   function Create_Sine
     (Freq_Provider : access Generator'Class) return access Sine_Generator
   is
   begin
      return Ret : constant access Sine_Generator :=
        new Sine_Generator'( Frequency_Provider =>
                              Generator_Access (Freq_Provider),
                            Current_Sample => 0,
                            Current_P => 0.0,
                            others => <>) 
        do
            -- initialisation actions here
            Ret.Current_P := 0.0;
        end return;
   end Create_Sine;

未经测试!但现在您知道了它的名字，任何常用的来源都应该能让您保持清醒。

此处，调用者拥有使用新对象初始化的访问类型，因此不存在访问类型超出所访问对象生命周期的危险。

总的来说，这个问题可能有更好的答案。我刚刚谈到了最直接的问题，但更广泛的问题是，您是否需要这里的访问类型？在 Ada 中，答案通常(但并非总是)是否。在很多情况下，来自其他语言的程序员只是使用指针，而在 Ada 中存在更简单或更好的处理方式。