Re: Problem where a function is invoked once but called twice (when invocation is within an allocator).

[Dan <dan@irvine.com>]

Here's a version of the test case that fails in Ada83 mode.


package Media is

   type Color is
      record
         val : integer;
      end record;

   type Image is array (integer range <>) of Color;
   pragma pack (Image);         -- matters!

   function next_Frame return Image;

   type Image_ptr is access Media.Image;

end Media;

with Text_IO; use Text_IO;
package body Media is
   counter: integer := 0;

   function next_Frame return Image is
   begin
      put_line("in next_frame");
      counter := counter + 1;
      return (1 .. 5-counter => (val => 10));
   end next_Frame;

end Media;



with Media;
with text_io;
procedure Test2 is

   Case_1 : Media.Image(1..4) :=     Media.Image' (Media.next_Frame);
   Case_2 : Media.Image_ptr   := new Media.Image' (Media.next_Frame);

   procedure put(x: Media.Image) is
   j: integer;
   begin
     for i in x'range loop
        text_io.put_line(x(i).val'img);
        j := 1/x(i).val;        -- ensure val is not zero
     end loop;
     text_io.new_line;
   end;

begin
   put(case_1);
   put(case_2.all);
end;