source/QtTest: updated

source/QtTest: updated

Modified:
source/QtTest/QTestEventListClass.prg

/*

  Qt4xHb - Bindings libraries for Harbour/xHarbour and Qt Framework 4

  Copyright (C) 2018 Marcos Antonio Gambeta <marcosgambeta AT outlook DOT com>

*/

/*
  DO NOT EDIT THIS FILE - the content was created using a source code generator
*/

#include "hbclass.ch"

#ifndef QT4XHB_NO_REQUESTS
#endif

CLASS QTestEventList

   DATA pointer
   DATA self_destruction INIT .F.

   METHOD new
   METHOD delete
   METHOD addDelay
   METHOD addKeyClick1
   METHOD addKeyClick2
   METHOD addKeyClick
   METHOD addKeyClicks
   METHOD addKeyPress1
   METHOD addKeyPress2
   METHOD addKeyPress
   METHOD addKeyRelease1
   METHOD addKeyRelease2
   METHOD addKeyRelease
   METHOD addMouseClick
   METHOD addMouseDClick
   METHOD addMouseMove
   METHOD addMousePress
   METHOD addMouseRelease
   METHOD clear
   METHOD simulate

   METHOD newFrom
   METHOD newFromObject
   METHOD newFromPointer
   METHOD selfDestruction
   METHOD setSelfDestruction

   DESTRUCTOR destroyObject

END CLASS

PROCEDURE destroyObject () CLASS QTestEventList
   IF ::self_destruction
      ::delete()
   ENDIF
RETURN

#pragma BEGINDUMP

#include <QTestEventList>

#include "qt4xhb_common.h"
#include "qt4xhb_macros.h"
#include "qt4xhb_utils.h"

/*
QTestEventList ()
*/
void QTestEventList_new1 ()
{
  QTestEventList * o = new QTestEventList ();
  _qt4xhb_returnNewObject( o, true );
}

/*
QTestEventList ( const QTestEventList & other )
*/
void QTestEventList_new2 ()
{
  QTestEventList * o = new QTestEventList ( *PQTESTEVENTLIST(1) );
  _qt4xhb_returnNewObject( o, true );
}

//[1]QTestEventList ()
//[2]QTestEventList ( const QTestEventList & other )

