gcc/testsuite/gnat.dg/opt68.adb

   1 -- { dg-do compile }
   2 -- { dg-options "-O3" }
   3
   4 with Ada.Unchecked_Deallocation;
   5
   6 package body Opt68 is
   7
   8   procedure Free
   9     is new Ada.Unchecked_Deallocation (Queue_Element, A_Queue_Element);
  10
  11   procedure Copy (dest : in out Queue; src : Queue) is
  12     d, s, pd, ps, t : A_Queue_Element;
  13   begin
  14     if src.sz /= 0 then
  15       d := dest.front;
  16       s := src.front;
  17       while d /= null and s /= null loop
  18         d.value := s.value;
  19         pd := d;
  20         ps := s;
  21         d  := d.next;
  22         s  := s.next;
  23       end loop;
  24       if src.sz = dest.sz then
  25         return;
  26       elsif s = null then
  27         while d /= null loop
  28           t := d.next;
  29           Free (d);
  30           d := t;
  31         end loop;
  32         dest.back      := pd;
  33         dest.back.next := null;
  34       else
  35         if pd = null then
  36           dest.front       := new Queue_Element;
  37           dest.front.value := s.value;
  38           s                := s.next;
  39           pd               := dest.front;
  40         end if;
  41         while s /= null loop
  42           pd.next       := new Queue_Element;
  43           pd.next.value := s.value;
  44           pd            := pd.next;
  45           s             := s.next;
  46         end loop;
  47         dest.back := pd;
  48       end if;
  49       dest.sz := src.sz;
  50     end if;
  51   end;
  52
  53 end Opt68;