GNAT problem: Discriminated tagged records as return types

GNAT problem: Discriminated tagged records as return types

[Jacob Sparre Andersen]

I have a problem with GNAT! (now again :-)

In the following procedure do I call a function, whose return type is a 
class. When I just use the returned object everything works as I expect it 
to do, _but_ if I try to put the returned object into a variable, it doesn't 
allways work.

The problem arises when the type of the returned object is a discriminated 
record, and the discriminant is larger than it's minimal value.

In more specific terms: The program writes outside the allocated memory, when 
it has read a tag with some arguments (Example: '<A Href="../">').

The procedure body is appended to this message. The collected sources can be 
picked up from 
http://www.nbi.dk/~sparre/Blandet_landhandel/GNAT_problems/mark_new.all

Thanks in advance,

   Jacob Sparre Andersen

PS: I'll remember to mail a copy of this message to report@gnat.com.
------------------------------------------------------------------------------
-- Mark_New (body)
--
-- This procedure is used to convert New tags to Img tags.

-- Written 1996.03.19 by Jacob Sparre Andersen
--   Based on Test_SGML_Stream (1996.03.17)

with Ada.Text_IO;                 use Ada.Text_IO;
with Character_Source;            use Character_Source;
with SGML;
with SGML.Abstract_Element;       use SGML.Abstract_Element;
with SGML.Character;              use SGML.Character;
with SGML.Stream;                 use SGML.Stream;
with SGML.Stream.Constructors;    use SGML.Stream.Constructors;
with SGML.Abbreviations;          use SGML.Abbreviations;
with SGML.Tag;                    use SGML.Tag;
with HTML;

procedure Mark_New is

   use SGML.Identifier_Strings;

   Example_File_Name : constant String := "Example.text";

   Stream : SGML.Stream.Instance := Load_Latin_1_File(Example_File_Name,
                                                      HTML.Abbreviations);

begin -- Test_SGML_Stream
   Put_Line("<!-- Document has been processed by Mark_New -->");

   while not End_Of_Stream(Stream) loop

      Put_Line(Current_Error, 
               "-- Reading new element...");

      Read_Next_Element(Stream);

      Put_Line(Current_Error, 
               "-- Read new element: " &
                 Image(Get_Current_Element(From => Stream)));

      Put_Line(Current_Error, 
               "-- End of stream = " & Boolean'Image(End_Of_Stream(Stream)));

   Put_Element:
      declare

         Element : SGML.Abstract_Element.Class := 
           Get_Current_Element(From => Stream);

      begin -- Put_Element

         Put_Line(Current_Error, 
                  "-- End of stream = " &
                    Boolean'Image(End_Of_Stream(Stream)));

         Put_Line(Current_Error, 
                  "-- Copied element: '" & Image(Element) & "'");

         if Element in SGML.Tag.Class then

            Put_Line(Current_Error, 
                     "-- Element is a tag.");

            if Name(SGML.Tag.Class(Element)) = "New" then
               Put("<Img Src=""New.gif"" Alt=""[New!]"">");
            else
               Put(Element);
            end if;

            Put_Line(Current_Error, 
                     "-- Tag written to Current_Output.");

         else
            Put(Element);
         end if;
      end Put_Element;
   end loop;

   New_Line;
   Put_Line("<!-- Document has been processed by Mark_New -->");
end Mark_New;
------------------------------------------------------------------------------