################################################################################
##
##  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
##  Version 2.x, Copyright (C) 2001, Paul Marquess.
##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
##
##  This program is free software; you can redistribute it and/or
##  modify it under the same terms as Perl itself.
##
################################################################################

=provides

__UNDEFINED__
SV_NOSTEAL
sv_setsv_flags
newSVsv_nomg
newSVsv_flags

=implementation

__UNDEFINED__ SV_NOSTEAL 16

#if ( { VERSION >= 5.7.3 } && { VERSION < 5.8.7 } ) || ( { VERSION >= 5.9.0 } && { VERSION < 5.9.2 } )
#undef sv_setsv_flags
#if defined(PERL_USE_GCC_BRACE_GROUPS)
#define sv_setsv_flags(dstr, sstr, flags)                                          \
  STMT_START {                                                                     \
    if (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) {  \
      SvTEMP_off((SV *)(sstr));                                                    \
      Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL);            \
      SvTEMP_on((SV *)(sstr));                                                     \
    } else {                                                                       \
      Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL);            \
    }                                                                              \
  } STMT_END
#else
#define sv_setsv_flags(dstr, sstr, flags)                                          \
  (                                                                                \
    (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) ? (   \
      SvTEMP_off((SV *)(sstr)),                                                    \
      Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL),            \
      SvTEMP_on((SV *)(sstr)),                                                     \
      1                                                                            \
    ) : (                                                                          \
      Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL),            \
      1                                                                            \
    )                                                                              \
  )
#endif
#endif

#if defined(PERL_USE_GCC_BRACE_GROUPS)
__UNDEFINED__ sv_setsv_flags(dstr, sstr, flags)                                    \
  STMT_START {                                                                     \
    if (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) {  \
      SvTEMP_off((SV *)(sstr));                                                    \
      if (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) {          \
        SvGMAGICAL_off((SV *)(sstr));                                              \
        sv_setsv((dstr), (sstr));                                                  \
        SvGMAGICAL_on((SV *)(sstr));                                               \
      } else {                                                                     \
        sv_setsv((dstr), (sstr));                                                  \
      }                                                                            \
      SvTEMP_on((SV *)(sstr));                                                     \
    } else {                                                                       \
      if (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) {          \
        SvGMAGICAL_off((SV *)(sstr));                                              \
        sv_setsv((dstr), (sstr));                                                  \
        SvGMAGICAL_on((SV *)(sstr));                                               \
      } else {                                                                     \
        sv_setsv((dstr), (sstr));                                                  \
      }                                                                            \
    }                                                                              \
  } STMT_END
#else
__UNDEFINED__ sv_setsv_flags(dstr, sstr, flags)                                    \
  (                                                                                \
    (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) ? (   \
      SvTEMP_off((SV *)(sstr)),                                                    \
      (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) ? (           \
        SvGMAGICAL_off((SV *)(sstr)),                                              \
        sv_setsv((dstr), (sstr)),                                                  \
        SvGMAGICAL_on((SV *)(sstr)),                                               \
        1                                                                          \
      ) : (                                                                        \
        sv_setsv((dstr), (sstr)),                                                  \
        1                                                                          \
      ),                                                                           \
      SvTEMP_on((SV *)(sstr)),                                                     \
      1                                                                            \
    ) : (                                                                          \
      (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) ? (           \
        SvGMAGICAL_off((SV *)(sstr)),                                              \
        sv_setsv((dstr), (sstr)),                                                  \
        SvGMAGICAL_on((SV *)(sstr)),                                               \
        1                                                                          \
      ) : (                                                                        \
        sv_setsv((dstr), (sstr)),                                                  \
        1                                                                          \
      )                                                                            \
    )                                                                              \
  )
#endif

#ifndef newSVsv_flags
#  if defined(PERL_USE_GCC_BRACE_GROUPS)
#    define  newSVsv_flags(sv, flags)                       \
        ({                                                  \
            SV *n= newSV(0);                             \
            sv_setsv_flags(n, (sv), (flags));             \
            n;                                            \
        })
#  else
    PERL_STATIC_INLINE SV* D_PPP_newSVsv_flags(SV *const old, I32 flags)
        {
            dTHX;
            SV *n= newSV(0);
            sv_setsv_flags(n, old, flags);
            return n;
        }
#    define  newSVsv_flags(sv, flags) D_PPP_newSVsv_flags(sv, flags)
#  endif
#endif

__UNDEFINED__ newSVsv_nomg(sv) newSVsv_flags((sv), SV_NOSTEAL)

#if { VERSION >= 5.17.5 }
__UNDEFINED__ sv_mortalcopy_flags(sv, flags) Perl_sv_mortalcopy_flags(aTHX_ (sv), (flags))
#else
__UNDEFINED__ sv_mortalcopy_flags(sv, flags) sv_2mortal(newSVsv_flags((sv), (flags)))
#endif

