Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW

["andrew.carroll@okstate.edu" <andrew.carroll@okstate.edu>]

I've made some further changes to the program.  I made the following
adjustments to the attribute_types.

type attribute is abstract tagged null record;

and I added the following functions/procedures

function getName (item: attribute) return string is abstract;
procedure setName(item: in out attribute; value: string) is abstract;
function getDomain(item: attribute) return string is abstract;
procedure setDomain(item: in out attribute; value: string) is
abstract;
function getByteEnd(item: attribute) return integer is abstract;
function isprimarykey(item: attribute) return boolean is abstract;
procedure makeprimarykey(item: in out attribute) is abstract;



This way there is not mistaking that it is dispatched.  The reason I
did this is because I tried debugging it to find out what the domain
value of an attribute was in the debug code inside the loadtable
procedure.  I would try to print the .domain field of
schemainfo.attributes(x) and it would kill the debugger.

Since I made the changes the error message is now "raised
PROGRAM_ERROR : EXCEPTION_ACCESS_VIOLATION".  Which if I'm not
mistaken means dangling pointer and that matches to errors I now get
in gdb.


Here is the new attribute_types.adb/ads files





with util, Ada.Calendar, ada.streams.stream_io;

use util, Ada.Calendar, ada.streams.stream_io;

package attribute_types is

    -----------------------------------
    --    Forwarding Declarations    --
    -----------------------------------
    type attribute is abstract tagged;
    type booleanattribute is tagged;
    type integerattribute is tagged;
    type stringattribute is tagged;
    type dateattribute is tagged;

    --------------------------------------
    --    Attribute Type Declarations    --
    --------------------------------------
    type attribute is abstract tagged null record;
--          name         : String (1 .. max_attributename_length) :=
--             (1 .. max_attributename_length => ' ');
--          domain       : String (1 .. max_typename_length) := (1 ..
max_typename_length => ' ');
--          isprimarykey : Boolean                                :=
False;
--          byte_start   : Integer                                :=
0;
--          byte_end     : Integer                                :=
0;
--    end record;

    --------------------------------------
    --    Basic Pointer Declarations    --
    --------------------------------------
    type attribute_ptr is access attribute'class;
--    type attribute_array is array (Integer range <>) of access
attribute'class;
    type attribute_array is array (Integer range <>) of attribute_ptr;
    type attribute_array_ptr is access all attribute_array;

    procedure to_disc (fout: file_type; item: in out attribute) is
abstract;
    function from_disc(fout: file_type; item: attribute) return
attribute'class is abstract;
    function getName (item: attribute) return string is abstract;
    procedure setName(item: in out attribute; value: string) is
abstract;
    function getDomain(item: attribute) return string is abstract;
    procedure setDomain(item: in out attribute; value: string) is
abstract;
    function getByteEnd(item: attribute) return integer is abstract;
    function isprimarykey(item: attribute) return boolean is
abstract;
    procedure makeprimarykey(item: in out attribute) is abstract;

    -----------------------------------
    --    Extended Attribute Types   --
    -----------------------------------
    type booleanattribute is new attribute with record
        name         : String (1 .. max_attributename_length) :=
           (1 .. max_attributename_length => ' ');
        domain       : String (1 .. max_typename_length) := (1 ..
max_typename_length => ' ');
        isprimarykey : Boolean                                :=
False;
        byte_start   : Integer                                := 0;
        byte_end     : Integer                                := 0;
        value : Boolean := False;
    end record;
    type booleanattribute_ptr is access all booleanattribute'class;
    procedure to_disc (fout: file_type; item: in out
booleanattribute);
    function from_disc(fin: file_type; item: booleanattribute) return
attribute'class;
    function getName (item: booleanattribute) return string;
    procedure setName(item: in out booleanattribute; value:
string);
    function getDomain(item: booleanattribute) return string;
    procedure setDomain(item: in out booleanattribute; value:
string);
    function getByteEnd(item: booleanattribute) return integer;
    function isprimarykey(item: booleanattribute) return boolean;
    procedure makeprimarykey(item: in out booleanattribute);

    type integerattribute is new attribute with record
        name         : String (1 .. max_attributename_length) :=
           (1 .. max_attributename_length => ' ');
        domain       : String (1 .. max_typename_length) := (1 ..
max_typename_length => ' ');
        isprimarykey : Boolean                                :=
False;
        byte_start   : Integer                                := 0;
        byte_end     : Integer                                := 0;
        value : Integer := 0;
    end record;
    type integerattribute_ptr is access all integerattribute'class;
    procedure to_disc (fout: file_type; item: in out
integerattribute);
    function from_disc(fin: file_type; item: integerattribute) return
