[svn:ponie] rev 290 - in trunk/perl: . ext/threads/t pod

[email protected] 24 Jun 2005 10:27:04 -0000
Newsgroups perl.ponie.changes
Message-ID <[email protected]>
Author: nicholas
Date: Fri Jun 24 03:27:03 2005
New Revision: 290

Modified:
   trunk/perl/embed.fnc
   trunk/perl/embed.h
   trunk/perl/ext/threads/t/problems.t
   trunk/perl/pod/perltodo.pod
   trunk/perl/proto.h
   trunk/perl/sv.c
Log:
Integrate change 24962 from blead (remove existing :unique implementation)


Modified: trunk/perl/embed.fnc
==============================================================================
--- trunk/perl/embed.fnc	(original)
+++ trunk/perl/embed.fnc	Fri Jun 24 03:27:03 2005
@@ -1180,9 +1180,6 @@ s	|int	|sv_2iuv_non_preserve	|SV *sv|I32
 #  endif
 s	|I32	|expect_number	|char** pattern
 #
-#  if defined(USE_ITHREADS)
-s	|SV*	|gv_share	|SV *sv|CLONE_PARAMS *param
-#  endif
 s	|bool	|utf8_mg_pos	|SV *sv|MAGIC **mgp|STRLEN **cachep|I32 i|I32 *offsetp|I32 uoff|U8 **sp|U8 *start|U8 *send
 s	|bool	|utf8_mg_pos_init	|SV *sv|MAGIC **mgp|STRLEN **cachep|I32 i|I32 *offsetp|U8 *s|U8 *start
 #if defined(PERL_COPY_ON_WRITE)

Modified: trunk/perl/embed.h
==============================================================================
--- trunk/perl/embed.h	(original)
+++ trunk/perl/embed.h	Fri Jun 24 03:27:03 2005
@@ -1725,11 +1725,6 @@
 #ifdef PERL_CORE
 #define expect_number		S_expect_number
 #endif
-#  if defined(USE_ITHREADS)
-#ifdef PERL_CORE
-#define gv_share		S_gv_share
-#endif
-#  endif
 #ifdef PERL_CORE
 #define utf8_mg_pos		S_utf8_mg_pos
 #endif
@@ -4207,11 +4202,6 @@
 #ifdef PERL_CORE
 #define expect_number(a)	S_expect_number(aTHX_ a)
 #endif
-#  if defined(USE_ITHREADS)
-#ifdef PERL_CORE
-#define gv_share(a,b)		S_gv_share(aTHX_ a,b)
-#endif
-#  endif
 #ifdef PERL_CORE
 #define utf8_mg_pos(a,b,c,d,e,f,g,h,i)	S_utf8_mg_pos(aTHX_ a,b,c,d,e,f,g,h,i)
 #endif

Modified: trunk/perl/ext/threads/t/problems.t
==============================================================================
--- trunk/perl/ext/threads/t/problems.t	(original)
+++ trunk/perl/ext/threads/t/problems.t	Fri Jun 24 03:27:03 2005
@@ -81,14 +81,18 @@ our @unique_array : unique;
 our %unique_hash : unique;
 threads->new(
     sub {
+	my $TODO = ":unique needs to be re-implemented in a non-broken way";
 	eval { $unique_scalar = 1 };
-	print $@ =~ /read-only/  ? '' : 'not ', "ok $test - unique_scalar\n";
+	print $@ =~ /read-only/
+	  ? '' : 'not ', "ok $test # TODO $TODO unique_scalar\n";
 	$test++;
 	eval { $unique_array[0] = 1 };
-	print $@ =~ /read-only/  ? '' : 'not ', "ok $test - unique_array\n";
+	print $@ =~ /read-only/
+	  ? '' : 'not ', "ok $test # TODO $TODO - unique_array\n";
 	$test++;
 	eval { $unique_hash{abc} = 1 };
-	print $@ =~ /disallowed/  ? '' : 'not ', "ok $test - unique_hash\n";
+	print $@ =~ /disallowed/
+	  ? '' : 'not ', "ok $test # TODO $TODO - unique_hash\n";
 	$test++;
     }
 )->join;

Modified: trunk/perl/pod/perltodo.pod
==============================================================================
--- trunk/perl/pod/perltodo.pod	(original)
+++ trunk/perl/pod/perltodo.pod	Fri Jun 24 03:27:03 2005
@@ -265,7 +265,21 @@ Some more nebulous ideas
 
 =head2 threads
 
