This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move all mro:: XS functions from mro.c to ext/mro/mro.xs, except for
[perl5.git] / mro.c
1 /*    mro.c
2  *
3  *    Copyright (c) 2007 Brandon L Black
4  *    Copyright (c) 2007, 2008 Larry Wall and others
5  *
6  *    You may distribute under the terms of either the GNU General Public
7  *    License or the Artistic License, as specified in the README file.
8  *
9  */
10
11 /*
12  * 'Which order shall we go in?' said Frodo.  'Eldest first, or quickest first?
13  *  You'll be last either way, Master Peregrin.'
14  *
15  *     [p.101 of _The Lord of the Rings_, I/iii: "A Conspiracy Unmasked"]
16  */
17
18 /*
19 =head1 MRO Functions
20
21 These functions are related to the method resolution order of perl classes
22
23 =cut
24 */
25
26 #include "EXTERN.h"
27 #define PERL_IN_MRO_C
28 #include "perl.h"
29
30 static const struct mro_alg dfs_alg =
31     {S_mro_get_linear_isa_dfs, "dfs", 3, 0, 0};
32
33 SV *
34 Perl_mro_get_private_data(pTHX_ struct mro_meta *const smeta,
35                           const struct mro_alg *const which)
36 {
37     SV **data;
38     PERL_ARGS_ASSERT_MRO_GET_PRIVATE_DATA;
39
40     data = Perl_hv_common(aTHX_ smeta->mro_linear_all, NULL,
41                           which->name, which->length, which->kflags,
42                           HV_FETCH_JUST_SV, NULL, which->hash);
43     if (!data)
44         return NULL;
45
46     /* If we've been asked to look up the private data for the current MRO, then
47        cache it.  */
48     if (smeta->mro_which == which)
49         smeta->mro_linear_current = *data;
50
51     return *data;
52 }
53
54 SV *
55 Perl_mro_set_private_data(pTHX_ struct mro_meta *const smeta,
56                           const struct mro_alg *const which, SV *const data)
57 {
58     PERL_ARGS_ASSERT_MRO_SET_PRIVATE_DATA;
59
60     if (!smeta->mro_linear_all) {
61         if (smeta->mro_which == which) {
62             /* If all we need to store is the current MRO's data, then don't use
63                memory on a hash with 1 element - store it direct, and signal
64                this by leaving the would-be-hash NULL.  */
65             smeta->mro_linear_current = data;
66             return data;
67         } else {
68             HV *const hv = newHV();
69             /* Start with 2 buckets. It's unlikely we'll need more. */
70             HvMAX(hv) = 1;      
71             smeta->mro_linear_all = hv;
72
73             if (smeta->mro_linear_current) {
74                 /* If we were storing something directly, put it in the hash
75                    before we lose it. */
76                 Perl_mro_set_private_data(aTHX_ smeta, smeta->mro_which, 
77                                           smeta->mro_linear_current);
78             }
79         }
80     }
81
82     /* We get here if we're storing more than one linearisation for this stash,
83        or the linearisation we are storing is not that if its current MRO.  */
84
85     if (smeta->mro_which == which) {
86         /* If we've been asked to store the private data for the current MRO,
87            then cache it.  */
88         smeta->mro_linear_current = data;
89     }
90
91     if (!Perl_hv_common(aTHX_ smeta->mro_linear_all, NULL,
92                         which->name, which->length, which->kflags,
93                         HV_FETCH_ISSTORE, data, which->hash)) {
94         Perl_croak(aTHX_ "panic: hv_store() failed in set_mro_private_data() "
95                    "for '%.*s' %d", (int) which->length, which->name,
96                    which->kflags);
97     }
98
99     return data;
100 }
101
102 const struct mro_alg *
103 Perl_mro_get_from_name(pTHX_ SV *name) {
104     SV **data;
105
106     PERL_ARGS_ASSERT_MRO_GET_FROM_NAME;
107
108     data = Perl_hv_common(aTHX_ PL_registered_mros, name, NULL, 0, 0,
109                           HV_FETCH_JUST_SV, NULL, 0);
110     if (!data)
111         return NULL;
112     assert(SvTYPE(*data) == SVt_IV);
113     assert(SvIOK(*data));
114     return INT2PTR(const struct mro_alg *, SvUVX(*data));
115 }
116
117 void
118 Perl_mro_register(pTHX_ const struct mro_alg *mro) {
119     SV *wrapper = newSVuv(PTR2UV(mro));
120
121     PERL_ARGS_ASSERT_MRO_REGISTER;
122
123     
124     if (!Perl_hv_common(aTHX_ PL_registered_mros, NULL,
125                         mro->name, mro->length, mro->kflags,
126                         HV_FETCH_ISSTORE, wrapper, mro->hash)) {
127         SvREFCNT_dec(wrapper);
128         Perl_croak(aTHX_ "panic: hv_store() failed in mro_register() "
129                    "for '%.*s' %d", (int) mro->length, mro->name, mro->kflags);
130     }
131 }
132
133 struct mro_meta*
134 Perl_mro_meta_init(pTHX_ HV* stash)
135 {
136     struct mro_meta* newmeta;
137
138     PERL_ARGS_ASSERT_MRO_META_INIT;
139     assert(HvAUX(stash));
140     assert(!(HvAUX(stash)->xhv_mro_meta));
141     Newxz(newmeta, 1, struct mro_meta);
142     HvAUX(stash)->xhv_mro_meta = newmeta;
143     newmeta->cache_gen = 1;
144     newmeta->pkg_gen = 1;
145     newmeta->mro_which = &dfs_alg;
146
147     return newmeta;
148 }
149
150 #if defined(USE_ITHREADS)
151
152 /* for sv_dup on new threads */
153 struct mro_meta*
154 Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param)
155 {
156     struct mro_meta* newmeta;
157
158     PERL_ARGS_ASSERT_MRO_META_DUP;
159
160     Newx(newmeta, 1, struct mro_meta);
161     Copy(smeta, newmeta, 1, struct mro_meta);
162
163     if (newmeta->mro_linear_all) {
164         newmeta->mro_linear_all
165             = MUTABLE_HV(SvREFCNT_inc(sv_dup((const SV *)newmeta->mro_linear_all, param)));
166         /* This is just acting as a shortcut pointer, and will be automatically
167            updated on the first get.  */
168         newmeta->mro_linear_current = NULL;
169     } else if (newmeta->mro_linear_current) {
170         /* Only the current MRO is stored, so this owns the data.  */
171         newmeta->mro_linear_current
172             = SvREFCNT_inc(sv_dup((const SV *)newmeta->mro_linear_current,
173                                   param));
174     }
175
176     if (newmeta->mro_nextmethod)
177         newmeta->mro_nextmethod
178             = MUTABLE_HV(SvREFCNT_inc(sv_dup((const SV *)newmeta->mro_nextmethod, param)));
179     if (newmeta->isa)
180         newmeta->isa
181             = MUTABLE_HV(SvREFCNT_inc(sv_dup((const SV *)newmeta->isa, param)));
182
183     return newmeta;
184 }
185
186 #endif /* USE_ITHREADS */
187
188 HV *
189 Perl_get_isa_hash(pTHX_ HV *const stash)
190 {
191     dVAR;
192     struct mro_meta *const meta = HvMROMETA(stash);
193
194     PERL_ARGS_ASSERT_GET_ISA_HASH;
195
196     if (!meta->isa) {
197         AV *const isa = mro_get_linear_isa(stash);
198         if (!meta->isa) {
199             HV *const isa_hash = newHV();
200             /* Linearisation didn't build it for us, so do it here.  */
201             SV *const *svp = AvARRAY(isa);
202             SV *const *const svp_end = svp + AvFILLp(isa) + 1;
203             const HEK *const canon_name = HvNAME_HEK(stash);
204
205             while (svp < svp_end) {
206                 (void) hv_store_ent(isa_hash, *svp++, &PL_sv_undef, 0);
207             }
208
209             (void) hv_common(isa_hash, NULL, HEK_KEY(canon_name),
210                              HEK_LEN(canon_name), HEK_FLAGS(canon_name),
211                              HV_FETCH_ISSTORE, &PL_sv_undef,
212                              HEK_HASH(canon_name));
213             (void) hv_store(isa_hash, "UNIVERSAL", 9, &PL_sv_undef, 0);
214
215             SvREADONLY_on(isa_hash);
216
217             meta->isa = isa_hash;
218         }
219     }
220     return meta->isa;
221 }
222
223 /*
224 =for apidoc mro_get_linear_isa_dfs
225
226 Returns the Depth-First Search linearization of @ISA
227 the given stash.  The return value is a read-only AV*.
228 C<level> should be 0 (it is used internally in this
229 function's recursion).
230
231 You are responsible for C<SvREFCNT_inc()> on the
232 return value if you plan to store it anywhere
233 semi-permanently (otherwise it might be deleted
234 out from under you the next time the cache is
235 invalidated).
236
237 =cut
238 */
239 static AV*
240 S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
241 {
242     AV* retval;
243     GV** gvp;
244     GV* gv;
245     AV* av;
246     const HEK* stashhek;
247     struct mro_meta* meta;
248     SV *our_name;
249     HV *stored;
250
251     PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_DFS;
252     assert(HvAUX(stash));
253
254     stashhek = HvNAME_HEK(stash);
255     if (!stashhek)
256       Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
257
258     if (level > 100)
259         Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
260                    HEK_KEY(stashhek));
261
262     meta = HvMROMETA(stash);
263
264     /* return cache if valid */
265     if((retval = MUTABLE_AV(MRO_GET_PRIVATE_DATA(meta, &dfs_alg)))) {
266         return retval;
267     }
268
269     /* not in cache, make a new one */
270
271     retval = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
272     /* We use this later in this function, but don't need a reference to it
273        beyond the end of this function, so reference count is fine.  */
274     our_name = newSVhek(stashhek);
275     av_push(retval, our_name); /* add ourselves at the top */
276
277     /* fetch our @ISA */
278     gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
279     av = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
280
281     /* "stored" is used to keep track of all of the classnames we have added to
282        the MRO so far, so we can do a quick exists check and avoid adding
283        duplicate classnames to the MRO as we go.
284        It's then retained to be re-used as a fast lookup for ->isa(), by adding
285        our own name and "UNIVERSAL" to it.  */
286
287     stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
288
289     if(av && AvFILLp(av) >= 0) {
290
291         SV **svp = AvARRAY(av);
292         I32 items = AvFILLp(av) + 1;
293
294         /* foreach(@ISA) */
295         while (items--) {
296             SV* const sv = *svp++;
297             HV* const basestash = gv_stashsv(sv, 0);
298             SV *const *subrv_p;
299             I32 subrv_items;
300
301             if (!basestash) {
302                 /* if no stash exists for this @ISA member,
303                    simply add it to the MRO and move on */
304                 subrv_p = &sv;
305                 subrv_items = 1;
306             }
307             else {
308                 /* otherwise, recurse into ourselves for the MRO
309                    of this @ISA member, and append their MRO to ours.
310                    The recursive call could throw an exception, which
311                    has memory management implications here, hence the use of
312                    the mortal.  */
313                 const AV *const subrv
314                     = mro_get_linear_isa_dfs(basestash, level + 1);
315
316                 subrv_p = AvARRAY(subrv);
317                 subrv_items = AvFILLp(subrv) + 1;
318             }
319             while(subrv_items--) {
320                 SV *const subsv = *subrv_p++;
321                 /* LVALUE fetch will create a new undefined SV if necessary
322                  */
323                 HE *const he = hv_fetch_ent(stored, subsv, 1, 0);
324                 assert(he);
325                 if(HeVAL(he) != &PL_sv_undef) {
326                     /* It was newly created.  Steal it for our new SV, and
327                        replace it in the hash with the "real" thing.  */
328                     SV *const val = HeVAL(he);
329                     HEK *const key = HeKEY_hek(he);
330
331                     HeVAL(he) = &PL_sv_undef;
332                     /* Save copying by making a shared hash key scalar. We
333                        inline this here rather than calling Perl_newSVpvn_share
334                        because we already have the scalar, and we already have
335                        the hash key.  */
336                     assert(SvTYPE(val) == SVt_NULL);
337                     sv_upgrade(val, SVt_PV);
338                     SvPV_set(val, HEK_KEY(share_hek_hek(key)));
339                     SvCUR_set(val, HEK_LEN(key));
340                     SvREADONLY_on(val);
341                     SvFAKE_on(val);
342                     SvPOK_on(val);
343                     if (HEK_UTF8(key))
344                         SvUTF8_on(val);
345
346                     av_push(retval, val);
347                 }
348             }
349         }
350     }
351
352     (void) hv_store_ent(stored, our_name, &PL_sv_undef, 0);
353     (void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
354
355     SvREFCNT_inc_simple_void_NN(stored);
356     SvTEMP_off(stored);
357     SvREADONLY_on(stored);
358
359     meta->isa = stored;
360
361     /* now that we're past the exception dangers, grab our own reference to
362        the AV we're about to use for the result. The reference owned by the
363        mortals' stack will be released soon, so everything will balance.  */
364     SvREFCNT_inc_simple_void_NN(retval);
365     SvTEMP_off(retval);
366
367     /* we don't want anyone modifying the cache entry but us,
368        and we do so by replacing it completely */
369     SvREADONLY_on(retval);
370
371     return MUTABLE_AV(Perl_mro_set_private_data(aTHX_ meta, &dfs_alg,
372                                                 MUTABLE_SV(retval)));
373 }
374
375 /*
376 =for apidoc mro_get_linear_isa
377
378 Returns either C<mro_get_linear_isa_c3> or
379 C<mro_get_linear_isa_dfs> for the given stash,
380 dependant upon which MRO is in effect
381 for that stash.  The return value is a
382 read-only AV*.
383
384 You are responsible for C<SvREFCNT_inc()> on the
385 return value if you plan to store it anywhere
386 semi-permanently (otherwise it might be deleted
387 out from under you the next time the cache is
388 invalidated).
389
390 =cut
391 */
392 AV*
393 Perl_mro_get_linear_isa(pTHX_ HV *stash)
394 {
395     struct mro_meta* meta;
396
397     PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA;
398     if(!SvOOK(stash))
399         Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
400
401     meta = HvMROMETA(stash);
402     if (!meta->mro_which)
403         Perl_croak(aTHX_ "panic: invalid MRO!");
404     return meta->mro_which->resolve(aTHX_ stash, 0);
405 }
406
407 /*
408 =for apidoc mro_isa_changed_in
409
410 Takes the necessary steps (cache invalidations, mostly)
411 when the @ISA of the given package has changed.  Invoked
412 by the C<setisa> magic, should not need to invoke directly.
413
414 =cut
415 */
416 void
417 Perl_mro_isa_changed_in(pTHX_ HV* stash)
418 {
419     dVAR;
420     HV* isarev;
421     AV* linear_mro;
422     HE* iter;
423     SV** svp;
424     I32 items;
425     bool is_universal;
426     struct mro_meta * meta;
427
428     const char * const stashname = HvNAME_get(stash);
429     const STRLEN stashname_len = HvNAMELEN_get(stash);
430
431     PERL_ARGS_ASSERT_MRO_ISA_CHANGED_IN;
432
433     if(!stashname)
434         Perl_croak(aTHX_ "Can't call mro_isa_changed_in() on anonymous symbol table");
435
436     /* wipe out the cached linearizations for this stash */
437     meta = HvMROMETA(stash);
438     if (meta->mro_linear_all) {
439         SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_all));
440         meta->mro_linear_all = NULL;
441         /* This is just acting as a shortcut pointer.  */
442         meta->mro_linear_current = NULL;
443     } else if (meta->mro_linear_current) {
444         /* Only the current MRO is stored, so this owns the data.  */
445         SvREFCNT_dec(meta->mro_linear_current);
446         meta->mro_linear_current = NULL;
447     }
448     if (meta->isa) {
449         SvREFCNT_dec(meta->isa);
450         meta->isa = NULL;
451     }
452
453     /* Inc the package generation, since our @ISA changed */
454     meta->pkg_gen++;
455
456     /* Wipe the global method cache if this package
457        is UNIVERSAL or one of its parents */
458
459     svp = hv_fetch(PL_isarev, stashname, stashname_len, 0);
460     isarev = svp ? MUTABLE_HV(*svp) : NULL;
461
462     if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
463         || (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
464         PL_sub_generation++;
465         is_universal = TRUE;
466     }
467     else { /* Wipe the local method cache otherwise */
468         meta->cache_gen++;
469         is_universal = FALSE;
470     }
471
472     /* wipe next::method cache too */
473     if(meta->mro_nextmethod) hv_clear(meta->mro_nextmethod);
474
475     /* Iterate the isarev (classes that are our children),
476        wiping out their linearization and method caches */
477     if(isarev) {
478         hv_iterinit(isarev);
479         while((iter = hv_iternext(isarev))) {
480             I32 len;
481             const char* const revkey = hv_iterkey(iter, &len);
482             HV* revstash = gv_stashpvn(revkey, len, 0);
483             struct mro_meta* revmeta;
484
485             if(!revstash) continue;
486             revmeta = HvMROMETA(revstash);
487             if (revmeta->mro_linear_all) {
488                 SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_all));
489                 revmeta->mro_linear_all = NULL;
490                 /* This is just acting as a shortcut pointer.  */
491                 revmeta->mro_linear_current = NULL;
492             } else if (revmeta->mro_linear_current) {
493                 /* Only the current MRO is stored, so this owns the data.  */
494                 SvREFCNT_dec(revmeta->mro_linear_current);
495                 revmeta->mro_linear_current = NULL;
496             }
497             if(!is_universal)
498                 revmeta->cache_gen++;
499             if(revmeta->mro_nextmethod)
500                 hv_clear(revmeta->mro_nextmethod);
501         }
502     }
503
504     /* Now iterate our MRO (parents), and do a few things:
505          1) instantiate with the "fake" flag if they don't exist
506          2) flag them as universal if we are universal
507          3) Add everything from our isarev to their isarev
508     */
509
510     /* We're starting at the 2nd element, skipping ourselves here */
511     linear_mro = mro_get_linear_isa(stash);
512     svp = AvARRAY(linear_mro) + 1;
513     items = AvFILLp(linear_mro);
514
515     while (items--) {
516         SV* const sv = *svp++;
517         HV* mroisarev;
518
519         HE *he = hv_fetch_ent(PL_isarev, sv, TRUE, 0);
520
521         /* That fetch should not fail.  But if it had to create a new SV for
522            us, then will need to upgrade it to an HV (which sv_upgrade() can
523            now do for us. */
524
525         mroisarev = MUTABLE_HV(HeVAL(he));
526
527         SvUPGRADE(MUTABLE_SV(mroisarev), SVt_PVHV);
528
529         /* This hash only ever contains PL_sv_yes. Storing it over itself is
530            almost as cheap as calling hv_exists, so on aggregate we expect to
531            save time by not making two calls to the common HV code for the
532            case where it doesn't exist.  */
533            
534         (void)hv_store(mroisarev, stashname, stashname_len, &PL_sv_yes, 0);
535
536         if(isarev) {
537             hv_iterinit(isarev);
538             while((iter = hv_iternext(isarev))) {
539                 I32 revkeylen;
540                 char* const revkey = hv_iterkey(iter, &revkeylen);
541                 (void)hv_store(mroisarev, revkey, revkeylen, &PL_sv_yes, 0);
542             }
543         }
544     }
545 }
546
547 /*
548 =for apidoc mro_method_changed_in
549
550 Invalidates method caching on any child classes
551 of the given stash, so that they might notice
552 the changes in this one.
553
554 Ideally, all instances of C<PL_sub_generation++> in
555 perl source outside of C<mro.c> should be
556 replaced by calls to this.
557
558 Perl automatically handles most of the common
559 ways a method might be redefined.  However, there
560 are a few ways you could change a method in a stash
561 without the cache code noticing, in which case you
562 need to call this method afterwards:
563
564 1) Directly manipulating the stash HV entries from
565 XS code.
566
567 2) Assigning a reference to a readonly scalar
568 constant into a stash entry in order to create
569 a constant subroutine (like constant.pm
570 does).
571
572 This same method is available from pure perl
573 via, C<mro::method_changed_in(classname)>.
574
575 =cut
576 */
577 void
578 Perl_mro_method_changed_in(pTHX_ HV *stash)
579 {
580     const char * const stashname = HvNAME_get(stash);
581     const STRLEN stashname_len = HvNAMELEN_get(stash);
582
583     SV ** const svp = hv_fetch(PL_isarev, stashname, stashname_len, 0);
584     HV * const isarev = svp ? MUTABLE_HV(*svp) : NULL;
585
586     PERL_ARGS_ASSERT_MRO_METHOD_CHANGED_IN;
587
588     if(!stashname)
589         Perl_croak(aTHX_ "Can't call mro_method_changed_in() on anonymous symbol table");
590
591     /* Inc the package generation, since a local method changed */
592     HvMROMETA(stash)->pkg_gen++;
593
594     /* If stash is UNIVERSAL, or one of UNIVERSAL's parents,
595        invalidate all method caches globally */
596     if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
597         || (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
598         PL_sub_generation++;
599         return;
600     }
601
602     /* else, invalidate the method caches of all child classes,
603        but not itself */
604     if(isarev) {
605         HE* iter;
606
607         hv_iterinit(isarev);
608         while((iter = hv_iternext(isarev))) {
609             I32 len;
610             const char* const revkey = hv_iterkey(iter, &len);
611             HV* const revstash = gv_stashpvn(revkey, len, 0);
612             struct mro_meta* mrometa;
613
614             if(!revstash) continue;
615             mrometa = HvMROMETA(revstash);
616             mrometa->cache_gen++;
617             if(mrometa->mro_nextmethod)
618                 hv_clear(mrometa->mro_nextmethod);
619         }
620     }
621 }
622
623 void
624 Perl_mro_set_mro(pTHX_ struct mro_meta *const meta, SV *const name)
625 {
626     const struct mro_alg *const which = Perl_mro_get_from_name(aTHX_ name);
627  
628     PERL_ARGS_ASSERT_MRO_SET_MRO;
629
630     if (!which)
631         Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", name);
632
633     if(meta->mro_which != which) {
634         if (meta->mro_linear_current && !meta->mro_linear_all) {
635             /* If we were storing something directly, put it in the hash before
636                we lose it. */
637             Perl_mro_set_private_data(aTHX_ meta, meta->mro_which, 
638                                       MUTABLE_SV(meta->mro_linear_current));
639         }
640         meta->mro_which = which;
641         /* Scrub our cached pointer to the private data.  */
642         meta->mro_linear_current = NULL;
643         /* Only affects local method cache, not
644            even child classes */
645         meta->cache_gen++;
646         if(meta->mro_nextmethod)
647             hv_clear(meta->mro_nextmethod);
648     }
649 }
650
651 #include "XSUB.h"
652
653 XS(XS_mro_method_changed_in);
654
655 void
656 Perl_boot_core_mro(pTHX)
657 {
658     dVAR;
659     static const char file[] = __FILE__;
660
661     Perl_mro_register(aTHX_ &dfs_alg);
662
663     newXSproto("mro::method_changed_in", XS_mro_method_changed_in, file, "$");
664 }
665
666 XS(XS_mro_method_changed_in)
667 {
668     dVAR;
669     dXSARGS;
670     SV* classname;
671     HV* class_stash;
672
673     if(items != 1)
674         croak_xs_usage(cv, "classname");
675     
676     classname = ST(0);
677
678     class_stash = gv_stashsv(classname, 0);
679     if(!class_stash) Perl_croak(aTHX_ "No such class: '%"SVf"'!", SVfARG(classname));
680
681     mro_method_changed_in(class_stash);
682
683     XSRETURN_EMPTY;
684 }
685
686 /*
687  * Local variables:
688  * c-indentation-style: bsd
689  * c-basic-offset: 4
690  * indent-tabs-mode: t
691  * End:
692  *
693  * ex: set ts=8 sts=4 sw=4 noet:
694  */