------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 1995 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>  <--------------

class TEST_OUT is
   include TEST;
   
   main is
      class_name("TEST_OUT");
      a: ABS_OUT1 := #;
      abs_a: $ABS_OUT := a;
      b: $STR;
      test("call1",a.foo(10,out b),"INT");
      test("call2",b.str,"10");
      c: $STR;
      test("call3",abs_a.foo(10,out c),"INT");
      test("call4",c.str,"10");
      test("call5",abs_a.foo_iter_test("i", 3), "i1i2i3");

      -- test bound routs with out args
      f1:ROUT{out $STR}:STR;
      f1 := bind(abs_a.foo(10,out _));
      d:$STR;
      test("call6", f1.call(out d), "INT");
      
      -- test out simple value args
      e:ABS_VAL_REF_TEST := #;
      val_a:VAL_A;
      abs_val_a:$ABS;
      e.foo(out val_a);
      test("call7", val_a.data.str, "21");

      -- test value out args used in a dispatched call
      e.foo(out abs_val_a);
      test("call8", abs_val_a.data.str, "21");

      -- test value out arg used in a bound routine
      f2:ROUT{out VAL_A}:=bind(e.foo(out _));
      f2.call(out val_a);
      test("call9", val_a.data.str, "21");
      
      -- test value out args used in an interator
      f:STR;
      e.value_iter_test(9, out f);
      test("call10", f, "123456789");
      
      -- test value out arg passed to a routine taking value out
      v1:VAL_A;
      e.abs_value_test(out v1);
      test("call11", v1.data.str, "10");
      -- same for bound routines
      f3:ROUT{out VAL_A} := bind(e.abs_value_test(out _));
      f3.call(out v1);
      test("call12", v1.data.str, "10");      
      -- same for iterators
      e.value_value_iter_test(6, out f);
      test("call13", f, "123456");
      
      -- test abstract out passed into a routine taking value out args
      g:$ABS;
      e.abs_value_test(out g);
      test("call14", g.data.str, "10");
      -- the same for bound routines
      f4:ROUT{out VAL_A}:=bind(e.abs_value_test(out _));
      h:$ABS;
      f4.call(out h);
      test("call15", h.data.str, "10");
      -- the same for iterators
      e.abs_value_iter_test(5, out f);
      test("call16", f, "12345");
      
      -- test abstract out passed into a routine taking a reference out arg
      e.abs_ref_test(out g);
      test("call17", g.data.str, "21");
      -- do the same for bound routines
      f5:ROUT{out REF_A}:=bind(e.abs_ref_test(out _));
      f5.call(out h);
      test("call18", h.data.str, "21");
      -- the same for iterators
      e.abs_ref_iter_test(9, out f);
      test("call19", f, "123456789");
      
      -- test ref out arg passed into a routine taking a ref out argument
      i:REF_A;
      e.abs_ref_test(out i);
      test("call20", i.data.str, "21");
      -- the same for bound routines
      f6:ROUT{out REF_A} := bind(e.abs_ref_test(out _));
      f6.call(out i);
      test("call21", i.data.str, "21");
      -- the same for iterators
      e.ref_ref_iter_test(5, out f);
      test("call22", f, "12345");      
      
      -- pass an element of a reference array of value elements as out arg
      arr:ARRAY{INT};
      arr:=#(5);
      s1:STR;
      loop
	 ind::=0.upto!(4);
	 ARRAY_TEST::set_elm(out arr[ind], ind);
	 s1 := s1 + arr[ind].str;
      end;
      test("call23", s1, "01234");
      -- the same for dispatched call
      arr_test:ARRAY_TEST:=#;
      abs_arr_test:$ARRAY_TEST;
      abs_arr_test := arr_test;
      s1:="";
      loop
	 ind::=0.upto!(4);
	 abs_arr_test.set_elm(out arr[ind], -ind);
	 s1 := s1 + arr[ind].str;
      end;
      test("call24", s1, "0-1-2-3-4");      
      -- the same for an iterator
      s1:="";
      loop
	 ind::=0.upto!(4);
	 arr_test.my_set!(out arr[ind], ind);
      end;
      loop s1 := s1+arr.elt!.str; end;
      test("call25", s1, "01234");
      -- the same for a dispatched iterator
      s1:="";
      abs_arr_test := arr_test;
      loop
	 ind::=0.upto!(4);
	 abs_arr_test.my_set!(out arr[ind], -ind);
      end;
      loop s1 := s1+arr.elt!.str; end;
      test("call26", s1, "0-1-2-3-4");      
      -- the same for a bound routine
      f7:ROUT{out INT}:=bind(arr_test.set_elm(out _, 21));
      k:INT := 3;
      f7.call(out arr[1]);
      test("call27", arr[1].str, "21");
      
      -- pass a value attribute as out argument
      attr_test::=#ATTR_TEST;
      attr_test.set_attr(out attr_test.the_attr, 21);
      test("call28", attr_test.the_attr, "21");
      -- the same for a dispatched call
      disp_attr_test : $ATTR_TEST;
      disp_attr_test := attr_test;
      disp_attr_test.set_attr(out disp_attr_test.the_attr, 99);
      test("call29", disp_attr_test.the_attr.str, "99");
      -- the same for an iterator
      loop
	 val::=100;
	 attr_test.set_attr!(out attr_test.the_attr, val);
	 val:=val+1;
      end;
      test("call30", disp_attr_test.the_attr.str, "100");
      -- the same for a dispatched iterator
      loop
	 val::=1;
	 disp_attr_test.set_attr!(out attr_test.the_attr, val);
	 val := val + 1;
      end;
      test("call31", attr_test.the_attr.str, "1");    
      -- the same for a dispatched iterator and a dispatched argument
      loop
	 val::=21;
	 disp_attr_test.set_attr!(out disp_attr_test.the_attr, 21);
	 val := val + 1;
      end;      
      test("call32", attr_test.the_attr.str, "21");          
      -- the same for a bound routine
      f8:ROUT{out INT}:=bind(disp_attr_test.set_attr(out _, 11));
      f8.call(out attr_test.the_attr);
      test("call33", attr_test.the_attr.str, "11");
      -- the same for a bound routine and a dispatched argument
      f9:ROUT{out INT}:=bind(disp_attr_test.set_attr(out _, 12));      
      f9.call(out disp_attr_test.the_attr);
      test("call34", disp_attr_test.the_attr.str, "12");      

      -- test simple value inout args
      l:INT:=2;
      VALUE_INOUT_TEST::foo(inout l);
      test("call35", l, "4");
      -- the same for a dispatched call
      val_inout_test ::= #VALUE_INOUT_TEST;
      disp_inout_test:$ABS_INOUT_TEST;
      disp_inout_test := val_inout_test;
      disp_inout_test.foo(inout l);
      test("call36", l, "8");
      -- the same for a reference object
      m::=#REF_A(2);
      REF_INOUT_TEST::foo(inout m);
      test("call37", m.data.str, "4");
      -- the same for a dispatched call
      disp_ref_inout_test:$ABS_REF_INOUT_TEST;
      ref_inout_test::=#REF_INOUT_TEST;
      disp_ref_inout_test := ref_inout_test;
      disp_ref_inout_test.foo(inout m);
      test("call38", m.data.str, "8");      

      -- simple value inout for bound routines
      f10:ROUT{inout INT} := bind(val_inout_test.foo(inout _));
      f10.call(inout l);
      test("call39", l, "16");            

      -- simple ref inout arg  for bound routines
      f11:ROUT{inout REF_A} := bind(ref_inout_test.foo(inout _));
      f11.call(inout m);
      test("call40", m.data.str, "16");  
      
      -- inout array elm
      arr[2] := 5;
      val_inout_test.foo(inout arr[2]);
      test("call41", arr[2], "10");  
      -- the same for a dispatched call
      disp_inout_test.foo(inout arr[2]);
      test("call42", arr[2], "20");       
      -- inout reference array elm
      ref_arr:ARRAY{REF_A}:=#(5);
      loop
	 ind::=0.upto!(ref_arr.size-1);
	 ref_arr[ind] := #REF_A(ind);
      end;
      ref_inout_test.foo(inout ref_arr[3]);
      test("call43", ref_arr[3].data, "6");  
      -- the same for a dispatched call
      disp_ref_inout_test.foo(inout ref_arr[3]);
      test("call44", ref_arr[3].data, "12");        
      -- the same for a bound routine call
      f11.call(inout ref_arr[3]);
      test("call45", ref_arr[3].data, "24");              
      
      finish;
   end;
   
