Ada-提出了可访问性检查 [英] Ada - accessibility check raised
本文介绍了Ada-提出了可访问性检查的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我已从Github下载此程序： https://github.com/raph -amiard / ada-synth-lib
I have downloaded this program from Github: https://github.com/raph-amiard/ada-synth-lib
我已经提出了第一个示例，但出现一个例外。如果有人能够让我了解为什么会这样，将不胜感激。我已经为此困扰了很长时间，我真的很想让这个工作正常。
I have attemted the first example and I am presented with an exception. If anybody would be able to give me an insight into why this is, it would be massively appreciated. I've been stumped on this for a long time and I'm really keen to get this working.
我收到的错误是： raised PROGRAM_ERROR：wave.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文件
Here is the waves.adb file
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文件
And lastly, the write_to_stdout.adb file
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;
感谢您的阅读，对于解决此问题的任何指导将是最有价值的。
Thank you for reading, and any guidance into solving this would be most appreicated.
干杯，
劳埃德
推荐答案
有问题的函数：
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;
创建一个新对象，并通过其本地作用域中的访问类型对其进行访问，并返回该访问的副本。在这种情况下，可能还可以，但是在类似的情况下，当函数返回时，对象本身超出了范围，留下了悬挂的访问权限。
creates a new object, accessed by an access type in its local scope and returns a copy of the access. In this case it is probably OK but there is the possibility of similar cases where the object itself goes out of scope when the function returns, leaving a dangling access.
在这种情况下，这可能是谨慎的，因为对对象的唯一引用是返回的对象，但是可访问性检查禁止整个类都可能包含错误。我之所以说可能，是因为理论上可以由某些编译器将对象分配到堆栈上，或者在本地拥有的存储池中分配对象，而不是为了更可靠地进行对象生命周期管理而将其分配给堆。
In this case it's probably overcautious since the only reference to the object is that returned, but the accessibility checks prohibit this whole class of potentially bug-ridden constructs. I say "probably" because the object could theoretically be allocated on the stack by some compilers, or in a locally owned storage pool rather than "the heap" for more reliable object lifetime management.
有一个解决方案：在返回的对象中而不是在立即丢弃的本地对象中创建访问。 Ada-2005及更高版本提供了扩展的回报构造来允许这种情况。看起来像这样：
There is a solution : create the access in place in the returned object, rather than in an immediately discarded local object. Ada-2005 and later provide an "extended return" construct to allow this. It looks something like:
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;
未经测试！但是，任何通常的消息来源都应该让您保持直觉，因为您知道它的名字。
not tested! but any of the usual sources should keep you straight now you know its name.
在这里，呼叫者拥有使用新初始化的访问类型
Here the caller owns the access type being initialised with the new object, so there is no danger of the access type out-living the accessed object.
总体上，对这个问题可能会有更好的答案。我刚刚谈到了切入点，但是更广泛的问题是，您是否根本需要访问类型？在Ada中，答案通常（但并非总是）是否。在许多情况下，来自其他语言的程序员只要在Ada中有一种更简单或更佳的处理方式，就可以找到指针。
There may be a better answer to this question overall. I have just addressed the immediate point, but the wider question is, do you need an access type here at all? In Ada the answer usually (but not always) is No. There are many cases where programmers coming from other languages just reach for the pointers, when there is a simpler or better way of doing things in Ada.
这篇关于Ada-提出了可访问性检查的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
