view release on metacpan or  search on metacpan

cbc/dimension.c  view on Meta::CPAN

*******************************************************************************/

static void dimtag_fini(pTHX_ DimensionTag *dim)
{
  assert(dim != NULL);

  switch (dim->type)
  {
    case DTT_MEMBER:
      assert(dim->u.member != NULL);
      Safefree(dim->u.member);
      break;

    case DTT_HOOK:
      assert(dim->u.hook != NULL);
      single_hook_delete(dim->u.hook);
      break;

    default:
      break;
  }
}

/*******************************************************************************
*
*   ROUTINE: validate_member_expression
*
*   WRITTEN BY: Marcus Holland-Moritz             ON: Mar 2006
*   CHANGED BY:                                   ON:
*
********************************************************************************
*
* DESCRIPTION:
*
*   ARGUMENTS:
*
*     RETURNS:
*
*******************************************************************************/

static void validate_member_expression(pTHX_ const MemberInfo *pmi,
                                             const char *member, const char *type)
{
  MemberInfo mi, mi2;
  const char *failed_type;

  assert(pmi != NULL);
  assert(member != NULL);

  if (pmi->parent == NULL)
  {
    Perl_croak(aTHX_ "Cannot use member expression '%s' as Dimension tag"
                     " for '%s' when not within a compound type", member, type);
  }

  mi.type.ptr = pmi->parent;
  mi.type.tflags = ((Struct *) pmi->parent)->tflags;
  mi.pDecl = NULL;
  mi.level = 0;

  (void) get_member(aTHX_ &mi, member, &mi2, CBC_GM_ACCEPT_DOTLESS_MEMBER |
                                             CBC_GM_REJECT_OUT_OF_BOUNDS_INDEX |
                                             CBC_GM_REJECT_OFFSET);

  failed_type = check_allowed_types_string(&mi2, ALLOW_BASIC_TYPES);

  if (failed_type)
  {
    Perl_croak(aTHX_ "Cannot use %s in member '%s' to determine a dimension for '%s'",
                     failed_type, member, type);
  }

  if (mi2.offset + (int)mi2.size > pmi->offset)
  {
    const char *where;

    if (mi2.offset == pmi->offset)
      where = "located at same offset as"; 
    else if (mi2.offset < pmi->offset)
      where = "overlapping with";
    else
      where = "located behind";

    Perl_croak(aTHX_ "Cannot use member '%s' %s '%s' in layout"
                     " to determine a dimension", member, where, type);
  }
}

/*******************************************************************************
*
*   ROUTINE: sv_to_dimension
*
*   WRITTEN BY: Marcus Holland-Moritz             ON: Mar 2006
*   CHANGED BY:                                   ON:
*
********************************************************************************
*
* DESCRIPTION:
*
*   ARGUMENTS:
*
*     RETURNS:
*
*******************************************************************************/

static long sv_to_dimension(pTHX_ SV *sv, const char *member)
{
  SV *warning;
  const char *value = NULL;

  assert(sv != NULL);

  SvGETMAGIC(sv);

  if (SvOK(sv) && !SvROK(sv))
  {
    if (looks_like_number(sv))
    {
      return SvIV(sv);
    }

    value = SvPV_nolen(sv);
  }