unmaintained/alien/marshall/syntax/syntax-tests.factor

   1 ! Copyright (C) 2009 Jeremy Hughes.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.inline.syntax alien.marshall.syntax destructors
   4 tools.test accessors kernel ;
   5 IN: alien.marshall.syntax.tests
   6
   7 DELETE-C-LIBRARY: test
   8 C-LIBRARY: test
   9
  10 C-INCLUDE: <stdlib.h>
  11 C-INCLUDE: <string.h>
  12 C-INCLUDE: <stdbool.h>
  13
  14 CM-FUNCTION: void outarg1 ( int* a )
  15     *a += 2;
  16 ;
  17
  18 CM-FUNCTION: unsigned-long* outarg2 ( unsigned-long a, unsigned-long* b )
  19     unsigned long* x = malloc(sizeof(unsigned long*));
  20     *b = 10 + *b;
  21     *x = a + *b;
  22     return x;
  23 ;
  24
  25 CM-STRUCTURE: wedge
  26     { "double" "degrees" } ;
  27
  28 CM-STRUCTURE: sundial
  29     { "double" "radius" }
  30     { "wedge" "wedge" } ;
  31
  32 CM-FUNCTION: double hours ( sundial* d )
  33     return d->wedge.degrees / 30;
  34 ;
  35
  36 CM-FUNCTION: void change_time ( double hours, sundial* d )
  37     d->wedge.degrees = hours * 30;
  38 ;
  39
  40 CM-FUNCTION: bool c_not ( bool p )
  41     return !p;
  42 ;
  43
  44 CM-FUNCTION: char* upcase ( const-char* s )
  45     int len = strlen(s);
  46     char* t = malloc(sizeof(char) * len);
  47     int i;
  48     for (i = 0; i < len; i++)
  49         t[i] = toupper(s[i]);
  50     t[i] = '\0';
  51     return t;
  52 ;
  53
  54 ;C-LIBRARY
  55
  56 { 1 1 } [ outarg1 ] must-infer-as
  57 [ 3 ] [ 1 outarg1 ] unit-test
  58 [ 3 ] [ t outarg1 ] unit-test
  59 [ 2 ] [ f outarg1 ] unit-test
  60
  61 { 2 2 } [ outarg2 ] must-infer-as
  62 [ 18 15 ] [ 3 5 outarg2 ] unit-test
  63
  64 { 1 1 } [ hours ] must-infer-as
  65 [ 5.0 ] [ <sundial> <wedge> 150 >>degrees >>wedge hours ] unit-test
  66
  67 { 2 0 } [ change_time ] must-infer-as
  68 [ 150.0 ] [ 5 <sundial> <wedge> 11 >>degrees >>wedge [ change_time ] keep wedge>> degrees>> ] unit-test
  69
  70 { 1 1 } [ c_not ] must-infer-as
  71 [ f ] [ "x" c_not ] unit-test
  72 [ f ] [ 0 c_not ] unit-test
  73
  74 { 1 1 } [ upcase ] must-infer-as
  75 [ "ABC" ] [ "abc" upcase ] unit-test