Ada 存在 STORAGE_ERROR 问题

Question

我在 RHEL6 上有一个让我头疼的小功能，我不知道发生了什么......而且调试起来很痛苦。当我运行这个程序时，我收到一个 STORAGE_ERROR，所以我做了一个 gstack 来查看程序挂起的位置（见下文）。它看起来像是 memcmp 的问题，尽管我不确定它在哪里/如何被调用。有解决方法的想法吗？

当我将此函数更改为仅返回“true”时，它似乎工作正常（STORAGE_ERROR 消失），因此我认为问题出在这部分中的某些逻辑： (Ada.Characters.Handling.To_Upper(EPS_List( 1).all) = "LOCALHOST");

  function Localhost_Only return Boolean is
  --++
     EPS_List : String_List_Type 
              := Values(Bstring.To_Bounded_String("EPS"));
  begin
    return (Ada.Characters.Handling.To_Upper(EPS_List(1).all) = "LOCALHOST");

  end Localhost_Only;

开始编辑***

另一种可行的方法是这样做（将其移出函数范围......为什么会这样工作？）：

   EPS_List : String_List_Type 
              := Values(Bstring.To_Bounded_String("EPS"));

  function Localhost_Only return Boolean is
  --++

  begin
    return (Ada.Characters.Handling.To_Upper(EPS_List(1).all) = "LOCALHOST");

  end Localhost_Only;

END EDIT***

gstack 进程输出：

Thread 1 (Thread 0x407059a0 (LWP 13610)):
#0  0x40000424 in __kernel_vsyscall ()
#1  0x00b2b2fc in pthread_cond_wait@@GLIBC_2.3.2 () from /lib/libpthread.so.0
#2  0x0b53dd9e in system__tasking__stages__vulnerable_complete_master ()
#3  0x0b53e242 in system__tasking__stages__finalize_global_tasks ()
#4  0x0b5845d3 in __gnat_last_chance_handler ()
#5  0x0b545c50 in ada__exceptions__exception_traces__unhandled_exception_terminateXn ()
#6  0x0b5459de in ada__exceptions__exception_propagation__propagate_exceptionXn ()
#7  0x0b5465c5 in __gnat_raise_nodefer_with_msg ()
#8  0x0b5469ed in ada__exceptions__raise_with_location_and_msg ()
#9  0x0b5469b8 in __gnat_raise_storage_error_msg ()
#10 0x0b546f98 in __gnat_rcheck_31 ()
#11 0x0b5363de in system__interrupt_management__notify_exception ()
#12 <signal handler called>
#13 0x0bcef590 in memcmp@@GLIBC_2.0 ()
#14 0x084a83c9 in common_network_configuration__localhost_only ()

相关类型/函数：

type Number_Of_Items_Type is range 0 .. 250;

subtype Index_Type is Number_Of_Items_Type 
     range Number_Of_Items_Type'First + 1 .. Number_Of_Items_Type'Last;

type String_List_Type is array (Index_Type range <>) 
     of String_Access.String_P_Type;

package Bstring is new Ada.Strings.Bounded.Generic_Bounded_Length 
                            (Max => Line_Length_Type'last);

   function Values(Name : Bstring.Bounded_String) return String_List_Type is
   --++
   -- ABSTRACT
   --   Return a list of pointers to strings. The strings are all the values
   --   associated with the specified name. All values are recursively 
   --   evaluated so that each entry in the returned list is a primitive
   --   name (i.e. integer, ip_address, or unix_workstation).
   --
   --   If a circular definition is detected, an empty list is returned. 
   --
   -- LOCAL DATA
     -- Number of items in list
     Count    : Number_Of_Items_Type := 0;

     -- List of pointers to strings containing the primitive values
     Out_List : String_List_Type (1 .. Index_Type'Last);

     -- The Index of the item being evaluated
     Item     : Config_Index_Type := 0;

     -- A safety net, to detect and prevent unlimited recursion, such as 
     -- will happen in the case of a circular definition.
     Depth    : Number_Of_Items_Type := 0;

     procedure Find_Values (Name : in Bstring.Bounded_String) is
     --++ 
     -- ABSTRACT
     --   This procedure recursively calls itself until it makes it all 
     --   The way through the Config_Array without finding a match on the
     --   specified Name. The index of the last name for which a match was
     --   found is used to get the value associated with that Name. This 
     --   is a primitive value associated with the name and is added to the
     --   Out_List. 
     --
     --   Depth is used to count the recursion depth, when it reaches a 
     --   maximum, no more recursive calls are made, preventing an endless
     --   loop in the case of a direct or indirect circular definition.
     begin 
       Depth := Depth + 1;
       for Index in 1 .. Config_Count loop
         if  Name_Match(Bstring.To_String(Name),Index) 
         and Count < Number_Of_Items_Type'last 
         and Depth < Number_Of_Items_Type'last then
           Item := Index;
           Find_Values (Config_Array(Index).Value);
         end if;
       end loop;
       if Item /= 0 then
         if Count < Number_Of_Items_Type'last then
           Count := Count + 1;
           Out_List(Count) := Config_Array(Item).Val_Ptr;
         end if;
         Item := 0;
       end if;
     end Find_Values;

   begin -- Values
     Find_Values(Name);
     if Depth < Number_Of_Items_Type'last then
       return Out_List(1..Count);
     else 
       return Null_String_List;
     end if;
   end Values;

Answer 1

我绝对的第一个猜测是 EPS_List(1) 没有指向有效的内存位置。你检查了吗？

据我所知，该数组最终是从名为 Config_Array 的指针加载的。因此，如果加载发生时未初始化，或者如果这些指针引用的内存在调用 Localhost_Only 之前被释放，则会出现这种性质的错误。

这段代码足够复杂，我需要进入 Localhost_Only 并检查这一点。使用调试器查看这些指针，或者在 return 语句之前添加调试代码以显示它们的值。

此外，您的 Localhost_Only 例程接受一个不受约束的数组，然后假设它包含元素 1。如果没有，我相信您应该得到类似 Constraint_Error 或 Range_Error 的信息，但如果您关闭编译器的范围检查，Storage_Error 可能会出现结果相反。无论哪种方式，您都应该以某种方式防范这种可能性。类似于 if EPS_List'length > 0则返回False； end if;...

---

在您的编辑中，我对为什么移动声明可以防止崩溃的最佳猜测是，当初始化发生时，它会发生变化。现在它发生得更早了。同样，将其恢复到崩溃状态并尝试使用调试器和/或调试打印语句找出到底发生了什么可能会有所回报。

Answer 2

解决办法是升级RHEL6上的编译器。