Ada2012:Ada.Finalization.Limited_Controlled 可能出错?

huangapple go评论49阅读模式
英文:

Ada2012: possible error for Ada.Finalization.Limited_Controlled?

问题

It appears that you're encountering a run-time error in your Ada program, specifically at trace #6, where the system is calling the adjust procedure for a Limited_Controlled type. Without the ability to analyze the complete code and its execution context, it's challenging to pinpoint the exact issue. However, I can provide some general insights:

  1. The error message suggests a problem with the limited controlled type, possibly related to the finalization process.

  2. Limited controlled types in Ada require initialization and finalization procedures to manage resources properly.

  3. It's essential to ensure that you've correctly implemented the Ada.Finalization.Limited_Controlled procedures for your types.

  4. Check if you have any circular dependencies or issues with the order of finalization for objects.

  5. Examine the code that triggers the run-time error and see if there are any issues with object creation, assignment, or finalization.

  6. You might want to review the use of the eventPublisher package and how it interacts with the components package, as the error could be related to these interactions.

  7. Ada debugging tools, like GNAT's debugger, can be valuable for pinpointing the exact cause of the error. Consider using them to step through your code and identify the issue.

Please review your code carefully, paying particular attention to the initialization and finalization procedures for limited controlled types. If you can provide more specific details about the error or the code section that triggers it, I can offer more targeted advice.

英文:

I'm facing now the following weird run-time error:

> raised PROGRAM_ERROR : s-finroo.adb:42 explicit raise

I'm trying to implement an Observer design pattern. Since my observers are limited and I want to avoid general access types, I'm storing the observers' address and notifying them using Ada.Adress_To_Access_Conversions.
My concrete observers are inheriting from Ada.Finalization.Limited_Controlled as I have to initialize and finalize them somehow as per my implementation.
Take a look at components.ads below, where Component_t is defined.

I leave you a minimal reproducibable example:

eventpublisher.ads

private with System;