attribute'class;
    function getName (item: integerattribute) return string;
    procedure setName(item: in out integerattribute; value:
string);
    function getDomain(item: integerattribute) return string;
    procedure setDomain(item: in out integerattribute; value:
string);
    function getByteEnd(item: integerattribute) return
integer;
    function isprimarykey(item: integerattribute) return boolean;
    procedure makeprimarykey(item: in out integerattribute);

    type stringattribute is new attribute with record
        name         : String (1 .. max_attributename_length) :=
           (1 .. max_attributename_length => ' ');
        domain       : String (1 .. max_typename_length) := (1 ..
max_typename_length => ' ');
        isprimarykey : Boolean                                :=
False;
        byte_start   : Integer                                := 0;
        byte_end     : Integer                                := 0;
        value : String (1 .. max_stringlength) := (1 ..
max_stringlength => ' ');
    end record;
    type stringattribute_ptr is access all stringattribute'class;
    procedure to_disc (fout: file_type; item: in out stringattribute);
    function from_disc(fin: file_type; item: stringattribute) return
attribute'class;
    function getName (item: stringattribute) return string;
    procedure setName(item: in out stringattribute; value:
string);
    function getDomain(item: stringattribute) return string;
    procedure setDomain(item: in out stringattribute; value:
string);
    function getByteEnd(item: stringattribute) return
integer;
    function isprimarykey(item: stringattribute) return boolean;
    procedure makeprimarykey(item: in out stringattribute);

    type dateattribute is new attribute with record
        name         : String (1 .. max_attributename_length) :=
           (1 .. max_attributename_length => ' ');
        domain       : String (1 .. max_typename_length) := (1 ..
max_typename_length => ' ');
        isprimarykey : Boolean                                :=
False;
        byte_start   : Integer                                := 0;
        byte_end     : Integer                                := 0;
        year  : Year_Number  := 1901;
        month : Month_Number := 1;
        day   : Day_Number   := 1;
        value : Time         := Time_Of (1901, 1, 1);
    end record;
    type dateattribute_ptr is access all dateattribute'class;
    procedure to_disc (fout: file_type; item: in out dateattribute);
    function from_disc(fin: file_type; item: dateattribute) return
attribute'class;
    function getName (item: dateattribute) return string;
    procedure setName(item: in out dateattribute; value:
string);
    function getDomain(item: dateattribute) return string;
    procedure setDomain(item: in out dateattribute; value:
string);
    function getByteEnd(item: dateattribute) return integer;
    function isprimarykey(item: dateattribute) return boolean;
    procedure makeprimarykey(item: in out dateattribute);

end attribute_types;


with ada.text_io, util, ada.calendar;
use util, ada.calendar;

package body attribute_types is

    -------------------------------
    --  BOOLEAN ATTRIBUTE STUFF  --
    -------------------------------
    procedure to_disc (fout: file_type; item: in out booleanattribute)
is
    begin
        item.byte_start := Integer'val (Index (fout));
        item.byte_end := Integer'val (Index (fout)) +
