Ada issue with STORAGE_ERROR

Question

I have this small function that is causing me headaches on RHEL6, and I am not sure what is going on... and it is a pain to debug. When I run this I am getting a STORAGE_ERROR, so I did a gstack to see where the program is hanging (See below). It looks like an issue with memcmp although I'm not sure where/how it is being called.. Any ideas for a workaround?

When I change this function to just return 'true' it seems to work fine (STORAGE_ERROR goes away), so I figure that the problem is with some logic in this part: (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;

BEGIN EDIT***

Another way that workst was doing this (Moving it out of function scope... Why does this work?):

   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 output on the process:

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 ()

Relevant types/function:

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

My absolute first guess here would be that EPS_List(1) isn't pointing to a valid memory location. Did you check that?

As near as I can tell, that array ultimately gets loaded from pointers out of something named Config_Array. So if that isn't initialized when the loading happens, or if the memory those pointers reference gets freed before Localhost_Only gets called, you would have errors of this nature.

This code is complex enough that I'd go into Localhost_Only and check on this. Either use the debugger to look at those pointers, or add debug code before your return statement to display their values.

Also, your Localhost_Only routine takes in an unconstrained array, then assumes it contains element 1. If it doesn't, I believe you should get something like Constraint_Error or Range_Error, but if you turned off your compiler's range checking, Storage_Error could result instead. Either way, you should protect against that eventuality somehow. Something like if EPS_List'length > 0 then return False; end if;...

---

On your edit, my best guess for why moving the declaration prevents the crash is that this changes when that initialization happens. It now happens much earlier. Again, it might pay off to put it back into the crashing state and try to figure out with the debugger and/or debug print statements what exactly is happening.

Answer 2

The solution was to upgrade the compiler on RHEL6..