end; -- class TEST_OUT
-------------------------------------------------------------------
abstract class $ABS_OUT is
   
   foo(b: $OB,out bar: $STR): STR;
   foo2(b: $OB,inout bar: $STR): STR;
   foo_iter_test(a:$STR, n:INT):STR;   
end;

-------------------------------------------------------------------
class ABS_OUT1 < $ABS_OUT is
   
   create: SAME is return new end;
   foo(b: $OB,out bar: $STR): STR is
      typecase b
      when INT then bar := b; return("INT"); 
      when STR then bar := b; return "STR";
      else 
      end;
      return "FALSE"
   end;
   
   foo_iter_test(a:$STR, n:INT):STR is
      res:STR;
      s:$STR;
      loop
	 foo_iter!(a, out s, n); 
	 res := res + s;
      end;
      return res;
   end;
   
   foo_iter!(b:$STR, out bar: $STR,once  n:INT) is
      loop
	 i::=1.upto!(n);
	 bar := b.str+i.str;
	 yield;
      end;
   end;
   
   foo2(b: $OB,inout bar: $STR): STR is
      typecase b
      when INT then bar := b; return("INT"); 
      when STR then bar := b; return "STR";
      else 
      end;
      return "FALSE"
   end;
end;
-------------------------------------------------------------------

