------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 199x by International Computer Science Institute            --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  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/LGPL 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_LOCKS is
   include R_TEST;

   syncing is
      number:INT := 4;
      r:ARRAY{INT}:=#(number);

      parloop
         i::=0.upto!(number-1);
      do @i%clusters
	 my_number:INT := i;
	 loop j::=1.upto!(10);
	    r[my_number]:=j;
	    sync;
	    test(TIMING::str+" sync "+j+" on "+THREAD_ID::me,r.str,"{"+j+","+j+","+j+","+j+"}");
	    sync;
	 end;
      end;
   end;
         
    
   disjunctive(m1,m2,m3,m4:$LOCK) is
      r:ARRAY2{INT}:=#(4,4);
      number:INT := 1;
      par
         loop
	    i::=0.upto!(3);
	    fork@i%clusters;
	    c1,c2,c3,c4:INT;
	    
	       id_str:FSTR:= #(THREAD_ID::me.str);
	       loop
	          j ::= 1.upto!(number);
		  #OUT + "thread: " +id_str + "  ["+j+"]\n";;
		  lock
		     when m1 then 
			#OUT + "c1 before : "+c1+"\n";
			c1:=c1+1;
			#OUT + "c1: "+c1+"\n";
			SYS::defer;
			sync;
		     when m2 then 
			#OUT + "c2 before : "+c2+"\n";
			c2:=c2+1;
			#OUT + "c2: "+c2+"\n";
			SYS::defer;
			sync;
		     when m3 then 
			#OUT + "c3 before : "+c3+"\n";
			c3:=c3+1;
			#OUT + "c3: "+c3+"\n";
			SYS::defer;
			sync;
		     when m4 then 
			#OUT + "c4 before : "+c4+"\n";
			c4:=c4+1;
			#OUT + "c4: "+c4+"\n";
			SYS::defer;
			sync;
		     else
			test("disjunctive lock","reached unreachable code","should never reach this test");
			sync;
		  end;
	          SYS::defer;
	          sync;
	       end;
	       test("c1+c2+c3+c4 ["+i+"]",c1+c2+c3+c4,number);
--	       test("c1>10 ["+i+"]",(c1>10).str+" "+c1,true.str+" "+c1);
--	       test("c2>10 ["+i+"]",(c2>10).str+" "+c2,true.str+" "+c2);
--	       test("c3>10 ["+i+"]",(c3>10).str+" "+c3,true.str+" "+c3);
--	       test("c4>10 ["+i+"]",(c4>10).str+" "+c4,true.str+" "+c4);
	       r[i,0]:=c1;
	       r[i,1]:=c2;
	       r[i,2]:=c3;
	       r[i,3]:=c4;
	    end;
	 end;
      end;
      -- loop i::=0.upto!(3);
	 -- #OUT+THREAD_ID::me+": "+r[i,0]+" "+r[i,1]+" "+r[i,2]+" "+r[i,3]+"\n";
      -- end;
      test("c1+c1+c1+c1",r[0,0]+r[1,0]+r[2,0]+r[3,0],number);
      test("c2+c2+c2+c2",r[0,1]+r[1,1]+r[2,1]+r[3,1],number);
      test("c3+c3+c3+c3",r[0,2]+r[1,2]+r[2,2]+r[3,2],number);
      test("c4+c4+c4+c4",r[0,3]+r[1,3]+r[2,3]+r[3,3],number);
      c1::=0;
      c2::=0;
      c3::=0;
      c4::=0;
      loop
--	 100.times!;  -- hangs on ALPHA
	 1.times!;
	 lock
	    when m1 then c1:=c1+1;
	    when m2 then c2:=c2+1;
	    when m3 then c3:=c3+1;
	    when m4 then c4:=c4+1;
	    else
	       test("disjunctive lock","reached unreachable code","should never reach this test");
	 end;
      end;
--      test("fairness c1>10",(c1>10).str+" "+c1,true.str+" "+c1);
--      test("fairness c2>10",(c2>10).str+" "+c2,true.str+" "+c2);
--      test("fairness c3>10",(c3>10).str+" "+c3,true.str+" "+c3);
--      test("fairness c4>10",(c4>10).str+" "+c4,true.str+" "+c4);
      test("no locks lost",c1+c2+c3+c4,number);
   end;

   tunlock(l:$LOCK) is
      lock when l then
         test("unlocking works",true,true);
      else
         test("unlocking works",false,true);
      end;
      SYS::defer;	
   end;
   unlocking(l:$LOCK) is
      a::=#ATTACH;
      lock when l then
	 unlock l;
         a:-tunlock(l);
	 TIMING::sleep(1);
	 lock when a.no_threads then end;
      end;
   end;

   main is
      class_name("SYNC");
      syncing;
      finish;
      class_name("LOCKS");
      -- This may deadlock
      -- disjunctive(#MUTEX,#ATTACH,#GATE,#GATE{INT});
      unlocking(#MUTEX);
      finish;
   end;
end; -- class GATE_TEST

-------------------------------------------------------------------
-- vim:sw=3:nosmartindent