(booleanattribute'size / 8) - 7;
--        booleanattribute'class'output(Stream(fout), item);
        booleanattribute'output(Stream(fout), item);
    end to_disc;

    function from_disc(fin: file_type; item: booleanattribute) return
attribute'class is
        temp : access attribute'class;
    begin
      temp := new booleanattribute;
--      temp.all := booleanattribute'class'input (Stream (fin));
      temp.all := booleanattribute'input (Stream (fin));
      return temp.all;
    end from_disc;

    function getName (item: booleanattribute) return string is
    begin
    	return item.name;
    end getName;

    procedure setName(item: in out booleanattribute; value: string) is
    begin
        item.name := value(value'first - 1 +
item.name'first..item.name'last);
    end setName;

    function getDomain(item: booleanattribute) return string is
    begin
    	return item.domain;
    end getDomain;

    procedure setDomain(item: in out booleanattribute; value: string)
is
    begin
        item.domain := value(value'first - 1 +
item.domain'first..item.domain'last);
    end setdomain;

    function getByteEnd(item: booleanattribute) return integer is
    begin
        return item.byte_end;
    end getByteEnd;

    function isprimarykey(item: booleanattribute) return boolean is
    begin
        return item.isprimarykey;
    end isprimarykey;

    procedure makeprimarykey(item: in out booleanattribute) is
    begin
        item.isprimarykey := true;
    end makeprimarykey;

    -------------------------------
    --  INTEGER ATTRIBUTE STUFF  --
    -------------------------------
    procedure to_disc (fout: file_type; item: in out integerattribute)
is
    begin
        item.byte_start := Integer'val (Index (fout));
        item.byte_end := Integer'val (Index (fout)) +
(integerattribute'size / 8) - 7;
--        integerattribute'class'output(Stream(fout), item);
        integerattribute'output(Stream(fout), item);
    end to_disc;

    function from_disc(fin: file_type; item: integerattribute) return
attribute'class is
    	temp : access attribute'class;
    begin
  	temp := new integerattribute;
--	temp.all := integerattribute'class'input (Stream (fin));
	temp.all := integerattribute'input (Stream (fin));
	return temp.all;
    end from_disc;

    function getName (item: integerattribute) return string is
    begin
        return item.name;
    end getName;

    procedure setName(item: in out integerattribute; value: string) is
    begin
        item.name := value(value'first - 1 +
item.name'first..item.name'last);
    end setName;

    function getDomain(item: integerattribute) return string is
    begin
    	return item.domain;
    end getDomain;

    procedure setDomain(item: in out integerattribute; value: string)
is
    begin
        item.domain := value(value'first - 1 +
item.domain'first..item.domain'last);
    end setdomain;

    function getByteEnd(item: integerattribute) return integer is
    begin
        return item.byte_end;
    end getByteEnd;

    function isprimarykey(item: integerattribute) return boolean is
    begin
        return item.isprimarykey;
    end isprimarykey;

    procedure makeprimarykey(item: in out integerattribute) is
    begin
        item.isprimarykey := true;
    end makeprimarykey;


    ------------------------------
    --  STRING ATTRIBUTE STUFF  --
    ------------------------------
    procedure to_disc (fout: file_type; item: in out stringattribute)
is
    begin
        item.byte_start := Integer'val (Index (fout));
        item.byte_end := Integer'val (Index (fout)) +
(stringattribute'size / 8) - 7;
--        stringattribute'class'output(Stream(fout), item);
        stringattribute'output(Stream(fout), item);
    end to_disc;

    function from_disc(fin: file_type; item: stringattribute) return
attribute'class is
    	temp: access attribute'class;
    begin
  	temp := new stringattribute;
--	temp.all := stringattribute'class'input (Stream (fin));
	temp.all := stringattribute'input (Stream (fin));
	return temp.all;
    end from_disc;

    function getName (item: stringattribute) return string is
    begin
        return item.name;
    end getName;

    procedure setName(item: in out stringattribute; value: string) is
    begin
        item.name := value(value'first - 1 +
item.name'first..item.name'last);
    end setName;

    function getDomain(item: stringattribute) return string is
    begin
    	return item.domain;
    end getDomain;

    procedure setDomain(item: in out stringattribute; value: string)
is
    begin
        item.domain := value(value'first - 1 +
item.domain'first..item.domain'last);
    end setdomain;

    function getByteEnd(item: stringattribute) return integer is
    begin
        return item.byte_end;
    end getByteEnd;

    function isprimarykey(item: stringattribute) return boolean is
    begin
        return item.isprimarykey;
    end isprimarykey;

    procedure makeprimarykey(item: in out stringattribute) is
    begin
        item.isprimarykey := true;
    end makeprimarykey;


    ----------------------------
    --  DATE ATTRIBUTE STUFF  --
    ----------------------------
    procedure to_disc (fout: file_type; item: in out dateattribute) is
    begin
        item.byte_start := Integer'val (Index (fout));
        item.byte_end := Integer'val (Index (fout)) +
(dateattribute'size / 8) - 11;
--        dateattribute'class'output(Stream(fout), item);
        dateattribute'output(Stream(fout), item);
    end to_disc;

    function from_disc(fin: file_type; item: dateattribute) return
attribute'class is
    	temp: access attribute'class;
    begin
    	temp := new dateattribute;
--	temp.all := dateattribute'class'input (Stream (fin));
	temp.all := dateattribute'input (Stream (fin));
	return temp.all;
    end from_disc;

    function getName (item: dateattribute) return string is
    begin
        return item.name;
    end getName;

    procedure setName(item: in out dateattribute; value: string) is
    begin
        item.name := value(value'first - 1 +
item.name'first..item.name'last);
    end setName;

    function getDomain(item: dateattribute) return string is
    begin
    	return item.domain;
    end getDomain;

    procedure setDomain(item: in out dateattribute; value: string) is
    begin
        item.domain := value(value'first - 1 +
item.domain'first..item.domain'last);
    end setdomain;

    function getByteEnd(item: dateattribute) return integer is
    begin
        return item.byte_end;
    end getByteEnd;

    function isprimarykey(item: dateattribute) return boolean is
    begin
        return item.isprimarykey;
    end isprimarykey;

    procedure makeprimarykey(item: in out dateattribute) is
    begin
        item.isprimarykey := true;
    end makeprimarykey;

begin
    null;
end attribute_types;