__UNDEFINED__ SvMAGIC_set(sv, val) \
                STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
                (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END

#if { VERSION < 5.9.3 }

__UNDEFINED__ SvPVX_const(sv)     ((const char*) (0 + SvPVX(sv)))
__UNDEFINED__ SvPVX_mutable(sv)   (0 + SvPVX(sv))

__UNDEFINED__ SvRV_set(sv, val) \
                STMT_START { assert(SvTYPE(sv) >=  SVt_RV); \
                (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END

#else

__UNDEFINED__ SvPVX_const(sv)     ((const char*)((sv)->sv_u.svu_pv))
__UNDEFINED__ SvPVX_mutable(sv)   ((sv)->sv_u.svu_pv)

__UNDEFINED__ SvRV_set(sv, val) \
                STMT_START { assert(SvTYPE(sv) >=  SVt_RV); \
                ((sv)->sv_u.svu_rv = (val)); } STMT_END

#endif

__UNDEFINED__ SvSTASH_set(sv, val) \
                STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
                (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END

#if { VERSION < 5.004 }

__UNDEFINED__ SvUV_set(sv, val) \
                STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
                (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END

#else

__UNDEFINED__ SvUV_set(sv, val) \
                STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
                (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END

#endif

=xsubs

IV
TestSvUV_set(sv, val)
        SV *sv
        UV val
        CODE:
                SvUV_set(sv, val);
                RETVAL = SvUVX(sv) == val ? 42 : -1;
        OUTPUT:
                RETVAL

IV
TestSvPVX_const(sv)
        SV *sv
        CODE:
                RETVAL = strEQ(SvPVX_const(sv), "mhx") ? 43 : -1;
        OUTPUT:
                RETVAL

IV
TestSvPVX_mutable(sv)
        SV *sv
        CODE:
                RETVAL = strEQ(SvPVX_mutable(sv), "mhx") ? 44 : -1;
        OUTPUT:
                RETVAL

void
TestSvSTASH_set(sv, name)
        SV *sv
        char *name
        CODE:
                sv = SvRV(sv);
                SvREFCNT_dec(SvSTASH(sv));
                SvSTASH_set(sv, (HV*) SvREFCNT_inc(gv_stashpv(name, 0)));

IV
Test_sv_setsv_SV_NOSTEAL()
        PREINIT:
                SV *sv1, *sv2;
        CODE:
                sv1 = sv_2mortal(newSVpv("test1", 0));
                sv2 = sv_2mortal(newSVpv("test2", 0));
                sv_setsv_flags(sv2, sv1, SV_NOSTEAL);
                RETVAL = (strEQ(SvPV_nolen(sv1), "test1") && strEQ(SvPV_nolen(sv2), "test1"));
        OUTPUT:
                RETVAL

SV *
newSVsv_nomg(sv)
        SV *sv
        CODE:
                RETVAL = newSVsv_nomg(sv);
        OUTPUT:
                RETVAL

void
sv_setsv_compile_test(sv)
        SV *sv
        CODE:
                sv_setsv(sv, NULL);
                sv_setsv_flags(sv, NULL, 0);
                sv_setsv_flags(sv, NULL, SV_NOSTEAL);

=tests plan => 15

my $foo = 5;
is(&Devel::PPPort::TestSvUV_set($foo, 12345), 42);
is(&Devel::PPPort::TestSvPVX_const("mhx"), 43);
is(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44);

my $bar = [];

bless $bar, 'foo';
is($bar->x(), 'foobar');

Devel::PPPort::TestSvSTASH_set($bar, 'bar');
is($bar->x(), 'hacker');

    if (ivers($]) != ivers(5.7.2)) {
        ok(Devel::PPPort::Test_sv_setsv_SV_NOSTEAL());
    }
    else {
        skip("7.2 broken for NOSTEAL", 1);
    }

    tie my $scalar, 'TieScalarCounter', 'string';

    is tied($scalar)->{fetch}, 0;
    is tied($scalar)->{store}, 0;
    my $copy = Devel::PPPort::newSVsv_nomg($scalar);
    is tied($scalar)->{fetch}, 0;
    is tied($scalar)->{store}, 0;

    my $fetch = $scalar;
    is tied($scalar)->{fetch}, 1;
    is tied($scalar)->{store}, 0;
    my $copy2 = Devel::PPPort::newSVsv_nomg($scalar);
    is tied($scalar)->{fetch}, 1;
    is tied($scalar)->{store}, 0;
    is $copy2, 'string';

package TieScalarCounter;

sub TIESCALAR {
    my ($class, $value) = @_;
    return bless { fetch => 0, store => 0, value => $value }, $class;
}

sub FETCH {
    my ($self) = @_;
    $self->{fetch}++;
    return $self->{value};
}

sub STORE {
    my ($self, $value) = @_;
    $self->{store}++;
    $self->{value} = $value;
}

package foo;

sub x { 'foobar' }

package bar;

sub x { 'hacker' }