------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 199x by International Computer Science Institute            --
-- This file is part of the GNU Sather package. It is free software; you may --
-- redistribute  and/or modify it under the terms of the  GNU General Public --
-- License (GPL)  as  published  by the  Free  Software  Foundation;  either --
-- version 2 of the license, or (at your option) any later version.          --
-- This  program  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/GPL for more details.        --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------

-- function of this class will bever be inlined, and the compiler
-- believes that they have no side effects at all
class OPT_DEBUG is
   attr order:INT;
   attr err_string:STR;
   shared error_flag:BOOL;
   start_order(s:STR)  is err_string:=s;order:=0; end;
   in_order(i:INT) is
      if order+1/=i then
         #OUT+"Oops, out of order call for \""+err_string+"\"\n";
	 #OUT+"I expected call "+(order+1)+" but got "+i+"\n";
	 error_flag:=true;
      end;
      order:=i;
   end;

   in_order(i:INT):INT is
      in_order(i);return 0;
   end;

   in_order(i:INT,a:ARRAY{INT}):ARRAY{INT} is
      in_order(i);return a;
   end;

   test(s:STR,i:INT,j:INT) is
      if i/=j then
         #OUT+"wrong condition "+s+" for \""+err_string+"\"\n";
	 #OUT+"I expected "+j+", but got "+i+"\n";
	 error_flag:=true;
      end;
   end;
   test(s:STR,i:BOOL,j:BOOL) is
      if i/=j then
         #OUT+"wrong condition "+s+" for \""+err_string+"\"\n";
	 #OUT+"I expected "+j+", but got "+i+"\n";
	 error_flag:=true;
      end;
   end;

   create:OPT_DEBUG is
      r::=new;
      return r;
   end;
end;

-- test array operation
class TEST_ARR is
   attr aar:ARRAY{INT};
   create:SAME is
      r::=new;
      r.aar:=#(100);
      return r;
   end;
   test is
      o:OPT_DEBUG:=#;
      lar:ARRAY{INT}:=#(100);
      aar:=#(100);

      i::=400;
      o.start_order("array.ind! [1]");
      o.in_order(1);
      j::=0;
      loop
	 o.in_order(j+6);
         i:=i+o.in_order(2,lar).ind!+o.in_order(3,lar).ind!+
	      o.in_order(4,aar).ind!+o.in_order(5,lar).ind!;
	 j:=j+1;
      end;
      o.in_order(107); -- note that in_order(j+4) is executed 101 times, as the first
      		       -- iter comes only after it.
      o.test("i",i,20200);
      o.test("j",j,100);

      i:=400;
      o.start_order("array.ind! [2]");
      o.in_order(1);
      j:=0;
      loop
	 if j>=0 then 
	    o.in_order(j+6);
	    i:=i+o.in_order(2,lar).ind!+o.in_order(3,lar).ind!+
		 o.in_order(4,aar).ind!+o.in_order(5,lar).ind!;
	    j:=j+1;
         end;
      end;
      o.in_order(107); -- note that in_order(j+4) is executed 101 times, as the first
      		       -- iter comes only after it.
      o.test("i",i,20200);
      o.test("j",j,100);

      o.start_order("array.set! [1]");
      o.in_order(1);
      j:=0;
      loop
	 o.in_order(j+6);
         o.in_order(3,aar).set!(o.in_order(2,aar).ind!*2+o.in_order(7+j));
         o.in_order(5,lar).set!(o.in_order(4,lar).ind!*4+o.in_order(8+j));
	 j:=j+3;
      end;
      o.in_order(307);
      o.test("aar",aar[1]=2 and aar[0]=0 and aar[50]=100 and aar[99]=198,true);
      o.test("lar",lar[1]=4 and lar[0]=0 and lar[50]=200 and lar[99]=396,true);
      o.test("j",j,300);

      i:=600;
      o.start_order("array.elt! [1]");
      o.in_order(1);
      j:=0;
      loop
         o.in_order(j+4);
         i:=i+o.in_order(2,aar).elt!+o.in_order(3,lar).elt!+o.in_order(j+5);
	 j:=j+2;
      end;
      o.in_order(205);
      o.test("i",i,30300);
      o.test("j",j,200);
   end;
end;

class TEST_INLINE is
   attr x:INT;
   create:SAME is return new; end;

   does_raise(i:INT) is
      if i<0 then raise "i should never be smaller than zero"; end;
   end;

   no_void_access(o:OPT_DEBUG,i:INT):INT is
      x:=o.in_order(i);
      return x;
   end;

   inline_iter!(once i:INT,once ord:INT,h:INT,once o:OPT_DEBUG):INT is
      l::=o.in_order(ord); -- only assignment statements are moved to
      			   -- to the beginning of a loop
      k::=1;
      loop
         while!(k<=i);
	 yield k;
	 k:=k+1;
      end;
   end;

   test is
      o:OPT_DEBUG:=#;

      o.start_order("inline iter with optimization");
      o.in_order(1);
      j::=0;
      i::=0;
      loop
	 o.in_order(j+4);
         i:=i+inline_iter!(o.in_order(2)+100,3,o.in_order(j+5),o);
	 j:=j+2;
      end;
      o.test("i",i,5050);
      o.test("j",j,200);

      o.start_order("inline iter without optimization");
      o.in_order(1);
      j:=0;
      i:=0;
      loop
	 does_raise(j);
	 if j=0 then 
	    o.in_order(j+2);
	    j:=j-1;
	 else 
	    o.in_order(j+4);
	 end;
         i:=i+inline_iter!(no_void_access(o,3)+100,5,o.in_order(j+5),o);
	 if j<0 then j:=0; end;
	 j:=j+2;
      end;
      o.test("i",i,5050);
      o.test("j",j,200);
   end;
end;

class MAIN is
   main is
      testarr::=#TEST_ARR;
      testarr.test;
      testinline::=#TEST_INLINE;
      testinline.test;
      if OPT_DEBUG::error_flag then 
         #OUT+"the optimizer did not pass all tests!\n";
         UNIX::exit(-1); 
      else
         #OUT+"the optimizer passed all tests!\n";
      end;
   end;
end;

-- vim:sw=3:nosmartindent
