test-c.sa

 
---------------------------> Sather 1.1 source file <-----------------------
---
-- test-fortran.sa: Test external fortran interface
-- Copyright (C) 1996, International Computer Science Institute
--
-- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
-- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
-- LICENSE contained in the file: Sather/Doc/License of the
-- Sather distribution. The license is also available from ICSI,
-- 1947 Center St., Suite 600, Berkeley CA 94704, USA.

-- Author: Boris Vaysman
-- Date:   7/29/96


class TEST_C 
class TEST_C is
   -- Test external C interface
   include TEST;
   
   main is
      class_name("TEST_C");
      
      -- Test C_INT type;
      i,j,k:C_INT;
      i:=#(1); j:=#(2);
      k := i+j;
      test("C_INT::plus", k.str, "3");
      k := i-j;
      test("C_INT::minus", k.str, "-1");      
      k:=i*j;
      test("C_INT::times", k.str, "2");            
      k := #C_INT(6) / #C_INT(2);
      test("C_INT::div", k.str, "3");     
      i:=#(2); j:=#(3);
      k := TEST_C_INT::TEST_C_INT_plus(#(2),#(3));
      test("TEST_C_INT::TEST_C_INT_plus", k.str, "5");           
      k := TEST_C_INT::TEST_C_INT_times(i,j);
      test("TEST_C_INT::TEST_C_INT_times", k.str, "6");                 
      TEST_C_INT::TEST_C_INT_swap(inout i, inout j);
      test("TEST_C_INT::TEST_C_INT_swap", i.str+" "+j.str, "3 2");
      
      
      --------------- TEST C_CHAR_PTR -----------------
      char_ptr:C_CHAR_PTR;
      chars:ARRAY{CHAR} := #(6);
      char_ptr:=#(chars);
      TEST_C_CHAR_PTR::set_array_chars(char_ptr, #(chars.size));
      str:STR;
      loop
	 str := str+chars.elt!;
      end;
      test("TEST_C_CHAR_PTR::set_array_chars", str, "sather");
      
      --------------- TEST C_INT_PTR -----------------      
      ints:ARRAY{INT} := #(5);
      TEST_C_INT_PTR::set_array_ints(#C_INT_PTR(ints), #(ints.size));
      str:=#;
      loop
	 str := str+ints.elt!;
      end;
      test("TEST_C_INT_PTR::set_array_ints", str, "01234"); 
      
      --------------- TEST CALLBACKS FROM C -----------------            
      k:=TEST_C_CALLBACKS::test_callback1(#(1),#(2));
      test("TEST_C_CALLBACKS::test_callback1", k.str, "3");
      
      kf:C_FLOAT;
      kf:=TEST_C_CALLBACKS::test_callback2(#(1.0),#(2.0));
      test("TEST_C_CALLBACKS::test_callback2", kf.str, "3");      
      
      i:=#(1); j:=#(2);
      TEST_C_CALLBACKS::test_callback3(inout i, inout j);
      test("TEST_C_CALLBACKS::test_callback3", i.str+" "+j.str, "2 1");
      
      --------------- TEST C STRUCTURE MAPPING --------------
      -- the layout needs to be generated by Sather
      bar:BAR;
      bar := BAR::create_bar;
      test("TEST STCRUCTS 0", bar.bar_attr_int.str+bar.bar_attr_float.str,"9999");
      
      bar.bar_attr_int := #(1);
      bar.bar_attr_float := #(1.0);
      test("TEST STRUCTS 1", bar.bar_attr_int.str+bar.bar_attr_float.str, "11");
      BAR::global_bar_float := #(100.0);
      test("TEST STRUCTS 2", BAR::global_bar_float.str, "100");
	   
      BAR::set_bar(bar, #(-1), #(-100.0));
      test("TEST STRUCTS 2", bar.bar_attr_int.str + " " + 
	   bar.bar_attr_float.str, "-1 -100");
      
      -- Layouts are provided by the included header files
      foo:FOO;
      foo := FOO::create_foo;
      foo.attribute_a := #C_INT(2);
      
      FOO::c_foo := foo;
      FOO::c_foo_int := #(2);
   end;
end;

external C class TEST_C_INT is
   TEST_C_INT_plus(a:C_INT,b:C_INT):C_INT;
   TEST_C_INT_times(a:C_INT,b:C_INT):C_INT;   
   TEST_C_INT_swap(inout a:C_INT, inout b:C_INT);
end;

external C class TEST_C_CHAR_PTR is
   set_array_chars(p:C_CHAR_PTR, length:C_INT);
end;

external C class TEST_C_INT_PTR is
   set_array_ints(p:C_INT_PTR, length:C_INT);
end;

external C class TEST_C_CALLBACKS is
   callback1(a:C_INT, b:C_INT):C_INT is
      return a+b;
   end;
   
   callback2(a:C_FLOAT, b:C_FLOAT):C_FLOAT is
      return a+b;
   end;   
   
   callback3(inout a:C_INT, inout b:C_INT) is
      tmp::=a;
      a := b;
      b:=tmp;
   end;
   
   -- C functions that call the above
   test_callback1(a:C_INT,b:C_INT):C_INT;
   test_callback2(a:C_FLOAT,b:C_FLOAT):C_FLOAT;   
   test_callback3(inout a:C_INT, inout b:C_INT);
end;

-- Test structs
-- The layout needs to be generated by Sather (both C_name and C_header
-- constant attributes are missing)
external C class BAR is
   attr bar_attr_int:C_INT;
   attr bar_attr_float:C_FLOAT;
   
   shared global_bar_float:C_FLOAT;
   create_bar:BAR;
   set_bar(bar:BAR, i:C_INT, f:C_FLOAT);
end;

external C class FOO is
   const C_name:STR := "C_FOO";
   const C_header:STR := "../foo.h";

   attr attribute_a: C_INT;
   attr attribute_b: C_FLOAT;
   attr attribute_c: C_CHAR;

   shared c_foo:FOO; 
   shared c_foo_int:C_INT; 
	 
   create_foo:FOO;
      
   print_foo is
   end;
end;