cvsuser 04/05/09 07:58:12
Modified: . MANIFEST
config/gen core_pmcs.pl
config/inter pmc.pl
t/op types.t
Added: classes pmc.num
Log:
fix assigned enum_class PMC enums
* the new file classes/pmc.num now hold PMC type ordering
* some hacks due to abstract and const PMCs
* remove a bogus test
Revision Changes Path
1.642 +1 -0 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.641
retrieving revision 1.642
diff -u -w -r1.641 -r1.642
--- MANIFEST 9 May 2004 07:56:23 -0000 1.641
+++ MANIFEST 9 May 2004 14:57:58 -0000 1.642
@@ -73,6 +73,7 @@
classes/pmc2c.pl []
classes/pmc2c2.pl []
classes/pmcarray.pmc []
+classes/pmc.num []
classes/pointer.pmc []
classes/random.pmc []
classes/ref.pmc []
1.1 parrot/classes/pmc.num
Index: pmc.num
===================================================================
# build and class enum order of all pmcs
# filenam {ws} number
# parents of some class should be listed before their childs
# default must be 0
default.pmc 0
# now utility PMCs that don't do MMD
null.pmc 1
env.pmc 2
perlenv.pmc 3
key.pmc 4
random.pmc 5
unmanagedstruct.pmc 6
managedstruct.pmc 7
delegate.pmc 8
csub.pmc 9
compiler.pmc 10
exception.pmc 11
version.pmc 12
vtablecache.pmc 13
parrotio.pmc 14
parrotlibrary.pmc 15
constparrotlibrary.pmc 16
parrotinterpreter.pmc 17
parrotthread.pmc 18
scratchpad.pmc 19
timer.pmc 20
pointer.pmc 21
# sub and subroutine like pmcs
sub.pmc 22
closure.pmc 23
continuation.pmc 24
retcontinuation.pmc 25
exception_handler.pmc 26
coroutine.pmc 27
eval.pmc 28
nci.pmc 29
# scalars
# abstract scalar.pmc 29
float.pmc 30
integer.pmc 31
# abstract perlscalar.pmc
perlint.pmc 32
perlnum.pmc 33
perlstring.pmc 34
perlundef.pmc 35
boolean.pmc 36
ref.pmc 37
sharedref.pmc 38
# arrays
array.pmc 39
floatvalarray.pmc 40
intlist.pmc 41
iterator.pmc 42
perlarray.pmc 43
pmcarray.pmc 44
sarray.pmc 45
constsarray.pmc 46
stringarray.pmc 47
multiarray.pmc 48
# hashes
perlhash.pmc 49
orderedhash.pmc 50
# other
tqueue.pmc 51
parrotclass.pmc 52
parrotobject.pmc 53
# obsolete soon
mmd_default.pmc 54
1.14 +6 -2 parrot/config/gen/core_pmcs.pl
Index: core_pmcs.pl
===================================================================
RCS file: /cvs/public/parrot/config/gen/core_pmcs.pl,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- core_pmcs.pl 26 Feb 2004 00:43:05 -0000 1.13
+++ core_pmcs.pl 9 May 2004 14:58:06 -0000 1.14
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: core_pmcs.pl,v 1.13 2004/02/26 00:43:05 mikescott Exp $
+# $Id: core_pmcs.pl,v 1.14 2004/05/09 14:58:06 leo Exp $
=head1 NAME
@@ -45,7 +45,11 @@
my @pmcs = split(/ /, Configure::Data->get('pmc_names'));
print OUT " enum_class_default,\n";
- print OUT " enum_class_$_,\n" foreach (@pmcs);
+ my $i = 1;
+ foreach (@pmcs) {
+ print OUT " enum_class_$_,\t/* $i */ \n";
+ $i++;
+ }
print OUT <<"END";
enum_class_core_max
};
1.17 +38 -2 parrot/config/inter/pmc.pl
Index: pmc.pl
===================================================================
RCS file: /cvs/public/parrot/config/inter/pmc.pl,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- pmc.pl 28 Apr 2004 15:21:04 -0000 1.16
+++ pmc.pl 9 May 2004 14:58:09 -0000 1.17
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: pmc.pl,v 1.16 2004/04/28 15:21:04 leo Exp $
+# $Id: pmc.pl,v 1.17 2004/05/09 14:58:09 leo Exp $
=head1 NAME
@@ -53,6 +53,39 @@
return @parents;
}
+sub get_pmc_order {
+ open IN, 'classes/pmc.num' or die "Can't read classes/pmc.num";
+ my %order;
+ while (<IN>) {
+ next if (/^#/);
+ if (/(\w+\.\w+)\s+(\d+)/) {
+ $order{$1} = $2;
+ }
+ }
+ close IN;
+ return \%order;
+}
+
+sub sort_pmcs {
+ my @pmcs = @_;
+ my $pmc_order = get_pmc_order();
+ my $n = scalar keys(%{$pmc_order});
+ my @sorted_pmcs;
+ for (@pmcs) {
+ if (exists $pmc_order->{$_}) {
+ $sorted_pmcs[$pmc_order->{$_}] = $_;
+ #if (exists $pmc_order->{"const$_"}) {
+ # $sorted_pmcs[$pmc_order->{"const$_"}] = "const$_";
+ #}
+ }
+ else {
+ $sorted_pmcs[$n++] = $_;
+ }
+ }
+ ## print "***\n", join(' ', @sorted_pmcs), "\n";
+ @sorted_pmcs;
+}
+
sub runstep {
my @pmc=(
sort
@@ -60,8 +93,9 @@
glob "./classes/*.pmc"
);
+ @pmc = sort_pmcs(@pmc);
- my $pmc_list = $_[1] || join(' ', @pmc);
+ my $pmc_list = $_[1] || join(' ', grep {defined $_} @pmc);
if($_[0]) {
print <<"END";
@@ -90,6 +124,7 @@
foreach my $pmc (split(/\s+/, $pmc_list)) {
$pmc =~ s/\.pmc$//;
+ next if ($pmc =~ /^const/);
# make each pmc depend upon its parent.
my $parent = pmc_parent($pmc).".pmc";
@@ -126,6 +161,7 @@
# non-abstract built-in PMCs.
my @names;
PMC: foreach my $pmc_file (split(/\s+/, $pmc_list)) {
+ next if ($pmc_file =~ /^const/);
my $name;
open(PMC, "classes/$pmc_file") or die "open classes/$pmc_file: $!";
my $const;
1.6 +1 -6 parrot/t/op/types.t
Index: types.t
===================================================================
RCS file: /cvs/public/parrot/t/op/types.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- types.t 8 Mar 2004 00:19:58 -0000 1.5
+++ types.t 9 May 2004 14:58:12 -0000 1.6
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: types.t,v 1.5 2004/03/08 00:19:58 chromatic Exp $
+# $Id: types.t,v 1.6 2004/05/09 14:58:12 leo Exp $
=head1 NAME
@@ -39,10 +39,6 @@
ok:
print "ok 1\n"
- typeof S0, 1
- # other types are tested in t/pmc/pmc.t
- ne S0, "Array", nok4
- print "ok 2\n"
end
nok1: print "first type (INTVAL) not found\n"
@@ -63,7 +59,6 @@
end
CODE
ok 1
-ok 2
OUTPUT
output_is(<<'CODE', <<'OUTPUT', "find_type with invalid type");