HB_FUNC_STATIC( QTESTEVENTLIST_NEW )
{
  if( ISNUMPAR(0) )
  {
    QTestEventList_new1();
  }
  else if( ISNUMPAR(1) && ISQTESTEVENTLIST(1) )
  {
    QTestEventList_new2();
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
}

HB_FUNC_STATIC( QTESTEVENTLIST_DELETE )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    delete obj;
    obj = NULL;
    PHB_ITEM self = hb_stackSelfItem();
    PHB_ITEM ptr = hb_itemPutPtr( NULL, NULL );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addDelay ( int msecs )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDDELAY )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISNUMPAR(1) && ISNUM(1) )
    {
#endif
      obj->addDelay ( PINT(1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addKeyClick ( Qt::Key qtKey, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYCLICK1 )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISBETWEEN(1,3) && ISNUM(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
#endif
      obj->addKeyClick ( (Qt::Key) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addKeyClick ( char ascii, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYCLICK2 )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISBETWEEN(1,3) && ISNUM(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
#endif
      obj->addKeyClick ( PCHAR(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

//[1]void addKeyClick ( Qt::Key qtKey, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
//[2]void addKeyClick ( char ascii, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )

HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYCLICK )
{
  if( ISBETWEEN(1,3) && ISNUM(1) && (ISNUM(2)||ISNIL(2)) && (ISNUM(3)||ISNIL(3)) )
  {
    HB_FUNC_EXEC( QTESTEVENTLIST_ADDKEYCLICK1 );
  }
  else if( ISBETWEEN(1,3) && ISCHAR(1) && (ISNUM(2)||ISNIL(2)) && (ISNUM(3)||ISNIL(3)) )
  {
    HB_FUNC_EXEC( QTESTEVENTLIST_ADDKEYCLICK2 );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
}

/*
void addKeyClicks ( const QString & keys, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYCLICKS )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISBETWEEN(1,3) && ISCHAR(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
#endif
      obj->addKeyClicks ( PQSTRING(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addKeyPress ( Qt::Key qtKey, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYPRESS1 )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISBETWEEN(1,3) && ISNUM(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
#endif
      obj->addKeyPress ( (Qt::Key) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addKeyPress ( char ascii, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYPRESS2 )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISBETWEEN(1,3) && ISNUM(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
#endif
      obj->addKeyPress ( PCHAR(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

//[1]void addKeyPress ( Qt::Key qtKey, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
//[2]void addKeyPress ( char ascii, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )

HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYPRESS )
{
  if( ISBETWEEN(1,3) && ISNUM(1) && (ISNUM(2)||ISNIL(2)) && (ISNUM(3)||ISNIL(3)) )
  {
    HB_FUNC_EXEC( QTESTEVENTLIST_ADDKEYPRESS1 );
  }
  else if( ISBETWEEN(1,3) && ISCHAR(1) && (ISNUM(2)||ISNIL(2)) && (ISNUM(3)||ISNIL(3)) )
  {
    HB_FUNC_EXEC( QTESTEVENTLIST_ADDKEYPRESS2 );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
}

/*
void addKeyRelease ( Qt::Key qtKey, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYRELEASE1 )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISBETWEEN(1,3) && ISNUM(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
#endif
      obj->addKeyRelease ( (Qt::Key) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addKeyRelease ( char ascii, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYRELEASE2 )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISBETWEEN(1,3) && ISNUM(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
#endif
      obj->addKeyRelease ( PCHAR(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

//[1]void addKeyRelease ( Qt::Key qtKey, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
//[2]void addKeyRelease ( char ascii, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )

HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYRELEASE )
{
  if( ISBETWEEN(1,3) && ISNUM(1) && (ISNUM(2)||ISNIL(2)) && (ISNUM(3)||ISNIL(3)) )
  {
    HB_FUNC_EXEC( QTESTEVENTLIST_ADDKEYRELEASE1 );
  }
  else if( ISBETWEEN(1,3) && ISCHAR(1) && (ISNUM(2)||ISNIL(2)) && (ISNUM(3)||ISNIL(3)) )
  {
    HB_FUNC_EXEC( QTESTEVENTLIST_ADDKEYRELEASE2 );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
}

/*
void addMouseClick ( Qt::MouseButton button, Qt::KeyboardModifiers modifiers = 0, QPoint pos = QPoint(), int delay = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDMOUSECLICK )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISBETWEEN(1,4) && ISNUM(1) && ISOPTNUM(2) && (ISQPOINT(3)||ISNIL(3)) && ISOPTNUM(4) )
    {
#endif
      obj->addMouseClick ( (Qt::MouseButton) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) 0 : (Qt::KeyboardModifiers) hb_parni(2), ISNIL(3)? QPoint() : *(QPoint *) _qt4xhb_itemGetPtr(3), OPINT(4,-1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addMouseDClick ( Qt::MouseButton button, Qt::KeyboardModifiers modifiers = 0, QPoint pos = QPoint(), int delay = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDMOUSEDCLICK )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISBETWEEN(1,4) && ISNUM(1) && ISOPTNUM(2) && (ISQPOINT(3)||ISNIL(3)) && ISOPTNUM(4) )
    {
#endif
      obj->addMouseDClick ( (Qt::MouseButton) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) 0 : (Qt::KeyboardModifiers) hb_parni(2), ISNIL(3)? QPoint() : *(QPoint *) _qt4xhb_itemGetPtr(3), OPINT(4,-1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addMouseMove ( QPoint pos = QPoint(), int delay = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDMOUSEMOVE )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISBETWEEN(0,2) && (ISQPOINT(1)||ISNIL(1)) && ISOPTNUM(2) )
    {
#endif
      obj->addMouseMove ( ISNIL(1)? QPoint() : *(QPoint *) _qt4xhb_itemGetPtr(1), OPINT(2,-1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addMousePress ( Qt::MouseButton button, Qt::KeyboardModifiers modifiers = 0, QPoint pos = QPoint(), int delay = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDMOUSEPRESS )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISBETWEEN(1,4) && ISNUM(1) && ISOPTNUM(2) && (ISQPOINT(3)||ISNIL(3)) && ISOPTNUM(4) )
    {
#endif
      obj->addMousePress ( (Qt::MouseButton) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) 0 : (Qt::KeyboardModifiers) hb_parni(2), ISNIL(3)? QPoint() : *(QPoint *) _qt4xhb_itemGetPtr(3), OPINT(4,-1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addMouseRelease ( Qt::MouseButton button, Qt::KeyboardModifiers modifiers = 0, QPoint pos = QPoint(), int delay = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDMOUSERELEASE )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISBETWEEN(1,4) && ISNUM(1) && ISOPTNUM(2) && (ISQPOINT(3)||ISNIL(3)) && ISOPTNUM(4) )
    {
#endif
      obj->addMouseRelease ( (Qt::MouseButton) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) 0 : (Qt::KeyboardModifiers) hb_parni(2), ISNIL(3)? QPoint() : *(QPoint *) _qt4xhb_itemGetPtr(3), OPINT(4,-1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void clear ()
*/
HB_FUNC_STATIC( QTESTEVENTLIST_CLEAR )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISNUMPAR(0) )
    {
#endif
      obj->clear ();
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void simulate ( QWidget * w )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_SIMULATE )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    if( ISNUMPAR(1) && ISQWIDGET(1) )
    {
#endif
      obj->simulate ( PQWIDGET(1) );
#ifndef QT4XHB_DONT_CHECK_PARAMETERS
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
#endif
  }

  hb_itemReturn( hb_stackSelfItem() );
}

HB_FUNC_STATIC( QTESTEVENTLIST_NEWFROM )
{
  PHB_ITEM self = hb_stackSelfItem();

  if( hb_pcount() == 1 && ISOBJECT(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_objSendMsg( hb_param(1, HB_IT_OBJECT ), "POINTER", 0 ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  else if( hb_pcount() == 1 && ISPOINTER(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_param(1, HB_IT_POINTER ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }

  hb_itemReturn( self );
}

HB_FUNC_STATIC( QTESTEVENTLIST_NEWFROMOBJECT )
{
  HB_FUNC_EXEC( QTESTEVENTLIST_NEWFROM );
}

HB_FUNC_STATIC( QTESTEVENTLIST_NEWFROMPOINTER )
{
  HB_FUNC_EXEC( QTESTEVENTLIST_NEWFROM );
}

HB_FUNC_STATIC( QTESTEVENTLIST_SELFDESTRUCTION )
{
  hb_retl( (bool) hb_itemGetL( hb_objSendMsg( hb_stackSelfItem(), "SELF_DESTRUCTION", 0 ) ) );
}

HB_FUNC_STATIC( QTESTEVENTLIST_SETSELFDESTRUCTION )
{
  PHB_ITEM self = hb_stackSelfItem();

  if( hb_pcount() == 1 && ISLOG(1) )
  {
    PHB_ITEM des = hb_itemPutL( NULL, hb_parl(1) );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }

  hb_itemReturn( self );
}

#pragma ENDDUMP

/*

  Qt4xHb - Bindings libraries for Harbour/xHarbour and Qt Framework 4

  Copyright (C) 2018 Marcos Antonio Gambeta <marcosgambeta AT outlook DOT com>

*/

/*
  DO NOT EDIT THIS FILE - the content was created using a source code generator
*/

#include "hbclass.ch"

#ifndef QT4XHB_NO_REQUESTS
#endif

CLASS QTestEventList

   DATA pointer
   DATA self_destruction INIT .F.

   METHOD new
   METHOD delete
   METHOD addDelay
   METHOD addKeyClick1
   METHOD addKeyClick2
   METHOD addKeyClick
   METHOD addKeyClicks
   METHOD addKeyPress1
   METHOD addKeyPress2
   METHOD addKeyPress
   METHOD addKeyRelease1
   METHOD addKeyRelease2
   METHOD addKeyRelease
   METHOD addMouseClick
   METHOD addMouseDClick
   METHOD addMouseMove
   METHOD addMousePress
   METHOD addMouseRelease
   METHOD clear
   METHOD simulate

   METHOD newFrom
   METHOD newFromObject
   METHOD newFromPointer
   METHOD selfDestruction
   METHOD setSelfDestruction

   DESTRUCTOR destroyObject

END CLASS

PROCEDURE destroyObject () CLASS QTestEventList
   IF ::self_destruction
      ::delete()
   ENDIF
RETURN

#pragma BEGINDUMP

#include <QTestEventList>

#include "qt4xhb_common.h"
#include "qt4xhb_macros.h"
#include "qt4xhb_utils.h"

/*
QTestEventList ()
*/
void QTestEventList_new1 ()
{
  QTestEventList * o = new QTestEventList ();
  _qt4xhb_returnNewObject( o, true );
}

/*
QTestEventList ( const QTestEventList & other )
*/
void QTestEventList_new2 ()
{
  QTestEventList * o = new QTestEventList ( *PQTESTEVENTLIST(1) );
  _qt4xhb_returnNewObject( o, true );
}

//[1]QTestEventList ()
//[2]QTestEventList ( const QTestEventList & other )

HB_FUNC_STATIC( QTESTEVENTLIST_NEW )
{
  if( ISNUMPAR(0) )
  {
    QTestEventList_new1();
  }
  else if( ISNUMPAR(1) && ISQTESTEVENTLIST(1) )
  {
    QTestEventList_new2();
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
}

HB_FUNC_STATIC( QTESTEVENTLIST_DELETE )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    delete obj;
    obj = NULL;
    PHB_ITEM self = hb_stackSelfItem();
    PHB_ITEM ptr = hb_itemPutPtr( NULL, NULL );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addDelay ( int msecs )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDDELAY )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISNUMPAR(1) && ISNUM(1) )
    {
      obj->addDelay ( PINT(1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addKeyClick ( Qt::Key qtKey, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYCLICK1 )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISBETWEEN(1,3) && ISNUM(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
      obj->addKeyClick ( (Qt::Key) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addKeyClick ( char ascii, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYCLICK2 )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISBETWEEN(1,3) && ISNUM(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
      obj->addKeyClick ( PCHAR(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

//[1]void addKeyClick ( Qt::Key qtKey, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
//[2]void addKeyClick ( char ascii, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )

HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYCLICK )
{
  if( ISBETWEEN(1,3) && ISNUM(1) && (ISNUM(2)||ISNIL(2)) && (ISNUM(3)||ISNIL(3)) )
  {
    HB_FUNC_EXEC( QTESTEVENTLIST_ADDKEYCLICK1 );
  }
  else if( ISBETWEEN(1,3) && ISCHAR(1) && (ISNUM(2)||ISNIL(2)) && (ISNUM(3)||ISNIL(3)) )
  {
    HB_FUNC_EXEC( QTESTEVENTLIST_ADDKEYCLICK2 );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
}

/*
void addKeyClicks ( const QString & keys, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYCLICKS )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISBETWEEN(1,3) && ISCHAR(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
      obj->addKeyClicks ( PQSTRING(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addKeyPress ( Qt::Key qtKey, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYPRESS1 )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISBETWEEN(1,3) && ISNUM(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
      obj->addKeyPress ( (Qt::Key) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addKeyPress ( char ascii, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYPRESS2 )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISBETWEEN(1,3) && ISNUM(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
      obj->addKeyPress ( PCHAR(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

//[1]void addKeyPress ( Qt::Key qtKey, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
//[2]void addKeyPress ( char ascii, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )

HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYPRESS )
{
  if( ISBETWEEN(1,3) && ISNUM(1) && (ISNUM(2)||ISNIL(2)) && (ISNUM(3)||ISNIL(3)) )
  {
    HB_FUNC_EXEC( QTESTEVENTLIST_ADDKEYPRESS1 );
  }
  else if( ISBETWEEN(1,3) && ISCHAR(1) && (ISNUM(2)||ISNIL(2)) && (ISNUM(3)||ISNIL(3)) )
  {
    HB_FUNC_EXEC( QTESTEVENTLIST_ADDKEYPRESS2 );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
}

/*
void addKeyRelease ( Qt::Key qtKey, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYRELEASE1 )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISBETWEEN(1,3) && ISNUM(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
      obj->addKeyRelease ( (Qt::Key) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addKeyRelease ( char ascii, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYRELEASE2 )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISBETWEEN(1,3) && ISNUM(1) && ISOPTNUM(2) && ISOPTNUM(3) )
    {
      obj->addKeyRelease ( PCHAR(1), ISNIL(2)? (Qt::KeyboardModifiers) Qt::NoModifier : (Qt::KeyboardModifiers) hb_parni(2), OPINT(3,-1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

//[1]void addKeyRelease ( Qt::Key qtKey, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )
//[2]void addKeyRelease ( char ascii, Qt::KeyboardModifiers modifiers = Qt::NoModifier, int msecs = -1 )

HB_FUNC_STATIC( QTESTEVENTLIST_ADDKEYRELEASE )
{
  if( ISBETWEEN(1,3) && ISNUM(1) && (ISNUM(2)||ISNIL(2)) && (ISNUM(3)||ISNIL(3)) )
  {
    HB_FUNC_EXEC( QTESTEVENTLIST_ADDKEYRELEASE1 );
  }
  else if( ISBETWEEN(1,3) && ISCHAR(1) && (ISNUM(2)||ISNIL(2)) && (ISNUM(3)||ISNIL(3)) )
  {
    HB_FUNC_EXEC( QTESTEVENTLIST_ADDKEYRELEASE2 );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
}

/*
void addMouseClick ( Qt::MouseButton button, Qt::KeyboardModifiers modifiers = 0, QPoint pos = QPoint(), int delay = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDMOUSECLICK )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISBETWEEN(1,4) && ISNUM(1) && ISOPTNUM(2) && (ISQPOINT(3)||ISNIL(3)) && ISOPTNUM(4) )
    {
      obj->addMouseClick ( (Qt::MouseButton) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) 0 : (Qt::KeyboardModifiers) hb_parni(2), ISNIL(3)? QPoint() : *(QPoint *) _qt4xhb_itemGetPtr(3), OPINT(4,-1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addMouseDClick ( Qt::MouseButton button, Qt::KeyboardModifiers modifiers = 0, QPoint pos = QPoint(), int delay = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDMOUSEDCLICK )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISBETWEEN(1,4) && ISNUM(1) && ISOPTNUM(2) && (ISQPOINT(3)||ISNIL(3)) && ISOPTNUM(4) )
    {
      obj->addMouseDClick ( (Qt::MouseButton) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) 0 : (Qt::KeyboardModifiers) hb_parni(2), ISNIL(3)? QPoint() : *(QPoint *) _qt4xhb_itemGetPtr(3), OPINT(4,-1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addMouseMove ( QPoint pos = QPoint(), int delay = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDMOUSEMOVE )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISBETWEEN(0,2) && (ISQPOINT(1)||ISNIL(1)) && ISOPTNUM(2) )
    {
      obj->addMouseMove ( ISNIL(1)? QPoint() : *(QPoint *) _qt4xhb_itemGetPtr(1), OPINT(2,-1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addMousePress ( Qt::MouseButton button, Qt::KeyboardModifiers modifiers = 0, QPoint pos = QPoint(), int delay = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDMOUSEPRESS )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISBETWEEN(1,4) && ISNUM(1) && ISOPTNUM(2) && (ISQPOINT(3)||ISNIL(3)) && ISOPTNUM(4) )
    {
      obj->addMousePress ( (Qt::MouseButton) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) 0 : (Qt::KeyboardModifiers) hb_parni(2), ISNIL(3)? QPoint() : *(QPoint *) _qt4xhb_itemGetPtr(3), OPINT(4,-1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void addMouseRelease ( Qt::MouseButton button, Qt::KeyboardModifiers modifiers = 0, QPoint pos = QPoint(), int delay = -1 )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_ADDMOUSERELEASE )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISBETWEEN(1,4) && ISNUM(1) && ISOPTNUM(2) && (ISQPOINT(3)||ISNIL(3)) && ISOPTNUM(4) )
    {
      obj->addMouseRelease ( (Qt::MouseButton) hb_parni(1), ISNIL(2)? (Qt::KeyboardModifiers) 0 : (Qt::KeyboardModifiers) hb_parni(2), ISNIL(3)? QPoint() : *(QPoint *) _qt4xhb_itemGetPtr(3), OPINT(4,-1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void clear ()
*/
HB_FUNC_STATIC( QTESTEVENTLIST_CLEAR )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISNUMPAR(0) )
    {
      obj->clear ();
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

/*
void simulate ( QWidget * w )
*/
HB_FUNC_STATIC( QTESTEVENTLIST_SIMULATE )
{
  QTestEventList * obj = (QTestEventList *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );

  if( obj )
  {
    if( ISNUMPAR(1) && ISQWIDGET(1) )
    {
      obj->simulate ( PQWIDGET(1) );
    }
    else
    {
      hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
    }
  }

  hb_itemReturn( hb_stackSelfItem() );
}

HB_FUNC_STATIC( QTESTEVENTLIST_NEWFROM )
{
  PHB_ITEM self = hb_stackSelfItem();

  if( hb_pcount() == 1 && ISOBJECT(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_objSendMsg( hb_param(1, HB_IT_OBJECT ), "POINTER", 0 ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  else if( hb_pcount() == 1 && ISPOINTER(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_param(1, HB_IT_POINTER ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }

  hb_itemReturn( self );
}

HB_FUNC_STATIC( QTESTEVENTLIST_NEWFROMOBJECT )
{
  HB_FUNC_EXEC( QTESTEVENTLIST_NEWFROM );
}

HB_FUNC_STATIC( QTESTEVENTLIST_NEWFROMPOINTER )
{
  HB_FUNC_EXEC( QTESTEVENTLIST_NEWFROM );
}

HB_FUNC_STATIC( QTESTEVENTLIST_SELFDESTRUCTION )
{
  hb_retl( (bool) hb_itemGetL( hb_objSendMsg( hb_stackSelfItem(), "SELF_DESTRUCTION", 0 ) ) );
}

HB_FUNC_STATIC( QTESTEVENTLIST_SETSELFDESTRUCTION )
{
  PHB_ITEM self = hb_stackSelfItem();

  if( hb_pcount() == 1 && ISLOG(1) )
  {
    PHB_ITEM des = hb_itemPutL( NULL, hb_parl(1) );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }

  hb_itemReturn( self );
}

#pragma ENDDUMP


Prevent duplicate type attributes

Prevent duplicate type attributes

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System.Collections.Generic
USING System.Diagnostics
USING Mono.Cecil
BEGIN NAMESPACE XSharpModel

   CLASS XPEPropertySymbol INHERIT XPEMemberSymbol
        PRIVATE _propdef      as PropertyDefinition
        PROPERTY Accessors    AS AccessorKind AUTO

		CONSTRUCTOR(def AS PropertyDefinition, asm AS XAssembly)
			SUPER(def:Name, Kind.Property, Modifiers.Public,  asm)
			SELF:Parent          := NULL
         SELF:DeclaringType   := def:DeclaringType:GetXSharpTypeName()
         SELF:_propdef        := def
			SELF:OriginalTypeName   := RemoveGenericParameters(def:PropertyType:FullName)
         SELF:TypeName        := SELF:Signature:DataType := def:PropertyType:GetXSharpTypeName()
         if def:GetMethod != NULL
            VAR xMethod := XPEMethodSymbol{def:GetMethod, asm}
            SELF:Attributes := xMethod:Attributes
         ELSEIF def:SetMethod != NULL
            VAR xMethod := XPEMethodSymbol{def:SetMethod, asm}
            SELF:Attributes := xMethod:Attributes
         ENDIF
         IF def:HasCustomAttributes
            SELF:_custatts       := _propdef:CustomAttributes
         ENDIF
         IF def:GetMethod != NULL
            SELF:Accessors |= AccessorKind.Get
         ENDIF
         IF def:SetMethod != NULL
            SELF:Accessors |= AccessorKind.Set
         ENDIF

    PROPERTY ClassGenText as STRING
            GET
                var result := SELF:VisibilityKeyword + " "
                result += SELF:ModifiersKeyword + " "
                result += SELF:KindKeyword + " "
                result += SELF:Prototype
                result += IIF(Accessors.HasFlag(AccessorKind.Get), " GET","")
                result += IIF(Accessors.HasFlag(AccessorKind.Set), " SET","")
                RETURN result:Replace("  ", " ")
            END GET
      END PROPERTY

      PROTECTED OVERRIDE METHOD Resolve() AS VOID
         IF ! _resolved
            IF _propdef:HasParameters
               SELF:AddParameters(_propdef:Parameters)
            ENDIF
            SUPER:Resolve()
         ENDIF
         RETURN
   END CLASS

   CLASS XPEFieldSymbol INHERIT XPEMemberSymbol
        PRIVATE _fielddef     as FieldDefinition

   STATIC METHOD ConvertAttributes (attributes AS FieldAttributes) as Modifiers
         var modifiers := Modifiers.None
         var visattributes := _AND(attributes, FieldAttributes.FieldAccessMask)
         SWITCH visattributes
         CASE FieldAttributes.Private    // 1
            modifiers :=   Modifiers.Private
         CASE FieldAttributes.Assembly  // 3
            modifiers :=   Modifiers.Internal
         CASE FieldAttributes.Family     // 4
            modifiers :=   Modifiers.Protected
         CASE FieldAttributes.FamORAssem // 5
         CASE FieldAttributes.FamANDAssem // 5
            modifiers :=   Modifiers.ProtectedInternal
         CASE FieldAttributes.Public     // 6
            modifiers :=   Modifiers.Public
         END SWITCH
         IF attributes:HasFlag(FieldAttributes.InitOnly)
            modifiers |= Modifiers.InitOnly
         ENDIF
         IF attributes:HasFlag(FieldAttributes.Literal)
            modifiers |= Modifiers.Const
         ENDIF
         IF attributes:HasFlag(FieldAttributes.Static)
            modifiers |= Modifiers.Static
         ENDIF
          RETURN modifiers

		CONSTRUCTOR(def AS FieldDefinition, asm AS XAssembly)
			SUPER(def:Name, Kind.Field, ConvertAttributes(def:Attributes),  asm)
         SELF:DeclaringType   := def:DeclaringType:GetXSharpTypeName()
         SELF:_fielddef       := def
         SELF:OriginalTypeName := RemoveGenericParameters(def:FieldType:FullName)
         SELF:TypeName        := SELF:Signature:DataType      := def:FieldType:GetXSharpTypeName()
         IF def:IsLiteral .AND. def:Constant != NULL
            SELF:Value := def:Constant:ToString()
         endif
         IF def:HasCustomAttributes
            SELF:_custatts       := def:CustomAttributes
         ENDIF

      PROTECTED OVERRIDE METHOD Resolve() AS VOID
         SUPER:Resolve()
         RETURN

     PROPERTY ClassGenText as STRING
            GET
                var result := SELF:VisibilityKeyword + " "
                result += SELF:ModifiersKeyword + " "
                IF SELF:Kind != Kind.Field
                    result += SELF:KindKeyword + " "
                ENDIF
                result += SELF:Prototype
                RETURN result:Replace("  ", " ")
            END GET
      END PROPERTY

   END CLASS

   CLASS XPEEventSymbol INHERIT XPEMemberSymbol
        PRIVATE _eventdef     as EventDefinition
        PROPERTY Accessors    AS AccessorKind AUTO

		CONSTRUCTOR(def AS EventDefinition, asm AS XAssembly)
			SUPER(def:Name, Kind.Event, Modifiers.Public,  asm)
         SELF:DeclaringType         := def:DeclaringType:GetXSharpTypeName()
         SELF:_eventdef             := def
         SELF:OriginalTypeName      := RemoveGenericParameters(def:EventType:FullName)
         SELF:TypeName              := SELF:Signature:DataType    := def:EventType:GetXSharpTypeName()
         if def:AddMethod != NULL
            VAR xMethod := XPEMethodSymbol{def:AddMethod, asm}
            SELF:Attributes := xMethod:Attributes
         elseif def:RemoveMethod != null
            VAR xMethod := XPEMethodSymbol{def:RemoveMethod, asm}
            SELF:Attributes := xMethod:Attributes
         endif
         IF def:HasCustomAttributes
            SELF:_custatts       := def:CustomAttributes
         ENDIF
         IF def:AddMethod != NULL
            SELF:Accessors |= AccessorKind.Add
         ENDIF
         IF def:RemoveMethod != NULL
            SELF:Accessors |= AccessorKind.Remove
         ENDIF

      PROTECTED OVERRIDE Method Resolve() AS VOID
         SUPER:Resolve()
         RETURN

        PROPERTY ClassGenText as STRING
            GET
                var result := SELF:VisibilityKeyword + " "
                result += SELF:ModifiersKeyword + " "
                result += SELF:KindKeyword + " "
                result += SELF:Prototype
                result += IIF(Accessors.HasFlag(AccessorKind.Add), " ADD","")
                result += IIF(Accessors.HasFlag(AccessorKind.Remove), " REMOVE","")
                RETURN result:Replace("  ", " ")
            END GET
      END PROPERTY

END CLASS

   CLASS XPEMethodSymbol  INHERIT XPEMemberSymbol
       PRIVATE _methoddef    as MethodDefinition
       PRIVATE _ccAttrib     AS Mono.Cecil.CustomAttribute

   STATIC METHOD ConvertAttributes (attributes AS MethodAttributes) as Modifiers
         var modifiers := Modifiers.None
         var visattributes := _AND(attributes, MethodAttributes.MemberAccessMask)
         SWITCH visattributes
         CASE MethodAttributes.Private    // 1
            modifiers :=  Modifiers.Private
         CASE MethodAttributes.Assembly  // 3
            modifiers :=  Modifiers.Internal
         CASE MethodAttributes.Family     // 4
            modifiers :=  Modifiers.Protected
         CASE MethodAttributes.FamORAssem // 5
         CASE MethodAttributes.FamANDAssem // 5
            modifiers :=  Modifiers.ProtectedInternal
         CASE MethodAttributes.Public     // 6
            modifiers :=  Modifiers.Public
         OTHERWISE
            modifiers := Modifiers.Public
         END SWITCH
         IF attributes:HasFlag(MethodAttributes.Abstract)
            modifiers |= Modifiers.Abstract
         ENDIF
         IF attributes:HasFlag(MethodAttributes.Final)
            modifiers |= Modifiers.Sealed
         ENDIF
         IF attributes:HasFlag(MethodAttributes.PInvokeImpl)
            modifiers |= Modifiers.External
         ENDIF
         IF attributes:HasFlag(MethodAttributes.UnmanagedExport)
            modifiers |= Modifiers.External
         ENDIF
         IF attributes:HasFlag(MethodAttributes.Virtual)
            modifiers |= Modifiers.Virtual
         ENDIF
         IF attributes:HasFlag(MethodAttributes.NewSlot)
            modifiers |= Modifiers.New
         ENDIF
         IF attributes:HasFlag(MethodAttributes.Static)
            modifiers |= Modifiers.Static
         ENDIF
         RETURN modifiers

  		 CONSTRUCTOR(def AS MethodDefinition, asm AS XAssembly)
			SUPER(def:Name, Kind.Method, ConvertAttributes(def:Attributes),  asm)
             SELF:DeclaringType   := def:DeclaringType:GetXSharpTypeName()
             IF DeclaringType:EndsWith("Functions")
                SELF:Attributes := _AND(SELF:Attributes, ~Modifiers.Static)
                SELF:Kind      := Kind.Function
             ENDIF
             SELF:OriginalTypeName   := RemoveGenericParameters(def:ReturnType:FullName)
             SELF:TypeName           := SELF:Signature:DataType := def:ReturnType:GetXSharpTypeName()
             SELF:_methoddef         := def
             IF def:HasCustomAttributes
                SELF:_custatts       := def:CustomAttributes
                FOREACH VAR attr IN def:CustomAttributes
                   SWITCH attr:AttributeType:FullName
                   CASE "System.Runtime.CompilerServices.ExtensionAttribute"
                      SELF:Signature:IsExtension := TRUE
                   CASE "XSharp.Internal.ClipperCallingConventionAttribute"
                   CASE "Vulcan.Internal.ClipperCallingConventionAttribute"
                      SELF:CallingConvention := CallingConvention.Clipper
                      _ccAttrib := attr
                   END SWITCH
                NEXT
                ENDIF
                IF def:HasGenericParameters
                    SELF:_generic := def:HasGenericParameters
                    SELF:_signature:ReadGenericParameters(def:GenericParameters)
                ENDIF
         PROTECTED OVERRIDE METHOD Resolve() AS VOID
            IF ! _resolved
               // Add Generic parameters first so have that info when processing the parameters
               IF _methoddef:HasGenericParameters
                  SELF:AddTypeParameters(_methoddef:GenericParameters)
               ENDIF
               IF _methoddef:HasParameters
                  IF SELF:CallingConvention = CallingConvention.Clipper
                     SELF:AddParameters(_ccAttrib)
                  ELSE
                     SELF:AddParameters(_methoddef:Parameters)
                  ENDIF
               ENDIF
               SUPER:Resolve()
            ENDIF

            RETURN
        PROPERTY ClassGenText as STRING
            GET
                var result := SELF:VisibilityKeyword + " "
                result += SELF:ModifiersKeyword + " "
                result += SELF:KindKeyword + " "
                var temp := SELF:GetProtoType(TRUE)
                if (SELF:Kind == Kind.Constructor)
                    temp := temp.Replace('}',')')
                    var pos := temp.IndexOf('{')
                    temp := "("+temp:Substring(pos+1)
                    result += temp
                ELSE
                    result += temp
                endif
                if self:CallingConvention == CallingConvention.Clipper
                    result += " CLIPPER"
                endif
                RETURN result:Replace("  ", " ")
            END GET
      END PROPERTY

   END CLASS

   [DebuggerDisplay("{ToString(),nq}")];
	ABSTRACT CLASS XPEMemberSymbol     INHERIT XPESymbol IMPLEMENTS IXMemberSymbol
		// Fields
        PROTECTED  _signature    AS XMemberSignature
        PROTECTED  _resolved    AS LOGIC
        PROTECTED  _generic     AS LOGIC
        PROPERTY  SubType      AS Kind AUTO
        PROPERTY  DeclaringType  AS STRING AUTO
        PROPERTY  Signature     AS XMemberSignature  GET _signature
        PROPERTY  IsGeneric    AS LOGIC GET _generic
        ABSTRACT PROPERTY  ClassGenText      AS STRING GET

		#region constructors

      CONSTRUCTOR(name AS STRING, kind AS Kind, attributes AS Modifiers, asm AS XAssembly)
			SUPER(name, kind, attributes,  asm)
         SELF:_signature      := XMemberSignature{}
         SELF:_resolved       := FALSE
         SELF:_custatts       := NULL
         SELF:_generic        := FALSE
         RETURN

      #endregion

      PROTECTED VIRTUAL METHOD Resolve() AS VOID
         IF SELF:_custatts != NULL
            FOREACH VAR custatt IN SELF:_custatts
               SWITCH custatt:AttributeType:FullName
               CASE "System.Diagnostics.DebuggerBrowsableAttribute"
                  VAR cvalue := custatt:ConstructorArguments[0]
                  IF cvalue:Type:FullName == typeof(DebuggerBrowsableState):FullName
                     VAR state := (DebuggerBrowsableState) cvalue:Value
                     IF state == DebuggerBrowsableState.Never
                        // hide these
                        SELF:Attributes := _OR(SELF:Modifiers, Modifiers.Internal)
                     ENDIF
                  ENDIF
               END SWITCH
            NEXT
         ENDIF
         SELF:_custatts := NULL
         RETURN

      PRIVATE METHOD DoResolve() AS VOID
         IF ! self:_resolved
            SELF:Resolve()
            self:_resolved := TRUE
         ENDIF

      METHOD AddParameters( oAttr as Mono.Cecil.CustomAttribute) AS VOID
         var arg    := oAttr:ConstructorArguments[0]
         var type   := arg:Type
         if type:FullName == "System.String[]"
            var args := (Mono.Cecil.CustomAttributeArgument[]) arg:Value
            FOREACH VAR argName in args
               var parRef := XPEParameterSymbol{self, argName:Value:ToString(), "USUAL"}
               parRef:ParamType := ParamType.As
               parRef:OriginalTypeName := "XSharp.__Usual"
               SELF:_signature:Parameters:Add(parRef)
            NEXT
         endif

      METHOD AddParameters (aPars as Mono.Collections.Generic.Collection<ParameterDefinition>) AS VOID
         SELF:_signature:Parameters:Clear()
         FOREACH var oPar in aPars
            var name  := oPar:Name
            var index := oPar:Index
            var type  := oPar:ParameterType:GetXSharpTypeName()
            var defValue := oPar:Constant
            var custatt := ""
            LOCAL parType as ParamType
            IF oPar:IsOut .and. oPar:IsIn
               parType := ParamType.Ref
            ELSEIF oPar:IsOut
               parType := ParamType.Out
            ELSEIF oPar:IsIn
               parType := ParamType.As
            ELSE
               parType := ParamType.As
            ENDIF
            if oPar:HasCustomAttributes
               defValue := SELF:DecodeCustomAttributes(oPar:CustomAttributes, oPar:ParameterType)
            ENDIF
            var parRef := XPEParameterSymbol{self, name, type}
            parRef:OriginalTypeName := RemoveGenericParameters(oPar:ParameterType:FullName)
            if defValue != NULL
               parRef:Value := defValue:ToString()
            ENDIF
            IF parRef:OriginalTypeName:Contains("&") .AND. parType == ParamType.As
               parType := ParamType.Ref
            ENDIF
            parRef:ParamType := parType
            IF parRef:OriginalTypeName:Contains("`")
               VAR count := SELF:TypeParameters:Count
               parRef:TypeName := parRef:OriginalTypeName:Replace("`"+count:ToString(),"")
            ENDIF
            SELF:_signature:Parameters:Add(parRef)
         NEXT
         RETURN

      METHOD DecodeCustomAttributes( attributes as Mono.Collections.Generic.Collection<CustomAttribute>, oType as TypeReference) AS STRING
         local result as STRING
         local done   as LOGIC
         FOREACH var attr in attributes
               SWITCH attr:AttributeType:FullName
               CASE "XSharp.Internal.DefaultParameterValueAttribute"
               CASE "Vulcan.Internal.DefaultParameterValueAttribute"
                  var arg1     := attr:ConstructorArguments[0]
                  IF arg1:Value is CustomAttributeArgument VAR arg
                     arg1 := arg
                  ENDIF
                  var arg2 := (Int32) attr:ConstructorArguments[1]:Value
                  switch arg2
                  case 1   // NIL
                     result := "NIL"
                  case 2   // Arg1 is date in ticks
                     var ticks := (Int64)  arg1:Value
                     var dt    := DateTime{ticks}
                     if dt == DateTime.MinValue
                         result := "NULL_DATE"
                     else
                        result    := dt:ToString("yyyy.MM.dd")
                     endif
                  case 3   // Arg1 is Symbol , when NULL then NULL_SYMBOL
                     var sym := (STRING)  arg1:Value
                     if (sym == NULL)
                        result := "NULL_SYMBOL"
                     else
                        result := "#" + sym:ToString()
                     endif
                  case 4   // Arg1 is PSZ, when NULL then NULL_SYMBOL
                     var psz1 := (STRING)  arg1:Value
                     if (psz1 == NULL)
                        result := "NULL_PSZ"
                     else
                        result := psz1:ToString()
                     endif
                  case 5   // Arg1 is NULL_PTR
                     VAR p := IntPtr{ (INT64) arg1:Value}
                     if (p == IntPtr.Zero)
                        result := "NULL_PTR"
                     ELSE
                        result := "0x"+p:ToString("X")
                     ENDIF

                  case 0   // Normal .Net value
                     var obj := arg1:Value
                     if (obj != null)
                        result := obj:ToString()
                        if arg1:Type:FullName == "System.String"
                           result := e"\""+result+e"\""
                        endif
                     else
                        switch oType:FullName
                        case "System.String"
                            return "NULL_STRING"
                        otherwise
                            return "NULL_OBJECT"
                        end switch
                     endif
                  end switch
                  done := TRUE
               END SWITCH
               if (done)
                  EXIT
               ENDIF

         NEXT
         return result

      METHOD AddTypeParameters(aPars AS Mono.Collections.Generic.Collection<GenericParameter>) AS VOID
         SELF:_signature:TypeParameters:Clear()
         FOREACH typeParam AS Mono.Cecil.GenericParameter IN aPars
            SELF:_signature:TypeParameters:Add(typeParam:Name)
         NEXT
         RETURN

//
			#region Properties
      PROPERTY Description AS STRING GET SELF:GetDescription()

	  PROPERTY FullName AS STRING GET SELF:GetFullName()

      PROPERTY IsStatic AS LOGIC GET SELF:Modifiers:HasFlag(Modifiers.Static)
      PROPERTY Location AS STRING GET SELF:Assembly:DisplayName

		PROPERTY HasParameters     AS LOGIC
         GET
            SELF:DoResolve()
            RETURN _signature:HasParameters
         END GET
      END PROPERTY

		PROPERTY ParameterCount    AS INT
         GET
            SELF:DoResolve()
            RETURN _signature:ParameterCount
         END GET
      END PROPERTY

		PROPERTY ParameterList     AS STRING
         GET
            SELF:DoResolve()
            RETURN _signature:ParameterList
         END GET
      END PROPERTY

      PROPERTY TypeParameters as IList<STRING>           GET SELF:_signature:TypeParameters:ToArray()
      PROPERTY TypeParameterList AS STRING               GET SELF:_signature:TypeParameterList
      PROPERTY TypeParameterConstraints as IList<STRING> GET SELF:_signature:TypeParameterContraints:ToArray()
      PROPERTY TypeParameterConstraintsList AS STRING    GET SELF:_signature:TypeParameterConstraintsList

      PROPERTY Parameters         AS IList<IXParameterSymbol>
         GET
            SELF:DoResolve()
            RETURN _signature:Parameters:ToArray()
         END GET
      END PROPERTY

      PROPERTY CallingConvention AS CallingConvention GET _signature:CallingConvention SET _signature:CallingConvention := @@value

      PROPERTY ParentType     AS IXTypeSymbol GET SELF:Parent ASTYPE IXTypeSymbol
		PROPERTY Prototype      AS STRING
         GET
            SELF:DoResolve()
            RETURN SELF:GetProtoType()
         END GET
      END PROPERTY

      PROPERTY IsExtension    AS LOGIC  GET _signature:IsExtension
      PROPERTY XMLSignature   AS STRING
         GET
            SELF:DoResolve()
            RETURN SELF:GetXmlSignature()
         END GET
      END PROPERTY

      METHOD ToString() AS STRING
         var result := i"{Kind} {Name}"
         if SELF:_signature != NULL .and. SELF:_signature:TypeParameters:Count > 0
            result += self:_signature:ToString()
         ENDIF
         RETURN result

     METHOD Clone() AS IXMemberSymbol
        var clone := (XPEMemberSymbol) SELF:MemberwiseClone()
        clone:_signature := SELF:_signature:Clone()
        RETURN (IXMemberSymbol) clone

     METHOD WithName(newName as STRING) AS IXMemberSymbol
        var clone := (XPEMemberSymbol) SELF:MemberwiseClone()
        clone:Name := newName
        clone:_signature := SELF:_signature:Clone()
        RETURN (IXMemberSymbol) clone

		#endregion
	END CLASS

END NAMESPACE

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System.Collections.Generic
USING System.Diagnostics
USING Mono.Cecil
BEGIN NAMESPACE XSharpModel

   CLASS XPEPropertySymbol INHERIT XPEMemberSymbol
        PRIVATE _propdef      as PropertyDefinition
        PROPERTY Accessors    AS AccessorKind AUTO

		CONSTRUCTOR(def AS PropertyDefinition, asm AS XAssembly)
			SUPER(def:Name, Kind.Property, Modifiers.Public,  asm)
			SELF:Parent          := NULL
         SELF:DeclaringType   := def:DeclaringType:GetXSharpTypeName()
         SELF:_propdef        := def
			SELF:OriginalTypeName   := RemoveGenericParameters(def:PropertyType:FullName)
         SELF:TypeName        := SELF:Signature:DataType := def:PropertyType:GetXSharpTypeName()
         if def:GetMethod != NULL
            VAR xMethod := XPEMethodSymbol{def:GetMethod, asm}
            SELF:Attributes := xMethod:Attributes
         ELSEIF def:SetMethod != NULL
            VAR xMethod := XPEMethodSymbol{def:SetMethod, asm}
            SELF:Attributes := xMethod:Attributes
         ENDIF
         IF def:HasCustomAttributes
            SELF:_custatts       := _propdef:CustomAttributes
         ENDIF
         IF def:GetMethod != NULL
            SELF:Accessors |= AccessorKind.Get
         ENDIF
         IF def:SetMethod != NULL
            SELF:Accessors |= AccessorKind.Set
         ENDIF

    PROPERTY ClassGenText as STRING
            GET
                var result := SELF:VisibilityKeyword + " "
                result += SELF:ModifiersKeyword + " "
                result += SELF:KindKeyword + " "
                result += SELF:Prototype
                result += IIF(Accessors.HasFlag(AccessorKind.Get), " GET","")
                result += IIF(Accessors.HasFlag(AccessorKind.Set), " SET","")
                RETURN result:Replace("  ", " ")
            END GET
      END PROPERTY

      PROTECTED OVERRIDE METHOD Resolve() AS VOID
         IF ! _resolved
            IF _propdef:HasParameters
               SELF:AddParameters(_propdef:Parameters)
            ENDIF
            SUPER:Resolve()
         ENDIF
         RETURN
   END CLASS

   CLASS XPEFieldSymbol INHERIT XPEMemberSymbol
        PRIVATE _fielddef     as FieldDefinition

   STATIC METHOD ConvertAttributes (attributes AS FieldAttributes) as Modifiers
         var modifiers := Modifiers.None
         var visattributes := _AND(attributes, FieldAttributes.FieldAccessMask)
         SWITCH visattributes
         CASE FieldAttributes.Private    // 1
            modifiers :=   Modifiers.Private
         CASE FieldAttributes.Assembly  // 3
            modifiers :=   Modifiers.Internal
         CASE FieldAttributes.Family     // 4
            modifiers :=   Modifiers.Protected
         CASE FieldAttributes.FamORAssem // 5
         CASE FieldAttributes.FamANDAssem // 5
            modifiers :=   Modifiers.ProtectedInternal
         CASE FieldAttributes.Public     // 6
            modifiers :=   Modifiers.Public
         END SWITCH
         IF attributes:HasFlag(FieldAttributes.InitOnly)
            modifiers |= Modifiers.InitOnly
         ENDIF
         IF attributes:HasFlag(FieldAttributes.Literal)
            modifiers |= Modifiers.Const
         ENDIF
         IF attributes:HasFlag(FieldAttributes.Static)
            modifiers |= Modifiers.Static
         ENDIF
          RETURN modifiers

		CONSTRUCTOR(def AS FieldDefinition, asm AS XAssembly)
			SUPER(def:Name, Kind.Field, ConvertAttributes(def:Attributes),  asm)
         SELF:DeclaringType   := def:DeclaringType:GetXSharpTypeName()
         SELF:_fielddef       := def
         SELF:OriginalTypeName := RemoveGenericParameters(def:FieldType:FullName)
         SELF:TypeName        := SELF:Signature:DataType      := def:FieldType:GetXSharpTypeName()
         IF def:IsLiteral .AND. def:Constant != NULL
            SELF:Value := def:Constant:ToString()
         endif
         IF def:HasCustomAttributes
            SELF:_custatts       := def:CustomAttributes
         ENDIF

      PROTECTED OVERRIDE METHOD Resolve() AS VOID
         SUPER:Resolve()
         RETURN

     PROPERTY ClassGenText as STRING
            GET
                var result := SELF:VisibilityKeyword + " "
                result += SELF:ModifiersKeyword + " "
                IF SELF:Kind != Kind.Field
                    result += SELF:KindKeyword + " "
                ENDIF
                result += SELF:Prototype
                RETURN result:Replace("  ", " ")
            END GET
      END PROPERTY

   END CLASS

   CLASS XPEEventSymbol INHERIT XPEMemberSymbol
        PRIVATE _eventdef     as EventDefinition
        PROPERTY Accessors    AS AccessorKind AUTO

		CONSTRUCTOR(def AS EventDefinition, asm AS XAssembly)
			SUPER(def:Name, Kind.Event, Modifiers.Public,  asm)
         SELF:DeclaringType         := def:DeclaringType:GetXSharpTypeName()
         SELF:_eventdef             := def
         SELF:OriginalTypeName      := RemoveGenericParameters(def:EventType:FullName)
         SELF:TypeName              := SELF:Signature:DataType    := def:EventType:GetXSharpTypeName()
         if def:AddMethod != NULL
            VAR xMethod := XPEMethodSymbol{def:AddMethod, asm}
            SELF:Attributes := xMethod:Attributes
         elseif def:RemoveMethod != null
            VAR xMethod := XPEMethodSymbol{def:RemoveMethod, asm}
            SELF:Attributes := xMethod:Attributes
         endif
         IF def:HasCustomAttributes
            SELF:_custatts       := def:CustomAttributes
         ENDIF
         IF def:AddMethod != NULL
            SELF:Accessors |= AccessorKind.Add
         ENDIF
         IF def:RemoveMethod != NULL
            SELF:Accessors |= AccessorKind.Remove
         ENDIF

      PROTECTED OVERRIDE Method Resolve() AS VOID
         SUPER:Resolve()
         RETURN

        PROPERTY ClassGenText as STRING
            GET
                var result := SELF:VisibilityKeyword + " "
                result += SELF:ModifiersKeyword + " "
                result += SELF:KindKeyword + " "
                result += SELF:Prototype
                result += IIF(Accessors.HasFlag(AccessorKind.Add), " ADD","")
                result += IIF(Accessors.HasFlag(AccessorKind.Remove), " REMOVE","")
                RETURN result:Replace("  ", " ")
            END GET
      END PROPERTY

END CLASS

   CLASS XPEMethodSymbol  INHERIT XPEMemberSymbol
       PRIVATE _methoddef    as MethodDefinition
       PRIVATE _ccAttrib     AS Mono.Cecil.CustomAttribute

   STATIC METHOD ConvertAttributes (attributes AS MethodAttributes) as Modifiers
         var modifiers := Modifiers.None
         var visattributes := _AND(attributes, MethodAttributes.MemberAccessMask)
         SWITCH visattributes
         CASE MethodAttributes.Private    // 1
            modifiers :=  Modifiers.Private
         CASE MethodAttributes.Assembly  // 3
            modifiers :=  Modifiers.Internal
         CASE MethodAttributes.Family     // 4
            modifiers :=  Modifiers.Protected
         CASE MethodAttributes.FamORAssem // 5
         CASE MethodAttributes.FamANDAssem // 5
            modifiers :=  Modifiers.ProtectedInternal
         CASE MethodAttributes.Public     // 6
            modifiers :=  Modifiers.Public
         OTHERWISE
            modifiers := Modifiers.Public
         END SWITCH
         IF attributes:HasFlag(MethodAttributes.Abstract)
            modifiers |= Modifiers.Abstract
         ENDIF
         IF attributes:HasFlag(MethodAttributes.Final)
            modifiers |= Modifiers.Sealed
         ENDIF
         IF attributes:HasFlag(MethodAttributes.PInvokeImpl)
            modifiers |= Modifiers.External
         ENDIF
         IF attributes:HasFlag(MethodAttributes.UnmanagedExport)
            modifiers |= Modifiers.External
         ENDIF
         IF attributes:HasFlag(MethodAttributes.Virtual)
            modifiers |= Modifiers.Virtual
         ENDIF
         IF attributes:HasFlag(MethodAttributes.NewSlot)
            modifiers |= Modifiers.New
         ENDIF
         IF attributes:HasFlag(MethodAttributes.Static)
            modifiers |= Modifiers.Static
         ENDIF
         RETURN modifiers

  		 CONSTRUCTOR(def AS MethodDefinition, asm AS XAssembly)
			SUPER(def:Name, Kind.Method, ConvertAttributes(def:Attributes),  asm)
             SELF:DeclaringType   := def:DeclaringType:GetXSharpTypeName()
             IF DeclaringType:EndsWith("Functions")
                SELF:Attributes := _AND(SELF:Attributes, ~Modifiers.Static)
                SELF:Kind      := Kind.Function
             ENDIF
             SELF:OriginalTypeName   := RemoveGenericParameters(def:ReturnType:FullName)
             SELF:TypeName           := SELF:Signature:DataType := def:ReturnType:GetXSharpTypeName()
             SELF:_methoddef         := def
             IF def:HasCustomAttributes
                SELF:_custatts       := def:CustomAttributes
                FOREACH VAR attr IN def:CustomAttributes
                   SWITCH attr:AttributeType:FullName
                   CASE "System.Runtime.CompilerServices.ExtensionAttribute"
                      SELF:Signature:IsExtension := TRUE
                   CASE "XSharp.Internal.ClipperCallingConventionAttribute"
                   CASE "Vulcan.Internal.ClipperCallingConventionAttribute"
                      SELF:CallingConvention := CallingConvention.Clipper
                      _ccAttrib := attr
                   END SWITCH
                NEXT
                ENDIF
                IF def:HasGenericParameters
                    SELF:_generic := def:HasGenericParameters
                    SELF:_signature:ReadGenericParameters(def:GenericParameters)
                ENDIF
         PROTECTED OVERRIDE METHOD Resolve() AS VOID
            IF ! _resolved
               // Add Generic parameters first so have that info when processing the parameters
               IF _methoddef:HasGenericParameters
                  SELF:AddTypeParameters(_methoddef:GenericParameters)
               ENDIF
               IF _methoddef:HasParameters
                  IF SELF:CallingConvention = CallingConvention.Clipper
                     SELF:AddParameters(_ccAttrib)
                  ELSE
                     SELF:AddParameters(_methoddef:Parameters)
                  ENDIF
               ENDIF
               SUPER:Resolve()
            ENDIF

            RETURN
        PROPERTY ClassGenText as STRING
            GET
                var result := SELF:VisibilityKeyword + " "
                result += SELF:ModifiersKeyword + " "
                result += SELF:KindKeyword + " "
                var temp := SELF:GetProtoType(TRUE)
                if (SELF:Kind == Kind.Constructor)
                    temp := temp.Replace('}',')')
                    var pos := temp.IndexOf('{')
                    temp := "("+temp:Substring(pos+1)
                    result += temp
                ELSE
                    result += temp
                endif
                if self:CallingConvention == CallingConvention.Clipper
                    result += " CLIPPER"
                endif
                RETURN result:Replace("  ", " ")
            END GET
      END PROPERTY

   END CLASS

   [DebuggerDisplay("{ToString(),nq}")];
	ABSTRACT CLASS XPEMemberSymbol     INHERIT XPESymbol IMPLEMENTS IXMemberSymbol
		// Fields
        PROTECTED  _signature    AS XMemberSignature
        PROTECTED  _resolved    AS LOGIC
        PROTECTED  _generic     AS LOGIC
        PROPERTY  SubType      AS Kind AUTO
        PROPERTY  DeclaringType  AS STRING AUTO
        PROPERTY  Signature     AS XMemberSignature  GET _signature
        PROPERTY  IsGeneric    AS LOGIC GET _generic
        ABSTRACT PROPERTY  ClassGenText      AS STRING GET

		#region constructors

      CONSTRUCTOR(name AS STRING, kind AS Kind, attributes AS Modifiers, asm AS XAssembly)
			SUPER(name, kind, attributes,  asm)
         SELF:_signature      := XMemberSignature{}
         SELF:_resolved       := FALSE
         SELF:_custatts       := NULL
         SELF:_generic        := FALSE
         RETURN

      #endregion

      PROTECTED VIRTUAL METHOD Resolve() AS VOID
         IF SELF:_custatts != NULL
            FOREACH VAR custatt IN SELF:_custatts
               SWITCH custatt:AttributeType:FullName
               CASE "System.Diagnostics.DebuggerBrowsableAttribute"
                  VAR cvalue := custatt:ConstructorArguments[0]
                  IF cvalue:Type:FullName == typeof(DebuggerBrowsableState):FullName
                     VAR state := (DebuggerBrowsableState) cvalue:Value
                     IF state == DebuggerBrowsableState.Never
                        // hide these
                        SELF:Attributes := _OR(SELF:Modifiers, Modifiers.Internal)
                     ENDIF
                  ENDIF
               END SWITCH
            NEXT
         ENDIF
         SELF:_custatts := NULL
         RETURN

      PRIVATE METHOD DoResolve() AS VOID
         IF ! self:_resolved
            SELF:Resolve()
            self:_resolved := TRUE
         ENDIF

      METHOD AddParameters( oAttr as Mono.Cecil.CustomAttribute) AS VOID
         var arg    := oAttr:ConstructorArguments[0]
         var type   := arg:Type
         if type:FullName == "System.String[]"
            var args := (Mono.Cecil.CustomAttributeArgument[]) arg:Value
            FOREACH VAR argName in args
               var parRef := XPEParameterSymbol{self, argName:Value:ToString(), "USUAL"}
               parRef:ParamType := ParamType.As
               parRef:OriginalTypeName := "XSharp.__Usual"
               SELF:_signature:Parameters:Add(parRef)
            NEXT
         endif

      METHOD AddParameters (aPars as Mono.Collections.Generic.Collection<ParameterDefinition>) AS VOID
         SELF:_signature:Parameters:Clear()
         FOREACH var oPar in aPars
            var name  := oPar:Name
            var index := oPar:Index
            var type  := oPar:ParameterType:GetXSharpTypeName()
            var defValue := oPar:Constant
            var custatt := ""
            LOCAL parType as ParamType
            IF oPar:IsOut .and. oPar:IsIn
               parType := ParamType.Ref
            ELSEIF oPar:IsOut
               parType := ParamType.Out
            ELSEIF oPar:IsIn
               parType := ParamType.As
            ELSE
               parType := ParamType.As
            ENDIF
            if oPar:HasCustomAttributes
               defValue := SELF:DecodeCustomAttributes(oPar:CustomAttributes, oPar:ParameterType)
            ENDIF
            var parRef := XPEParameterSymbol{self, name, type}
            parRef:OriginalTypeName := RemoveGenericParameters(oPar:ParameterType:FullName)
            if defValue != NULL
               parRef:Value := defValue:ToString()
            ENDIF
            IF parRef:OriginalTypeName:Contains("&") .AND. parType == ParamType.As
               parType := ParamType.Ref
            ENDIF
            parRef:ParamType := parType
            IF parRef:OriginalTypeName:Contains("`")
               VAR count := SELF:TypeParameters:Count
               parRef:TypeName := parRef:OriginalTypeName:Replace("`"+count:ToString(),"")
            ENDIF
            SELF:_signature:Parameters:Add(parRef)
         NEXT
         RETURN

      METHOD DecodeCustomAttributes( attributes as Mono.Collections.Generic.Collection<CustomAttribute>, oType as TypeReference) AS STRING
         local result as STRING
         local done   as LOGIC
         FOREACH var attr in attributes
               SWITCH attr:AttributeType:FullName
               CASE "XSharp.Internal.DefaultParameterValueAttribute"
               CASE "Vulcan.Internal.DefaultParameterValueAttribute"
                  var arg1     := attr:ConstructorArguments[0]
                  IF arg1:Value is CustomAttributeArgument VAR arg
                     arg1 := arg
                  ENDIF
                  var arg2 := (Int32) attr:ConstructorArguments[1]:Value
                  switch arg2
                  case 1   // NIL
                     result := "NIL"
                  case 2   // Arg1 is date in ticks
                     var ticks := (Int64)  arg1:Value
                     var dt    := DateTime{ticks}
                     if dt == DateTime.MinValue
                         result := "NULL_DATE"
                     else
                        result    := dt:ToString("yyyy.MM.dd")
                     endif
                  case 3   // Arg1 is Symbol , when NULL then NULL_SYMBOL
                     var sym := (STRING)  arg1:Value
                     if (sym == NULL)
                        result := "NULL_SYMBOL"
                     else
                        result := "#" + sym:ToString()
                     endif
                  case 4   // Arg1 is PSZ, when NULL then NULL_SYMBOL
                     var psz1 := (STRING)  arg1:Value
                     if (psz1 == NULL)
                        result := "NULL_PSZ"
                     else
                        result := psz1:ToString()
                     endif
                  case 5   // Arg1 is NULL_PTR
                     VAR p := IntPtr{ (INT64) arg1:Value}
                     if (p == IntPtr.Zero)
                        result := "NULL_PTR"
                     ELSE
                        result := "0x"+p:ToString("X")
                     ENDIF

                  case 0   // Normal .Net value
                     var obj := arg1:Value
                     if (obj != null)
                        result := obj:ToString()
                        if arg1:Type:FullName == "System.String"
                           result := e"\""+result+e"\""
                        endif
                     else
                        switch oType:FullName
                        case "System.String"
                            return "NULL_STRING"
                        otherwise
                            return "NULL_OBJECT"
                        end switch
                     endif
                  end switch
                  done := TRUE
               END SWITCH
               if (done)
                  EXIT
               ENDIF

         NEXT
         return result

      METHOD AddTypeParameters(aPars AS Mono.Collections.Generic.Collection<GenericParameter>) AS VOID
         FOREACH typeParam AS Mono.Cecil.GenericParameter IN aPars
            SELF:_signature:TypeParameters:Add(typeParam:Name)
         NEXT
         RETURN

//
			#region Properties
      PROPERTY Description AS STRING GET SELF:GetDescription()

	  PROPERTY FullName AS STRING GET SELF:GetFullName()

      PROPERTY IsStatic AS LOGIC GET SELF:Modifiers:HasFlag(Modifiers.Static)
      PROPERTY Location AS STRING GET SELF:Assembly:DisplayName

		PROPERTY HasParameters     AS LOGIC
         GET
            SELF:DoResolve()
            RETURN _signature:HasParameters
         END GET
      END PROPERTY

		PROPERTY ParameterCount    AS INT
         GET
            SELF:DoResolve()
            RETURN _signature:ParameterCount
         END GET
      END PROPERTY

		PROPERTY ParameterList     AS STRING
         GET
            SELF:DoResolve()
            RETURN _signature:ParameterList
         END GET
      END PROPERTY

      PROPERTY TypeParameters as IList<STRING>           GET SELF:_signature:TypeParameters:ToArray()
      PROPERTY TypeParameterList AS STRING               GET SELF:_signature:TypeParameterList
      PROPERTY TypeParameterConstraints as IList<STRING> GET SELF:_signature:TypeParameterContraints:ToArray()
      PROPERTY TypeParameterConstraintsList AS STRING    GET SELF:_signature:TypeParameterConstraintsList

      PROPERTY Parameters         AS IList<IXParameterSymbol>
         GET
            SELF:DoResolve()
            RETURN _signature:Parameters:ToArray()
         END GET
      END PROPERTY

      PROPERTY CallingConvention AS CallingConvention GET _signature:CallingConvention SET _signature:CallingConvention := @@value

      PROPERTY ParentType     AS IXTypeSymbol GET SELF:Parent ASTYPE IXTypeSymbol
		PROPERTY Prototype      AS STRING
         GET
            SELF:DoResolve()
            RETURN SELF:GetProtoType()
         END GET
      END PROPERTY

      PROPERTY IsExtension    AS LOGIC  GET _signature:IsExtension
      PROPERTY XMLSignature   AS STRING
         GET
            SELF:DoResolve()
            RETURN SELF:GetXmlSignature()
         END GET
      END PROPERTY

      METHOD ToString() AS STRING
         var result := i"{Kind} {Name}"
         if SELF:_signature != NULL .and. SELF:_signature:TypeParameters:Count > 0
            result += self:_signature:ToString()
         ENDIF
         RETURN result

     METHOD Clone() AS IXMemberSymbol
        var clone := (XPEMemberSymbol) SELF:MemberwiseClone()
        clone:_signature := SELF:_signature:Clone()
        RETURN (IXMemberSymbol) clone

     METHOD WithName(newName as STRING) AS IXMemberSymbol
        var clone := (XPEMemberSymbol) SELF:MemberwiseClone()
        clone:Name := newName
        clone:_signature := SELF:_signature:Clone()
        RETURN (IXMemberSymbol) clone

		#endregion
	END CLASS

END NAMESPACE


[Runtime tests] Added tests for the Bit* VFP functions

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System
USING System.Collections.Generic
USING System.Linq
USING System.Text
USING XUnit

// Array tests are not working correctly yet with the current build
BEGIN NAMESPACE XSharp.VFP.Tests

	CLASS NumericTests

		[Fact, Trait("Category", "Numeric")];
		METHOD ConversionTests() AS VOID
            LOCAL c1 AS CURRENCY
            LOCAL c2 AS CURRENCY
            LOCAL f1 AS FLOAT
            LOCAL f2 AS FLOAT
            c1 := $1.2345
            c2 := NToM(1.2345444)
            Assert.True( c1  == c2 )
            f1 := 1.2345
            f2 := MToN($1.2345)
            Assert.True( f1  == f2 )
            Assert.Equal(1, Sign(1.2345))
            Assert.Equal(-1, Sign(-1.2345))
            Assert.Equal(0, Sign(0.0))

            LOCAL u AS USUAL
            u := Val("$12345")
            Assert.Equal((DWORD) __UsualType.Currency, UsualType(u))

		[Fact, Trait("Category", "Numeric")];
		METHOD BitTests() AS VOID
            Assert.Equal(0h0000,      BitAnd(0h, 0hFFFF) )
            Assert.Equal(6,           BitAnd(318, 7.5) )
            Assert.Equal(160,         BitAnd(-838, 0x06AC, 873445) )
            Assert.Equal(0h0000,      BitAnd(0h, 0hFFFF) )
            Assert.Equal(0h01234567,  BitAnd(0h01234567, 0h89abcdef) )
            Assert.Equal(319,         BitOr(318, 7.5) )
            Assert.Equal(-1,          BitOr(-838, 0x06AC, 873445) )
            Assert.Equal(0hffff,      BitOr(0h, 0hFFFF) )
            Assert.Equal(0h89abcdef,  BitOr(0h01234567, 0h89abcdef) )
            Assert.Equal(313,         BitXOr(318, 7.5) )
            Assert.Equal(-873997,     BitXOr(-838, 0x06AC, 873445) )
            Assert.Equal(0hffff,      BitXOr(0h, 0hFFFF) )
            Assert.Equal(0h88888888,  BitXOr(0h01234567, 0h89abcdef) )

            Assert.Equal(-2,          BitNot(0x01) )
            Assert.Equal(0h,          BitNot(0h) )
            Assert.Equal(0h7fff,      BitNot(0hffff, 7) )
            Assert.Equal(0h7ff8,      BitNot(0hffff, 7, 4) )

            Assert.Equal(11239297,    BitClear(0x00abff81, 15) )
            Assert.Equal(0h,          BitClear(0h) )
            Assert.Equal(0h0000,      BitClear(0hffff) )
            Assert.Equal(0hfeff,      BitClear(0hffff, 0) )
            Assert.Equal(0h00ff,      BitClear(0hffff, 0, 8) )

            Assert.Equal(-2136211583, BitSet(0x00abff81, 31) )
            Assert.Equal(0h,          BitSet(0h) )
            Assert.Equal(0hffff,      BitSet(0h0000) )
            Assert.Equal(0h0400,      BitSet(0h0000, 2) )
            Assert.Equal(0hfc03,      BitSet(0h0000, 2, 8) )

            Assert.Equal(536870911,   BitRShift(0xFFFFFFFFL, 3) )
            Assert.Equal(-8,          BitLShift(536870911, 3) )

            Assert.True(  BitTest(-1, 0) )
            Assert.False( BitTest(-2, 0) )
            Assert.False( BitTest(0hfffffffff7ffff, 35) )

	END CLASS

END NAMESPACE

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System
USING System.Collections.Generic
USING System.Linq
USING System.Text
USING XUnit

// Array tests are not working correctly yet with the current build
BEGIN NAMESPACE XSharp.VFP.Tests

	CLASS NumericTests

		[Fact, Trait("Category", "Numeric")];
		METHOD ConversionTests() AS VOID
            LOCAL c1 AS CURRENCY
            LOCAL c2 AS CURRENCY
            LOCAL f1 AS FLOAT
            LOCAL f2 AS FLOAT
            c1 := $1.2345
            c2 := NToM(1.2345444)
            Assert.True( c1  == c2 )
            f1 := 1.2345
            f2 := MToN($1.2345)
            Assert.True( f1  == f2 )
            Assert.Equal(1, Sign(1.2345))
            Assert.Equal(-1, Sign(-1.2345))
            Assert.Equal(0, Sign(0.0))

            LOCAL u as USUAL
            u := Val("$12345")
            Assert.Equal((dword) __UsualType.Currency, UsualType(u))

	END CLASS

END NAMESPACE


define up' for DigitList' too

define up' for DigitList' too

import "../src/LangPrelude.prg" (maybeM)
import "Inventory.prg"

monad maybeM

data Fin :: Nat ~> *0 where
  Fz :: Fin (S m)
  Fs :: Fin m -> Fin (S m)
 deriving Nat(f)

data DigitList :: Nat ~> *0 where
  None :: DigitList a
  Longer :: DigitList a -> Fin a -> DigitList a
 deriving LeftList(dl)

up :: Nat' (2+b)t -> DigitList (2+b)t -> DigitList (2+b)t
up _ []dl = [1f]dl
up b [bla; f]dl = case tryIncr b f of
                  Nothing -> [up b bla; 0f]dl
                  Just d -> [bla; d]dl

tryIncr :: Nat' (2+b)t -> Fin (2+b)t -> Maybe (Fin (2+b)t)
tryIncr 2v 1f = Nothing
tryIncr (2+v)v 0f = Just 1f
tryIncr (3+v)v 1f = Just 2f
tryIncr (3+v)v (1+f)f = do { i <- tryIncr (2+v)v f; return (1+i)f }

-- same with reflected types
--
data Fin' :: Nat ~> Nat ~> *0 where
  Fz' :: Fin' (S m) Z
  Fs' :: Fin' m n -> Fin' (S m) (S n)
 deriving Nat(fp)

data DigitList' :: Nat ~> Inventory Nat ~> *0 where
  None' :: DigitList' a []i
  Longer' :: DigitList' a inv -> Fin' a t -> DigitList' a [inv; t]i
 deriving LeftList(dlp)

tryIncr' :: Nat' (2+b)t -> Fin' (2+b)t a -> (Equal (2+b)t (1+a)t + Fin' (2+b)t (1+a)t)
tryIncr' 2v 1fp = L Eq
tryIncr' (2+v)v 0fp = R 1fp
tryIncr' (3+v)v 1fp = R 2fp
tryIncr' (3+v)v (1+f)fp = case tryIncr' (2+v)v f of
                          L Eq -> L Eq
                          R i -> R (1+i)fp

upInv :: Nat ~> Inventory Nat ~> Inventory Nat
{upInv b []i} = [1t]i
{upInv (1+b)t [rest; b]i} = [{upInv (1+b)t rest}; 0t]i
{upInv (2+b)t [rest; a]i} = [rest; (1+a)t]i

up' :: Nat' (2+b)t -> DigitList' (2+b)t i -> DigitList' (2+b)t {upInv (2+b)t i}
up' _ []dlp = [1fp]dlp
up' b [bla; f]dlp = case tryIncr' b f of
                    L Eq -> [up' b bla; 0fp]dlp
                    R d -> [bla; d]dlp

import "../src/LangPrelude.prg" (maybeM)
import "Inventory.prg"

monad maybeM

data Fin :: Nat ~> *0 where
  Fz :: Fin (S m)
  Fs :: Fin m -> Fin (S m)
 deriving Nat(f)

data DigitList :: Nat ~> *0 where
  None :: DigitList a
  Longer :: DigitList a -> Fin a -> DigitList a
 deriving LeftList(dl)

up :: Nat' (2+b)t -> DigitList (2+b)t -> DigitList (2+b)t
up _ []dl = [1f]dl
up b [bla; f]dl = case tryIncr b f of
                  Nothing -> [up b bla; 0f]dl
                  Just d -> [bla; d]dl

tryIncr :: Nat' (2+b)t -> Fin (2+b)t -> Maybe (Fin (2+b)t)
tryIncr 2v 1f = Nothing
tryIncr (2+v)v 0f = Just 1f
tryIncr (3+v)v 1f = Just 2f
tryIncr (3+v)v (1+f)f = do { i <- tryIncr (2+v)v f; return (1+i)f }

data Fin' :: Nat ~> Nat ~> *0 where
  Fz' :: Fin' (S m) Z
  Fs' :: Fin' m n -> Fin' (S m) (S n)
 deriving Nat(fp)

data DigitList' :: Nat ~> Inventory Nat ~> *0 where
  None' :: DigitList' a []i
  Longer' :: DigitList' a inv -> Fin' a t -> DigitList' a [inv; t]i
 deriving LeftList(dlp)


levelup always fits into poly

levelup always fits into poly

import "../src/LangPrelude.prg" (maybeM)

data Thrist :: (l ~> l ~> *) ~> l ~> l ~> * where
  Nil :: Thrist k a a
  Cons :: k a b -> Thrist k b c -> Thrist k a c
 deriving List(t)

data Multiplicity :: *2 where
  Mono :: Multiplicity
  Poly :: Multiplicity

data Lev :: Multiplicity ~> *1 where
  ValueLevel :: Lev Mono
  LevelUp :: Lev m ~> Lev m
  PolyLevel :: Lev Poly -- level n .
 deriving syntax (lev) Nat(ValueLevel, LevelUp)

data HiddenLev :: *1 where
  HideLev :: Lev m ~> HiddenLev

data Level :: Lev n ~> * where
  ValueLevel :: Level ValueLevel
  LevelUp :: Level l -> Level (LevelUp l)
  PolyLevel :: Level PolyLevel
 deriving syntax (l) Nat(ValueLevel, LevelUp)

data Signature = Sig

data Iceberg :: * ~> * ~> * where
  Constructor :: Label t -> Level l -> Signature -> Iceberg () ()

data Icename :: Tag ~> Tag ~> * where -- entities with certain name
  NamedConstructor :: Label t -> Level l -> Signature -> Icename t t

data Icelevel :: Lev n ~> Lev n ~> * where -- entities with certain level
  LevelConstructor :: LevelSubsumes l' l => Label t -> Level l -> Signature -> Icelevel l' l'

builtIn :: Thrist Iceberg () ()
builtIn = [ Constructor `Z 0l Sig, Constructor `S 0l Sig, Constructor natPrime 0l Sig
          , Constructor `Z 1l Sig, Constructor `S 1l Sig, Constructor `Nat 2l Sig
          , Constructor starN (LevelUp (LevelUp PolyLevel)) Sig
          , Constructor constraintN (LevelUp (LevelUp PolyLevel)) Sig]t
  where HideLabel natPrime = newLabel "Nat'"
        HideLabel starN = newLabel "*n"
        HideLabel constraintN = newLabel "#n"

projectName :: Label l -> Thrist Iceberg () () -> Thrist Icename l l
projectName _ []t = []t
projectName l [Constructor l' lev sig; rest]t = case sameLabel l l' of
                                                L Eq -> [NamedConstructor l' lev sig; projectName l rest]t
                                                _ -> projectName l rest

-- should be LevelFits
prop LevelSubsumes :: Lev n ~> Lev n' ~> * where
  BothValue :: LevelSubsumes ValueLevel ValueLevel
  BothPoly :: LevelSubsumes PolyLevel PolyLevel
  BothUp :: LevelSubsumes k k' -> LevelSubsumes (LevelUp k) (LevelUp k')
  ValuePoly :: LevelSubsumes ValueLevel PolyLevel
  AbovePoly :: {-LevelSubsumes (LevelUp k) (LevelUp k) ->-} LevelSubsumes (LevelUp k) PolyLevel

fits :: Level l -> Level l' -> Maybe (LevelSubsumes l l')
fits ValueLevel ValueLevel = Just BothValue
fits PolyLevel PolyLevel = Just BothPoly
fits (LevelUp l) (LevelUp l') = do ev <- fits l l'
                                   return $ BothUp ev
                                 where monad maybeM
fits ValueLevel PolyLevel = Just ValuePoly
fits (LevelUp l) PolyLevel = Just AbovePoly
fits _ _ = Nothing

projectLevel :: Level l -> Thrist Iceberg () () -> Thrist Icelevel l l
projectLevel _ []t = []t
projectLevel l [Constructor t l' sig; rest]t = case fits l l' of
                                               Just BothValue -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just BothPoly -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just (BothUp below) -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just ValuePoly -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               _ -> projectLevel l rest

import "../src/LangPrelude.prg" (maybeM)

data Thrist :: (l ~> l ~> *) ~> l ~> l ~> * where
  Nil :: Thrist k a a
  Cons :: k a b -> Thrist k b c -> Thrist k a c
 deriving List(t)

data Multiplicity :: *2 where
  Mono :: Multiplicity
  Poly :: Multiplicity

data Lev :: Multiplicity ~> *1 where
  ValueLevel :: Lev Mono
  LevelUp :: Lev m ~> Lev m
  PolyLevel :: Lev Poly -- level n .
 deriving syntax (lev) Nat(ValueLevel, LevelUp)

data HiddenLev :: *1 where
  HideLev :: Lev m ~> HiddenLev

data Level :: Lev n ~> * where
  ValueLevel :: Level ValueLevel
  LevelUp :: Level l -> Level (LevelUp l)
  PolyLevel :: Level PolyLevel
 deriving syntax (l) Nat(ValueLevel, LevelUp)

data Signature = Sig

data Iceberg :: * ~> * ~> * where
  Constructor :: Label t -> Level l -> Signature -> Iceberg () ()

data Icename :: Tag ~> Tag ~> * where -- entities with certain name
  NamedConstructor :: Label t -> Level l -> Signature -> Icename t t

data Icelevel :: Lev n ~> Lev n ~> * where -- entities with certain level
  LevelConstructor :: LevelSubsumes l' l => Label t -> Level l -> Signature -> Icelevel l' l'

builtIn :: Thrist Iceberg () ()
builtIn = [ Constructor `Z 0l Sig, Constructor `S 0l Sig, Constructor natPrime 0l Sig
          , Constructor `Z 1l Sig, Constructor `S 1l Sig, Constructor `Nat 2l Sig
          , Constructor starN (LevelUp (LevelUp PolyLevel)) Sig
          , Constructor constraintN (LevelUp (LevelUp PolyLevel)) Sig]t
  where HideLabel natPrime = newLabel "Nat'"
        HideLabel starN = newLabel "*n"
        HideLabel constraintN = newLabel "#n"

projectName :: Label l -> Thrist Iceberg () () -> Thrist Icename l l
projectName _ []t = []t
projectName l [Constructor l' lev sig; rest]t = case sameLabel l l' of
                                                L Eq -> [NamedConstructor l' lev sig; projectName l rest]t
                                                _ -> projectName l rest

-- should be LevelFits
prop LevelSubsumes :: Lev n ~> Lev n' ~> * where
  BothValue :: LevelSubsumes ValueLevel ValueLevel
  BothPoly :: LevelSubsumes PolyLevel PolyLevel
  BothUp :: LevelSubsumes k k' -> LevelSubsumes (LevelUp k) (LevelUp k')
  ValuePoly :: LevelSubsumes ValueLevel PolyLevel

fits :: Level l -> Level l' -> Maybe (LevelSubsumes l l')
fits ValueLevel ValueLevel = Just BothValue
fits PolyLevel PolyLevel = Just BothPoly
fits (LevelUp l) (LevelUp l') = do ev <- fits l l'
                                   return $ BothUp ev
                                 where monad maybeM
fits ValueLevel PolyLevel = Just ValuePoly
fits _ _ = Nothing

projectLevel :: Level l -> Thrist Iceberg () () -> Thrist Icelevel l l
projectLevel _ []t = []t
projectLevel l [Constructor t l' sig; rest]t = case fits l l' of
                                               Just BothValue -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just BothPoly -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just (BothUp below) -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               Just ValuePoly -> [LevelConstructor t l' sig; projectLevel l rest]t
                                               _ -> projectLevel l rest