On Thu, Jan 5, 2012 at 16:59, Andrew Dunstan <and...@dunslane.net> wrote:
>
>
> On 01/05/2012 06:31 PM, Alex Hunsaker wrote:
>>
>> On Thu, Jan 5, 2012 at 16:02, Andrew Dunstan<and...@dunslane.net>  wrote:
>>>
>>> Fix breakage from earlier plperl fix.

>> I can't help but think this seems a bit inefficient
>
> So, yes, we should probably adjust this one more time, but ideally we need a
> better test than just SvREADONLY(). If you want to follow up your
> investigation of exactly when we need a copied SV and see how much you can
> narrow it down that would be great.

After further digging I found it chokes on any non scalar (IOW any
reference). I attached a simple c program that I tested with 5.8.9,
5.10.1, 5.12.4 and 5.14.2 (for those who did not know about it,
perlbrew made testing across all those perls relatively painless).

PFA that copies if its readonly and its not a scalar. Also I fixed up
Tom's complaint about having sv2cstr() inside do_util_elog's PG_TRY
block. I didn't bother fixing the ones in plperl.c tho-- some seemed
like they would require quite a bit of rejiggering.

I didn't bother adding regression tests-- should I have?
*** a/src/pl/plperl/Util.xs
--- b/src/pl/plperl/Util.xs
***************
*** 37,47 **** static void
  do_util_elog(int level, SV *msg)
  {
  	MemoryContext oldcontext = CurrentMemoryContext;
! 	char	   * volatile cmsg = NULL;
  
  	PG_TRY();
  	{
- 		cmsg = sv2cstr(msg);
  		elog(level, "%s", cmsg);
  		pfree(cmsg);
  	}
--- 37,46 ----
  do_util_elog(int level, SV *msg)
  {
  	MemoryContext oldcontext = CurrentMemoryContext;
! 	char	   * volatile cmsg = sv2cstr(msg);
  
  	PG_TRY();
  	{
  		elog(level, "%s", cmsg);
  		pfree(cmsg);
  	}
*** a/src/pl/plperl/plperl_helpers.h
--- b/src/pl/plperl/plperl_helpers.h
***************
*** 47,74 **** sv2cstr(SV *sv)
  {
  	char	   *val, *res;
  	STRLEN		len;
! 	SV         *nsv;
  
  	/*
  	 * get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
  	 *
! 	 * SvPVutf8() croaks nastily on certain things, like typeglobs and
! 	 * readonly objects such as $^V. That's a perl bug - it's not supposed to
! 	 * happen. To avoid crashing the backend, we make a copy of the
! 	 * sv before passing it to SvPVutf8(). The copy is garbage collected 
! 	 * when we're done with it.
  	 */
! 	nsv = newSVsv(sv);
! 	val = SvPVutf8(nsv, len);
  
  	/*
  	 * we use perl's length in the event we had an embedded null byte to ensure
  	 * we error out properly
  	 */
! 	res =  utf_u2e(val, len);
  
  	/* safe now to garbage collect the new SV */
! 	SvREFCNT_dec(nsv);
  
  	return res;
  }
--- 47,79 ----
  {
  	char	   *val, *res;
  	STRLEN		len;
! 	svtype		type = SvTYPE(sv);
  
  	/*
  	 * get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
  	 *
! 	 * SvPVutf8() croaks nastily on readonly refs, That's a perl bug - it's not
! 	 * supposed to happen. To avoid crashing the backend, we make a copy of the
! 	 * sv before passing it to SvPVutf8().
  	 */
! 	if (SvREADONLY(sv) &&
! 			(type != SVt_IV ||
! 			type != SVt_NV ||
! 			type != SVt_PV))
! 		sv = newSVsv(sv);
! 	else
! 		SvREFCNT_inc(sv);
! 
! 	val = SvPVutf8(sv, len);
  
  	/*
  	 * we use perl's length in the event we had an embedded null byte to ensure
  	 * we error out properly
  	 */
! 	res = utf_u2e(val, len);
  
  	/* safe now to garbage collect the new SV */
! 	SvREFCNT_dec(sv);
  
  	return res;
  }
/*
 * compile with gcc  -O2 -ggdb `perl -MExtUtils::Embed -e ccopts -e ldopts` svutf8_ro_test.c
 */
#include <EXTERN.h>
#include <perl.h>

int main(void)
{
	char *embed[] = { "", "-e", "0" };
	int x;
	AV	*test;
	PerlInterpreter *perl;

	perl_construct(perl);
	perl_parse(perl, NULL, 3, embed, NULL);
	perl_run(perl);

	eval_pv("my $scalar = 'string';"
			"@test = ("
			"'string', "
			"$scalar, "
			"\\$scalar, "
			"1, "
			"1.5, "
			"[], "
			"{}, "
			"$^V, ,"
			"v5.0.0, "
			"sub {}, "
			"qr//, "
			"*STDIN, "
			"bless({}, ''), "
			");", 1);

	test = get_av("test", 0);
	for(x=0; x<=av_len(test); x++)
	{
		char *crap;
		STRLEN len;
		SV *sv = *av_fetch(test, x, 0);
		svtype type = SvTYPE(sv);

		SvREADONLY_on(sv);

		if (SvREADONLY(sv) &&
				type != SVt_IV ||
				type != SVt_NV ||
				type != SVt_PV)
			sv = newSVsv(sv);

		crap = SvPVutf8(sv, len);
	}

	perl_destruct(perl);
	perl_free(perl);

	return 0;
}
-- 
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers

Reply via email to