-Make threads more robust.
+=over 4
+
+=item *
+
+Re-implement C<:unique> in a way that is actualy thread-safe
+
+=item *
+
+Make C<threads::shared> share aggregates properly
+
+(these two may actually share approach, if not implementation
+
+=back
+
+Generally make threads more robust. See also L<iCOW>
 
 =head2 POSIX memory footprint
 

Modified: trunk/perl/proto.h
==============================================================================
--- trunk/perl/proto.h	(original)
+++ trunk/perl/proto.h	Fri Jun 24 03:27:03 2005
@@ -1132,9 +1132,6 @@ STATIC int	S_sv_2iuv_non_preserve(pTHX_ 
 #  endif
 STATIC I32	S_expect_number(pTHX_ char** pattern);
 #
-#  if defined(USE_ITHREADS)
-STATIC SV*	S_gv_share(pTHX_ SV *sv, CLONE_PARAMS *param);
-#  endif
 STATIC bool	S_utf8_mg_pos(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, I32 uoff, U8 **sp, U8 *start, U8 *send);
 STATIC bool	S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, U8 *s, U8 *start);
 #if defined(PERL_COPY_ON_WRITE)

Modified: trunk/perl/sv.c
==============================================================================
--- trunk/perl/sv.c	(original)
+++ trunk/perl/sv.c	Fri Jun 24 03:27:03 2005
@@ -9430,63 +9430,6 @@ Perl_ptr_table_free(pTHX_ PTR_TBL_t *tbl
 char *PL_watch_pvx;
 #endif
 
-/* attempt to make everything in the typeglob readonly */
-
-STATIC SV *
-S_gv_share(pTHX_ SV *sstr, CLONE_PARAMS *param)
-{
-    GV *gv = (GV*)sstr;
-    SV *sv = &param->proto_perl->Isv_no; /* just need SvREADONLY-ness */
-
-    if (GvIO(gv) || GvFORM(gv)) {
-        GvUNIQUE_off(gv); /* GvIOs cannot be shared. nor can GvFORMs */
-    }
-    else if (!GvCV(gv)) {
-        GvCV(gv) = (CV*)sv;
-    }
-    else {
-        /* CvPADLISTs cannot be shared */
-        if (!SvREADONLY(GvCV(gv)) && !CvXSUB(GvCV(gv))) {
-            GvUNIQUE_off(gv);
-        }
-    }
-
-    if (!GvUNIQUE(gv)) {
-#if 0
-        PerlIO_printf(Perl_debug_log, "gv_share: unable to share %s::%s\n",
-                      HvNAME(GvSTASH(gv)), GvNAME(gv));
-#endif
-        return Nullsv;
-    }
-
-    /*
-     * write attempts will die with
-     * "Modification of a read-only value attempted"
-     */
-    if (!GvSV(gv)) {
-        GvSV(gv) = sv;
-    }
-    else {
-        SvREADONLY_on(GvSV(gv));
-    }
-
-    if (!GvAV(gv)) {
-        GvAV(gv) = (AV*)sv;
-    }
-    else {
-        SvREADONLY_on(GvAV(gv));
-    }
-
-    if (!GvHV(gv)) {
-        GvHV(gv) = (HV*)sv;
-    }
-    else {
-        SvREADONLY_on(GvHV(gv));
-    }
-
-    return sstr; /* he_dup() will SvREFCNT_inc() */
-}
-
 /* duplicate an SV of any type (including AV, HV etc) */
 
 void
@@ -9677,17 +9620,7 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS
 	break;
     case SVt_PVGV:
 	if (GvUNIQUE((GV*)sstr)) {
-            SV *share;
-            if ((share = gv_share(sstr, param))) {
-                del_SV(dstr);
-                dstr = share;
-                ptr_table_store(PL_ptr_table, sstr, dstr);
-#if 0
-                PerlIO_printf(Perl_debug_log, "sv_dup: sharing %s::%s\n",
-                              HvNAME(GvSTASH(share)), GvNAME(share));
-#endif
-                break;
-            }
+	    /* Do sharing here.  */
 	}
 	SvANY(dstr)	= new_XPVGV();
 	SvCUR_set(dstr, SvCUR(sstr));