abstract class $ABS is
   data: INT;
   data(init:INT):$ABS;
end;
   
immutable class VAL_A < $ABS is
   attr data: INT;
end;

class REF_A < $ABS is
   attr data: INT;
   
   create(i:INT):SAME is
      res ::= new;
      res.data := i;
      return res;
   end;

   data(init:INT):$ABS is
      if void(self) then
	 return #REF_A(init);
      else
	 data := init;
	 return self;
      end;
   end;
   
end;

class ABS_VAL_REF_TEST is
   attr v:VAL_A;
   
   foo(out a:VAL_A) is
      a:=v.data(21);
   end;
   
   create:SAME is
      res ::= new;
      return res;
   end;
   
   value_iter_test(n:INT, out res:STR) is
      loop
	 v1:VAL_A;
	 value_iter!(n, out v1);
	 res := res + v1.data.str;
      end;
   end;
   
   abs_value_iter_test(n:INT, out res:STR) is
      loop
	 av:$ABS;
	 value_iter!(n, out av);
	 res := res + av.data.str;
      end;
   end;
   
   value_iter!(once n:INT, out v1:VAL_A) is
      loop
	 i::=1.upto!(n);
	 v1 := v.data(i);
	 yield;
      end;
   end;
 

   value_value_iter_test(n:INT, out res:STR) is
      loop
	 av:VAL_A;
	 value_iter!(n, out av);
	 res := res + av.data.str;
      end;
   end;
   
   abs_value_test(out a:VAL_A) is
      a := a.data(10);
   end;
   
   abs_ref_test(out a:REF_A) is
      a:=#(21);
   end;
   
   abs_ref_iter_test(n:INT, out res:STR) is
      loop
	 av:$ABS;
	 ref_iter!(n, out av);
	 res := res + av.data.str;
      end;
   end;
   
   ref_ref_iter_test(n:INT, out res:STR) is
      loop
	 v:REF_A;
	 ref_iter!(n, out v);
	 res := res + v.data.str;
      end;
   end;
   
   ref_iter!(once n:INT, out v1:REF_A) is
      loop
	 i::=1.upto!(n);
	 v1 := #(i);
	 yield;
      end;
   end;
end;
-------------------------------------------------------------------
abstract class $ARRAY_TEST is
   set_elm(out elm:INT, val:INT);
   my_set!(out elm:INT, val:INT);
end;

class ARRAY_TEST < $ARRAY_TEST is
   set_elm(out elm:INT, val:INT) is
      elm := val;
   end;

   my_set!(out elm:INT, val:INT) is
      loop
	 elm := val;
	 yield;
      end;
   end;
   
   create: SAME is
      res ::= new;
      return res;
   end;
end;
-------------------------------------------------------------------

abstract class $ATTR_TEST is
   set_attr(out the_attr:INT,val:INT);
   set_attr!(out the_attr:INT, val:INT);
   the_attr: INT;
   the_attr(val:INT);
end;

class ATTR_TEST < $ATTR_TEST is
   attr the_attr:INT;
   
   set_attr(out elm:INT, val:INT) is
      elm := val;
   end;
   
   set_attr!(out elm:INT, val:INT) is
      elm := val;
      yield;
   end;
   
   create:SAME is
      res::=new;
      res.the_attr := -1;
      return res;
   end;
end;


abstract class $ABS_INOUT_TEST is
   foo(inout a:INT);
end;

class VALUE_INOUT_TEST < $ABS_INOUT_TEST is
   foo(inout a:INT) is
      a := a*2;
   end;
   
   create:SAME is
      return new;
   end;
end;

abstract class $ABS_REF_INOUT_TEST is
   foo(inout a:REF_A);
end;

class REF_INOUT_TEST < $ABS_REF_INOUT_TEST is
   foo(inout a:REF_A) is
      a:=#REF_A(a.data*2);
   end;
   
   create:SAME is
      return new;
   end;
end;
   
