cvs commit: parrot/t/pmc objects.t

[Leopold Toetsch]

cvsuser     04/04/01 01:21:29

  Modified:    ops      object.ops
               t/pmc    objects.t
  Log:
  [perl #28134] [PATCH ops/object.ops] Report Class Name for Subclass Error
  
  Here's a patch to improve the string exception thrown when subclassing
  goes awry.  I've also added a newline to the end of the message to
  prettify the output.
  
  Courtesy of Chromatic <[EMAIL PROTECTED]>
  
  Revision  Changes    Path
  1.39      +6 -3      parrot/ops/object.ops
  
  Index: object.ops
  ===================================================================
  RCS file: /cvs/public/parrot/ops/object.ops,v
  retrieving revision 1.38
  retrieving revision 1.39
  diff -u -w -r1.38 -r1.39
  --- object.ops        26 Mar 2004 15:01:38 -0000      1.38
  +++ object.ops        1 Apr 2004 09:21:25 -0000       1.39
  @@ -191,7 +191,8 @@
     PMC *class = VTABLE_get_pmc_keyed_str(interpreter,
         interpreter->class_hash, $2);
     if (!class || !PObj_is_class_TEST(class)) {
  -    internal_exception(NO_CLASS, "Class doesn't exist");
  +    internal_exception(NO_CLASS, "Class '%s' doesn't exist\n",
  +             string_to_cstring( interpreter, $3 ));
     }
     $1 = Parrot_single_subclass(interpreter, class, $3);
     goto NEXT();
  @@ -201,7 +202,8 @@
     PMC *class = VTABLE_get_pmc_keyed_str(interpreter,
         interpreter->class_hash, $2);
     if (!class || !PObj_is_class_TEST(class)) {
  -    internal_exception(NO_CLASS, "Class doesn't exist");
  +    internal_exception(NO_CLASS, "Class '%s' doesn't exist\n",
  +             string_to_cstring( interpreter, $2 ));
     }
     $1 = Parrot_single_subclass(interpreter, class, NULL);
     goto NEXT();
  @@ -232,7 +234,8 @@
     if (VTABLE_exists_keyed_str(interpreter, interpreter->class_hash, $2)) {
       $1 = VTABLE_get_pmc_keyed_str(interpreter, interpreter->class_hash,  $2);
     } else {
  -    internal_exception(NO_CLASS, "Class doesn't exist");
  +    internal_exception(NO_CLASS, "Class '%s' doesn't exist\n",
  +             string_to_cstring( interpreter, $2 ));
     }
     goto NEXT();
   }
  
  
  
  1.38      +4 -4      parrot/t/pmc/objects.t
  
  Index: objects.t
  ===================================================================
  RCS file: /cvs/public/parrot/t/pmc/objects.t,v
  retrieving revision 1.37
  retrieving revision 1.38
  diff -u -w -r1.37 -r1.38
  --- objects.t 18 Mar 2004 08:57:30 -0000      1.37
  +++ objects.t 1 Apr 2004 09:21:29 -0000       1.38
  @@ -1,6 +1,6 @@
   #! perl -w
   # Copyright: 2001-2003 The Perl Foundation.  All Rights Reserved.
  -# $Id: objects.t,v 1.37 2004/03/18 08:57:30 leo Exp $
  +# $Id: objects.t,v 1.38 2004/04/01 09:21:29 leo Exp $
   
   =head1 NAME
   
  @@ -97,7 +97,7 @@
   CODE
   /Foo
   FooBar
  -Class doesn't exist/
  +Class 'NoSuch' doesn't exist/
   OUTPUT
   # ' for vim
   
  @@ -999,7 +999,7 @@
       print "Uh-oh...\n"
       end
   CODE
  -/Class doesn't exist/
  +/Class 'Nemo' doesn't exist/
   OUTPUT
   
   output_like(<<'CODE', <<'OUTPUT', "anon. subclass of non-existant class");
  @@ -1007,7 +1007,7 @@
       print "Uh-oh...\n"
       end
   CODE
  -/Class doesn't exist/
  +/Class 'Character' doesn't exist/
   OUTPUT
   
   output_like(<<'CODE', <<'OUTPUT', "anon. subclass classname");