package eventPublisher is

  type Observer_t is limited interface;
  procedure Event (this : in out Observer_t) is abstract;

  type EventPublisher_t is tagged limited private;
  procedure pSubscribeEvent (this : in out EventPublisher_t;
                             TrainId : Natural;
                             sub : Observer_t'Class);

  procedure pUnsubscribeEvent (this : in out EventPublisher_t;
                               TrainId : Natural;
                               sub : Observer_t'Class);

  procedure pNotifyEvent (this : in out EventPublisher_t);

  function fGetEventPublisher return not null access EventPublisher_t;

private

  type EventObserver_t is tagged
     record
       obs : System.Address := System.Null_Address;
     end record;

  type EventPublisher_t is tagged limited
     record
       eventManager : EventObserver_t;
     end record;

end eventPublisher;

eventpublisher.adb

with System.Address_To_Access_Conversions;
with Ada.Text_IO;

package body eventPublisher is

  function "=" (Left, Righ : System.Address) return Boolean renames System."=";

  eventPublisher : access EventPublisher_t := new EventPublisher_t;

  package Event_OPS is new System.Address_To_Access_Conversions (Observer_t'Class);

  function fGetEventPublisher return not null access EventPublisher_t is
  begin
    return eventPublisher;
  end fGetEventPublisher;

  -------------------
  -- pSubscribeEvent --
  -------------------

  procedure pSubscribeEvent
    (this : in out EventPublisher_t; TrainId : Natural;
     sub  :        Observer_t'Class)
  is
  begin
    Ada.Text_IO.Put_Line("Subscribing to Event");
    this.eventManager.obs := sub'Address;
  end pSubscribeEvent;

  procedure pUnsubscribeEvent (this : in out EventPublisher_t;
                               TrainId : Natural;
                               sub : Observer_t'Class) is
  begin
    Ada.Text_IO.Put_Line("Unsubscribing to Event");
    if this.eventManager.obs = sub'Address then
      this.eventManager.obs := System.Null_Address;
    else
      null;
    end if;

  end pUnsubscribeEvent;

  procedure pNotifyEvent (this : in out EventPublisher_t) is
  begin
    if this.eventManager.obs /= System.Null_Address then
      Ada.Text_IO.Put_Line("Notifying to observer");
      Event_OPS.To_Pointer(this.eventManager.obs).Event;
    end if;
  end pNotifyEvent;

components.ads

with eventPublisher;
private with Ada.Finalization;

package components is

  type Root_t (Id : Natural) is abstract tagged limited null record;

  type Child_t (Id : Natural) is limited new Root_t with private;

  procedure pSubscribe (this : in out Child_t);
  procedure pUnsubscribe (this : in out Child_t);

private

  type Component_t (Id : Natural) is limited new
    Ada.Finalization.Limited_Controlled and --> if you comment out this, everything works
    eventPublisher.Observer_t with null record;

  overriding
  procedure Event (this : in out Component_t);

  type Child_t (Id : Natural) is limited new Root_t (Id => Id) with
     record
       component : Component_t(Id => Id);
     end record;

end components;

components.adb

with Ada.Text_IO;

package body components is
  -----------
  -- Event --
  -----------

  overriding procedure Event (this : in out Component_t) is
  begin
    Ada.Text_IO.Put_Line("Processing Event");
  end Event;
  ----------------
  -- pSubscribe --
  ----------------

  procedure pSubscribe (this : in out Child_t) is
  begin
    eventPublisher.fGetEventPublisher.pSubscribeEvent(TrainId => this.Id,
                                                    sub => this.component);
  end pSubscribe;

  procedure pUnsubscribe (this : in out Child_t) is
  begin
    eventPublisher.fGetEventPublisher.pUnsubscribeEvent(TrainId => this.Id,
                                                      sub => this.component);
  end pUnsubscribe;

end components;

And finally, main.adb

with Ada.Text_IO;
with components;
with eventPublisher;

procedure Main is

  c : components.Child_t(Id => 1);
  pub : constant access eventPublisher.EventPublisher_t := eventPublisher.fGetEventPublisher;

begin
  c.pSubscribe;
  pub.pNotifyEvent;
  c.pUnsubscribe;
end Main;

This is the backtrace:

#0  <__gnat_debug_raise_exception> (e=0x45ab60 <program_error>, message=...) at s-excdeb.adb:41
#1  0x0000000000407265 in ada.exceptions.complete_occurrence (x=x@entry=0x467300) at a-except.adb:1019
#2  0x0000000000407275 in ada.exceptions.complete_and_propagate_occurrence (x=x@entry=0x467300) at a-except.adb:1030
#3  0x00000000004076ac in ada.exceptions.raise_with_location_and_msg (e=0x45ab60 <program_error>, f=(system.address) 0x4437d8, l=42, c=c@entry=0, m=m@entry=(system.address) 0x441150) at a-except.adb:1241
#4  0x0000000000407629 in <__gnat_raise_program_error_msg> (file=<optimized out>, line=<optimized out>, msg=msg@entry=0x441150 <ada.exceptions.rmsg_22>) at a-except.adb:1197
#5  0x00000000004078e0 in <__gnat_rcheck_PE_Explicit_Raise> (file=<optimized out>, line=<optimized out>) at a-except.adb:1435
#6  0x0000000000416ba5 in system.finalization_root.adjust ()
#7  0x0000000000404fea in eventpublisher.pnotifyevent ()
#8  0x00000000004041be in main ()

Do you know what the heck is going on? Why the run-time is calling to Adjust for a Limited_Controlled type at trace #6?

答案1

得分: 2

这篇文章中,已故的Robert Dewar(AdaCore的创始人)说:

"永远不要在指向无约束数组类型的指针上使用Address_To_Access_Conversions。"

我知道你没有无约束数组类型,但相关类型是相对复杂的。

我对你的代码进行了最小的更改,它可以正常运行。

   type Observer_Class_P is access all Observer_T'Class;

   procedure pSubscribeEvent (this : in out EventPublisher_t;
                              TrainId : Natural;
                              sub : Observer_t'Class);

   type EventObserver_t is tagged
      record
         obs : Observer_Class_P;
      end record;

   procedure pSubscribeEvent
     (this : in out EventPublisher_t; TrainId : Natural;
      sub  :        Observer_t'Class)
   is
   begin
      Ada.Text_IO.Put_Line("订阅事件中");
      this.eventManager.obs := sub'Unrestricted_Access; -- 对此感到抱歉 :-(
   end pSubscribeEvent;

   procedure pNotifyEvent (this : in out EventPublisher_t) is
   begin
      if this.eventManager.obs /= null then
         Ada.Text_IO.Put_Line("通知观察者中");
         this.eventManager.Obs.Event;
      end if;
   end pNotifyEvent;
英文:

In this article the late Robert Dewar (founder of AdaCore) says

>NEVER use Address_To_Access_Conversions with pointers to unconstrained array types.

I know you don't have unconstrained array types, but the type concerned is moderately complex.

I made minimal changes to your code, and it ran without problem.

   type Observer_Class_P is access all Observer_T'Class;

   procedure pSubscribeEvent (this : in out EventPublisher_t;
                              TrainId : Natural;
                              sub : Observer_t'Class);

   type EventObserver_t is tagged
      record
         obs : Observer_Class_P;
      end record;

   procedure pSubscribeEvent
     (this : in out EventPublisher_t; TrainId : Natural;
      sub  :        Observer_t'Class)
   is
   begin
      Ada.Text_IO.Put_Line("Subscribing to Event");
      this.eventManager.obs := sub'Unrestricted_Access; -- sorry about this :-(
   end pSubscribeEvent;

   procedure pNotifyEvent (this : in out EventPublisher_t) is
   begin
      if this.eventManager.obs /= null then
         Ada.Text_IO.Put_Line("Notifying to observer");
         this.eventManager.Obs.Event;
      end if;
   end pNotifyEvent;

答案2

得分: 2

以下是您要翻译的内容:

"Ok, one thing to consider is alternate methods for interfacing. In particular, have you considered generics?

GENERIC
   Type Subscriber is private;
   with procedure Event (this : in out Subscriber) is <>;
   with package Notification_List is new Ada.Containers.Indefinite_Vector
         (Element => Subscriber, others => <>);
   Notification : in out Notification_List.Vector;
PROCEDURE Do_Notification;

and

PROCEDURE Do_Notification is
begin
   For C of Notification.Iterate loop
      Notification.Update_Element( C, Event'Access );
   end loop;
end Do_Notification;

And now, with the above construction, you can use non-tagged types as your Subscriber! -- Though for your particular case, you'll need to instantiate Ada.Containers.Indefinite_Vector with Observer_T'Class.

英文:

Ok, one thing to consider is alternate methods for interfacing. In particular, have you considered generics?

GENERIC
   Type Subscriber is private;
   with procedure Event (this : in out Subscriber) is &lt;&gt;;
   with package Notification_List is new Ada.Containers.Indefinite_Vector
         (Element =&gt; Subscriber, others =&gt; &lt;&gt;);
   Notification : in out Notification_List.Vector;
PROCEDURE Do_Notification;

and

PROCEDURE Do_Notification is
begin
   For C of Notification.Iterate loop
      Notification.Update_Element( C, Event&#39;Access );
   end loop;
end Do_Notification;

And now, with the above construction, you can use non-tagged types as your Subscriber! -- Though for your particular case, you'll need to instantiate Ada.Containers.Indefinite_Vector with Observer_T&#39;Class.

huangapple
  • 本文由 发表于 2023年6月30日 00:36:03
  • 转载请务必保留本文链接:https://go.coder-hub.com/76583001.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定