From ffcd7ff6c6e1b30c8970bb722ab9b376da85d82b Mon Sep 17 00:00:00 2001 From: "James E Keenan (Jim)" Date: Mon, 8 Nov 2010 01:46:54 +0000 Subject: [PATCH 001/102] Create branch to work on http://trac.parrot.org/parrot/ticket/532. git-svn-id: https://svn.parrot.org/parrot/branches/tt532_headerizer_refactor@49797 d31e2699-5ff4-0310-a27c-f18f2fbe73fe From 7c838e31782a10cbd00df0dca7cffb1ad4bbeca3 Mon Sep 17 00:00:00 2001 From: "James E Keenan (Jim)" Date: Mon, 8 Nov 2010 02:05:29 +0000 Subject: [PATCH 002/102] Begin to move functions out of tools/dev/headerizer.pl and into new module lib/Parrot/Headerizer/Functions.pm. git-svn-id: https://svn.parrot.org/parrot/branches/tt532_headerizer_refactor@49799 d31e2699-5ff4-0310-a27c-f18f2fbe73fe --- MANIFEST | 3 +- config/init/hints/darwin.pm | 2 +- lib/Parrot/Headerizer/Functions.pm | 57 ++++++++++++++++++++++++++++++ tools/dev/headerizer.pl | 23 +++--------- 4 files changed, 64 insertions(+), 21 deletions(-) create mode 100644 lib/Parrot/Headerizer/Functions.pm diff --git a/MANIFEST b/MANIFEST index dfd36c0a36..42c8967413 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,7 +1,7 @@ # ex: set ro: # $Id$ # -# generated by tools/dev/mk_manifest_and_skip.pl Mon Nov 1 23:38:16 2010 UT +# generated by tools/dev/mk_manifest_and_skip.pl Mon Nov 8 01:50:18 2010 UT # # See below for documentation on the format of this file. # @@ -1071,6 +1071,7 @@ lib/Parrot/Harness/DefaultTests.pm [devel]lib lib/Parrot/Harness/Options.pm [devel]lib lib/Parrot/Harness/Smoke.pm [devel]lib lib/Parrot/Headerizer.pm [devel]lib +lib/Parrot/Headerizer/Functions.pm [devel]lib lib/Parrot/IO/Directory.pm [devel]lib lib/Parrot/IO/File.pm [devel]lib lib/Parrot/IO/Path.pm [devel]lib diff --git a/config/init/hints/darwin.pm b/config/init/hints/darwin.pm index 46f70586bd..3ba264fdda 100644 --- a/config/init/hints/darwin.pm +++ b/config/init/hints/darwin.pm @@ -62,7 +62,7 @@ sub runstep { $flagsref->{$flag} =~ s/^\s+//; } - my $osvers = `/usr/sbin/sysctl -n kern.osreldate`; + my $osvers = `/usr/sbin/sysctl -n kern.osrelease`; chomp $osvers; $conf->data->set( diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm new file mode 100644 index 0000000000..0104c752af --- /dev/null +++ b/lib/Parrot/Headerizer/Functions.pm @@ -0,0 +1,57 @@ +# Copyright (C) 2004-2010, Parrot Foundation. +# $Id$ + +package Parrot::Headerizer::Functions; +use strict; +use warnings; +use base qw( Exporter ); +our @EXPORT_OK = qw( + read_file + write_file +); + +=head1 NAME + +Parrot::Headerizer::Functions - Functions used in headerizer programs + +=head1 SYNOPSIS + + use Parrot::Headerizer::Functions qw( + read_file + write_file + ); + +=head1 DESCRIPTION + +This package holds (non-object-oriented) functions used in +F. + +=cut + +sub read_file { + my $filename = shift; + + open my $fh, '<', $filename or die "couldn't read '$filename': $!"; + my $text = do { local $/ = undef; <$fh> }; + close $fh; + + return $text; +} + +sub write_file { + my $filename = shift; + my $text = shift; + + open my $fh, '>', $filename or die "couldn't write '$filename': $!"; + print {$fh} $text; + close $fh; +} + +1; + +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4: diff --git a/tools/dev/headerizer.pl b/tools/dev/headerizer.pl index dec12234a1..b3455bd393 100644 --- a/tools/dev/headerizer.pl +++ b/tools/dev/headerizer.pl @@ -66,6 +66,10 @@ =head1 COMMAND-LINE OPTIONS use lib qw( lib ); use Parrot::Config; use Parrot::Headerizer; +use Parrot::Headerizer::Functions qw( + read_file + write_file +); my $headerizer = Parrot::Headerizer->new; @@ -258,25 +262,6 @@ sub make_function_decls { return @decls; } -sub read_file { - my $filename = shift; - - open my $fh, '<', $filename or die "couldn't read '$filename': $!"; - my $text = do { local $/ = undef; <$fh> }; - close $fh; - - return $text; -} - -sub write_file { - my $filename = shift; - my $text = shift; - - open my $fh, '>', $filename or die "couldn't write '$filename': $!"; - print {$fh} $text; - close $fh; -} - sub replace_headerized_declarations { my $source_code = shift; my $sourcefile = shift; From 4bee1cac2c531cdb302684c21af01e202f5ba111 Mon Sep 17 00:00:00 2001 From: "James E Keenan (Jim)" Date: Mon, 8 Nov 2010 02:13:21 +0000 Subject: [PATCH 003/102] Move declaration of main() into first position among functions. git-svn-id: https://svn.parrot.org/parrot/branches/tt532_headerizer_refactor@49800 d31e2699-5ff4-0310-a27c-f18f2fbe73fe --- tools/dev/headerizer.pl | 311 ++++++++++++++++++++-------------------- 1 file changed, 157 insertions(+), 154 deletions(-) diff --git a/tools/dev/headerizer.pl b/tools/dev/headerizer.pl index b3455bd393..88ca8eb4e1 100644 --- a/tools/dev/headerizer.pl +++ b/tools/dev/headerizer.pl @@ -1,6 +1,17 @@ #! perl # Copyright (C) 2001-2010, Parrot Foundation. # $Id$ +use strict; +use warnings; + +use Getopt::Long; +use lib qw( lib ); +use Parrot::Config; +use Parrot::Headerizer; +use Parrot::Headerizer::Functions qw( + read_file + write_file +); =head1 NAME @@ -59,24 +70,158 @@ =head1 COMMAND-LINE OPTIONS =cut -use strict; -use warnings; - -use Getopt::Long; -use lib qw( lib ); -use Parrot::Config; -use Parrot::Headerizer; -use Parrot::Headerizer::Functions qw( - read_file - write_file -); - my $headerizer = Parrot::Headerizer->new; main(); =head1 FUNCTIONS +=head2 C + +=cut + +sub main { + my $macro_match; + GetOptions( + 'macro=s' => \$macro_match, + ) or exit(1); + + die 'No files specified.' unless @ARGV; + my %ofiles; + ++$ofiles{$_} for @ARGV; + my @ofiles = sort keys %ofiles; + for (@ofiles) { + print "$_ is specified more than once.\n" if $ofiles{$_} > 1; + } + my %sourcefiles; + my %sourcefiles_with_statics; + my %api; + + # Walk the object files and find corresponding source (either .c or .pmc) + for my $ofile (@ofiles) { + + # Skip files in the src/ops/ subdirectory. + + next if $ofile =~ m/^\Qsrc$PConfig{slash}ops\E/ || # if run by hand... + $ofile =~ m{^src/ops}; # ... or by makefile + + $ofile =~ s/\\/\//g; + + my $is_yacc = ($ofile =~ /\.y$/); + if ( !$is_yacc ) { + my $sfile = $ofile; + $sfile =~ s/\Q$PConfig{o}\E$/.s/; + next if -f $sfile; + } + + my $cfile = $ofile; + $cfile =~ s/\Q$PConfig{o}\E$/.c/ or $is_yacc + or die "$cfile doesn't look like an object file"; + + my $pmcfile = $ofile; + $pmcfile =~ s/\Q$PConfig{o}\E$/.pmc/; + + my $from_pmc = -f $pmcfile && !$is_yacc; + + my $sourcefile = $from_pmc ? $pmcfile : $cfile; + + my $source_code = read_file( $sourcefile ); + die qq{can't find HEADERIZER HFILE directive in "$sourcefile"} + unless $source_code =~ + m{ /\* \s+ HEADERIZER\ HFILE: \s+ ([^*]+?) \s+ \*/ }sx; + + my $hfile = $1; + if ( ( $hfile ne 'none' ) && ( not -f $hfile ) ) { + die qq{"$hfile" not found (referenced from "$sourcefile")}; + } + + my @decls; + if ( $macro_match ) { + @decls = $headerizer->extract_function_declarations( $source_code ); + } + else { + @decls = extract_function_declarations_and_update_source( $sourcefile ); + } + + for my $decl (@decls) { + my $components = $headerizer->function_components_from_declaration( $sourcefile, $decl ); + push( @{ $sourcefiles{$hfile}->{$sourcefile} }, $components ) unless $hfile eq 'none'; + push( @{ $sourcefiles_with_statics{$sourcefile} }, $components ) if $components->{is_static}; + if ( $macro_match ) { + if ( grep { $_ eq $macro_match } @{$components->{macros}} ) { + push( @{ $api{$sourcefile} }, $components ); + } + } + } + } # for @cfiles + + if ( $macro_match ) { + my $nfuncs = 0; + for my $cfile ( sort keys %api ) { + my @funcs = sort { $a->{name} cmp $b->{name} } @{$api{$cfile}}; + print "$cfile\n"; + for my $func ( @funcs ) { + print " $func->{name}\n"; + ++$nfuncs; + } + } + my $s = $nfuncs == 1 ? '' : 's'; + print "$nfuncs $macro_match function$s\n"; + } + else { # Normal headerization and updating + # Update all the .h files + for my $hfile ( sort keys %sourcefiles ) { + my $sourcefiles = $sourcefiles{$hfile}; + + my $header = read_file($hfile); + + for my $cfile ( sort keys %{$sourcefiles} ) { + my @funcs = @{ $sourcefiles->{$cfile} }; + @funcs = grep { not $_->{is_static} } @funcs; # skip statics + + $header = replace_headerized_declarations( $header, $cfile, $hfile, @funcs ); + } + + write_file( $hfile, $header ); + } + + # Update all the .c files in place + for my $cfile ( sort keys %sourcefiles_with_statics ) { + my @funcs = @{ $sourcefiles_with_statics{$cfile} }; + @funcs = grep { $_->{is_static} } @funcs; + + my $source = read_file($cfile); + $source = replace_headerized_declarations( $source, 'static', $cfile, @funcs ); + + write_file( $cfile, $source ); + } + print "Headerization complete.\n"; + } + + my %warnings = %{$headerizer->{warnings}}; + if ( keys %warnings ) { + my $nwarnings = 0; + my $nwarningfuncs = 0; + my $nwarningfiles = 0; + for my $file ( sort keys %warnings ) { + ++$nwarningfiles; + print "$file\n"; + my $funcs = $warnings{$file}; + for my $func ( sort keys %{$funcs} ) { + ++$nwarningfuncs; + for my $error ( @{ $funcs->{$func} } ) { + print " $func: $error\n"; + ++$nwarnings; + } + } + } + + print "$nwarnings warnings in $nwarningfuncs funcs in $nwarningfiles C files\n"; + } + + return; +} + =head2 extract_function_declaration_and_update_source( $cfile_name ) Extract all the function declarations from the C file specified by @@ -295,148 +440,6 @@ sub api_first_then_alpha { || ( lc $a->{name} cmp lc $b->{name} ); } -sub main { - my $macro_match; - GetOptions( - 'macro=s' => \$macro_match, - ) or exit(1); - - die 'No files specified.' unless @ARGV; - my %ofiles; - ++$ofiles{$_} for @ARGV; - my @ofiles = sort keys %ofiles; - for (@ofiles) { - print "$_ is specified more than once.\n" if $ofiles{$_} > 1; - } - my %sourcefiles; - my %sourcefiles_with_statics; - my %api; - - # Walk the object files and find corresponding source (either .c or .pmc) - for my $ofile (@ofiles) { - - # Skip files in the src/ops/ subdirectory. - - next if $ofile =~ m/^\Qsrc$PConfig{slash}ops\E/ || # if run by hand... - $ofile =~ m{^src/ops}; # ... or by makefile - - $ofile =~ s/\\/\//g; - - my $is_yacc = ($ofile =~ /\.y$/); - if ( !$is_yacc ) { - my $sfile = $ofile; - $sfile =~ s/\Q$PConfig{o}\E$/.s/; - next if -f $sfile; - } - - my $cfile = $ofile; - $cfile =~ s/\Q$PConfig{o}\E$/.c/ or $is_yacc - or die "$cfile doesn't look like an object file"; - - my $pmcfile = $ofile; - $pmcfile =~ s/\Q$PConfig{o}\E$/.pmc/; - - my $from_pmc = -f $pmcfile && !$is_yacc; - - my $sourcefile = $from_pmc ? $pmcfile : $cfile; - - my $source_code = read_file( $sourcefile ); - die qq{can't find HEADERIZER HFILE directive in "$sourcefile"} - unless $source_code =~ - m{ /\* \s+ HEADERIZER\ HFILE: \s+ ([^*]+?) \s+ \*/ }sx; - - my $hfile = $1; - if ( ( $hfile ne 'none' ) && ( not -f $hfile ) ) { - die qq{"$hfile" not found (referenced from "$sourcefile")}; - } - - my @decls; - if ( $macro_match ) { - @decls = $headerizer->extract_function_declarations( $source_code ); - } - else { - @decls = extract_function_declarations_and_update_source( $sourcefile ); - } - - for my $decl (@decls) { - my $components = $headerizer->function_components_from_declaration( $sourcefile, $decl ); - push( @{ $sourcefiles{$hfile}->{$sourcefile} }, $components ) unless $hfile eq 'none'; - push( @{ $sourcefiles_with_statics{$sourcefile} }, $components ) if $components->{is_static}; - if ( $macro_match ) { - if ( grep { $_ eq $macro_match } @{$components->{macros}} ) { - push( @{ $api{$sourcefile} }, $components ); - } - } - } - } # for @cfiles - - if ( $macro_match ) { - my $nfuncs = 0; - for my $cfile ( sort keys %api ) { - my @funcs = sort { $a->{name} cmp $b->{name} } @{$api{$cfile}}; - print "$cfile\n"; - for my $func ( @funcs ) { - print " $func->{name}\n"; - ++$nfuncs; - } - } - my $s = $nfuncs == 1 ? '' : 's'; - print "$nfuncs $macro_match function$s\n"; - } - else { # Normal headerization and updating - # Update all the .h files - for my $hfile ( sort keys %sourcefiles ) { - my $sourcefiles = $sourcefiles{$hfile}; - - my $header = read_file($hfile); - - for my $cfile ( sort keys %{$sourcefiles} ) { - my @funcs = @{ $sourcefiles->{$cfile} }; - @funcs = grep { not $_->{is_static} } @funcs; # skip statics - - $header = replace_headerized_declarations( $header, $cfile, $hfile, @funcs ); - } - - write_file( $hfile, $header ); - } - - # Update all the .c files in place - for my $cfile ( sort keys %sourcefiles_with_statics ) { - my @funcs = @{ $sourcefiles_with_statics{$cfile} }; - @funcs = grep { $_->{is_static} } @funcs; - - my $source = read_file($cfile); - $source = replace_headerized_declarations( $source, 'static', $cfile, @funcs ); - - write_file( $cfile, $source ); - } - print "Headerization complete.\n"; - } - - my %warnings = %{$headerizer->{warnings}}; - if ( keys %warnings ) { - my $nwarnings = 0; - my $nwarningfuncs = 0; - my $nwarningfiles = 0; - for my $file ( sort keys %warnings ) { - ++$nwarningfiles; - print "$file\n"; - my $funcs = $warnings{$file}; - for my $func ( sort keys %{$funcs} ) { - ++$nwarningfuncs; - for my $error ( @{ $funcs->{$func} } ) { - print " $func: $error\n"; - ++$nwarnings; - } - } - } - - print "$nwarnings warnings in $nwarningfuncs funcs in $nwarningfiles C files\n"; - } - - return; -} - # From earlier documentation: # * Generate docs from funcs # * Somehow handle static functions in the source file From b7b8593d510a71f20b20b27dfef27900bd58d541 Mon Sep 17 00:00:00 2001 From: "James E Keenan (Jim)" Date: Mon, 8 Nov 2010 02:19:54 +0000 Subject: [PATCH 004/102] Encapsulate some code within main() into a function. Place that function in Parrot::Headerizer::Functions. git-svn-id: https://svn.parrot.org/parrot/branches/tt532_headerizer_refactor@49801 d31e2699-5ff4-0310-a27c-f18f2fbe73fe --- lib/Parrot/Headerizer/Functions.pm | 25 +++++++++++++++++++++++++ tools/dev/headerizer.pl | 22 ++-------------------- 2 files changed, 27 insertions(+), 20 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index 0104c752af..c298bbec62 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -6,6 +6,7 @@ use strict; use warnings; use base qw( Exporter ); our @EXPORT_OK = qw( + print_headerizer_warnings read_file write_file ); @@ -28,6 +29,30 @@ F. =cut +sub print_headerizer_warnings { + my $warnings_ref = shift; + my %warnings = %{$warnings_ref}; + if ( keys %warnings ) { + my $nwarnings = 0; + my $nwarningfuncs = 0; + my $nwarningfiles = 0; + for my $file ( sort keys %warnings ) { + ++$nwarningfiles; + print "$file\n"; + my $funcs = $warnings{$file}; + for my $func ( sort keys %{$funcs} ) { + ++$nwarningfuncs; + for my $error ( @{ $funcs->{$func} } ) { + print " $func: $error\n"; + ++$nwarnings; + } + } + } + + print "$nwarnings warnings in $nwarningfuncs funcs in $nwarningfiles C files\n"; + } +} + sub read_file { my $filename = shift; diff --git a/tools/dev/headerizer.pl b/tools/dev/headerizer.pl index 88ca8eb4e1..403b9648f8 100644 --- a/tools/dev/headerizer.pl +++ b/tools/dev/headerizer.pl @@ -9,6 +9,7 @@ use Parrot::Config; use Parrot::Headerizer; use Parrot::Headerizer::Functions qw( + print_headerizer_warnings read_file write_file ); @@ -198,26 +199,7 @@ sub main { print "Headerization complete.\n"; } - my %warnings = %{$headerizer->{warnings}}; - if ( keys %warnings ) { - my $nwarnings = 0; - my $nwarningfuncs = 0; - my $nwarningfiles = 0; - for my $file ( sort keys %warnings ) { - ++$nwarningfiles; - print "$file\n"; - my $funcs = $warnings{$file}; - for my $func ( sort keys %{$funcs} ) { - ++$nwarningfuncs; - for my $error ( @{ $funcs->{$func} } ) { - print " $func: $error\n"; - ++$nwarnings; - } - } - } - - print "$nwarnings warnings in $nwarningfuncs funcs in $nwarningfiles C files\n"; - } + print_headerizer_warnings($headerizer->{warnings}); return; } From 619ef4dff99b3761202e1287e4d367d392330176 Mon Sep 17 00:00:00 2001 From: "James E Keenan (Jim)" Date: Mon, 8 Nov 2010 02:41:51 +0000 Subject: [PATCH 005/102] Create a file to hold tests of Parrot::Headerizer::Functions. git-svn-id: https://svn.parrot.org/parrot/branches/tt532_headerizer_refactor@49802 d31e2699-5ff4-0310-a27c-f18f2fbe73fe --- MANIFEST | 3 +- t/tools/dev/headerizer/01_functions.t | 63 +++++++++++++++++++++++++++ 2 files changed, 65 insertions(+), 1 deletion(-) create mode 100644 t/tools/dev/headerizer/01_functions.t diff --git a/MANIFEST b/MANIFEST index 42c8967413..00ecd562a5 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,7 +1,7 @@ # ex: set ro: # $Id$ # -# generated by tools/dev/mk_manifest_and_skip.pl Mon Nov 8 01:50:18 2010 UT +# generated by tools/dev/mk_manifest_and_skip.pl Mon Nov 8 02:41:45 2010 UT # # See below for documentation on the format of this file. # @@ -2052,6 +2052,7 @@ t/steps/inter/yacc-01.t [test] t/steps/inter/yacc-02.t [test] t/stress/gc.t [test] t/tools/create_language.t [test] +t/tools/dev/headerizer/01_functions.t [test] t/tools/dev/pmctree.t [test] t/tools/dev/searchops.t [test] t/tools/dev/searchops/samples.pm [test] diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t new file mode 100644 index 0000000000..70a22e6c56 --- /dev/null +++ b/t/tools/dev/headerizer/01_functions.t @@ -0,0 +1,63 @@ +#! perl +# Copyright (C) 2010, Parrot Foundation. +# $Id$ +# 01_functions.t + +use strict; +use warnings; +use Test::More qw(no_plan); # tests => 60; +use Cwd; +use File::Basename; +use File::Copy; +use File::Temp qw( tempdir ); +use lib qw( lib ); +use Parrot::Headerizer::Functions qw( + print_headerizer_warnings + read_file + write_file +); +use IO::CaptureOutput qw| capture |; + + +pass("Completed all tests in $0"); + +sub touch_parrot { + open my $FH, '>', q{parrot} + or die "Unable to open handle for writing: $!"; + print $FH "\n"; + close $FH or die "Unable to close handle after writing: $!"; +} + +################### DOCUMENTATION ################### + +=head1 NAME + +01_functions.t - Test functions in Parrot::Headerizer::Functions. + +=head1 SYNOPSIS + + % prove t/tools/dev/headerizer/01_functions.t + +=head1 DESCRIPTION + +The files in this directory test the publicly callable subroutines found in +F. By doing so, they help test the functionality +of the F utility. + + +=head1 AUTHOR + +James E Keenan + +=head1 SEE ALSO + +F; F. + +=cut + +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4: From d7649c0aac86f5ee050589ed87ea8a9b9224e0fe Mon Sep 17 00:00:00 2001 From: "James E Keenan (Jim)" Date: Mon, 8 Nov 2010 02:56:12 +0000 Subject: [PATCH 006/102] Write basic tests of read_file() and write_file(). git-svn-id: https://svn.parrot.org/parrot/branches/tt532_headerizer_refactor@49803 d31e2699-5ff4-0310-a27c-f18f2fbe73fe --- lib/Parrot/Headerizer/Functions.pm | 4 ++++ t/tools/dev/headerizer/01_functions.t | 27 +++++++++++++++++++++++++-- 2 files changed, 29 insertions(+), 2 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index c298bbec62..c90ffbf959 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -18,6 +18,7 @@ Parrot::Headerizer::Functions - Functions used in headerizer programs =head1 SYNOPSIS use Parrot::Headerizer::Functions qw( + print_headerizer_warnings read_file write_file ); @@ -53,6 +54,9 @@ sub print_headerizer_warnings { } } +# We can't alias this to Parrot::BuildUtil::slurp_file() because that function +# changes DOS line endings to Unix, which we don't necessarily want here. + sub read_file { my $filename = shift; diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index 70a22e6c56..322ebfed15 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -7,9 +7,10 @@ use strict; use warnings; use Test::More qw(no_plan); # tests => 60; use Cwd; -use File::Basename; -use File::Copy; +#use File::Basename; +#use File::Copy; use File::Temp qw( tempdir ); +use Tie::File; use lib qw( lib ); use Parrot::Headerizer::Functions qw( print_headerizer_warnings @@ -18,6 +19,28 @@ use Parrot::Headerizer::Functions qw( ); use IO::CaptureOutput qw| capture |; +my $cwd = cwd(); +{ + my $tdir = tempdir( CLEANUP => 1 ); + chdir $tdir; + my $file = "filename$$"; + my @lines_to_write = ( + "Goodbye\n", + "cruel\n", + "world\n", + ); + my $text = join( '' => @lines_to_write ); + write_file($file, $text); + ok(-f $file, "File was written"); + + my $text_returned = read_file($file); + ok($text_returned, "Got non-empty string back from read_file()"); + my @lines_read = split /\n/, $text_returned; + is($lines_read[0], 'Goodbye', "Got first line"); + is($lines_read[1], 'cruel', "Got second line"); + is($lines_read[2], 'world', "Got third line"); +} + pass("Completed all tests in $0"); From 583cf9b704959843170fd58b6a01ea1c7a6ba59d Mon Sep 17 00:00:00 2001 From: "James E Keenan (Jim)" Date: Mon, 8 Nov 2010 03:09:04 +0000 Subject: [PATCH 007/102] Add tests of print_headerizer_warnings(). git-svn-id: https://svn.parrot.org/parrot/branches/tt532_headerizer_refactor@49804 d31e2699-5ff4-0310-a27c-f18f2fbe73fe --- t/tools/dev/headerizer/01_functions.t | 47 ++++++++++++++++++++++++--- 1 file changed, 43 insertions(+), 4 deletions(-) diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index 322ebfed15..39646f1f9a 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -5,12 +5,9 @@ use strict; use warnings; -use Test::More qw(no_plan); # tests => 60; +use Test::More tests => 15; use Cwd; -#use File::Basename; -#use File::Copy; use File::Temp qw( tempdir ); -use Tie::File; use lib qw( lib ); use Parrot::Headerizer::Functions qw( print_headerizer_warnings @@ -41,6 +38,48 @@ my $cwd = cwd(); is($lines_read[2], 'world', "Got third line"); } +my $warnings = { + 'file1' => { + 'func_alpha' => [ + 'alpha warning 1', + 'alpha warning 2', + 'alpha warning 3', + ], + 'func_beta' => [ + 'beta warning 1', + 'beta warning 2', + ], + }, + 'file2' => { + 'func_gamma' => [ + 'gamma warning 1', + 'gamma warning 2', + 'gamma warning 3', + ], + }, +}; + +{ + my ($stdout, $stderr); + capture( + sub { print_headerizer_warnings($warnings); }, + \$stdout, + \$stderr, + ); + for my $func( qw| alpha gamma | ) { + for (1..3) { + like( $stdout, qr/func_alpha: alpha warning $_/s, + "Got expected output" ); + } + } + for (1..2) { + like( $stdout, qr/func_beta: beta warning $_/s, + "Got expected output" ); + } + like( $stdout, qr/8 warnings in 3 funcs in 2 C files/, + "Got expected summary of headerizer warnings" ); +} + pass("Completed all tests in $0"); From b0a5ec70d20eddf5eef224400ce2c25360fe57bf Mon Sep 17 00:00:00 2001 From: jkeenan Date: Mon, 15 Nov 2010 18:41:47 -0500 Subject: [PATCH 008/102] Eliminate sub main() in favor of direct code. --- tools/dev/headerizer.pl | 195 +++++++++++++++++++--------------------- 1 file changed, 93 insertions(+), 102 deletions(-) diff --git a/tools/dev/headerizer.pl b/tools/dev/headerizer.pl index 403b9648f8..2f6b3579c5 100644 --- a/tools/dev/headerizer.pl +++ b/tools/dev/headerizer.pl @@ -73,136 +73,127 @@ =head1 COMMAND-LINE OPTIONS my $headerizer = Parrot::Headerizer->new; -main(); - -=head1 FUNCTIONS - -=head2 C - -=cut +my $macro_match; +GetOptions( + 'macro=s' => \$macro_match, +) or exit(1); + +die 'No files specified.' unless @ARGV; +my %ofiles; +++$ofiles{$_} for @ARGV; +my @ofiles = sort keys %ofiles; +for (@ofiles) { + print "$_ is specified more than once.\n" if $ofiles{$_} > 1; +} +my %sourcefiles; +my %sourcefiles_with_statics; +my %api; -sub main { - my $macro_match; - GetOptions( - 'macro=s' => \$macro_match, - ) or exit(1); - - die 'No files specified.' unless @ARGV; - my %ofiles; - ++$ofiles{$_} for @ARGV; - my @ofiles = sort keys %ofiles; - for (@ofiles) { - print "$_ is specified more than once.\n" if $ofiles{$_} > 1; - } - my %sourcefiles; - my %sourcefiles_with_statics; - my %api; +# Walk the object files and find corresponding source (either .c or .pmc) +for my $ofile (@ofiles) { - # Walk the object files and find corresponding source (either .c or .pmc) - for my $ofile (@ofiles) { + # Skip files in the src/ops/ subdirectory. - # Skip files in the src/ops/ subdirectory. + next if $ofile =~ m/^\Qsrc$PConfig{slash}ops\E/ || # if run by hand... + $ofile =~ m{^src/ops}; # ... or by makefile - next if $ofile =~ m/^\Qsrc$PConfig{slash}ops\E/ || # if run by hand... - $ofile =~ m{^src/ops}; # ... or by makefile + $ofile =~ s/\\/\//g; - $ofile =~ s/\\/\//g; + my $is_yacc = ($ofile =~ /\.y$/); + if ( !$is_yacc ) { + my $sfile = $ofile; + $sfile =~ s/\Q$PConfig{o}\E$/.s/; + next if -f $sfile; + } - my $is_yacc = ($ofile =~ /\.y$/); - if ( !$is_yacc ) { - my $sfile = $ofile; - $sfile =~ s/\Q$PConfig{o}\E$/.s/; - next if -f $sfile; - } + my $cfile = $ofile; + $cfile =~ s/\Q$PConfig{o}\E$/.c/ or $is_yacc + or die "$cfile doesn't look like an object file"; - my $cfile = $ofile; - $cfile =~ s/\Q$PConfig{o}\E$/.c/ or $is_yacc - or die "$cfile doesn't look like an object file"; + my $pmcfile = $ofile; + $pmcfile =~ s/\Q$PConfig{o}\E$/.pmc/; - my $pmcfile = $ofile; - $pmcfile =~ s/\Q$PConfig{o}\E$/.pmc/; + my $from_pmc = -f $pmcfile && !$is_yacc; - my $from_pmc = -f $pmcfile && !$is_yacc; + my $sourcefile = $from_pmc ? $pmcfile : $cfile; - my $sourcefile = $from_pmc ? $pmcfile : $cfile; + my $source_code = read_file( $sourcefile ); + die qq{can't find HEADERIZER HFILE directive in "$sourcefile"} + unless $source_code =~ + m{ /\* \s+ HEADERIZER\ HFILE: \s+ ([^*]+?) \s+ \*/ }sx; - my $source_code = read_file( $sourcefile ); - die qq{can't find HEADERIZER HFILE directive in "$sourcefile"} - unless $source_code =~ - m{ /\* \s+ HEADERIZER\ HFILE: \s+ ([^*]+?) \s+ \*/ }sx; + my $hfile = $1; + if ( ( $hfile ne 'none' ) && ( not -f $hfile ) ) { + die qq{"$hfile" not found (referenced from "$sourcefile")}; + } - my $hfile = $1; - if ( ( $hfile ne 'none' ) && ( not -f $hfile ) ) { - die qq{"$hfile" not found (referenced from "$sourcefile")}; - } + my @decls; + if ( $macro_match ) { + @decls = $headerizer->extract_function_declarations( $source_code ); + } + else { + @decls = extract_function_declarations_and_update_source( $sourcefile ); + } - my @decls; + for my $decl (@decls) { + my $components = $headerizer->function_components_from_declaration( $sourcefile, $decl ); + push( @{ $sourcefiles{$hfile}->{$sourcefile} }, $components ) unless $hfile eq 'none'; + push( @{ $sourcefiles_with_statics{$sourcefile} }, $components ) if $components->{is_static}; if ( $macro_match ) { - @decls = $headerizer->extract_function_declarations( $source_code ); - } - else { - @decls = extract_function_declarations_and_update_source( $sourcefile ); - } - - for my $decl (@decls) { - my $components = $headerizer->function_components_from_declaration( $sourcefile, $decl ); - push( @{ $sourcefiles{$hfile}->{$sourcefile} }, $components ) unless $hfile eq 'none'; - push( @{ $sourcefiles_with_statics{$sourcefile} }, $components ) if $components->{is_static}; - if ( $macro_match ) { - if ( grep { $_ eq $macro_match } @{$components->{macros}} ) { - push( @{ $api{$sourcefile} }, $components ); - } + if ( grep { $_ eq $macro_match } @{$components->{macros}} ) { + push( @{ $api{$sourcefile} }, $components ); } } - } # for @cfiles - - if ( $macro_match ) { - my $nfuncs = 0; - for my $cfile ( sort keys %api ) { - my @funcs = sort { $a->{name} cmp $b->{name} } @{$api{$cfile}}; - print "$cfile\n"; - for my $func ( @funcs ) { - print " $func->{name}\n"; - ++$nfuncs; - } + } +} # for @cfiles + +if ( $macro_match ) { + my $nfuncs = 0; + for my $cfile ( sort keys %api ) { + my @funcs = sort { $a->{name} cmp $b->{name} } @{$api{$cfile}}; + print "$cfile\n"; + for my $func ( @funcs ) { + print " $func->{name}\n"; + ++$nfuncs; } - my $s = $nfuncs == 1 ? '' : 's'; - print "$nfuncs $macro_match function$s\n"; } - else { # Normal headerization and updating - # Update all the .h files - for my $hfile ( sort keys %sourcefiles ) { - my $sourcefiles = $sourcefiles{$hfile}; + my $s = $nfuncs == 1 ? '' : 's'; + print "$nfuncs $macro_match function$s\n"; +} +else { # Normal headerization and updating + # Update all the .h files + for my $hfile ( sort keys %sourcefiles ) { + my $sourcefiles = $sourcefiles{$hfile}; - my $header = read_file($hfile); + my $header = read_file($hfile); - for my $cfile ( sort keys %{$sourcefiles} ) { - my @funcs = @{ $sourcefiles->{$cfile} }; - @funcs = grep { not $_->{is_static} } @funcs; # skip statics + for my $cfile ( sort keys %{$sourcefiles} ) { + my @funcs = @{ $sourcefiles->{$cfile} }; + @funcs = grep { not $_->{is_static} } @funcs; # skip statics - $header = replace_headerized_declarations( $header, $cfile, $hfile, @funcs ); - } - - write_file( $hfile, $header ); + $header = replace_headerized_declarations( $header, $cfile, $hfile, @funcs ); } - # Update all the .c files in place - for my $cfile ( sort keys %sourcefiles_with_statics ) { - my @funcs = @{ $sourcefiles_with_statics{$cfile} }; - @funcs = grep { $_->{is_static} } @funcs; + write_file( $hfile, $header ); + } + + # Update all the .c files in place + for my $cfile ( sort keys %sourcefiles_with_statics ) { + my @funcs = @{ $sourcefiles_with_statics{$cfile} }; + @funcs = grep { $_->{is_static} } @funcs; - my $source = read_file($cfile); - $source = replace_headerized_declarations( $source, 'static', $cfile, @funcs ); + my $source = read_file($cfile); + $source = replace_headerized_declarations( $source, 'static', $cfile, @funcs ); - write_file( $cfile, $source ); - } - print "Headerization complete.\n"; + write_file( $cfile, $source ); } + print "Headerization complete.\n"; +} - print_headerizer_warnings($headerizer->{warnings}); +print_headerizer_warnings($headerizer->{warnings}); - return; -} + +=head1 FUNCTIONS =head2 extract_function_declaration_and_update_source( $cfile_name ) From 02f5b420fa506e18af8c5e5bdf3e774821980764 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Fri, 19 Nov 2010 21:53:01 -0500 Subject: [PATCH 009/102] Move call to constructor closer to where object is first used. --- tools/dev/headerizer.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tools/dev/headerizer.pl b/tools/dev/headerizer.pl index 2f6b3579c5..7df44929e0 100644 --- a/tools/dev/headerizer.pl +++ b/tools/dev/headerizer.pl @@ -71,8 +71,6 @@ =head1 COMMAND-LINE OPTIONS =cut -my $headerizer = Parrot::Headerizer->new; - my $macro_match; GetOptions( 'macro=s' => \$macro_match, @@ -88,6 +86,8 @@ =head1 COMMAND-LINE OPTIONS my %sourcefiles; my %sourcefiles_with_statics; my %api; +my $headerizer = Parrot::Headerizer->new; + # Walk the object files and find corresponding source (either .c or .pmc) for my $ofile (@ofiles) { From 75b36d5c4d538fd81463fcb886f3c2cf53c88bd5 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sat, 20 Nov 2010 21:26:52 -0500 Subject: [PATCH 010/102] Extract some code from tools/dev/headerizer.pl and place it into Parrot::Headerizer::Functions::qualify_sourcefile(). Start to test that function. Provide more documentation for functions in Parrot::Headerizer::Functions. Add a new test file to test Parrot::Headerizer methods. Update MANIFEST. --- MANIFEST | 1 + lib/Parrot/Headerizer/Functions.pm | 146 +++++++++++++++++++++++++- t/tools/dev/headerizer/01_functions.t | 32 ++++-- t/tools/dev/headerizer/02_methods.t | 66 ++++++++++++ tools/dev/headerizer.pl | 28 ++--- 5 files changed, 242 insertions(+), 31 deletions(-) create mode 100644 t/tools/dev/headerizer/02_methods.t diff --git a/MANIFEST b/MANIFEST index 00ecd562a5..4d833137f3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2053,6 +2053,7 @@ t/steps/inter/yacc-02.t [test] t/stress/gc.t [test] t/tools/create_language.t [test] t/tools/dev/headerizer/01_functions.t [test] +t/tools/dev/headerizer/02_methods.t [test] t/tools/dev/pmctree.t [test] t/tools/dev/searchops.t [test] t/tools/dev/searchops/samples.pm [test] diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index c90ffbf959..fa27ccdc22 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -9,6 +9,7 @@ our @EXPORT_OK = qw( print_headerizer_warnings read_file write_file + qualify_sourcefile ); =head1 NAME @@ -21,6 +22,7 @@ Parrot::Headerizer::Functions - Functions used in headerizer programs print_headerizer_warnings read_file write_file + qualify_sourcefile ); =head1 DESCRIPTION @@ -28,6 +30,22 @@ Parrot::Headerizer::Functions - Functions used in headerizer programs This package holds (non-object-oriented) functions used in F. +=head1 SUBROUTINES + +=head2 C + +=over 4 + +=item * Purpose + +=item * Arguments + +=item * Return Value + +=item * Comment + +=back + =cut sub print_headerizer_warnings { @@ -54,8 +72,31 @@ sub print_headerizer_warnings { } } -# We can't alias this to Parrot::BuildUtil::slurp_file() because that function -# changes DOS line endings to Unix, which we don't necessarily want here. +=head2 C + +=over 4 + +=item * Purpose + +Read a file into a string. + +=item * Arguments + +String holding name of file to be read. + +=item * Return Value + +String holding the file's content. + +=item * Comment + +We can't alias this to C because that function +changes DOS line endings to Unix, which we don't necessarily want here. + +=back + +=cut + sub read_file { my $filename = shift; @@ -67,6 +108,27 @@ sub read_file { return $text; } +=head2 C + +=over 4 + +=item * Purpose + +Write a file. + +=item * Arguments + +List of two scalars: string holding name of file to be written; text to be +written to the file. + +=item * Return Value + +Implicitly returns true upon success. + +=back + +=cut + sub write_file { my $filename = shift; my $text = shift; @@ -76,6 +138,86 @@ sub write_file { close $fh; } +=head2 C + +=over 4 + +=item * Purpose + +Given the name of a C object file, derive the name of its C<.c> or C<.pmc> +source code file, verify that file's existence, read in its source code, and +verify the existence of the corresponding C<.h> file. + +=item * Arguments + + my ($sourcefile, $source_code, $hfile) = + qualify_sourcefile( { + ofile => $ofile, + PConfig => \%PConfig, + is_yacc => $is_yacc, + } ); + +Reference to hash with 3 key-value pairs: + +=over 4 + +=item * C + +String holding name of C or yacc object file. + +=item * C + +Reference to Parrot configuration hash. + +=item * C + +Boolean reporting whether the source code file is a yacc file or not. + +=back + +=item * Return Value + +List of 3 scalars: String holding source code file, string holding the ssource +code, string holding header file (or C if no header file is found). + +=item * Comment + +The subroutine will die if the value provided for C does not have a +corresponding C<.c> file or if it is a yacc file. The subroutine will also +die if it cannot locate an C directive in the source code +file. The subroutine will also die if any header file referenced from the +source code cannot be located. + +=back + +=cut + +sub qualify_sourcefile { + my $args = shift; + my $cfile = $args->{ofile}; + $cfile =~ s/\Q$args->{PConfig}->{o}\E$/.c/ or $args->{is_yacc} + or die "$cfile doesn't look like an object file"; + + my $pmcfile = $args->{ofile}; + $pmcfile =~ s/\Q$args->{PConfig}->{o}\E$/.pmc/; + + my $from_pmc = -f $pmcfile && !$args->{is_yacc}; + + my $sourcefile = $from_pmc ? $pmcfile : $cfile; + + my $source_code = read_file( $sourcefile ); + die qq{can't find HEADERIZER HFILE directive in "$sourcefile"} + unless $source_code =~ + m{ /\* \s+ HEADERIZER\ HFILE: \s+ ([^*]+?) \s+ \*/ }sx; + + my $hfile = $1; + if ( ( $hfile ne 'none' ) && ( not -f $hfile ) ) { + die qq{"$hfile" not found (referenced from "$sourcefile")}; + } + + return ($sourcefile, $source_code, $hfile); +} + 1; # Local Variables: diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index 39646f1f9a..1aa1635785 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -5,14 +5,16 @@ use strict; use warnings; -use Test::More tests => 15; +use Test::More qw(no_plan); # tests => 15; use Cwd; use File::Temp qw( tempdir ); use lib qw( lib ); +use Parrot::Config; use Parrot::Headerizer::Functions qw( print_headerizer_warnings read_file write_file + qualify_sourcefile ); use IO::CaptureOutput qw| capture |; @@ -36,6 +38,7 @@ my $cwd = cwd(); is($lines_read[0], 'Goodbye', "Got first line"); is($lines_read[1], 'cruel', "Got second line"); is($lines_read[2], 'world', "Got third line"); + chdir $cwd or die "Unable to chdir: $!"; } my $warnings = { @@ -80,15 +83,28 @@ my $warnings = { "Got expected summary of headerizer warnings" ); } - +my ($ofile, $is_yacc); +my ($sourcefile, $source_code, $hfile); +$ofile = 'foobar.xyz'; +eval { + my ($sourcefile, $source_code, $hfile) = + qualify_sourcefile( { + ofile => $ofile, + PConfig => \%PConfig, + is_yacc => 0, + } ); +}; +like($@, qr/$ofile doesn't look like an object file/, + "Got expected die message for non-object, non-yacc file" ); + pass("Completed all tests in $0"); -sub touch_parrot { - open my $FH, '>', q{parrot} - or die "Unable to open handle for writing: $!"; - print $FH "\n"; - close $FH or die "Unable to close handle after writing: $!"; -} +#sub touch_parrot { +# open my $FH, '>', q{parrot} +# or die "Unable to open handle for writing: $!"; +# print $FH "\n"; +# close $FH or die "Unable to close handle after writing: $!"; +#} ################### DOCUMENTATION ################### diff --git a/t/tools/dev/headerizer/02_methods.t b/t/tools/dev/headerizer/02_methods.t new file mode 100644 index 0000000000..b491c94578 --- /dev/null +++ b/t/tools/dev/headerizer/02_methods.t @@ -0,0 +1,66 @@ +#! perl +# Copyright (C) 2010, Parrot Foundation. +# $Id$ +# 02_methods.t + +use strict; +use warnings; +use Test::More qw(no_plan); # tests => 15; +#use Cwd; +#use File::Temp qw( tempdir ); +use lib qw( lib ); +use Parrot::Headerizer; +#use IO::CaptureOutput qw| capture |; + +my $self = Parrot::Headerizer->new(); +isa_ok( $self, 'Parrot::Headerizer' ); +ok( $self->valid_macro( 'PARROT_EXPORT' ), + "valid_macro() confirmed validity of macro" ); +ok(! $self->valid_macro( 'PARROT_FOOBAR' ), + "valid_macro() confirmed invalidity of macro" ); +my @valid_macros = $self->valid_macros; +ok( @valid_macros, + "Headerizer object contains list of valid macros" ); + + +pass("Completed all tests in $0"); + +#sub touch_parrot { +# open my $FH, '>', q{parrot} +# or die "Unable to open handle for writing: $!"; +# print $FH "\n"; +# close $FH or die "Unable to close handle after writing: $!"; +#} + +################### DOCUMENTATION ################### + +=head1 NAME + +02_methods.t - Test functions in Parrot::Headerizer. + +=head1 SYNOPSIS + + % prove t/tools/dev/headerizer/02_methods.t + +=head1 DESCRIPTION + +The files in this directory test the publicly callable subroutines found in +F. By doing so, they help test the functionality +of the F utility. + +=head1 AUTHOR + +James E Keenan + +=head1 SEE ALSO + +F; F. + +=cut + +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4: diff --git a/tools/dev/headerizer.pl b/tools/dev/headerizer.pl index 7df44929e0..10324398ef 100644 --- a/tools/dev/headerizer.pl +++ b/tools/dev/headerizer.pl @@ -12,6 +12,7 @@ print_headerizer_warnings read_file write_file + qualify_sourcefile ); =head1 NAME @@ -93,7 +94,6 @@ =head1 COMMAND-LINE OPTIONS for my $ofile (@ofiles) { # Skip files in the src/ops/ subdirectory. - next if $ofile =~ m/^\Qsrc$PConfig{slash}ops\E/ || # if run by hand... $ofile =~ m{^src/ops}; # ... or by makefile @@ -106,26 +106,12 @@ =head1 COMMAND-LINE OPTIONS next if -f $sfile; } - my $cfile = $ofile; - $cfile =~ s/\Q$PConfig{o}\E$/.c/ or $is_yacc - or die "$cfile doesn't look like an object file"; - - my $pmcfile = $ofile; - $pmcfile =~ s/\Q$PConfig{o}\E$/.pmc/; - - my $from_pmc = -f $pmcfile && !$is_yacc; - - my $sourcefile = $from_pmc ? $pmcfile : $cfile; - - my $source_code = read_file( $sourcefile ); - die qq{can't find HEADERIZER HFILE directive in "$sourcefile"} - unless $source_code =~ - m{ /\* \s+ HEADERIZER\ HFILE: \s+ ([^*]+?) \s+ \*/ }sx; - - my $hfile = $1; - if ( ( $hfile ne 'none' ) && ( not -f $hfile ) ) { - die qq{"$hfile" not found (referenced from "$sourcefile")}; - } + my ($sourcefile, $source_code, $hfile) = + qualify_sourcefile( { + ofile => $ofile, + PConfig => \%PConfig, + is_yacc => $is_yacc, + } ); my @decls; if ( $macro_match ) { From eabb0e871c8c8eeaa754ae9a0e0f9677e118e153 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sun, 21 Nov 2010 09:04:55 -0500 Subject: [PATCH 011/102] Test additional branches and conditions in Parrot::Headerizer::Functions::qualify_sourcefile(). --- t/tools/dev/headerizer/01_functions.t | 49 +++++++++++++++++++ .../dev/headerizer/testlib/lack_directive.in | 1 + t/tools/dev/headerizer/testlib/none.in | 3 ++ 3 files changed, 53 insertions(+) create mode 100644 t/tools/dev/headerizer/testlib/lack_directive.in create mode 100644 t/tools/dev/headerizer/testlib/none.in diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index 1aa1635785..a247599a37 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -6,7 +6,9 @@ use strict; use warnings; use Test::More qw(no_plan); # tests => 15; +use Carp; use Cwd; +use File::Copy; use File::Temp qw( tempdir ); use lib qw( lib ); use Parrot::Config; @@ -97,6 +99,53 @@ eval { like($@, qr/$ofile doesn't look like an object file/, "Got expected die message for non-object, non-yacc file" ); +# Testing Needs We don't really need a .o file, we just need its name. +# However, we do need one .c file and one .pmc file. In order to have the +# codingstd tests skip these, we should name them .in and then copy them into +# position with the extensions we need. We need one file where there is no +# HEADERIZER HFILE directive within the file. We need a case where the +# HEADERIZER HFILE directive contains 'none'. We need a case where the header +# file exists and one where it does not. + +{ + my $tdir = tempdir( CLEANUP => 1 ); + my $stub = 'lack_directive'; + copy "$cwd/t/tools/dev/headerizer/testlib/$stub.in" => + "$tdir/$stub.c" or croak "Unable to copy file for testing"; + $ofile = "$tdir/$stub.o"; + my $expected_cfile = "$tdir/$stub.c"; + eval { + my ($sourcefile, $source_code, $hfile) = + qualify_sourcefile( { + ofile => $ofile, + PConfig => \%PConfig, + is_yacc => 0, + } ); + }; + like($@, qr/can't find HEADERIZER HFILE directive in "$expected_cfile"/, + "Got expected die message for file lacking HEADERIZER HFILE directive" ); +} + +#t/tools/dev/headerizer/testlib/none.in +{ + my $tdir = tempdir( CLEANUP => 1 ); + my $stub = 'none'; + copy "$cwd/t/tools/dev/headerizer/testlib/$stub.in" => + "$tdir/$stub.c" or croak "Unable to copy file for testing"; + $ofile = "$tdir/$stub.o"; + my $expected_cfile = "$tdir/$stub.c"; + my ($sourcefile, $source_code, $hfile) = + qualify_sourcefile( { + ofile => $ofile, + PConfig => \%PConfig, + is_yacc => 0, + } ); + is( $sourcefile, $expected_cfile, "Got expected C source file" ); + like( $source_code, qr/This file has 'none'/, + "Got expected source code" ); + is( $hfile, 'none', "As expected, no header file" ); +} + pass("Completed all tests in $0"); #sub touch_parrot { diff --git a/t/tools/dev/headerizer/testlib/lack_directive.in b/t/tools/dev/headerizer/testlib/lack_directive.in new file mode 100644 index 0000000000..343ea37378 --- /dev/null +++ b/t/tools/dev/headerizer/testlib/lack_directive.in @@ -0,0 +1 @@ +This file lacks a HEADERIZER HFILE directive embedded in a C-style comment. diff --git a/t/tools/dev/headerizer/testlib/none.in b/t/tools/dev/headerizer/testlib/none.in new file mode 100644 index 0000000000..17d20fb194 --- /dev/null +++ b/t/tools/dev/headerizer/testlib/none.in @@ -0,0 +1,3 @@ +This file has 'none' for its HEADERIZER HFILE directive. +/* HEADERIZER HFILE: none */ + From a8c428da9527c93040ee10c45b9458c02c94381f Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sun, 21 Nov 2010 09:54:36 -0500 Subject: [PATCH 012/102] Test additional branches and conditions in Parrot::Headerizer::Functions::qualify_sourcefile(). --- t/tools/dev/headerizer/01_functions.t | 20 ++++++++++++++++++- .../headerizer/testlib/missingheaderfile.in | 2 ++ 2 files changed, 21 insertions(+), 1 deletion(-) create mode 100644 t/tools/dev/headerizer/testlib/missingheaderfile.in diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index a247599a37..d9d47b4a8f 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -126,7 +126,6 @@ like($@, qr/$ofile doesn't look like an object file/, "Got expected die message for file lacking HEADERIZER HFILE directive" ); } -#t/tools/dev/headerizer/testlib/none.in { my $tdir = tempdir( CLEANUP => 1 ); my $stub = 'none'; @@ -146,6 +145,25 @@ like($@, qr/$ofile doesn't look like an object file/, is( $hfile, 'none', "As expected, no header file" ); } +{ + my $tdir = tempdir( CLEANUP => 1 ); + my $stub = 'missingheaderfile'; + copy "$cwd/t/tools/dev/headerizer/testlib/$stub.in" => + "$tdir/$stub.c" or croak "Unable to copy file for testing"; + $ofile = "$tdir/$stub.o"; + my $expected_cfile = "$tdir/$stub.c"; + eval { + my ($sourcefile, $source_code, $hfile) = + qualify_sourcefile( { + ofile => $ofile, + PConfig => \%PConfig, + is_yacc => 0, + } ); + }; + like($@, qr/"$stub" not found \(referenced from "$expected_cfile"\)/, + "Got expected error message for missing header file" ); +} + pass("Completed all tests in $0"); #sub touch_parrot { diff --git a/t/tools/dev/headerizer/testlib/missingheaderfile.in b/t/tools/dev/headerizer/testlib/missingheaderfile.in new file mode 100644 index 0000000000..4ac585b97f --- /dev/null +++ b/t/tools/dev/headerizer/testlib/missingheaderfile.in @@ -0,0 +1,2 @@ +This file has a valid HEADERIZER HFILE directive but no corresponding header file. +/* HEADERIZER HFILE: missingheaderfile */ From ed0a74524b05b081d2a61608d781b896fcccf03c Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sun, 21 Nov 2010 10:01:39 -0500 Subject: [PATCH 013/102] Test additional branches and conditions in Parrot::Headerizer::Functions::qualify_sourcefile(). --- t/tools/dev/headerizer/01_functions.t | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index d9d47b4a8f..c2bd29facc 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -85,6 +85,17 @@ my $warnings = { "Got expected summary of headerizer warnings" ); } +$warnings = {}; +{ + my ($stdout, $stderr); + capture( + sub { print_headerizer_warnings($warnings); }, + \$stdout, + \$stderr, + ); + ok(! $stdout, "No warnings, hence no warnings printed" ); +} + my ($ofile, $is_yacc); my ($sourcefile, $source_code, $hfile); $ofile = 'foobar.xyz'; From 8128e25f4c832c1755bc9c3194599977acaed011 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sun, 21 Nov 2010 19:18:45 -0500 Subject: [PATCH 014/102] Test additional branches and conditions in Parrot::Headerizer::Functions::qualify_sourcefile(). --- t/tools/dev/headerizer/01_functions.t | 70 +++++++++++++++++++ .../dev/headerizer/testlib/hvalidheader.in | 1 + t/tools/dev/headerizer/testlib/imcc.in | 5 ++ t/tools/dev/headerizer/testlib/validheader.in | 3 + 4 files changed, 79 insertions(+) create mode 100644 t/tools/dev/headerizer/testlib/hvalidheader.in create mode 100644 t/tools/dev/headerizer/testlib/imcc.in create mode 100644 t/tools/dev/headerizer/testlib/validheader.in diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index c2bd29facc..8aa80094b0 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -96,6 +96,12 @@ $warnings = {}; ok(! $stdout, "No warnings, hence no warnings printed" ); } +my $filename = 'foobar'; +eval { + read_file($filename); +}; +like($@, qr/couldn't read '$filename'/, "Got expected error message for read_file()"); + my ($ofile, $is_yacc); my ($sourcefile, $source_code, $hfile); $ofile = 'foobar.xyz'; @@ -175,6 +181,70 @@ like($@, qr/$ofile doesn't look like an object file/, "Got expected error message for missing header file" ); } +{ + my $tdir = tempdir( CLEANUP => 1 ); + my $stub = 'validheader'; + copy "$cwd/t/tools/dev/headerizer/testlib/$stub.in" => + "$tdir/$stub.c" or croak "Unable to copy file for testing"; + copy "$cwd/t/tools/dev/headerizer/testlib/h$stub.in" => + "$tdir/$stub.h" or croak "Unable to copy file for testing"; + $ofile = "$tdir/$stub.o"; + my $expected_cfile = "$tdir/$stub.c"; + chdir $tdir; + my ($sourcefile, $source_code, $hfile) = + qualify_sourcefile( { + ofile => $ofile, + PConfig => \%PConfig, + is_yacc => 0, + } ); + chdir $cwd; + is( $sourcefile, $expected_cfile, "Got expected C source file" ); + like( $source_code, qr/This file has a valid HEADERIZER HFILE/, + "Got expected source code" ); + is( $hfile, "$stub.h", "Got expected header file" ); +} + +{ + my $tdir = tempdir( CLEANUP => 1 ); + my $stub = 'validheader'; + copy "$cwd/t/tools/dev/headerizer/testlib/$stub.in" => + "$tdir/$stub.pmc" or croak "Unable to copy file for testing"; + copy "$cwd/t/tools/dev/headerizer/testlib/h$stub.in" => + "$tdir/$stub.h" or croak "Unable to copy file for testing"; + $ofile = "$tdir/$stub.o"; + my $expected_cfile = "$tdir/$stub.pmc"; + chdir $tdir; + my ($sourcefile, $source_code, $hfile) = + qualify_sourcefile( { + ofile => $ofile, + PConfig => \%PConfig, + is_yacc => 0, + } ); + chdir $cwd; + is( $sourcefile, $expected_cfile, "Got expected PMC file" ); + like( $source_code, qr/This file has a valid HEADERIZER HFILE/, + "Got expected source code" ); + is( $hfile, "$stub.h", "Got expected header file" ); +} + +{ + my $tdir = tempdir( CLEANUP => 1 ); + my $stub = 'imcc'; + copy "$cwd/t/tools/dev/headerizer/testlib/$stub.in" => + "$tdir/$stub.y" or croak "Unable to copy file for testing"; + $ofile = "$tdir/$stub.y"; + my $expected_cfile = $ofile; + my ($sourcefile, $source_code, $hfile) = + qualify_sourcefile( { + ofile => $ofile, + PConfig => \%PConfig, + is_yacc => 1, + } ); + is( $sourcefile, $expected_cfile, "Got expected C source file" ); + like( $source_code, qr/HEADERIZER HFILE: none/, "Got expected source code" ); + is( $hfile, 'none', "As expected, no header file" ); +} + pass("Completed all tests in $0"); #sub touch_parrot { diff --git a/t/tools/dev/headerizer/testlib/hvalidheader.in b/t/tools/dev/headerizer/testlib/hvalidheader.in new file mode 100644 index 0000000000..95627b470b --- /dev/null +++ b/t/tools/dev/headerizer/testlib/hvalidheader.in @@ -0,0 +1 @@ +This is used in testing only. diff --git a/t/tools/dev/headerizer/testlib/imcc.in b/t/tools/dev/headerizer/testlib/imcc.in new file mode 100644 index 0000000000..c9bc865918 --- /dev/null +++ b/t/tools/dev/headerizer/testlib/imcc.in @@ -0,0 +1,5 @@ +%top{ +/* HEADERIZER HFILE: none */ +/* HEADERIZER STOP */ +} + diff --git a/t/tools/dev/headerizer/testlib/validheader.in b/t/tools/dev/headerizer/testlib/validheader.in new file mode 100644 index 0000000000..cb60540694 --- /dev/null +++ b/t/tools/dev/headerizer/testlib/validheader.in @@ -0,0 +1,3 @@ +This file has a valid HEADERIZER HFILE directive and has a corresponding header file. +/* HEADERIZER HFILE: validheader.h */ + From 883196d132e09cdedd1f04d6d66bb8f630ca962b Mon Sep 17 00:00:00 2001 From: jkeenan Date: Thu, 25 Nov 2010 13:24:15 -0500 Subject: [PATCH 015/102] Rename lib/Parrot/Headerizer.pm to lib/Parrot/Headerizer/Object.pm. Move most code out of tools/dev/headerizer.pl into Parrot::Headerizer::Object or Parrot::Headerizer::Functions. Tests need to be updated. --- MANIFEST | 2 +- lib/Parrot/Headerizer.pm | 371 ------------- lib/Parrot/Headerizer/Functions.pm | 80 ++- lib/Parrot/Headerizer/Object.pm | 722 ++++++++++++++++++++++++++ t/codingstd/c_function_docs.t | 4 +- t/codingstd/pmc_docs.t | 4 +- t/tools/dev/headerizer/01_functions.t | 27 + t/tools/dev/headerizer/02_methods.t | 8 +- tools/dev/headerizer.pl | 336 +----------- 9 files changed, 826 insertions(+), 728 deletions(-) delete mode 100644 lib/Parrot/Headerizer.pm create mode 100644 lib/Parrot/Headerizer/Object.pm diff --git a/MANIFEST b/MANIFEST index 4d833137f3..6cd65ad2b4 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1070,7 +1070,7 @@ lib/Parrot/H2inc.pm [devel]lib lib/Parrot/Harness/DefaultTests.pm [devel]lib lib/Parrot/Harness/Options.pm [devel]lib lib/Parrot/Harness/Smoke.pm [devel]lib -lib/Parrot/Headerizer.pm [devel]lib +lib/Parrot/Headerizer/Object.pm [devel]lib lib/Parrot/Headerizer/Functions.pm [devel]lib lib/Parrot/IO/Directory.pm [devel]lib lib/Parrot/IO/File.pm [devel]lib diff --git a/lib/Parrot/Headerizer.pm b/lib/Parrot/Headerizer.pm deleted file mode 100644 index cd52d440de..0000000000 --- a/lib/Parrot/Headerizer.pm +++ /dev/null @@ -1,371 +0,0 @@ -# Copyright (C) 2004-2010, Parrot Foundation. -# $Id$ - -package Parrot::Headerizer; - -=head1 NAME - -Parrot::Headerizer - Parrot Header Generation functionality - -=head1 SYNOPSIS - - use Parrot::Headerizer; - - my $headerizer = Parrot::Headerizer->new(); - -=head1 DESCRIPTION - -C knows how to extract all kinds of information out -of C-language files. - -=head2 Class Methods - -=over 4 - -=cut - -use strict; -use warnings; - -=item C - -Constructor of headerizer objects. - -=cut - -sub new { - my ($class) = @_; - - my $self = bless { - warnings => {}, - }, $class; - - $self->{valid_macros} = { map { ( $_, 1 ) } qw( - PARROT_EXPORT - PARROT_INLINE - PARROT_NOINLINE - - PARROT_CAN_RETURN_NULL - PARROT_CANNOT_RETURN_NULL - - PARROT_IGNORABLE_RESULT - PARROT_WARN_UNUSED_RESULT - - PARROT_PURE_FUNCTION - PARROT_CONST_FUNCTION - - PARROT_DOES_NOT_RETURN - PARROT_DOES_NOT_RETURN_WHEN_FALSE - - PARROT_MALLOC - PARROT_OBSERVER - - PARROT_HOT - PARROT_COLD - ) - }; - - return $self; -} - -=item C - - $headerizer->valid_macro( $macro ) - -Returns a boolean saying whether I<$macro> is a valid C macro. - -=cut - -sub valid_macro { - my $self = shift; - my $macro = shift; - - return exists $self->{valid_macros}{$macro}; -} - -=item C - - $headerizer->valid_macros() - -Returns a list of all the valid C macros. - -=cut - -sub valid_macros { - my $self = shift; - - my @macros = sort keys %{$self->{valid_macros}}; - - return @macros; -} - -=item C - - $headerizer->extract_function_declarations($text) - -Extracts the function declarations from the text argument, and returns an -array of strings containing the function declarations. - -=cut - -sub extract_function_declarations { - my $self = shift; - my $text = shift; - - # Only check the YACC C code if we find what looks like YACC file - $text =~ s/%\{(.*)%\}.*/$1/sm; - - # Drop all text after HEADERIZER STOP - $text =~ s{/\*\s*HEADERIZER STOP.+}{}s; - - # Strip blocks of comments - $text =~ s{^/\*.*?\*/}{}mxsg; - - # Strip # compiler directives - $text =~ s{^#(\\\n|.)*}{}mg; - - # Strip code blocks - $text =~ s/^{.+?^}//msg; - - # Split on paragraphs - my @funcs = split /\n{2,}/, $text; - - # If it doesn't start in the left column, it's not a func - @funcs = grep { /^\S/ } @funcs; - - # Typedefs, enums and externs are no good - @funcs = grep { !/^(?:typedef|enum|extern)\b/ } @funcs; - - # Structs are OK if they're not alone on the line - @funcs = grep { !/^struct.+;\n/ } @funcs; - - # Structs are OK if they're not being defined - @funcs = grep { !/^(?:static\s+)?struct.+{\n/ } @funcs; - - # Ignore magic function name YY_DECL - @funcs = grep { !/YY_DECL/ } @funcs; - - # Ignore anything with magic words HEADERIZER SKIP - @funcs = grep { !m{/\*\s*HEADERIZER SKIP\s*\*/} } @funcs; - - # pmclass declarations in PMC files are no good - @funcs = grep { !m{^pmclass } } @funcs; - - # Variables are of no use to us - @funcs = grep { !/=/ } @funcs; - - # Get rid of any blocks at the end - s/\s*{.*//s for @funcs; - - # Toast anything non-whitespace - @funcs = grep { /\S/ } @funcs; - - # If it's got a semicolon, it's not a function header - @funcs = grep { !/;/ } @funcs; - - # remove any remaining }'s - @funcs = grep {! /^}/} @funcs; - - chomp @funcs; - - return @funcs; -} - -=item C - -$file => the filename -$proto => the function declaration - -Returns an anonymous hash of function components: - - file => $file, - name => $name, - args => \@args, - macros => \@macros, - is_static => $is_static, - is_inline => $parrot_inline, - is_api => $parrot_api, - is_ignorable => $is_ignorable, - return_type => $return_type, - -=cut - -sub function_components_from_declaration { - my $self = shift; - my $file = shift; - my $proto = shift; - - my @lines = split( /\n/, $proto ); - chomp @lines; - - my @macros; - my $parrot_api; - my $parrot_inline; - - while ( @lines && ( $lines[0] =~ /^PARROT_/ ) ) { - my $macro = shift @lines; - if ( $macro eq 'PARROT_EXPORT' ) { - $parrot_api = 1; - } - elsif ( $macro eq 'PARROT_INLINE' ) { - $parrot_inline = 1; - } - push( @macros, $macro ); - } - - my $return_type = shift @lines; - my $args = join( ' ', @lines ); - - $args =~ s/\s+/ /g; - $args =~ s{([^(]+)\s*\((.+)\);?}{$2} - or die qq{Couldn't handle "$proto" in $file\n}; - - my $name = $1; - $args = $2; - - die "Can't have both PARROT_EXPORT and PARROT_INLINE on $name\n" if $parrot_inline && $parrot_api; - - my @args = split( /\s*,\s*/, $args ); - for (@args) { - /\S+\s+\S+/ - || ( $_ eq '...' ) - || ( $_ eq 'void' ) - || ( $_ =~ /(PARROT|NULLOK|SHIM)_INTERP/ ) - or die "Bad args in $proto"; - } - - my $is_ignorable = 0; - my $is_static = 0; - $is_static = $2 if $return_type =~ s/^((static)\s+)?//i; - - die "$file $name: Impossible to have both static and PARROT_EXPORT" if $parrot_api && $is_static; - - my %macros; - for my $macro (@macros) { - $macros{$macro} = 1; - if (not $self->valid_macro($macro)) { - $self->squawk( $file, $name, "Invalid macro $macro" ); - } - if ( $macro eq 'PARROT_IGNORABLE_RESULT' ) { - $is_ignorable = 1; - } - } - if ( $return_type =~ /\*/ ) { - if ( !$macros{PARROT_CAN_RETURN_NULL} && !$macros{PARROT_CANNOT_RETURN_NULL} ) { - if ( $name !~ /^yy/ ) { # Don't complain about lexer-created functions - $self->squawk( $file, $name, - 'Returns a pointer, but no PARROT_CAN(NOT)_RETURN_NULL macro found.' ); - } - } - elsif ( $macros{PARROT_CAN_RETURN_NULL} && $macros{PARROT_CANNOT_RETURN_NULL} ) { - $self->squawk( $file, $name, - q{Can't have both PARROT_CAN_RETURN_NULL and PARROT_CANNOT_RETURN_NULL together.} ); - } - } - - return { - file => $file, - name => $name, - args => \@args, - macros => \@macros, - is_static => $is_static, - is_inline => $parrot_inline, - is_api => $parrot_api, - is_ignorable => $is_ignorable, - return_type => $return_type, - }; -} - -=item C - -Given an extracted function signature, return a modified -version suitable for inclusion in POD documentation. - -=cut - -sub generate_documentation_signature { - my $self = shift; - my $function_decl = shift; - - # strip out any PARROT_* function modifiers - foreach my $key ($self->valid_macros) { - $function_decl =~ s/^$key$//m; - } - - $function_decl =~ s/^\s+//g; - $function_decl =~ s/\s+/ /g; - - # strip out any ARG* modifiers - $function_decl =~ s/ARG(?:IN|IN_NULLOK|OUT|OUT_NULLOK|MOD|MOD_NULLOK|FREE|FREE_NOTNULL)\((.*?)\)/$1/g; - - # strip out the SHIM modifier - $function_decl =~ s/SHIM\((.*?)\)/$1/g; - - # strip out the NULL modifiers - $function_decl =~ s/(?:NULLOK|NOTNULL)\((.*?)\)/$1/g; - - # SHIM_INTERP is still a PARROT_INTERP - $function_decl =~ s/SHIM_INTERP/PARROT_INTERP/g; - - # wrap with POD - $function_decl = "=item C<$function_decl>"; - - # Wrap long lines. - my $line_len = 80; - return $function_decl if length($function_decl)<= $line_len; - - my @doc_chunks = split /\s+/, $function_decl; - my $split_decl = ''; - my @line; - while (@doc_chunks) { - my $chunk = shift @doc_chunks; - if (length(join(' ', @line, $chunk)) <= $line_len) { - push @line, $chunk; - } - else { - $split_decl .= join(' ', @line) . "\n"; - @line=($chunk); - } - } - if (@line) { - $split_decl .= join(' ', @line) . "\n"; - } - - $split_decl =~ s/\n$//; - - return $split_decl; -} - -=item C - -Headerizer-specific ways of complaining if something went wrong. - -$file => filename -$func => function name -$error => error message text - -=cut - -sub squawk { - my $self = shift; - my $file = shift; - my $func = shift; - my $error = shift; - - push( @{ $self->{warnings}{$file}{$func} }, $error ); - - return; -} - -=back - -=cut - -1; - -# Local Variables: -# mode: cperl -# cperl-indent-level: 4 -# fill-column: 100 -# End: -# vim: expandtab shiftwidth=4: diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index fa27ccdc22..d994c45a58 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -6,10 +6,12 @@ use strict; use warnings; use base qw( Exporter ); our @EXPORT_OK = qw( - print_headerizer_warnings + process_argv read_file write_file qualify_sourcefile + asserts_from_args + api_first_then_alpha ); =head1 NAME @@ -23,6 +25,8 @@ Parrot::Headerizer::Functions - Functions used in headerizer programs read_file write_file qualify_sourcefile + asserts_from_args + api_first_then_alpha ); =head1 DESCRIPTION @@ -32,46 +36,43 @@ F. =head1 SUBROUTINES -=head2 C +=head2 C =over 4 =item * Purpose +Validate list of object files provided as arguments. + =item * Arguments + @ofiles = process_argv(@ARGV); + +List of files specified on the command-line. + =item * Return Value +Validated list of object files. + =item * Comment =back =cut -sub print_headerizer_warnings { - my $warnings_ref = shift; - my %warnings = %{$warnings_ref}; - if ( keys %warnings ) { - my $nwarnings = 0; - my $nwarningfuncs = 0; - my $nwarningfiles = 0; - for my $file ( sort keys %warnings ) { - ++$nwarningfiles; - print "$file\n"; - my $funcs = $warnings{$file}; - for my $func ( sort keys %{$funcs} ) { - ++$nwarningfuncs; - for my $error ( @{ $funcs->{$func} } ) { - print " $func: $error\n"; - ++$nwarnings; - } - } - } - - print "$nwarnings warnings in $nwarningfuncs funcs in $nwarningfiles C files\n"; +sub process_argv { + my @argv = @_; + die 'No files specified.' unless @argv; + my %ofiles; + ++$ofiles{$_} for @argv; + my @ofiles = sort keys %ofiles; + for (@ofiles) { + print "$_ is specified more than once.\n" if $ofiles{$_} > 1; } + return @ofiles; } + =head2 C =over 4 @@ -218,6 +219,39 @@ sub qualify_sourcefile { return ($sourcefile, $source_code, $hfile); } +sub asserts_from_args { + my @args = @_; + my @asserts; + + for my $arg (@args) { + if ( $arg =~ m{(ARGIN|ARGOUT|ARGMOD|ARGFREE_NOTNULL|NOTNULL)\((.+)\)} ) { + my $var = $2; + if($var =~ /\(*\s*([a-zA-Z_][a-zA-Z0-9_]*)\s*\)\s*\(/) { + # argument is a function pointer + $var = $1; + } + else { + # try to isolate the variable's name; + # strip off everything before the final space or asterisk. + $var =~ s{.+[* ]([^* ]+)$}{$1}; + # strip off a trailing "[]", if any. + $var =~ s{\[\]$}{}; + } + push( @asserts, "PARROT_ASSERT_ARG($var)" ); + } + if( $arg eq 'PARROT_INTERP' ) { + push( @asserts, "PARROT_ASSERT_ARG(interp)" ); + } + } + + return (@asserts); +} + + +sub api_first_then_alpha { + return ( ( $b->{is_api} || 0 ) <=> ( $a->{is_api} || 0 ) ) + || ( lc $a->{name} cmp lc $b->{name} ); +} 1; # Local Variables: diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm new file mode 100644 index 0000000000..13679e01fd --- /dev/null +++ b/lib/Parrot/Headerizer/Object.pm @@ -0,0 +1,722 @@ +# Copyright (C) 2004-2010, Parrot Foundation. +# $Id$ + +package Parrot::Headerizer::Object; + +=head1 NAME + +Parrot::Headerizer::Object - Parrot Header Generation functionality + +=head1 SYNOPSIS + + use Parrot::Headerizer::Object; + + my $headerizer = Parrot::Headerizer::Object->new(); + +=head1 DESCRIPTION + +C knows how to extract all kinds of information out +of C-language files. + +=head2 Class Methods + +=over 4 + +=cut + +use strict; +use warnings; +use Scalar::Util qw( reftype ); +use lib qw( lib ); +use Parrot::Config; +use Parrot::Headerizer::Functions qw( + read_file + write_file + qualify_sourcefile + asserts_from_args + api_first_then_alpha +); + +=item C + +Constructor of headerizer objects. + +=cut + +sub new { + my ($class, $args) = @_; + if (defined $args) { + die "Argument to Parrot::Headerizer::Object must be hashref" + unless reftype($args) eq 'HASH'; + } + else { + $args = {}; + } + $args->{macro_match} = undef unless defined $args->{macro_match}; + $args->{warnings} = {}; + $args->{message} = ''; + $args->{valid_macros} = { map { ( $_, 1 ) } qw( + PARROT_EXPORT + PARROT_INLINE + PARROT_NOINLINE + + PARROT_CAN_RETURN_NULL + PARROT_CANNOT_RETURN_NULL + + PARROT_IGNORABLE_RESULT + PARROT_WARN_UNUSED_RESULT + + PARROT_PURE_FUNCTION + PARROT_CONST_FUNCTION + + PARROT_DOES_NOT_RETURN + PARROT_DOES_NOT_RETURN_WHEN_FALSE + + PARROT_MALLOC + PARROT_OBSERVER + + PARROT_HOT + PARROT_COLD + ) + }; + return bless $args, $class; +} + +=item C + + $headerizer->valid_macro( $macro ) + +Returns a boolean saying whether I<$macro> is a valid C macro. + +=cut + +sub valid_macro { + my $self = shift; + my $macro = shift; + + return exists $self->{valid_macros}{$macro}; +} + +=item C + + $headerizer->valid_macros() + +Returns a list of all the valid C macros. + +=cut + +sub valid_macros { + my $self = shift; + + my @macros = sort keys %{$self->{valid_macros}}; + + return @macros; +} + +=item C + + $headerizer->extract_function_declarations($text) + +Extracts the function declarations from the text argument, and returns an +array of strings containing the function declarations. + +=cut + +sub extract_function_declarations { + my $self = shift; + my $text = shift; + + # Only check the YACC C code if we find what looks like YACC file + $text =~ s/%\{(.*)%\}.*/$1/sm; + + # Drop all text after HEADERIZER STOP + $text =~ s{/\*\s*HEADERIZER STOP.+}{}s; + + # Strip blocks of comments + $text =~ s{^/\*.*?\*/}{}mxsg; + + # Strip # compiler directives + $text =~ s{^#(\\\n|.)*}{}mg; + + # Strip code blocks + $text =~ s/^{.+?^}//msg; + + # Split on paragraphs + my @funcs = split /\n{2,}/, $text; + + # If it doesn't start in the left column, it's not a func + @funcs = grep { /^\S/ } @funcs; + + # Typedefs, enums and externs are no good + @funcs = grep { !/^(?:typedef|enum|extern)\b/ } @funcs; + + # Structs are OK if they're not alone on the line + @funcs = grep { !/^struct.+;\n/ } @funcs; + + # Structs are OK if they're not being defined + @funcs = grep { !/^(?:static\s+)?struct.+{\n/ } @funcs; + + # Ignore magic function name YY_DECL + @funcs = grep { !/YY_DECL/ } @funcs; + + # Ignore anything with magic words HEADERIZER SKIP + @funcs = grep { !m{/\*\s*HEADERIZER SKIP\s*\*/} } @funcs; + + # pmclass declarations in PMC files are no good + @funcs = grep { !m{^pmclass } } @funcs; + + # Variables are of no use to us + @funcs = grep { !/=/ } @funcs; + + # Get rid of any blocks at the end + s/\s*{.*//s for @funcs; + + # Toast anything non-whitespace + @funcs = grep { /\S/ } @funcs; + + # If it's got a semicolon, it's not a function header + @funcs = grep { !/;/ } @funcs; + + # remove any remaining }'s + @funcs = grep {! /^}/} @funcs; + + chomp @funcs; + + return @funcs; +} + +=item C + +$file => the filename +$proto => the function declaration + +Returns an anonymous hash of function components: + + file => $file, + name => $name, + args => \@args, + macros => \@macros, + is_static => $is_static, + is_inline => $parrot_inline, + is_api => $parrot_api, + is_ignorable => $is_ignorable, + return_type => $return_type, + +=cut + +sub function_components_from_declaration { + my $self = shift; + my $file = shift; + my $proto = shift; + + my @lines = split( /\n/, $proto ); + chomp @lines; + + my @macros; + my $parrot_api; + my $parrot_inline; + + while ( @lines && ( $lines[0] =~ /^PARROT_/ ) ) { + my $macro = shift @lines; + if ( $macro eq 'PARROT_EXPORT' ) { + $parrot_api = 1; + } + elsif ( $macro eq 'PARROT_INLINE' ) { + $parrot_inline = 1; + } + push( @macros, $macro ); + } + + my $return_type = shift @lines; + my $args = join( ' ', @lines ); + + $args =~ s/\s+/ /g; + $args =~ s{([^(]+)\s*\((.+)\);?}{$2} + or die qq{Couldn't handle "$proto" in $file\n}; + + my $name = $1; + $args = $2; + + die "Can't have both PARROT_EXPORT and PARROT_INLINE on $name\n" if $parrot_inline && $parrot_api; + + my @args = split( /\s*,\s*/, $args ); + for (@args) { + /\S+\s+\S+/ + || ( $_ eq '...' ) + || ( $_ eq 'void' ) + || ( $_ =~ /(PARROT|NULLOK|SHIM)_INTERP/ ) + or die "Bad args in $proto"; + } + + my $is_ignorable = 0; + my $is_static = 0; + $is_static = $2 if $return_type =~ s/^((static)\s+)?//i; + + die "$file $name: Impossible to have both static and PARROT_EXPORT" if $parrot_api && $is_static; + + my %macros; + for my $macro (@macros) { + $macros{$macro} = 1; + if (not $self->valid_macro($macro)) { + $self->squawk( $file, $name, "Invalid macro $macro" ); + } + if ( $macro eq 'PARROT_IGNORABLE_RESULT' ) { + $is_ignorable = 1; + } + } + if ( $return_type =~ /\*/ ) { + if ( !$macros{PARROT_CAN_RETURN_NULL} && !$macros{PARROT_CANNOT_RETURN_NULL} ) { + if ( $name !~ /^yy/ ) { # Don't complain about lexer-created functions + $self->squawk( $file, $name, + 'Returns a pointer, but no PARROT_CAN(NOT)_RETURN_NULL macro found.' ); + } + } + elsif ( $macros{PARROT_CAN_RETURN_NULL} && $macros{PARROT_CANNOT_RETURN_NULL} ) { + $self->squawk( $file, $name, + q{Can't have both PARROT_CAN_RETURN_NULL and PARROT_CANNOT_RETURN_NULL together.} ); + } + } + + return { + file => $file, + name => $name, + args => \@args, + macros => \@macros, + is_static => $is_static, + is_inline => $parrot_inline, + is_api => $parrot_api, + is_ignorable => $is_ignorable, + return_type => $return_type, + }; +} + +=item C + +Given an extracted function signature, return a modified +version suitable for inclusion in POD documentation. + +=cut + +sub generate_documentation_signature { + my $self = shift; + my $function_decl = shift; + + # strip out any PARROT_* function modifiers + foreach my $key ($self->valid_macros) { + $function_decl =~ s/^$key$//m; + } + + $function_decl =~ s/^\s+//g; + $function_decl =~ s/\s+/ /g; + + # strip out any ARG* modifiers + $function_decl =~ s/ARG(?:IN|IN_NULLOK|OUT|OUT_NULLOK|MOD|MOD_NULLOK|FREE|FREE_NOTNULL)\((.*?)\)/$1/g; + + # strip out the SHIM modifier + $function_decl =~ s/SHIM\((.*?)\)/$1/g; + + # strip out the NULL modifiers + $function_decl =~ s/(?:NULLOK|NOTNULL)\((.*?)\)/$1/g; + + # SHIM_INTERP is still a PARROT_INTERP + $function_decl =~ s/SHIM_INTERP/PARROT_INTERP/g; + + # wrap with POD + $function_decl = "=item C<$function_decl>"; + + # Wrap long lines. + my $line_len = 80; + return $function_decl if length($function_decl)<= $line_len; + + my @doc_chunks = split /\s+/, $function_decl; + my $split_decl = ''; + my @line; + while (@doc_chunks) { + my $chunk = shift @doc_chunks; + if (length(join(' ', @line, $chunk)) <= $line_len) { + push @line, $chunk; + } + else { + $split_decl .= join(' ', @line) . "\n"; + @line=($chunk); + } + } + if (@line) { + $split_decl .= join(' ', @line) . "\n"; + } + + $split_decl =~ s/\n$//; + + return $split_decl; +} + +=item C + +Headerizer-specific ways of complaining if something went wrong. + +$file => filename +$func => function name +$error => error message text + +=cut + +sub squawk { + my $self = shift; + my $file = shift; + my $func = shift; + my $error = shift; + + push( @{ $self->{warnings}{$file}{$func} }, $error ); + + return; +} + +sub get_sources { + my $self = shift; + my @ofiles = @_; + my %sourcefiles; + my %sourcefiles_with_statics; + my %api; + # Walk the object files and find corresponding source (either .c or .pmc) + for my $ofile (@ofiles) { + + # Skip files in the src/ops/ subdirectory. + next if $ofile =~ m/^\Qsrc$PConfig{slash}ops\E/ || # if run by hand... + $ofile =~ m{^src/ops}; # ... or by makefile + + $ofile =~ s/\\/\//g; + + my $is_yacc = ($ofile =~ /\.y$/); + if ( !$is_yacc ) { + my $sfile = $ofile; + $sfile =~ s/\Q$PConfig{o}\E$/.s/; + next if -f $sfile; + } + + my ($sourcefile, $source_code, $hfile) = + qualify_sourcefile( { + ofile => $ofile, + PConfig => \%PConfig, + is_yacc => $is_yacc, + } ); + + my @decls; + if ( $self->{macro_match} ) { + @decls = $self->extract_function_declarations( $source_code ); + } + else { + @decls = $self->extract_function_declarations_and_update_source( $sourcefile ); + } + + for my $decl (@decls) { + my $components = $self->function_components_from_declaration( $sourcefile, $decl ); + push( @{ $sourcefiles{$hfile}->{$sourcefile} }, $components ) unless $hfile eq 'none'; + push( @{ $sourcefiles_with_statics{$sourcefile} }, $components ) if $components->{is_static}; + if ( $self->{macro_match} ) { + if ( grep { $_ eq $self->{macro_match} } @{$components->{macros}} ) { + push( @{ $api{$sourcefile} }, $components ); + } + } + } + } # for @cfiles + $self->{sourcefiles} = \%sourcefiles; + $self->{sourcefiles_with_statics} = \%sourcefiles_with_statics; + $self->{api} = \%api; +} + +=head2 extract_function_declaration_and_update_source( $cfile_name ) + +Extract all the function declarations from the C file specified by +I<$cfile_name>, and update the comment blocks within. + +=cut + +sub extract_function_declarations_and_update_source { + my $self = shift; + my $cfile_name = shift; + + open( my $fhin, '<', $cfile_name ) or die "Can't open $cfile_name: $!"; + my $text = join( '', <$fhin> ); + close $fhin; + + my @func_declarations = $self->extract_function_declarations( $text ); + for my $decl ( @func_declarations ) { + my $specs = $self->function_components_from_declaration( $cfile_name, $decl ); + my $name = $specs->{name}; + + my $heading = $self->generate_documentation_signature($decl); + + $text =~ s/=item C<[^>]*\b$name\b[^>]*>\n+/$heading\n\n/sm or do { + warn "$cfile_name: $name has no POD\n" unless $name =~ /^yy/; # lexer funcs don't have to have POD + } + } + open( my $fhout, '>', $cfile_name ) or die "Can't create $cfile_name: $!"; + print {$fhout} $text; + close $fhout; + + return @func_declarations; +} + +sub process_sources { + my ($self) = @_; + my %sourcefiles = %{$self->{sourcefiles}}; + my %sourcefiles_with_statics = %{$self->{sourcefiles_with_statics}}; + my %api = %{$self->{api}}; + if ( $self->{macro_match} ) { + my $nfuncs = 0; + for my $cfile ( sort keys %api ) { + my @funcs = sort { $a->{name} cmp $b->{name} } @{$api{$cfile}}; + print "$cfile\n"; + for my $func ( @funcs ) { + print " $func->{name}\n"; + ++$nfuncs; + } + } + my $s = $nfuncs == 1 ? '' : 's'; + $self->{message} = "$nfuncs $self->{macro_match} function$s"; + } + else { # Normal headerization and updating + # Update all the .h files + for my $hfile ( sort keys %sourcefiles ) { + my $sourcefiles = $sourcefiles{$hfile}; + + my $header = read_file($hfile); + + for my $cfile ( sort keys %{$sourcefiles} ) { + my @funcs = @{ $sourcefiles->{$cfile} }; + @funcs = grep { not $_->{is_static} } @funcs; # skip statics + + $header = $self->replace_headerized_declarations( $header, $cfile, $hfile, @funcs ); + } + + write_file( $hfile, $header ); + } + + # Update all the .c files in place + for my $cfile ( sort keys %sourcefiles_with_statics ) { + my @funcs = @{ $sourcefiles_with_statics{$cfile} }; + @funcs = grep { $_->{is_static} } @funcs; + + my $source = read_file($cfile); + $source = $self->replace_headerized_declarations( $source, 'static', $cfile, @funcs ); + + write_file( $cfile, $source ); + } + $self->{message} = "Headerization complete."; + } +} + +sub print_final_message { + my $self = shift; + if ($self->{message} ne '') { + print "$self->{message}\n"; + } +} + +sub make_function_decls { + my $self = shift; + my @funcs = @_; + + my @decls; + foreach my $func (@funcs) { + my $multiline = 0; + + my $return = $func->{return_type}; + my $alt_void = ' '; + + # Splint can't handle /*@alt void@*/ on pointers, although this page + # http://www.mail-archive.com/lclint-interest@virginia.edu/msg00139.html + # seems to say that we can. + if ( $func->{is_ignorable} && ($return !~ /\*/) ) { + $alt_void = " /*\@alt void@*/\n"; + } + + my $decl = sprintf( "%s%s%s(", $return, $alt_void, $func->{name} ); + $decl = "static $decl" if $func->{is_static}; + + my @args = @{ $func->{args} }; + my @attrs = $self->attrs_from_args( $func, @args ); + + for my $arg (@args) { + if ( $arg =~ m{SHIM\((.+)\)} ) { + $arg = $1; + if ( $func->{is_static} || ( $arg =~ /\*/ ) ) { + $arg = "SHIM($arg)"; + } + else { + $arg = "NULLOK($arg)"; + } + } + } + + my $argline = join( ", ", @args ); + if ( length( $decl . $argline ) <= 75 ) { + $decl = "$decl$argline)"; + } + else { + if ( $args[0] =~ /^((SHIM|PARROT)_INTERP|Interp)\b/ ) { + $decl .= ( shift @args ); + $decl .= "," if @args; + } + $argline = join( ",", map { "\n\t$_" } @args ); + $decl = "$decl$argline)"; + $multiline = 1; + } + + my $attrs = join( "", map { "\n\t\t$_" } @attrs ); + if ($attrs) { + $decl .= $attrs; + $multiline = 1; + } + my @macros = @{ $func->{macros} }; + $multiline = 1 if @macros; + + $decl .= $multiline ? ";\n" : ";"; + $decl = join( "\n", @macros, $decl ); + $decl =~ s/\t/ /g; + push( @decls, $decl ); + } + + foreach my $func (@funcs) { + my @args = @{ $func->{args} }; + my @asserts = asserts_from_args( @args ); + + my $assert = "#define ASSERT_ARGS_" . $func->{name}; + if(length($func->{name}) > 29) { + $assert .= " \\\n "; + } + $assert .= " __attribute__unused__ int _ASSERT_ARGS_CHECK = ("; + if(@asserts) { + $assert .= "\\\n "; + $assert .= join(" \\\n , ", @asserts); + } + else { + $assert .= "0"; + } + $assert .= ")"; + push(@decls, $assert); + } + + return @decls; +} + +sub attrs_from_args { + my $self = shift; + my $func = shift; + my @args = @_; + + my @attrs = (); + my @mods = (); + + my $name = $func->{name}; + my $file = $func->{file}; + my $n = 0; + for my $arg (@args) { + ++$n; + if ( $arg =~ m{ARG(?:MOD|OUT)(?:_NULLOK)?\((.+?)\)} ) { + my $modified = $1; + if ( $modified =~ s/.*\*/*/ ) { + # We're OK + } + else { + $modified =~ s/.* (\w+)$/$1/ or die qq{Unable to figure out the modified parm out of "$modified"}; + } + push( @mods, "FUNC_MODIFIES($modified)" ); + } + if ( $arg =~ m{(ARGIN|ARGOUT|ARGMOD|ARGFREE_NOTNULL|NOTNULL)\(} || $arg eq 'PARROT_INTERP' ) { + push( @attrs, "__attribute__nonnull__($n)" ); + } + if ( ( $arg =~ m{\*} ) && ( $arg !~ /\b(SHIM|((ARGIN|ARGOUT|ARGMOD)(_NULLOK)?)|ARGFREE(_NOTNULL)?)\b/ ) ) { + if ( $name !~ /^yy/ ) { # Don't complain about the lexer auto-generated funcs + $self->squawk( $file, $name, qq{"$arg" isn't protected with an ARGIN, ARGOUT or ARGMOD (or a _NULLOK variant), or ARGFREE} ); + } + } + if ( ($arg =~ /\bconst\b/) && ($arg =~ /\*/) && ($arg !~ /\*\*/) && ($arg =~ /\b(ARG(MOD|OUT))\b/) ) { + $self->squawk( $file, $name, qq{"$arg" is const, but that $1 conflicts with const} ); + } + } + + return (@attrs,@mods); +} + +sub replace_headerized_declarations { + my $self = shift; + my $source_code = shift; + my $sourcefile = shift; + my $hfile = shift; + my @funcs = @_; + + # Allow a way to not headerize statics + if ( $source_code =~ m{/\*\s*HEADERIZER NONE:\s*$sourcefile\s*\*/} ) { + return $source_code; + } + + @funcs = sort api_first_then_alpha @funcs; + + my @function_decls = $self->make_function_decls(@funcs); + + my $function_decls = join( "\n", @function_decls ); + my $STARTMARKER = qr{/\* HEADERIZER BEGIN: $sourcefile \*/\n}; + my $ENDMARKER = qr{/\* HEADERIZER END: $sourcefile \*/\n?}; + my $DO_NOT_TOUCH = q{/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */}; + + $source_code =~ + s{($STARTMARKER)(?:.*?)($ENDMARKER)} + {$1$DO_NOT_TOUCH\n\n$function_decls\n$DO_NOT_TOUCH\n$2}s + or die "Need begin/end HEADERIZER markers for $sourcefile in $hfile\n"; + + return $source_code; +} + +=head2 C + +=over 4 + +=item * Purpose + +=item * Arguments + +=item * Return Value + +=item * Comment + +=back + +=cut + +sub print_warnings { + my $self = shift; + my %warnings = %{$self->{warnings}}; + if ( keys %warnings ) { + my $nwarnings = 0; + my $nwarningfuncs = 0; + my $nwarningfiles = 0; + for my $file ( sort keys %warnings ) { + ++$nwarningfiles; + print "$file\n"; + my $funcs = $warnings{$file}; + for my $func ( sort keys %{$funcs} ) { + ++$nwarningfuncs; + for my $error ( @{ $funcs->{$func} } ) { + print " $func: $error\n"; + ++$nwarnings; + } + } + } + + print "$nwarnings warnings in $nwarningfuncs funcs in $nwarningfiles C files\n"; + } +} + +=back + +=cut + +1; + +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4: diff --git a/t/codingstd/c_function_docs.t b/t/codingstd/c_function_docs.t index 38ea23776d..31695ff086 100644 --- a/t/codingstd/c_function_docs.t +++ b/t/codingstd/c_function_docs.t @@ -9,7 +9,7 @@ use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Config qw(%PConfig); use Parrot::Distribution; -use Parrot::Headerizer; +use Parrot::Headerizer::Object; =head1 NAME @@ -31,7 +31,7 @@ declared. =cut my $DIST = Parrot::Distribution->new; -my $headerizer = Parrot::Headerizer->new; +my $headerizer = Parrot::Headerizer::Object->new; # can not handle .ops or .pmc files yet my @files = grep {/\.(c|h)$/ } @ARGV ? @ARGV : diff --git a/t/codingstd/pmc_docs.t b/t/codingstd/pmc_docs.t index 08b314bcdd..a9615d0f83 100644 --- a/t/codingstd/pmc_docs.t +++ b/t/codingstd/pmc_docs.t @@ -9,7 +9,7 @@ use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Config qw(%PConfig); use Parrot::Distribution; -use Parrot::Headerizer; +use Parrot::Headerizer::Object; =head1 NAME @@ -31,7 +31,7 @@ declared. =cut my $DIST = Parrot::Distribution->new; -my $headerizer = Parrot::Headerizer->new; +my $headerizer = Parrot::Headerizer::Object->new; my @files = @ARGV ? @ARGV : map {s/^$PConfig{build_dir}\///; $_} diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index 8aa80094b0..28a7bcefbc 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -13,6 +13,7 @@ use File::Temp qw( tempdir ); use lib qw( lib ); use Parrot::Config; use Parrot::Headerizer::Functions qw( + process_argv print_headerizer_warnings read_file write_file @@ -21,6 +22,32 @@ use Parrot::Headerizer::Functions qw( use IO::CaptureOutput qw| capture |; my $cwd = cwd(); + +my @ofiles; +eval { + @ofiles = process_argv(); +}; +like($@, qr/No files specified/, + "Got expected error message for no files specified"); + +@ofiles = qw( alpha.o beta.o gamma.o alpha.o ); +{ + my ($stdout, $stderr); + capture( + sub { @ofiles = process_argv(@ofiles); }, + \$stdout, + \$stderr, + ); + is(@ofiles, 3, "Got expected number of ofiles"); + like( $stdout, + qr/alpha\.o is specified more than once/s, + "Got expected message for an argument supplied more than once" + ); +} + +@ofiles = qw( alpha.o beta.o gamma.o ); +is(@ofiles, 3, "Got expected number of ofiles"); + { my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir; diff --git a/t/tools/dev/headerizer/02_methods.t b/t/tools/dev/headerizer/02_methods.t index b491c94578..7662435119 100644 --- a/t/tools/dev/headerizer/02_methods.t +++ b/t/tools/dev/headerizer/02_methods.t @@ -9,11 +9,11 @@ use Test::More qw(no_plan); # tests => 15; #use Cwd; #use File::Temp qw( tempdir ); use lib qw( lib ); -use Parrot::Headerizer; +use Parrot::Headerizer::Object; #use IO::CaptureOutput qw| capture |; -my $self = Parrot::Headerizer->new(); -isa_ok( $self, 'Parrot::Headerizer' ); +my $self = Parrot::Headerizer::Object->new(); +isa_ok( $self, 'Parrot::Headerizer::Object' ); ok( $self->valid_macro( 'PARROT_EXPORT' ), "valid_macro() confirmed validity of macro" ); ok(! $self->valid_macro( 'PARROT_FOOBAR' ), @@ -36,7 +36,7 @@ pass("Completed all tests in $0"); =head1 NAME -02_methods.t - Test functions in Parrot::Headerizer. +02_methods.t - Test functions in Parrot::Headerizer::Object. =head1 SYNOPSIS diff --git a/tools/dev/headerizer.pl b/tools/dev/headerizer.pl index 10324398ef..9bcfa04561 100644 --- a/tools/dev/headerizer.pl +++ b/tools/dev/headerizer.pl @@ -6,14 +6,11 @@ use Getopt::Long; use lib qw( lib ); -use Parrot::Config; -use Parrot::Headerizer; +use Parrot::Headerizer::Object; use Parrot::Headerizer::Functions qw( - print_headerizer_warnings - read_file - write_file - qualify_sourcefile + process_argv ); +# print_headerizer_warnings =head1 NAME @@ -77,327 +74,16 @@ =head1 COMMAND-LINE OPTIONS 'macro=s' => \$macro_match, ) or exit(1); -die 'No files specified.' unless @ARGV; -my %ofiles; -++$ofiles{$_} for @ARGV; -my @ofiles = sort keys %ofiles; -for (@ofiles) { - print "$_ is specified more than once.\n" if $ofiles{$_} > 1; -} -my %sourcefiles; -my %sourcefiles_with_statics; -my %api; -my $headerizer = Parrot::Headerizer->new; +my @ofiles = process_argv(@ARGV); +my $headerizer = Parrot::Headerizer::Object->new( { + macro_match => $macro_match, +} ); +$headerizer->get_sources(@ofiles); +$headerizer->process_sources(); +$headerizer->print_final_message(); +$headerizer->print_warnings(); -# Walk the object files and find corresponding source (either .c or .pmc) -for my $ofile (@ofiles) { - - # Skip files in the src/ops/ subdirectory. - next if $ofile =~ m/^\Qsrc$PConfig{slash}ops\E/ || # if run by hand... - $ofile =~ m{^src/ops}; # ... or by makefile - - $ofile =~ s/\\/\//g; - - my $is_yacc = ($ofile =~ /\.y$/); - if ( !$is_yacc ) { - my $sfile = $ofile; - $sfile =~ s/\Q$PConfig{o}\E$/.s/; - next if -f $sfile; - } - - my ($sourcefile, $source_code, $hfile) = - qualify_sourcefile( { - ofile => $ofile, - PConfig => \%PConfig, - is_yacc => $is_yacc, - } ); - - my @decls; - if ( $macro_match ) { - @decls = $headerizer->extract_function_declarations( $source_code ); - } - else { - @decls = extract_function_declarations_and_update_source( $sourcefile ); - } - - for my $decl (@decls) { - my $components = $headerizer->function_components_from_declaration( $sourcefile, $decl ); - push( @{ $sourcefiles{$hfile}->{$sourcefile} }, $components ) unless $hfile eq 'none'; - push( @{ $sourcefiles_with_statics{$sourcefile} }, $components ) if $components->{is_static}; - if ( $macro_match ) { - if ( grep { $_ eq $macro_match } @{$components->{macros}} ) { - push( @{ $api{$sourcefile} }, $components ); - } - } - } -} # for @cfiles - -if ( $macro_match ) { - my $nfuncs = 0; - for my $cfile ( sort keys %api ) { - my @funcs = sort { $a->{name} cmp $b->{name} } @{$api{$cfile}}; - print "$cfile\n"; - for my $func ( @funcs ) { - print " $func->{name}\n"; - ++$nfuncs; - } - } - my $s = $nfuncs == 1 ? '' : 's'; - print "$nfuncs $macro_match function$s\n"; -} -else { # Normal headerization and updating - # Update all the .h files - for my $hfile ( sort keys %sourcefiles ) { - my $sourcefiles = $sourcefiles{$hfile}; - - my $header = read_file($hfile); - - for my $cfile ( sort keys %{$sourcefiles} ) { - my @funcs = @{ $sourcefiles->{$cfile} }; - @funcs = grep { not $_->{is_static} } @funcs; # skip statics - - $header = replace_headerized_declarations( $header, $cfile, $hfile, @funcs ); - } - - write_file( $hfile, $header ); - } - - # Update all the .c files in place - for my $cfile ( sort keys %sourcefiles_with_statics ) { - my @funcs = @{ $sourcefiles_with_statics{$cfile} }; - @funcs = grep { $_->{is_static} } @funcs; - - my $source = read_file($cfile); - $source = replace_headerized_declarations( $source, 'static', $cfile, @funcs ); - - write_file( $cfile, $source ); - } - print "Headerization complete.\n"; -} - -print_headerizer_warnings($headerizer->{warnings}); - - -=head1 FUNCTIONS - -=head2 extract_function_declaration_and_update_source( $cfile_name ) - -Extract all the function declarations from the C file specified by -I<$cfile_name>, and update the comment blocks within. - -=cut - -sub extract_function_declarations_and_update_source { - my $cfile_name = shift; - - open( my $fhin, '<', $cfile_name ) or die "Can't open $cfile_name: $!"; - my $text = join( '', <$fhin> ); - close $fhin; - - my @func_declarations = $headerizer->extract_function_declarations( $text ); - for my $decl ( @func_declarations ) { - my $specs = $headerizer->function_components_from_declaration( $cfile_name, $decl ); - my $name = $specs->{name}; - - my $heading = $headerizer->generate_documentation_signature($decl); - - $text =~ s/=item C<[^>]*\b$name\b[^>]*>\n+/$heading\n\n/sm or do { - warn "$cfile_name: $name has no POD\n" unless $name =~ /^yy/; # lexer funcs don't have to have POD - } - } - open( my $fhout, '>', $cfile_name ) or die "Can't create $cfile_name: $!"; - print {$fhout} $text; - close $fhout; - - return @func_declarations; -} - - -sub attrs_from_args { - my $func = shift; - my @args = @_; - - my @attrs = (); - my @mods = (); - - my $name = $func->{name}; - my $file = $func->{file}; - my $n = 0; - for my $arg (@args) { - ++$n; - if ( $arg =~ m{ARG(?:MOD|OUT)(?:_NULLOK)?\((.+?)\)} ) { - my $modified = $1; - if ( $modified =~ s/.*\*/*/ ) { - # We're OK - } - else { - $modified =~ s/.* (\w+)$/$1/ or die qq{Unable to figure out the modified parm out of "$modified"}; - } - push( @mods, "FUNC_MODIFIES($modified)" ); - } - if ( $arg =~ m{(ARGIN|ARGOUT|ARGMOD|ARGFREE_NOTNULL|NOTNULL)\(} || $arg eq 'PARROT_INTERP' ) { - push( @attrs, "__attribute__nonnull__($n)" ); - } - if ( ( $arg =~ m{\*} ) && ( $arg !~ /\b(SHIM|((ARGIN|ARGOUT|ARGMOD)(_NULLOK)?)|ARGFREE(_NOTNULL)?)\b/ ) ) { - if ( $name !~ /^yy/ ) { # Don't complain about the lexer auto-generated funcs - $headerizer->squawk( $file, $name, qq{"$arg" isn't protected with an ARGIN, ARGOUT or ARGMOD (or a _NULLOK variant), or ARGFREE} ); - } - } - if ( ($arg =~ /\bconst\b/) && ($arg =~ /\*/) && ($arg !~ /\*\*/) && ($arg =~ /\b(ARG(MOD|OUT))\b/) ) { - $headerizer->squawk( $file, $name, qq{"$arg" is const, but that $1 conflicts with const} ); - } - } - - return (@attrs,@mods); -} - -sub asserts_from_args { - my @args = @_; - my @asserts; - - for my $arg (@args) { - if ( $arg =~ m{(ARGIN|ARGOUT|ARGMOD|ARGFREE_NOTNULL|NOTNULL)\((.+)\)} ) { - my $var = $2; - if($var =~ /\(*\s*([a-zA-Z_][a-zA-Z0-9_]*)\s*\)\s*\(/) { - # argument is a function pointer - $var = $1; - } - else { - # try to isolate the variable's name; - # strip off everything before the final space or asterisk. - $var =~ s{.+[* ]([^* ]+)$}{$1}; - # strip off a trailing "[]", if any. - $var =~ s{\[\]$}{}; - } - push( @asserts, "PARROT_ASSERT_ARG($var)" ); - } - if( $arg eq 'PARROT_INTERP' ) { - push( @asserts, "PARROT_ASSERT_ARG(interp)" ); - } - } - - return (@asserts); -} - -sub make_function_decls { - my @funcs = @_; - - my @decls; - foreach my $func (@funcs) { - my $multiline = 0; - - my $return = $func->{return_type}; - my $alt_void = ' '; - - # Splint can't handle /*@alt void@*/ on pointers, although this page - # http://www.mail-archive.com/lclint-interest@virginia.edu/msg00139.html - # seems to say that we can. - if ( $func->{is_ignorable} && ($return !~ /\*/) ) { - $alt_void = " /*\@alt void@*/\n"; - } - - my $decl = sprintf( "%s%s%s(", $return, $alt_void, $func->{name} ); - $decl = "static $decl" if $func->{is_static}; - - my @args = @{ $func->{args} }; - my @attrs = attrs_from_args( $func, @args ); - - for my $arg (@args) { - if ( $arg =~ m{SHIM\((.+)\)} ) { - $arg = $1; - if ( $func->{is_static} || ( $arg =~ /\*/ ) ) { - $arg = "SHIM($arg)"; - } - else { - $arg = "NULLOK($arg)"; - } - } - } - - my $argline = join( ", ", @args ); - if ( length( $decl . $argline ) <= 75 ) { - $decl = "$decl$argline)"; - } - else { - if ( $args[0] =~ /^((SHIM|PARROT)_INTERP|Interp)\b/ ) { - $decl .= ( shift @args ); - $decl .= "," if @args; - } - $argline = join( ",", map { "\n\t$_" } @args ); - $decl = "$decl$argline)"; - $multiline = 1; - } - - my $attrs = join( "", map { "\n\t\t$_" } @attrs ); - if ($attrs) { - $decl .= $attrs; - $multiline = 1; - } - my @macros = @{ $func->{macros} }; - $multiline = 1 if @macros; - - $decl .= $multiline ? ";\n" : ";"; - $decl = join( "\n", @macros, $decl ); - $decl =~ s/\t/ /g; - push( @decls, $decl ); - } - - foreach my $func (@funcs) { - my @args = @{ $func->{args} }; - my @asserts = asserts_from_args( @args ); - - my $assert = "#define ASSERT_ARGS_" . $func->{name}; - if(length($func->{name}) > 29) { - $assert .= " \\\n "; - } - $assert .= " __attribute__unused__ int _ASSERT_ARGS_CHECK = ("; - if(@asserts) { - $assert .= "\\\n "; - $assert .= join(" \\\n , ", @asserts); - } - else { - $assert .= "0"; - } - $assert .= ")"; - push(@decls, $assert); - } - - return @decls; -} - -sub replace_headerized_declarations { - my $source_code = shift; - my $sourcefile = shift; - my $hfile = shift; - my @funcs = @_; - - # Allow a way to not headerize statics - if ( $source_code =~ m{/\*\s*HEADERIZER NONE:\s*$sourcefile\s*\*/} ) { - return $source_code; - } - - @funcs = sort api_first_then_alpha @funcs; - - my @function_decls = make_function_decls(@funcs); - - my $function_decls = join( "\n", @function_decls ); - my $STARTMARKER = qr{/\* HEADERIZER BEGIN: $sourcefile \*/\n}; - my $ENDMARKER = qr{/\* HEADERIZER END: $sourcefile \*/\n?}; - my $DO_NOT_TOUCH = q{/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */}; - - $source_code =~ - s{($STARTMARKER)(?:.*?)($ENDMARKER)} - {$1$DO_NOT_TOUCH\n\n$function_decls\n$DO_NOT_TOUCH\n$2}s - or die "Need begin/end HEADERIZER markers for $sourcefile in $hfile\n"; - - return $source_code; -} - -sub api_first_then_alpha { - return ( ( $b->{is_api} || 0 ) <=> ( $a->{is_api} || 0 ) ) - || ( lc $a->{name} cmp lc $b->{name} ); -} # From earlier documentation: # * Generate docs from funcs From 778bdb9be29afd71f9e03cf0c99bf82f09fb1567 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Thu, 25 Nov 2010 15:19:16 -0500 Subject: [PATCH 016/102] Add tests for Parrot::Headerizer::Functions::assert_args(). Allow for possibility of uninitialized values in api_first_then_alpha(). Rearrange some code for more logical order. --- lib/Parrot/Headerizer/Functions.pm | 2 +- lib/Parrot/Headerizer/Object.pm | 61 ++++++++++--------- t/tools/dev/headerizer/01_functions.t | 87 ++++++++------------------- t/tools/dev/headerizer/02_methods.t | 63 ++++++++++++++++--- 4 files changed, 112 insertions(+), 101 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index d994c45a58..4db44c3c67 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -250,7 +250,7 @@ sub asserts_from_args { sub api_first_then_alpha { return ( ( $b->{is_api} || 0 ) <=> ( $a->{is_api} || 0 ) ) - || ( lc $a->{name} cmp lc $b->{name} ); + || ( lc ($a->{name} || '') cmp lc ($b->{name} || '') ); } 1; diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 13679e01fd..7f18a2d4aa 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -26,6 +26,7 @@ of C-language files. use strict; use warnings; +use Data::Dumper;$Data::Dumper::Indent=1; use Scalar::Util qw( reftype ); use lib qw( lib ); use Parrot::Config; @@ -513,6 +514,36 @@ sub print_final_message { } } +sub replace_headerized_declarations { + my $self = shift; + my $source_code = shift; + my $sourcefile = shift; + my $hfile = shift; + my @funcs = @_; + + # Allow a way to not headerize statics + if ( $source_code =~ m{/\*\s*HEADERIZER NONE:\s*$sourcefile\s*\*/} ) { + return $source_code; + } + + @funcs = sort api_first_then_alpha @funcs; +print STDERR "Inside replace_headerized_declarations\n"; +print STDERR Dumper \@funcs; + my @function_decls = $self->make_function_decls(@funcs); + + my $function_decls = join( "\n", @function_decls ); + my $STARTMARKER = qr{/\* HEADERIZER BEGIN: $sourcefile \*/\n}; + my $ENDMARKER = qr{/\* HEADERIZER END: $sourcefile \*/\n?}; + my $DO_NOT_TOUCH = q{/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */}; + + $source_code =~ + s{($STARTMARKER)(?:.*?)($ENDMARKER)} + {$1$DO_NOT_TOUCH\n\n$function_decls\n$DO_NOT_TOUCH\n$2}s + or die "Need begin/end HEADERIZER markers for $sourcefile in $hfile\n"; + + return $source_code; +} + sub make_function_decls { my $self = shift; my @funcs = @_; @@ -580,6 +611,7 @@ sub make_function_decls { foreach my $func (@funcs) { my @args = @{ $func->{args} }; my @asserts = asserts_from_args( @args ); +print STDERR Dumper [ \@args, \@asserts ]; my $assert = "#define ASSERT_ARGS_" . $func->{name}; if(length($func->{name}) > 29) { @@ -639,35 +671,6 @@ sub attrs_from_args { return (@attrs,@mods); } -sub replace_headerized_declarations { - my $self = shift; - my $source_code = shift; - my $sourcefile = shift; - my $hfile = shift; - my @funcs = @_; - - # Allow a way to not headerize statics - if ( $source_code =~ m{/\*\s*HEADERIZER NONE:\s*$sourcefile\s*\*/} ) { - return $source_code; - } - - @funcs = sort api_first_then_alpha @funcs; - - my @function_decls = $self->make_function_decls(@funcs); - - my $function_decls = join( "\n", @function_decls ); - my $STARTMARKER = qr{/\* HEADERIZER BEGIN: $sourcefile \*/\n}; - my $ENDMARKER = qr{/\* HEADERIZER END: $sourcefile \*/\n?}; - my $DO_NOT_TOUCH = q{/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */}; - - $source_code =~ - s{($STARTMARKER)(?:.*?)($ENDMARKER)} - {$1$DO_NOT_TOUCH\n\n$function_decls\n$DO_NOT_TOUCH\n$2}s - or die "Need begin/end HEADERIZER markers for $sourcefile in $hfile\n"; - - return $source_code; -} - =head2 C =over 4 diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index 28a7bcefbc..ab32604820 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -5,6 +5,7 @@ use strict; use warnings; +#use Data::Dumper; use Test::More qw(no_plan); # tests => 15; use Carp; use Cwd; @@ -14,10 +15,11 @@ use lib qw( lib ); use Parrot::Config; use Parrot::Headerizer::Functions qw( process_argv - print_headerizer_warnings read_file write_file qualify_sourcefile + asserts_from_args + api_first_then_alpha ); use IO::CaptureOutput qw| capture |; @@ -70,59 +72,6 @@ is(@ofiles, 3, "Got expected number of ofiles"); chdir $cwd or die "Unable to chdir: $!"; } -my $warnings = { - 'file1' => { - 'func_alpha' => [ - 'alpha warning 1', - 'alpha warning 2', - 'alpha warning 3', - ], - 'func_beta' => [ - 'beta warning 1', - 'beta warning 2', - ], - }, - 'file2' => { - 'func_gamma' => [ - 'gamma warning 1', - 'gamma warning 2', - 'gamma warning 3', - ], - }, -}; - -{ - my ($stdout, $stderr); - capture( - sub { print_headerizer_warnings($warnings); }, - \$stdout, - \$stderr, - ); - for my $func( qw| alpha gamma | ) { - for (1..3) { - like( $stdout, qr/func_alpha: alpha warning $_/s, - "Got expected output" ); - } - } - for (1..2) { - like( $stdout, qr/func_beta: beta warning $_/s, - "Got expected output" ); - } - like( $stdout, qr/8 warnings in 3 funcs in 2 C files/, - "Got expected summary of headerizer warnings" ); -} - -$warnings = {}; -{ - my ($stdout, $stderr); - capture( - sub { print_headerizer_warnings($warnings); }, - \$stdout, - \$stderr, - ); - ok(! $stdout, "No warnings, hence no warnings printed" ); -} - my $filename = 'foobar'; eval { read_file($filename); @@ -272,14 +221,30 @@ like($@, qr/$ofile doesn't look like an object file/, is( $hfile, 'none', "As expected, no header file" ); } -pass("Completed all tests in $0"); +my (@args, %asserts); +@args = ( + 'SHIM_INTERP', + 'ARGIN(Linked_List *list)', + 'ARGIN(List_Item_Header *item)', +); +%asserts = map { $_ => 1 } asserts_from_args( @args ); +is( keys %asserts, 2, "Got expected number of asserts" ); +ok( exists $asserts{'PARROT_ASSERT_ARG(list)'}, "Got expected assert" ); +ok( exists $asserts{'PARROT_ASSERT_ARG(item)'}, "Got expected assert" ); + +@args = ( + 'PARROT_INTERP', + 'ARGIN(Linked_List *list)', + 'ARGIN(List_Item_Header *item)', + 'SHIM_INTERP', +); +%asserts = map { $_ => 1 } asserts_from_args( @args ); +is( keys %asserts, 3, "Got expected number of asserts" ); +ok( exists $asserts{'PARROT_ASSERT_ARG(list)'}, "Got expected assert" ); +ok( exists $asserts{'PARROT_ASSERT_ARG(item)'}, "Got expected assert" ); +ok( exists $asserts{'PARROT_ASSERT_ARG(interp)'}, "Got expected assert" ); -#sub touch_parrot { -# open my $FH, '>', q{parrot} -# or die "Unable to open handle for writing: $!"; -# print $FH "\n"; -# close $FH or die "Unable to close handle after writing: $!"; -#} +pass("Completed all tests in $0"); ################### DOCUMENTATION ################### diff --git a/t/tools/dev/headerizer/02_methods.t b/t/tools/dev/headerizer/02_methods.t index 7662435119..017f4c87ba 100644 --- a/t/tools/dev/headerizer/02_methods.t +++ b/t/tools/dev/headerizer/02_methods.t @@ -6,11 +6,9 @@ use strict; use warnings; use Test::More qw(no_plan); # tests => 15; -#use Cwd; -#use File::Temp qw( tempdir ); use lib qw( lib ); use Parrot::Headerizer::Object; -#use IO::CaptureOutput qw| capture |; +use IO::CaptureOutput qw| capture |; my $self = Parrot::Headerizer::Object->new(); isa_ok( $self, 'Parrot::Headerizer::Object' ); @@ -22,16 +20,61 @@ my @valid_macros = $self->valid_macros; ok( @valid_macros, "Headerizer object contains list of valid macros" ); +my $warnings = { + 'file1' => { + 'func_alpha' => [ + 'alpha warning 1', + 'alpha warning 2', + 'alpha warning 3', + ], + 'func_beta' => [ + 'beta warning 1', + 'beta warning 2', + ], + }, + 'file2' => { + 'func_gamma' => [ + 'gamma warning 1', + 'gamma warning 2', + 'gamma warning 3', + ], + }, +}; +$self->{warnings} = $warnings; +{ + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + for my $func( qw| alpha gamma | ) { + for (1..3) { + like( $stdout, qr/func_alpha: alpha warning $_/s, + "Got expected output" ); + } + } + for (1..2) { + like( $stdout, qr/func_beta: beta warning $_/s, + "Got expected output" ); + } + like( $stdout, qr/8 warnings in 3 funcs in 2 C files/, + "Got expected summary of headerizer warnings" ); +} + +$self->{warnings} = {}; +{ + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + ok(! $stdout, "No warnings, hence no warnings printed" ); +} pass("Completed all tests in $0"); -#sub touch_parrot { -# open my $FH, '>', q{parrot} -# or die "Unable to open handle for writing: $!"; -# print $FH "\n"; -# close $FH or die "Unable to close handle after writing: $!"; -#} - ################### DOCUMENTATION ################### =head1 NAME From c9bf5a09e7df22bf7adeffaf7d5820a7d6af987f Mon Sep 17 00:00:00 2001 From: jkeenan Date: Fri, 26 Nov 2010 12:06:30 -0500 Subject: [PATCH 017/102] Place methods in more logical order within module. api_first_then_alpha() was not testing correctly; place it directly in code rather than in imported subroutine. Add tests. --- lib/Parrot/Headerizer/Functions.pm | 8 +- lib/Parrot/Headerizer/Object.pm | 253 +++++++++++++------------- t/tools/dev/headerizer/01_functions.t | 19 +- t/tools/dev/headerizer/02_methods.t | 53 +++++- tools/dev/headerizer.pl | 1 - 5 files changed, 194 insertions(+), 140 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index 4db44c3c67..615d1684cf 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -11,7 +11,6 @@ our @EXPORT_OK = qw( write_file qualify_sourcefile asserts_from_args - api_first_then_alpha ); =head1 NAME @@ -26,7 +25,6 @@ Parrot::Headerizer::Functions - Functions used in headerizer programs write_file qualify_sourcefile asserts_from_args - api_first_then_alpha ); =head1 DESCRIPTION @@ -228,6 +226,7 @@ sub asserts_from_args { my $var = $2; if($var =~ /\(*\s*([a-zA-Z_][a-zA-Z0-9_]*)\s*\)\s*\(/) { # argument is a function pointer + # Is this branch ever reached? $var = $1; } else { @@ -247,11 +246,6 @@ sub asserts_from_args { return (@asserts); } - -sub api_first_then_alpha { - return ( ( $b->{is_api} || 0 ) <=> ( $a->{is_api} || 0 ) ) - || ( lc ($a->{name} || '') cmp lc ($b->{name} || '') ); -} 1; # Local Variables: diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 7f18a2d4aa..78fa197066 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -26,7 +26,6 @@ of C-language files. use strict; use warnings; -use Data::Dumper;$Data::Dumper::Indent=1; use Scalar::Util qw( reftype ); use lib qw( lib ); use Parrot::Config; @@ -35,7 +34,6 @@ use Parrot::Headerizer::Functions qw( write_file qualify_sourcefile asserts_from_args - api_first_then_alpha ); =item C @@ -83,35 +81,57 @@ sub new { return bless $args, $class; } -=item C - - $headerizer->valid_macro( $macro ) - -Returns a boolean saying whether I<$macro> is a valid C macro. - -=cut - -sub valid_macro { - my $self = shift; - my $macro = shift; - - return exists $self->{valid_macros}{$macro}; -} - -=item C - - $headerizer->valid_macros() - -Returns a list of all the valid C macros. - -=cut - -sub valid_macros { +sub get_sources { my $self = shift; - - my @macros = sort keys %{$self->{valid_macros}}; - - return @macros; + my @ofiles = @_; + my %sourcefiles; + my %sourcefiles_with_statics; + my %api; + # Walk the object files and find corresponding source (either .c or .pmc) + for my $ofile (@ofiles) { + + # Skip files in the src/ops/ subdirectory. + next if $ofile =~ m/^\Qsrc$PConfig{slash}ops\E/ || # if run by hand... + $ofile =~ m{^src/ops}; # ... or by makefile + + $ofile =~ s/\\/\//g; + + my $is_yacc = ($ofile =~ /\.y$/); + if ( !$is_yacc ) { + my $sfile = $ofile; + $sfile =~ s/\Q$PConfig{o}\E$/.s/; + next if -f $sfile; + } + + my ($sourcefile, $source_code, $hfile) = + qualify_sourcefile( { + ofile => $ofile, + PConfig => \%PConfig, + is_yacc => $is_yacc, + } ); + + my @decls; + if ( $self->{macro_match} ) { + @decls = $self->extract_function_declarations( $source_code ); + } + else { + @decls = $self->extract_function_declarations_and_update_source( $sourcefile ); + } + + for my $decl (@decls) { + my $components = $self->function_components_from_declaration( $sourcefile, $decl ); + push( @{ $sourcefiles{$hfile}->{$sourcefile} }, $components ) unless $hfile eq 'none'; + push( @{ $sourcefiles_with_statics{$sourcefile} }, $components ) if $components->{is_static}; + if ( $self->{macro_match} ) { + if ( grep { $_ eq $self->{macro_match} } @{$components->{macros}} ) { + push( @{ $api{$sourcefile} }, $components ); + } + } + } + } # for @cfiles + $self->{sourcefiles} = \%sourcefiles; + $self->{sourcefiles_with_statics} = \%sourcefiles_with_statics; + $self->{api} = \%api; } =item C @@ -186,6 +206,39 @@ sub extract_function_declarations { return @funcs; } +=head2 extract_function_declaration_and_update_source( $cfile_name ) + +Extract all the function declarations from the C file specified by +I<$cfile_name>, and update the comment blocks within. + +=cut + +sub extract_function_declarations_and_update_source { + my $self = shift; + my $cfile_name = shift; + + open( my $fhin, '<', $cfile_name ) or die "Can't open $cfile_name: $!"; + my $text = join( '', <$fhin> ); + close $fhin; + + my @func_declarations = $self->extract_function_declarations( $text ); + for my $decl ( @func_declarations ) { + my $specs = $self->function_components_from_declaration( $cfile_name, $decl ); + my $name = $specs->{name}; + + my $heading = $self->generate_documentation_signature($decl); + + $text =~ s/=item C<[^>]*\b$name\b[^>]*>\n+/$heading\n\n/sm or do { + warn "$cfile_name: $name has no POD\n" unless $name =~ /^yy/; # lexer funcs don't have to have POD + } + } + open( my $fhout, '>', $cfile_name ) or die "Can't create $cfile_name: $!"; + print {$fhout} $text; + close $fhout; + + return @func_declarations; +} + =item C $file => the filename @@ -351,111 +404,56 @@ sub generate_documentation_signature { return $split_decl; } -=item C +=item C -Headerizer-specific ways of complaining if something went wrong. + $headerizer->valid_macro( $macro ) -$file => filename -$func => function name -$error => error message text +Returns a boolean saying whether I<$macro> is a valid C macro. =cut -sub squawk { - my $self = shift; - my $file = shift; - my $func = shift; - my $error = shift; - - push( @{ $self->{warnings}{$file}{$func} }, $error ); +sub valid_macro { + my $self = shift; + my $macro = shift; - return; + return exists $self->{valid_macros}{$macro}; } -sub get_sources { - my $self = shift; - my @ofiles = @_; - my %sourcefiles; - my %sourcefiles_with_statics; - my %api; - # Walk the object files and find corresponding source (either .c or .pmc) - for my $ofile (@ofiles) { - - # Skip files in the src/ops/ subdirectory. - next if $ofile =~ m/^\Qsrc$PConfig{slash}ops\E/ || # if run by hand... - $ofile =~ m{^src/ops}; # ... or by makefile - - $ofile =~ s/\\/\//g; - - my $is_yacc = ($ofile =~ /\.y$/); - if ( !$is_yacc ) { - my $sfile = $ofile; - $sfile =~ s/\Q$PConfig{o}\E$/.s/; - next if -f $sfile; - } - - my ($sourcefile, $source_code, $hfile) = - qualify_sourcefile( { - ofile => $ofile, - PConfig => \%PConfig, - is_yacc => $is_yacc, - } ); - - my @decls; - if ( $self->{macro_match} ) { - @decls = $self->extract_function_declarations( $source_code ); - } - else { - @decls = $self->extract_function_declarations_and_update_source( $sourcefile ); - } - - for my $decl (@decls) { - my $components = $self->function_components_from_declaration( $sourcefile, $decl ); - push( @{ $sourcefiles{$hfile}->{$sourcefile} }, $components ) unless $hfile eq 'none'; - push( @{ $sourcefiles_with_statics{$sourcefile} }, $components ) if $components->{is_static}; - if ( $self->{macro_match} ) { - if ( grep { $_ eq $self->{macro_match} } @{$components->{macros}} ) { - push( @{ $api{$sourcefile} }, $components ); - } - } - } - } # for @cfiles - $self->{sourcefiles} = \%sourcefiles; - $self->{sourcefiles_with_statics} = \%sourcefiles_with_statics; - $self->{api} = \%api; -} +=item C -=head2 extract_function_declaration_and_update_source( $cfile_name ) + $headerizer->valid_macros() -Extract all the function declarations from the C file specified by -I<$cfile_name>, and update the comment blocks within. +Returns a list of all the valid C macros. =cut -sub extract_function_declarations_and_update_source { +sub valid_macros { my $self = shift; - my $cfile_name = shift; - open( my $fhin, '<', $cfile_name ) or die "Can't open $cfile_name: $!"; - my $text = join( '', <$fhin> ); - close $fhin; + my @macros = sort keys %{$self->{valid_macros}}; - my @func_declarations = $self->extract_function_declarations( $text ); - for my $decl ( @func_declarations ) { - my $specs = $self->function_components_from_declaration( $cfile_name, $decl ); - my $name = $specs->{name}; + return @macros; +} - my $heading = $self->generate_documentation_signature($decl); +=item C - $text =~ s/=item C<[^>]*\b$name\b[^>]*>\n+/$heading\n\n/sm or do { - warn "$cfile_name: $name has no POD\n" unless $name =~ /^yy/; # lexer funcs don't have to have POD - } - } - open( my $fhout, '>', $cfile_name ) or die "Can't create $cfile_name: $!"; - print {$fhout} $text; - close $fhout; +Headerizer-specific ways of complaining if something went wrong. - return @func_declarations; +$file => filename +$func => function name +$error => error message text + +=cut + +sub squawk { + my $self = shift; + my $file = shift; + my $func = shift; + my $error = shift; + + push( @{ $self->{warnings}{$file}{$func} }, $error ); + + return; } sub process_sources { @@ -486,7 +484,6 @@ sub process_sources { for my $cfile ( sort keys %{$sourcefiles} ) { my @funcs = @{ $sourcefiles->{$cfile} }; @funcs = grep { not $_->{is_static} } @funcs; # skip statics - $header = $self->replace_headerized_declarations( $header, $cfile, $hfile, @funcs ); } @@ -507,13 +504,6 @@ sub process_sources { } } -sub print_final_message { - my $self = shift; - if ($self->{message} ne '') { - print "$self->{message}\n"; - } -} - sub replace_headerized_declarations { my $self = shift; my $source_code = shift; @@ -526,9 +516,10 @@ sub replace_headerized_declarations { return $source_code; } - @funcs = sort api_first_then_alpha @funcs; -print STDERR "Inside replace_headerized_declarations\n"; -print STDERR Dumper \@funcs; + @funcs = sort { + ( ( $b->{is_api} || 0 ) <=> ( $a->{is_api} || 0 ) ) + || ( ( lc($a->{name}) || '') cmp ( lc($b->{name}) || '') ) + } @funcs; my @function_decls = $self->make_function_decls(@funcs); my $function_decls = join( "\n", @function_decls ); @@ -611,7 +602,6 @@ sub make_function_decls { foreach my $func (@funcs) { my @args = @{ $func->{args} }; my @asserts = asserts_from_args( @args ); -print STDERR Dumper [ \@args, \@asserts ]; my $assert = "#define ASSERT_ARGS_" . $func->{name}; if(length($func->{name}) > 29) { @@ -671,6 +661,13 @@ sub attrs_from_args { return (@attrs,@mods); } +sub print_final_message { + my $self = shift; + if ($self->{message} ne '') { + print "$self->{message}\n"; + } +} + =head2 C =over 4 diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index ab32604820..7f0c402d84 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -5,8 +5,7 @@ use strict; use warnings; -#use Data::Dumper; -use Test::More qw(no_plan); # tests => 15; +use Test::More tests => 38; use Carp; use Cwd; use File::Copy; @@ -19,8 +18,8 @@ use Parrot::Headerizer::Functions qw( write_file qualify_sourcefile asserts_from_args - api_first_then_alpha ); + use IO::CaptureOutput qw| capture |; my $cwd = cwd(); @@ -244,6 +243,20 @@ ok( exists $asserts{'PARROT_ASSERT_ARG(list)'}, "Got expected assert" ); ok( exists $asserts{'PARROT_ASSERT_ARG(item)'}, "Got expected assert" ); ok( exists $asserts{'PARROT_ASSERT_ARG(interp)'}, "Got expected assert" ); +@args = ( + 'ARGFREE_NOTNULL(( _abcDEF123 )())', + 'PARROT_INTERP', + 'ARGIN(Linked_List *list)', + 'ARGIN(List_Item_Header *item)', + 'SHIM_INTERP', +); +%asserts = map { $_ => 1 } asserts_from_args( @args ); +is( keys %asserts, 4, "Got expected number of asserts" ); +ok( exists $asserts{'PARROT_ASSERT_ARG(list)'}, "Got expected assert" ); +ok( exists $asserts{'PARROT_ASSERT_ARG(item)'}, "Got expected assert" ); +ok( exists $asserts{'PARROT_ASSERT_ARG(interp)'}, "Got expected assert" ); +ok( exists $asserts{'PARROT_ASSERT_ARG(_abcDEF123)'}, "Got expected assert" ); + pass("Completed all tests in $0"); ################### DOCUMENTATION ################### diff --git a/t/tools/dev/headerizer/02_methods.t b/t/tools/dev/headerizer/02_methods.t index 017f4c87ba..8f6daf4165 100644 --- a/t/tools/dev/headerizer/02_methods.t +++ b/t/tools/dev/headerizer/02_methods.t @@ -10,7 +10,15 @@ use lib qw( lib ); use Parrot::Headerizer::Object; use IO::CaptureOutput qw| capture |; -my $self = Parrot::Headerizer::Object->new(); +my $self; +eval { $self = Parrot::Headerizer::Object->new([]); }; +like($@, qr/Argument to Parrot::Headerizer::Object must be hashref/, + "Got expected error message for bad argument to constructor" ); + +$self = Parrot::Headerizer::Object->new({ macro_match => 1}); +isa_ok( $self, 'Parrot::Headerizer::Object' ); + +$self = Parrot::Headerizer::Object->new(); isa_ok( $self, 'Parrot::Headerizer::Object' ); ok( $self->valid_macro( 'PARROT_EXPORT' ), "valid_macro() confirmed validity of macro" ); @@ -19,6 +27,31 @@ ok(! $self->valid_macro( 'PARROT_FOOBAR' ), my @valid_macros = $self->valid_macros; ok( @valid_macros, "Headerizer object contains list of valid macros" ); +ok(! defined $self->{macro_match}, "macro_match undefined" ); + +my $msg = 'message'; +$self->{message} = $msg; +{ + my ($stdout, $stderr); + capture( + sub { $self->print_final_message(); }, + \$stdout, + \$stderr, + ); + like($stdout, qr/$msg/s, "Got expected final message"); +} +$msg = ''; +$self->{message} = $msg; +{ + my ($stdout, $stderr); + capture( + sub { $self->print_final_message(); }, + \$stdout, + \$stderr, + ); + chomp($stdout); + ok(! $stdout, "No final message"); +} my $warnings = { 'file1' => { @@ -72,6 +105,24 @@ $self->{warnings} = {}; ); ok(! $stdout, "No warnings, hence no warnings printed" ); } +my ($file, $func, @error); +$file = 'file 4'; +$func = 'func_delta'; +$error[0] = 'delta warning 4'; +$self->squawk($file, $func, $error[0]); +$error[1] = 'delta warning 5'; +$self->squawk($file, $func, $error[1]); +{ + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + for (0..1) { + like($stdout, qr/$error[$_]/s, "Got expected squawk message"); + } +} pass("Completed all tests in $0"); diff --git a/tools/dev/headerizer.pl b/tools/dev/headerizer.pl index 9bcfa04561..352a557721 100644 --- a/tools/dev/headerizer.pl +++ b/tools/dev/headerizer.pl @@ -10,7 +10,6 @@ use Parrot::Headerizer::Functions qw( process_argv ); -# print_headerizer_warnings =head1 NAME From c232b9f2b4a5d361fb7c948e267c8ecdbe82fa6a Mon Sep 17 00:00:00 2001 From: jkeenan Date: Fri, 26 Nov 2010 14:23:45 -0500 Subject: [PATCH 018/102] Add tests for Parrot::Headerizer::Object methods. --- lib/Parrot/Headerizer/Object.pm | 12 +- t/tools/dev/headerizer/02_methods.t | 101 ++++++++++ t/tools/dev/headerizer/testlib/list.in | 243 +++++++++++++++++++++++ t/tools/dev/headerizer/testlib/list_h.in | 171 ++++++++++++++++ 4 files changed, 523 insertions(+), 4 deletions(-) create mode 100644 t/tools/dev/headerizer/testlib/list.in create mode 100644 t/tools/dev/headerizer/testlib/list_h.in diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 78fa197066..e1c27693d0 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -115,13 +115,17 @@ sub get_sources { @decls = $self->extract_function_declarations( $source_code ); } else { - @decls = $self->extract_function_declarations_and_update_source( $sourcefile ); + @decls = + $self->extract_function_declarations_and_update_source( $sourcefile ); } for my $decl (@decls) { - my $components = $self->function_components_from_declaration( $sourcefile, $decl ); - push( @{ $sourcefiles{$hfile}->{$sourcefile} }, $components ) unless $hfile eq 'none'; - push( @{ $sourcefiles_with_statics{$sourcefile} }, $components ) if $components->{is_static}; + my $components = + $self->function_components_from_declaration( $sourcefile, $decl ); + push( @{ $sourcefiles{$hfile}->{$sourcefile} }, $components ) + unless $hfile eq 'none'; + push( @{ $sourcefiles_with_statics{$sourcefile} }, $components ) + if $components->{is_static}; if ( $self->{macro_match} ) { if ( grep { $_ eq $self->{macro_match} } @{$components->{macros}} ) { push( @{ $api{$sourcefile} }, $components ); diff --git a/t/tools/dev/headerizer/02_methods.t b/t/tools/dev/headerizer/02_methods.t index 8f6daf4165..edc1a81ff0 100644 --- a/t/tools/dev/headerizer/02_methods.t +++ b/t/tools/dev/headerizer/02_methods.t @@ -5,6 +5,12 @@ use strict; use warnings; +use Carp; +use Cwd; +use File::Copy; +use File::Path qw( mkpath ); +use File::Spec; +use File::Temp qw( tempdir ); use Test::More qw(no_plan); # tests => 15; use lib qw( lib ); use Parrot::Headerizer::Object; @@ -124,8 +130,103 @@ $self->squawk($file, $func, $error[1]); } } +my $cwd = cwd(); +{ + my $tdir = tempdir( CLEANUP => 1 ); + chdir $tdir or croak "Unable to chdir during testing"; + + my $srcdir = File::Spec->catpath( $tdir, 'src' ); + my $srcopsdir = File::Spec->catpath( $tdir, 'src', 'ops' ); + mkpath( $srcopsdir, 0, 0777 ); + my $srcopso = File::Spec->catfile( $srcopsdir, 'ops.o' ); + touchfile($srcopso); + $self = Parrot::Headerizer::Object->new(); + isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self->get_sources($srcopso); + ok( ! keys %{$self->{sourcefiles}}, + "Skipped file in src/ops/ -> no sourcefiles" ); + ok( ! keys %{$self->{sourcefiles_with_statics}}, + "Skipped file in src/ops/ -> no sourcefiles_with_statics" ); + ok( ! keys %{$self->{api}}, + "Skipped file in src/ops/ -> no api" ); + + chdir $cwd or croak "Unable to chdir back after testing"; +} + +{ + my $tdir = tempdir( CLEANUP => 1 ); + chdir $tdir or croak "Unable to chdir during testing"; + + my $srcdir = File::Spec->catpath( $tdir, 'src' ); + mkpath( $srcdir, 0, 0777 ); + my $srco = File::Spec->catfile( $srcdir, 'other.o' ); + touchfile($srco); + my $srcs = File::Spec->catfile( $srcdir, 'other.s' ); + touchfile($srcs); + $self = Parrot::Headerizer::Object->new(); + isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self->get_sources($srco); + ok( ! keys %{$self->{sourcefiles}}, + "Skipped file in src/ -> no sourcefiles" ); + ok( ! keys %{$self->{sourcefiles_with_statics}}, + "Skipped file in src/ -> no sourcefiles_with_statics" ); + ok( ! keys %{$self->{api}}, + "Skipped file in src/ -> no api" ); + + chdir $cwd or croak "Unable to chdir back after testing"; +} + +{ + my $tdir = tempdir( CLEANUP => 1 ); + chdir $tdir or croak "Unable to chdir during testing"; + + my $srcdir = File::Spec->catpath( $tdir, 'src' ); + mkpath( $srcdir, 0, 0777 ); + my $srco = File::Spec->catfile( $srcdir, 'list.o' ); + touchfile($srco); + my $srcc = File::Spec->catfile( $srcdir, 'list.c' ); + copy "$cwd/t/tools/dev/headerizer/testlib/list.in" => $srcc + or croak "Unable to copy"; + my $incdir = File::Spec->catpath( $tdir, 'include', 'parrot' ); + mkpath( $incdir, 0, 0777 ); + my $inch = File::Spec->catfile( $incdir, 'list.h' ); + copy "$cwd/t/tools/dev/headerizer/testlib/list_h.in" => $inch + or croak "Unable to copy"; + + $self = Parrot::Headerizer::Object->new(); + isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self->get_sources($srco); + ok( keys %{$self->{sourcefiles}}, + "sourcefiles" ); + ok( ! keys %{$self->{sourcefiles_with_statics}}, + "no sourcefiles_with_statics" ); + ok( ! keys %{$self->{api}}, + "no api" ); + + $self->process_sources(); + { + my ($stdout, $stderr); + capture( + sub { $self->print_final_message; }, + \$stdout, + \$stderr, + ); + like($stdout, qr/Headerization complete/, + "Got expected final message" ); + } + chdir $cwd or croak "Unable to chdir back after testing"; +} + pass("Completed all tests in $0"); +sub touchfile { + my $filename = shift; + open my $IN, '>', $filename or croak "Unable to open for writing"; + print $IN "\n"; + close $IN or croak "Unable to close after writing"; + return 1; +} + ################### DOCUMENTATION ################### =head1 NAME diff --git a/t/tools/dev/headerizer/testlib/list.in b/t/tools/dev/headerizer/testlib/list.in new file mode 100644 index 0000000000..62a3cf0357 --- /dev/null +++ b/t/tools/dev/headerizer/testlib/list.in @@ -0,0 +1,243 @@ +/* +Copyright (C) 2010, Parrot Foundation. +$Id$ + +=head1 NAME + +src/list.c - Implementation of double linked lists. + +=head1 DESCRIPTION + +This code implements double linked list of GCable objects. + +=cut + +*/ + +#include "parrot/parrot.h" +#include "parrot/list.h" + +/* HEADERIZER HFILE: include/parrot/list.h */ + +/* HEADERIZER BEGIN: static */ +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ + +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ +/* HEADERIZER END: static */ + +/* + +=over 4 + +=item C + +Allocate a doubly link list + +=cut + +*/ + +PARROT_EXPORT +PARROT_CANNOT_RETURN_NULL +struct Linked_List* +Parrot_list_new(SHIM_INTERP) +{ + ASSERT_ARGS(Parrot_list_new) + + Linked_List *res = (Linked_List*)mem_sys_allocate_zeroed(sizeof (Linked_List)); + return res; +} + +/* + +=item C + +Destroy the specified list (free up memory associated with the list) + +=cut + +*/ + +PARROT_EXPORT +void +Parrot_list_destroy(SHIM_INTERP, ARGMOD(Linked_List* list)) +{ + ASSERT_ARGS(Parrot_list_destroy) + + mem_sys_free(list); +} + +/* + +=item C + +Append an item to the list + +=cut + +*/ + +PARROT_EXPORT +void +Parrot_list_append(SHIM_INTERP, ARGMOD(Linked_List *list), ARGMOD(List_Item_Header *item)) +{ + ASSERT_ARGS(Parrot_list_append) + + item->prev = item->next = NULL; + + if (list->last) { + item->prev = list->last; + list->last->next = item; + } + + list->last = item; + + if (!list->first) + list->first = item; + + list->count++; +#ifndef NDEBUG + item->owner = list; +#endif +} + +/* + +=item C + +Remove an item from the list, returning the (pointer to) item + +=cut + +*/ + +PARROT_EXPORT +PARROT_CAN_RETURN_NULL +List_Item_Header* +Parrot_list_remove(SHIM_INTERP, ARGMOD(Linked_List *list), ARGMOD(List_Item_Header *item)) +{ + ASSERT_ARGS(Parrot_list_remove) + + List_Item_Header *next = item->next; + List_Item_Header *prev = item->prev; + + PARROT_ASSERT(list == item->owner); + + /* First item */ + if (list->first == item) + list->first = next; + + if (list->last == item) + list->last = prev; + + if (prev) + prev->next = next; + if (next) + next->prev = prev; + + list->count--; + return item; +} + +/* + +=item C + +Pop an item off the list - i.e. get the first item in the list and remove it. + +=cut + +*/ + +PARROT_EXPORT +PARROT_CAN_RETURN_NULL +List_Item_Header* +Parrot_list_pop(PARROT_INTERP, ARGIN(Linked_List *list)) +{ + ASSERT_ARGS(Parrot_list_pop) + + List_Item_Header *ret = list->first; + if (ret) + LIST_REMOVE(list, ret); + return ret; +} + +/* + +=item C + +Check the validity of the list + +=cut + +*/ + +PARROT_EXPORT +INTVAL +Parrot_list_check(SHIM_INTERP, ARGIN(Linked_List *list)) +{ + ASSERT_ARGS(Parrot_list_check) + + List_Item_Header *tmp = list->first; + size_t counter = 0; + + while (tmp) { + List_Item_Header *next = tmp->next; + PARROT_ASSERT(tmp->owner == list); + tmp = next; + ++counter; + PARROT_ASSERT(counter <= list->count); + } + + return 1; +} + +/* + +=item C + +Returns True if the is in the list + +=cut + +*/ + +PARROT_EXPORT +INTVAL +Parrot_list_contains(SHIM_INTERP, ARGIN(Linked_List *list), ARGIN(List_Item_Header *item)) +{ + ASSERT_ARGS(Parrot_list_contains) + + List_Item_Header *tmp = list->first; + +#ifndef NDEBUG + if (item->owner != list) + return 0; +#endif + + while (tmp) { + if (tmp == item) + return 1; + tmp = tmp->next; + } + + return 0; +} + +/* + +=back + +=cut + +*/ + +/* + * Local variables: + * c-file-style: "parrot" + * End: + * vim: expandtab shiftwidth=4: + */ diff --git a/t/tools/dev/headerizer/testlib/list_h.in b/t/tools/dev/headerizer/testlib/list_h.in new file mode 100644 index 0000000000..668e5f835d --- /dev/null +++ b/t/tools/dev/headerizer/testlib/list_h.in @@ -0,0 +1,171 @@ +/* +Copyright (C) 2010, Parrot Foundation. +$Id$ + +=head1 NAME + +src/gc/list.h - Linked lists of allocated objects. + +=head1 DESCRIPTION + +Implementation of double linked lists used by various GC implementations. + +*/ + +#ifndef PARROT_GC_LIST_H_GUARD +#define PARROT_GC_LIST_H_GUARD + +/* Allocatable objects has headers to use in linked lists */ +typedef struct List_Item_Header { + struct List_Item_Header *prev; + struct List_Item_Header *next; + +#ifndef NDEBUG + struct Linked_List *owner; +#endif +} List_Item_Header; + +/* Double-linked list. */ +/* N.B. List doesn't _own_ items */ +typedef struct Linked_List { + struct List_Item_Header *first; + struct List_Item_Header *last; + + /* Cache object count in list. We use it very often */ + size_t count; +} Linked_List; + +/* Such headers allocated in front of real objects. */ +/* There is helper macros to convert to/from real objects */ +#define Obj2LLH(p) ((List_Item_Header *)((char*)(p) - sizeof (List_Item_Header))) +#define LLH2Obj_typed(p, type) ((type*)((char*)(p) + sizeof (List_Item_Header))) +#define LLH2Obj(p) LLH2Obj_typed(p, void) + +#ifdef NDEBUG +# define SET_LIST_OWNER(l, i) +#else +# define SET_LIST_OWNER(l, i) (i)->owner = (l); +#endif + +#define LIST_APPEND(l, i) \ +do { \ + List_Item_Header *_item = (i); \ + Linked_List *_list = (l); \ + \ + if (_list->last) { \ + _item->prev = _list->last; \ + _list->last->next = _item; \ + } \ + else if (!_list->first) { \ + _item->prev = NULL; \ + _list->first = _item; \ + } \ + \ + _list->last = _item; \ + _item->next = NULL; \ + \ + SET_LIST_OWNER(_list, _item) \ + _list->count++; \ +} while (0); + +#define LIST_REMOVE(l, i) \ +do { \ + List_Item_Header *_item = (i); \ + Linked_List *_list = (l); \ + List_Item_Header *next = _item->next; \ + List_Item_Header *prev = _item->prev; \ + \ + PARROT_ASSERT(_list == _item->owner); \ + \ + /* First _item */ \ + if (_list->first == _item) \ + _list->first = next; \ + \ + if (_list->last == _item) \ + _list->last = prev; \ + \ + if (prev) \ + prev->next = next; \ + if (next) \ + next->prev = prev; \ + \ + _list->count--; \ +} while (0) + + +/* HEADERIZER BEGIN: src/list.c */ +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ + +PARROT_EXPORT +void Parrot_list_append(SHIM_INTERP, + ARGMOD(Linked_List *list), + ARGMOD(List_Item_Header *item)) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*list) + FUNC_MODIFIES(*item); + +PARROT_EXPORT +INTVAL Parrot_list_check(SHIM_INTERP, ARGIN(Linked_List *list)) + __attribute__nonnull__(2); + +PARROT_EXPORT +INTVAL Parrot_list_contains(SHIM_INTERP, + ARGIN(Linked_List *list), + ARGIN(List_Item_Header *item)) + __attribute__nonnull__(2) + __attribute__nonnull__(3); + +PARROT_EXPORT +void Parrot_list_destroy(SHIM_INTERP, ARGMOD(Linked_List* list)) + __attribute__nonnull__(2) + FUNC_MODIFIES(* list); + +PARROT_EXPORT +PARROT_CANNOT_RETURN_NULL +struct Linked_List* Parrot_list_new(SHIM_INTERP); + +PARROT_EXPORT +PARROT_CAN_RETURN_NULL +List_Item_Header* Parrot_list_pop(PARROT_INTERP, ARGIN(Linked_List *list)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +PARROT_CAN_RETURN_NULL +List_Item_Header* Parrot_list_remove(SHIM_INTERP, + ARGMOD(Linked_List *list), + ARGMOD(List_Item_Header *item)) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*list) + FUNC_MODIFIES(*item); + +#define ASSERT_ARGS_Parrot_list_append __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(list) \ + , PARROT_ASSERT_ARG(item)) +#define ASSERT_ARGS_Parrot_list_check __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(list)) +#define ASSERT_ARGS_Parrot_list_contains __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(list) \ + , PARROT_ASSERT_ARG(item)) +#define ASSERT_ARGS_Parrot_list_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(list)) +#define ASSERT_ARGS_Parrot_list_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) +#define ASSERT_ARGS_Parrot_list_pop __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(list)) +#define ASSERT_ARGS_Parrot_list_remove __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(list) \ + , PARROT_ASSERT_ARG(item)) +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ +/* HEADERIZER END: src/list.c */ + +#endif /* PARROT_GC_LIST_H_GUARD */ + +/* + * Local variables: + * c-file-style: "parrot" + * End: + * vim: expandtab shiftwidth=4: + */ From 237a741d6a40bd280b3ed16c3a7fcbab21f8c5d4 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Fri, 26 Nov 2010 15:12:28 -0500 Subject: [PATCH 019/102] Add 'headerizer_tests' target. --- config/gen/makefiles/root.in | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/config/gen/makefiles/root.in b/config/gen/makefiles/root.in index ed915dad6c..fd92863c18 100644 --- a/config/gen/makefiles/root.in +++ b/config/gen/makefiles/root.in @@ -1795,16 +1795,16 @@ RUNCORE_TEST_FILES = \ --runcore-tests SRC_TEST_FILES = \ t/src/*.t -TOOLS_TEST_FILES = \ - t/tools/*.t +TOOLS_TEST_DIR = t/tools +TOOLS_TEST_FILES = $(TOOLS_TEST_DIR)/tools/*.t LIBRARY_TEST_FILES = @library_tests@ -PMC2CUTILS_DIR = t/tools/pmc2cutils +PMC2CUTILS_DIR = $(TOOLS_TEST_DIR)/pmc2cutils HARNESS_DIR = t/pharness BUILDTOOLS_TEST_FILES = \ $(PMC2CUTILS_DIR)/*.t \ $(HARNESS_DIR)/*.t MANIFEST_DIR = t/manifest -INSTALL_TOOLS_DIR = t/tools/install +INSTALL_TOOLS_DIR = $(TOOLS_TEST_DIR)/install MANIFEST_TEST_FILES = \ $(MANIFEST_DIR)/*.t \ $(INSTALL_TOOLS_DIR)/*.t @@ -1817,6 +1817,7 @@ PBC_TEST_FILES = \ #IF(has_icu): t/op/testlib/test_strings.pbc \ t/pmc/testlib/annotations.pbc \ t/pmc/testlib/number.pbc +HEADERIZER_TEST_FILES = $(TOOLS_TEST_DIR)/dev/headerizer/*.t # pbc files used for several tests; # not needed for build, hence this target is not included in 'all' @@ -1879,7 +1880,8 @@ fulltest : benchmark_tests \ manifest_tests \ examples_tests \ - distro_tests + distro_tests \ + headerizer_tests # bounds checking, slow core testb : test_prep @@ -1965,6 +1967,10 @@ distro_tests : test_prep configure_tests : $(PERL) t/harness $(CONFIGURE_TEST_FILES) +# headerizer tests +headerizer_tests : test_prep + $(PERL) t/harness $(HEADERIZER_TEST_FILES) + # library tests - tests run by make test but not by make fulltest or make cover library_tests : test_prep $(PERL) t/harness $(EXTRA_TEST_ARGS) $(LIBRARY_TEST_FILES) From 2377b3ba49c6d34b3b3e6ef31afd2d7f195681b5 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sat, 27 Nov 2010 11:31:52 -0500 Subject: [PATCH 020/102] Add tests for 'macro_match' option. --- t/tools/dev/headerizer/02_methods.t | 52 +++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) diff --git a/t/tools/dev/headerizer/02_methods.t b/t/tools/dev/headerizer/02_methods.t index edc1a81ff0..ac8ba8f6cb 100644 --- a/t/tools/dev/headerizer/02_methods.t +++ b/t/tools/dev/headerizer/02_methods.t @@ -217,6 +217,58 @@ my $cwd = cwd(); chdir $cwd or croak "Unable to chdir back after testing"; } +{ + my $tdir = tempdir( CLEANUP => 1 ); + chdir $tdir or croak "Unable to chdir during testing"; + + my $srcdir = File::Spec->catpath( $tdir, 'src' ); + mkpath( $srcdir, 0, 0777 ); + my $srco = File::Spec->catfile( $srcdir, 'list.o' ); + touchfile($srco); + my $srcc = File::Spec->catfile( $srcdir, 'list.c' ); + copy "$cwd/t/tools/dev/headerizer/testlib/list.in" => $srcc + or croak "Unable to copy"; + my $incdir = File::Spec->catpath( $tdir, 'include', 'parrot' ); + mkpath( $incdir, 0, 0777 ); + my $inch = File::Spec->catfile( $incdir, 'list.h' ); + copy "$cwd/t/tools/dev/headerizer/testlib/list_h.in" => $inch + or croak "Unable to copy"; + + my $macro = 'PARROT_CAN_RETURN_NULL'; + $self = Parrot::Headerizer::Object->new( { + macro_match => $macro, + } ); + isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self->get_sources($srco); + ok( keys %{$self->{sourcefiles}}, + "sourcefiles" ); + ok( ! keys %{$self->{sourcefiles_with_statics}}, + "no sourcefiles_with_statics" ); + ok( keys %{$self->{api}}, + "api" ); + + { + my ($stdout, $stderr); + capture( + sub { $self->process_sources(); }, + \$stdout, + \$stderr, + ); + like($stdout, qr/src\/list\.c\s+Parrot_list_pop\s+Parrot_list_remove/s, + "Got expected list of functions matching requested macro" ); + } + { + my ($stdout, $stderr); + capture( + sub { $self->print_final_message; }, + \$stdout, + \$stderr, + ); + like($stdout, qr/2 $macro functions/s, + "Got expected final message" ); + } + chdir $cwd or croak "Unable to chdir back after testing"; +} pass("Completed all tests in $0"); sub touchfile { From 7f94d349d534827a2dc1b60617528001877a9d2a Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sat, 27 Nov 2010 11:38:18 -0500 Subject: [PATCH 021/102] Provide better documentation for '--macro' option. --- tools/dev/headerizer.pl | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/tools/dev/headerizer.pl b/tools/dev/headerizer.pl index 352a557721..8846d47b10 100644 --- a/tools/dev/headerizer.pl +++ b/tools/dev/headerizer.pl @@ -62,7 +62,14 @@ =head1 COMMAND-LINE OPTIONS =item C<--macro=X> -Print a list of all functions that have macro X. For example, --macro=PARROT_EXPORT. +Print a list of all functions that have macro C. Example: + + $> perl tools/dev/headerizer.pl --macro=PARROT_CAN_RETURN_NULL src/list.o + + src/list.c + Parrot_list_pop + Parrot_list_remove + 2 PARROT_CAN_RETURN_NULL functions =back From ab904c839ef1697db52395b36ff804fded965ecc Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sun, 28 Nov 2010 13:09:40 -0500 Subject: [PATCH 022/102] Add tests for case where sourcefile is a PMC. Add sample file used in illustrating that case. --- t/tools/dev/headerizer/02_methods.t | 40 +- .../testlib/fixedbooleanarray_pmc.in | 642 ++++++++++++++++++ 2 files changed, 681 insertions(+), 1 deletion(-) create mode 100644 t/tools/dev/headerizer/testlib/fixedbooleanarray_pmc.in diff --git a/t/tools/dev/headerizer/02_methods.t b/t/tools/dev/headerizer/02_methods.t index ac8ba8f6cb..7130386539 100644 --- a/t/tools/dev/headerizer/02_methods.t +++ b/t/tools/dev/headerizer/02_methods.t @@ -11,7 +11,7 @@ use File::Copy; use File::Path qw( mkpath ); use File::Spec; use File::Temp qw( tempdir ); -use Test::More qw(no_plan); # tests => 15; +use Test::More qw(no_plan); # tests => 46; use lib qw( lib ); use Parrot::Headerizer::Object; use IO::CaptureOutput qw| capture |; @@ -269,6 +269,44 @@ my $cwd = cwd(); } chdir $cwd or croak "Unable to chdir back after testing"; } + +{ + my $tdir = tempdir( CLEANUP => 1 ); + chdir $tdir or croak "Unable to chdir during testing"; + + my $stub = 'fixedbooleanarray'; + my $srcdir = File::Spec->catpath( $tdir, 'src', 'pmc' ); + mkpath( $srcdir, 0, 0777 ); + my $srco = File::Spec->catfile( $srcdir, "$stub.o" ); + touchfile($srco); + my $srcc = File::Spec->catfile( $srcdir, "$stub.c" ); + copy "$cwd/t/tools/dev/headerizer/testlib/${stub}_pmc.in" => $srcc + or croak "Unable to copy"; + + $self = Parrot::Headerizer::Object->new(); + isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self->get_sources($srco); + ok( ! keys %{$self->{sourcefiles}}, + "no sourcefiles" ); + ok( keys %{$self->{sourcefiles_with_statics}}, + "sourcefiles_with_statics" ); + ok( ! keys %{$self->{api}}, + "no api" ); + + $self->process_sources(); + { + my ($stdout, $stderr); + capture( + sub { $self->print_final_message; }, + \$stdout, + \$stderr, + ); + like($stdout, qr/Headerization complete/, + "Got expected final message" ); + } + chdir $cwd or croak "Unable to chdir back after testing"; +} + pass("Completed all tests in $0"); sub touchfile { diff --git a/t/tools/dev/headerizer/testlib/fixedbooleanarray_pmc.in b/t/tools/dev/headerizer/testlib/fixedbooleanarray_pmc.in new file mode 100644 index 0000000000..148a122d77 --- /dev/null +++ b/t/tools/dev/headerizer/testlib/fixedbooleanarray_pmc.in @@ -0,0 +1,642 @@ +/* +Copyright (C) 2001-2010, Parrot Foundation. +$Id$ + +=head1 NAME + +src/pmc/fixedbooleanarray.pmc - fixed size array for booleans only + +=head1 DESCRIPTION + +The C PMC implements an array of fixed size, which +stores booleans. It uses the C PMC for all conversions. The +C PMC is extended by the C +PMC. + +=head2 Functions + +=over 4 + +=item C + +Auxiliar function to avoid repeating the size evaluation. + +=cut + +*/ + +#define BITS_PER_CHAR 8 + +/* HEADERIZER HFILE: none */ +/* HEADERIZER BEGIN: static */ +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ + +PARROT_INLINE +static UINTVAL get_size_in_bytes(UINTVAL size); + +#define ASSERT_ARGS_get_size_in_bytes __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ +/* HEADERIZER END: static */ + +PARROT_INLINE +static UINTVAL +get_size_in_bytes(UINTVAL size) +{ + ASSERT_ARGS(get_size_in_bytes) + + return (size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; +} + + +pmclass FixedBooleanArray auto_attrs provides array { + ATTR UINTVAL size; /* # of bits this fba holds */ + ATTR UINTVAL resize_threshold; /* max capacity before resizing */ + ATTR unsigned char * bit_array; /* where the bits go */ + +/* + +=back + +=head2 Vtable functions + +=over 4 + +=item C + +Initializes the array. + +=cut + +*/ + + VTABLE void init() { + PObj_custom_destroy_SET(SELF); + } + +/* + +=item C + +Initializes the array. + +=cut + +*/ + + VTABLE void init_int(INTVAL size) { + const size_t size_in_bytes = get_size_in_bytes(size); + + if (size < 0) + Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, + _("FixedBooleanArray: Cannot set array size to a negative number (%d)"), size); + + SET_ATTR_size(INTERP, SELF, size); + SET_ATTR_resize_threshold(INTERP, SELF, size_in_bytes * BITS_PER_CHAR); + SET_ATTR_bit_array(INTERP, SELF, mem_gc_allocate_n_zeroed_typed(INTERP, size_in_bytes, + unsigned char)); + PObj_custom_destroy_SET(SELF); + } + + +/* + +=item C + +Destroys the array. + +=cut + +*/ + + VTABLE void destroy() { + unsigned char *bit_array; + GET_ATTR_bit_array(INTERP, SELF, bit_array); + if (bit_array) + mem_gc_free(INTERP, bit_array); + } + +/* + +=item C + +Creates and returns a copy of the array. + +=cut + +*/ + + VTABLE PMC *clone() { + unsigned char * my_bit_array, * clone_bit_array; + UINTVAL resize_threshold, size; + PMC * const dest = Parrot_pmc_new(INTERP, SELF->vtable->base_type); + + GET_ATTR_bit_array(INTERP, SELF, my_bit_array); + GET_ATTR_size(INTERP, SELF, size); + GET_ATTR_resize_threshold(INTERP, SELF, resize_threshold); + + if (my_bit_array) { + const size_t size_in_bytes = get_size_in_bytes(resize_threshold); + + SET_ATTR_size(INTERP, dest, size); + SET_ATTR_resize_threshold(INTERP, dest, resize_threshold); + + clone_bit_array = mem_gc_allocate_n_typed(INTERP, size_in_bytes, unsigned char); + mem_sys_memcopy(clone_bit_array, my_bit_array, size_in_bytes); + + SET_ATTR_bit_array(INTERP, dest, clone_bit_array); + } + + PObj_custom_destroy_SET(dest); + return dest; + } + +/* + +=item C + +Returns whether the array has any elements (meaning been initialized, for a +fixed sized array). + +=cut + +*/ + VTABLE INTVAL get_bool() { + return SELF.elements() ? 1 : 0; + } + +/* + +=item C + +=cut + +*/ + + VTABLE INTVAL elements() { + UINTVAL size; + GET_ATTR_size(INTERP, SELF, size); + return size; + } + +/* + +=item C + +Returns the number of elements in the array. + +=cut + +*/ + + VTABLE INTVAL get_integer() { + return SELF.elements(); + } + +/* + +=item C + +Returns the integer value of the element at index C. + +=cut + +*/ + + VTABLE INTVAL get_integer_keyed_int(INTVAL key) { + UINTVAL size; + const unsigned char * bit_array; + GET_ATTR_bit_array(INTERP, SELF, bit_array); + GET_ATTR_size(INTERP, SELF, size); + + if (key < 0 || (UINTVAL)key >= size) + Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, + "FixedBooleanArray: index out of bounds!"); + + return (bit_array[key / BITS_PER_CHAR] & (1 << (key % BITS_PER_CHAR))) ? 1 : 0; + } + +/* + +=item C + +Returns the integer value of the element at index C<*key>. + +=cut + +*/ + + VTABLE INTVAL get_integer_keyed(PMC *key) { + /* simple int keys only */ + const INTVAL k = VTABLE_get_integer(INTERP, key); + return SELF.get_integer_keyed_int(k); + } + + +/* + +=item C + +Returns the floating-point value of the element at index C. + +=cut + +*/ + + VTABLE FLOATVAL get_number_keyed_int(INTVAL key) { + const INTVAL i = SELF.get_integer_keyed_int(key); + return (FLOATVAL)i; + } + +/* + +=item C + +Returns the floating-point value of the element at index C<*key>. + +=cut + +*/ + + VTABLE FLOATVAL get_number_keyed(PMC *key) { + const INTVAL k = VTABLE_get_integer(INTERP, key); + return SELF.get_number_keyed_int(k); + } + +/* + +=item C + +Returns the Parrot string representation of the array. + +=cut + +*/ + + VTABLE STRING *get_string() { + STRING *zero, *one; + STRING *str = STRINGNULL; + UINTVAL i; + UINTVAL elems = SELF.elements(); + + zero = CONST_STRING(INTERP, "0"); + one = CONST_STRING(INTERP, "1"); + + for (i = 0; i < elems; ++i) { + if (SELF.get_integer_keyed_int((INTVAL)i)) + str = Parrot_str_concat(INTERP, str, one); + else + str = Parrot_str_concat(INTERP, str, zero); + } + + return str; + + } + +/* + +=item C + +Returns the Parrot string value of the element at index C. + +=cut + +*/ + + VTABLE STRING *get_string_keyed_int(INTVAL key) { + PMC * const val = SELF.get_pmc_keyed_int(key); + return VTABLE_get_string(INTERP, val); + } + +/* + +=item C + +Returns the Parrot string value of the element at index C<*key>. + +=cut + +*/ + + VTABLE STRING *get_string_keyed(PMC *key) { + const INTVAL k = VTABLE_get_integer(INTERP, key); + return SELF.get_string_keyed_int(k); + } + + +/* + +=item C + +Returns the PMC value of the element at index C. + +=cut + +*/ + + VTABLE PMC *get_pmc_keyed_int(INTVAL key) { + return Parrot_pmc_new_init_int(INTERP, enum_class_Boolean, + SELF.get_integer_keyed_int(key)); + } + +/* + +=item C + +Returns the PMC value of the element at index C<*key>. + +=cut + +*/ + + VTABLE PMC *get_pmc_keyed(PMC *key) { + const INTVAL k = VTABLE_get_integer(INTERP, key); + return SELF.get_pmc_keyed_int(k); + } + +/* + +=item C + +Resizes the array to C elements. + +=cut + +*/ + + VTABLE void set_integer_native(INTVAL size) { + const size_t size_in_bytes = get_size_in_bytes(size); + UINTVAL old_size; + unsigned char *bit_array; + + GET_ATTR_size(INTERP, SELF, old_size); + + if (old_size || size < 1) + Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, + "FixedBooleanArray: Can't resize!"); + + SET_ATTR_size(INTERP, SELF, size); + SET_ATTR_resize_threshold(INTERP, SELF, size_in_bytes * BITS_PER_CHAR); + bit_array = mem_gc_allocate_n_typed(INTERP, size_in_bytes, unsigned char); + memset(bit_array, 0, size_in_bytes); + SET_ATTR_bit_array(INTERP, SELF, bit_array); + } + +/* + +=item C + +Sets the integer value of the element at index C to C. + +=cut + +*/ + + VTABLE void set_integer_keyed_int(INTVAL key, INTVAL value) { + UINTVAL size; + unsigned char * bit_array; + GET_ATTR_bit_array(INTERP, SELF, bit_array); + GET_ATTR_size(INTERP, SELF, size); + + if (key < 0 || (UINTVAL)key >= size) + Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS, + "FixedBooleanArray: index out of bounds!"); + + if (value) + bit_array[key/BITS_PER_CHAR] |= (1 << (key % BITS_PER_CHAR)); + else + bit_array[key/BITS_PER_CHAR] &= ~(1 << (key % BITS_PER_CHAR)); + } + +/* + +=item C + +Sets the integer value of the element at index C to C. + +=cut + +*/ + + VTABLE void set_integer_keyed(PMC *key, INTVAL value) { + const INTVAL k = VTABLE_get_integer(INTERP, key); + SELF.set_integer_keyed_int(k, value); + } + +/* + +=item C + +Sets the floating-point value of the element at index C to +C. + +=cut + +*/ + + VTABLE void set_number_keyed_int(INTVAL key, FLOATVAL value) { + SELF.set_integer_keyed_int(key, !FLOAT_IS_ZERO(value)); + } + +/* + +=item C + +Sets the floating-point value of the element at index C to +C. + +=cut + +*/ + + VTABLE void set_number_keyed(PMC *key, FLOATVAL value) { + const INTVAL k = VTABLE_get_integer(INTERP, key); + SELF.set_number_keyed_int(k, value); + } + +/* + +=item C + +Sets the Parrot string value of the element at index C to C. + +=cut + +*/ + + VTABLE void set_string_keyed_int(INTVAL key, STRING *value) { + INTVAL tempInt; + PMC * const tempPMC = Parrot_pmc_new(INTERP, enum_class_Boolean); + + VTABLE_set_string_native(INTERP, tempPMC, value); + tempInt = VTABLE_get_integer(INTERP, tempPMC); + + SELF.set_integer_keyed_int(key, tempInt); + } + +/* + +=item C + +Sets the string value of the element at index C to +C. + +=cut + +*/ + + VTABLE void set_string_keyed(PMC *key, STRING *value) { + const INTVAL k = VTABLE_get_integer(INTERP, key); + SELF.set_string_keyed_int(k, value); + } + +/* + +=item C + +Sets the PMC value of the element at index C to C<*src>. + +=cut + +*/ + + VTABLE void set_pmc_keyed_int(INTVAL key, PMC *src) { + const INTVAL tempInt = VTABLE_get_integer(INTERP, src); + SELF.set_integer_keyed_int(key, tempInt); + } + +/* + +=item C + +Sets the string value of the element at index C to +C. + +=cut + +*/ + + VTABLE void set_pmc_keyed(PMC *key, PMC *value) { + const INTVAL k = VTABLE_get_integer(INTERP, key); + SELF.set_pmc_keyed_int(k, value); + } + +/* + +=item C + +Return a new iterator for SELF. + +=cut + +*/ + + VTABLE PMC *get_iter() { + return Parrot_pmc_new_init(INTERP, enum_class_ArrayIterator, SELF); + } + + + +/* + +=back + +=head2 Freeze/thaw Interface + +=over 4 + +=item C + +Used to archive the string. + +=cut + +*/ + VTABLE void freeze(PMC *info) { + UINTVAL size, resize_threshold; + unsigned char * bit_array; + STRING * s; + GET_ATTR_size(INTERP, SELF, size); + GET_ATTR_resize_threshold(INTERP, SELF, resize_threshold); + GET_ATTR_bit_array(INTERP, SELF, bit_array); + + s = Parrot_str_new(INTERP, (char*)bit_array, + (resize_threshold / BITS_PER_CHAR)); + + VTABLE_push_integer(INTERP, info, size); + VTABLE_push_string(INTERP, info, s); + } + +/* + +=item C + +Used to unarchive the string. + +=cut + +*/ + VTABLE void thaw(PMC *info) { + SUPER(info); + + { + const INTVAL size = VTABLE_shift_integer(INTERP, info); + STRING * const s = VTABLE_shift_string(INTERP, info); + + unsigned char * const bit_array = (unsigned char *)Parrot_str_to_cstring(INTERP, s); + const UINTVAL threshold = Parrot_str_byte_length(INTERP, s) * BITS_PER_CHAR; + + SET_ATTR_size(INTERP, SELF, size); + SET_ATTR_resize_threshold(INTERP, SELF, threshold); + SET_ATTR_bit_array(INTERP, SELF, bit_array); + } + } + +/* + +=back + +=head2 Methods + +=over 4 + +=item C + +Sets all of the entires to true if fill is a true value, otherwise +sets them all to false. + +=cut + +*/ + + METHOD fill(INTVAL fill) { + UINTVAL size; + unsigned char * bit_array; + size_t size_in_bytes; + + GET_ATTR_bit_array(INTERP, SELF, bit_array); + GET_ATTR_size(INTERP, SELF, size); + size_in_bytes = get_size_in_bytes(size); + + if (size_in_bytes) + memset(bit_array, fill ? 0xff : 0, size_in_bytes); + } +} + +/* + +=back + +=head1 SEE ALSO + +F. + +=cut + +*/ + +/* + * Local variables: + * c-file-style: "parrot" + * End: + * vim: expandtab shiftwidth=4: + */ From c998b1e57c9b6610c5c48cf5569d56a115023cce Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sun, 28 Nov 2010 21:45:15 -0500 Subject: [PATCH 023/102] To demonstrate all execution paths, encapsulate some code within Parrot::Headerizer::Object methods into subroutines, move the subs into Parrot::Headerizer::Functions and add tests for them. --- lib/Parrot/Headerizer/Functions.pm | 46 +++ lib/Parrot/Headerizer/Object.pm | 53 +-- t/tools/dev/headerizer/01_functions.t | 43 +- t/tools/dev/headerizer/02_methods.t | 66 ++- t/tools/dev/headerizer/testlib/nci_pmc.in | 474 ++++++++++++++++++++++ 5 files changed, 635 insertions(+), 47 deletions(-) create mode 100644 t/tools/dev/headerizer/testlib/nci_pmc.in diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index 615d1684cf..a4628adb67 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -5,12 +5,15 @@ package Parrot::Headerizer::Functions; use strict; use warnings; use base qw( Exporter ); +use Data::Dumper;$Data::Dumper::Indent=1; our @EXPORT_OK = qw( process_argv read_file write_file qualify_sourcefile asserts_from_args + shim_test + add_asserts_to_declarations ); =head1 NAME @@ -246,6 +249,49 @@ sub asserts_from_args { return (@asserts); } +# my @modified_args = shim_test($func, \@args); +sub shim_test { + my ($func, $argsref) = @_; +print STDERR Dumper [ $func, $argsref ]; + my @args = @{$argsref}; + for my $arg (@args) { + if ( $arg =~ m{SHIM\((.+)\)} ) { + $arg = $1; + if ( $func->{is_static} || ( $arg =~ /\*/ ) ) { + $arg = "SHIM($arg)"; + } + else { + $arg = "NULLOK($arg)"; + } + } + } + return @args; +} + +sub add_asserts_to_declarations { + my ($funcs_ref, $decls_ref) = @_; +#print STDERR Dumper $funcs_ref; + foreach my $func (@{ $funcs_ref }) { + my $assert = "#define ASSERT_ARGS_" . $func->{name}; + if(length($func->{name}) > 29) { + $assert .= " \\\n "; + } + $assert .= " __attribute__unused__ int _ASSERT_ARGS_CHECK = ("; + + my @asserts = asserts_from_args( @{ $func->{args} } ); + if(@asserts) { + $assert .= "\\\n "; + $assert .= join(" \\\n , ", @asserts); + } + else { + $assert .= "0"; + } + $assert .= ")"; + push(@{ $decls_ref }, $assert); + } + return @{ $decls_ref }; +} + 1; # Local Variables: diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index e1c27693d0..362f8d638d 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -34,6 +34,8 @@ use Parrot::Headerizer::Functions qw( write_file qualify_sourcefile asserts_from_args + shim_test + add_asserts_to_declarations ); =item C @@ -547,44 +549,37 @@ sub make_function_decls { foreach my $func (@funcs) { my $multiline = 0; - my $return = $func->{return_type}; my $alt_void = ' '; # Splint can't handle /*@alt void@*/ on pointers, although this page # http://www.mail-archive.com/lclint-interest@virginia.edu/msg00139.html # seems to say that we can. - if ( $func->{is_ignorable} && ($return !~ /\*/) ) { + if ( $func->{is_ignorable} && ($func->{return_type} !~ /\*/) ) { $alt_void = " /*\@alt void@*/\n"; } - my $decl = sprintf( "%s%s%s(", $return, $alt_void, $func->{name} ); + my $decl = sprintf( "%s%s%s(" => ( + $func->{return_type}, + $alt_void, + $func->{name} + ) ); $decl = "static $decl" if $func->{is_static}; my @args = @{ $func->{args} }; my @attrs = $self->attrs_from_args( $func, @args ); - for my $arg (@args) { - if ( $arg =~ m{SHIM\((.+)\)} ) { - $arg = $1; - if ( $func->{is_static} || ( $arg =~ /\*/ ) ) { - $arg = "SHIM($arg)"; - } - else { - $arg = "NULLOK($arg)"; - } - } - } + my @modified_args = shim_test($func, \@args); - my $argline = join( ", ", @args ); + my $argline = join( ", ", @modified_args ); if ( length( $decl . $argline ) <= 75 ) { $decl = "$decl$argline)"; } else { - if ( $args[0] =~ /^((SHIM|PARROT)_INTERP|Interp)\b/ ) { - $decl .= ( shift @args ); - $decl .= "," if @args; + if ( $modified_args[0] =~ /^((SHIM|PARROT)_INTERP|Interp)\b/ ) { + $decl .= ( shift @modified_args ); + $decl .= "," if @modified_args; } - $argline = join( ",", map { "\n\t$_" } @args ); + $argline = join( ",", map { "\n\t$_" } @modified_args ); $decl = "$decl$argline)"; $multiline = 1; } @@ -603,25 +598,7 @@ sub make_function_decls { push( @decls, $decl ); } - foreach my $func (@funcs) { - my @args = @{ $func->{args} }; - my @asserts = asserts_from_args( @args ); - - my $assert = "#define ASSERT_ARGS_" . $func->{name}; - if(length($func->{name}) > 29) { - $assert .= " \\\n "; - } - $assert .= " __attribute__unused__ int _ASSERT_ARGS_CHECK = ("; - if(@asserts) { - $assert .= "\\\n "; - $assert .= join(" \\\n , ", @asserts); - } - else { - $assert .= "0"; - } - $assert .= ")"; - push(@decls, $assert); - } + @decls = add_asserts_to_declarations( \@funcs, \@decls ); return @decls; } diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index 7f0c402d84..ff5dfb60cb 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -5,7 +5,7 @@ use strict; use warnings; -use Test::More tests => 38; +use Test::More qw(no_plan); # tests => 38; use Carp; use Cwd; use File::Copy; @@ -18,13 +18,16 @@ use Parrot::Headerizer::Functions qw( write_file qualify_sourcefile asserts_from_args + shim_test + add_asserts_to_declarations ); use IO::CaptureOutput qw| capture |; my $cwd = cwd(); - my @ofiles; + +# process_argv() eval { @ofiles = process_argv(); }; @@ -49,6 +52,7 @@ like($@, qr/No files specified/, @ofiles = qw( alpha.o beta.o gamma.o ); is(@ofiles, 3, "Got expected number of ofiles"); +# read_file; write_file { my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir; @@ -77,6 +81,7 @@ eval { }; like($@, qr/couldn't read '$filename'/, "Got expected error message for read_file()"); +# qualify_sourcefile() my ($ofile, $is_yacc); my ($sourcefile, $source_code, $hfile); $ofile = 'foobar.xyz'; @@ -220,6 +225,7 @@ like($@, qr/$ofile doesn't look like an object file/, is( $hfile, 'none', "As expected, no header file" ); } +# asserts_from_args() my (@args, %asserts); @args = ( 'SHIM_INTERP', @@ -257,6 +263,39 @@ ok( exists $asserts{'PARROT_ASSERT_ARG(item)'}, "Got expected assert" ); ok( exists $asserts{'PARROT_ASSERT_ARG(interp)'}, "Got expected assert" ); ok( exists $asserts{'PARROT_ASSERT_ARG(_abcDEF123)'}, "Got expected assert" ); +# my @modified_args = shim_test($func, \@args); + +# add_asserts_to_declarations() +my $funcs_ref = [ + { + 'macros' => [ + 'PARROT_EXPORT' + ], + 'return_type' => 'void', + 'is_api' => 1, + 'is_inline' => undef, + 'is_static' => undef, + 'args' => [ + 'SHIM_INTERP', + 'ARGMOD(Linked_List *list)', + 'ARGMOD(List_Item_Header *item)' + ], + 'name' => 'Parrot_list_append_and_append_and_append', + 'file' => 'src/list.c', + 'is_ignorable' => 0 + }, +]; +my $decls_ref = []; +my @decls = add_asserts_to_declarations($funcs_ref, $decls_ref); +my $expected = <<'EXP'; +#define ASSERT_ARGS_Parrot_list_append_and_append_and_append \ + __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(list) \ +EXP +$expected .= ' , PARROT_ASSERT_ARG(item))'; +is( $decls[0], $expected, + "Got expected declaration from add_asserts_to_declarations()" ); + pass("Completed all tests in $0"); ################### DOCUMENTATION ################### diff --git a/t/tools/dev/headerizer/02_methods.t b/t/tools/dev/headerizer/02_methods.t index 7130386539..7a1b3f5fd5 100644 --- a/t/tools/dev/headerizer/02_methods.t +++ b/t/tools/dev/headerizer/02_methods.t @@ -13,9 +13,11 @@ use File::Spec; use File::Temp qw( tempdir ); use Test::More qw(no_plan); # tests => 46; use lib qw( lib ); +use Parrot::Headerizer::Functions qw( read_file ); use Parrot::Headerizer::Object; use IO::CaptureOutput qw| capture |; +my $cwd = cwd(); my $self; eval { $self = Parrot::Headerizer::Object->new([]); }; like($@, qr/Argument to Parrot::Headerizer::Object must be hashref/, @@ -35,6 +37,7 @@ ok( @valid_macros, "Headerizer object contains list of valid macros" ); ok(! defined $self->{macro_match}, "macro_match undefined" ); +# print_final_message() my $msg = 'message'; $self->{message} = $msg; { @@ -59,6 +62,7 @@ $self->{message} = $msg; ok(! $stdout, "No final message"); } +# print_warnings() my $warnings = { 'file1' => { 'func_alpha' => [ @@ -101,6 +105,7 @@ $self->{warnings} = $warnings; "Got expected summary of headerizer warnings" ); } +# squawk() $self->{warnings} = {}; { my ($stdout, $stderr); @@ -130,7 +135,7 @@ $self->squawk($file, $func, $error[1]); } } -my $cwd = cwd(); +# skip files in src/ops/ { my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or croak "Unable to chdir during testing"; @@ -153,6 +158,7 @@ my $cwd = cwd(); chdir $cwd or croak "Unable to chdir back after testing"; } +# missing source file { my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or croak "Unable to chdir during testing"; @@ -176,20 +182,22 @@ my $cwd = cwd(); chdir $cwd or croak "Unable to chdir back after testing"; } +# regular .c source file { my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or croak "Unable to chdir during testing"; + my $stub = 'list'; my $srcdir = File::Spec->catpath( $tdir, 'src' ); mkpath( $srcdir, 0, 0777 ); - my $srco = File::Spec->catfile( $srcdir, 'list.o' ); + my $srco = File::Spec->catfile( $srcdir, "$stub.o" ); touchfile($srco); - my $srcc = File::Spec->catfile( $srcdir, 'list.c' ); + my $srcc = File::Spec->catfile( $srcdir, "$stub.c" ); copy "$cwd/t/tools/dev/headerizer/testlib/list.in" => $srcc or croak "Unable to copy"; my $incdir = File::Spec->catpath( $tdir, 'include', 'parrot' ); mkpath( $incdir, 0, 0777 ); - my $inch = File::Spec->catfile( $incdir, 'list.h' ); + my $inch = File::Spec->catfile( $incdir, "$stub.h" ); copy "$cwd/t/tools/dev/headerizer/testlib/list_h.in" => $inch or croak "Unable to copy"; @@ -217,20 +225,22 @@ my $cwd = cwd(); chdir $cwd or croak "Unable to chdir back after testing"; } +# macro_match command-line option { my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or croak "Unable to chdir during testing"; + my $stub = 'list'; my $srcdir = File::Spec->catpath( $tdir, 'src' ); mkpath( $srcdir, 0, 0777 ); - my $srco = File::Spec->catfile( $srcdir, 'list.o' ); + my $srco = File::Spec->catfile( $srcdir, "$stub.o" ); touchfile($srco); - my $srcc = File::Spec->catfile( $srcdir, 'list.c' ); + my $srcc = File::Spec->catfile( $srcdir, "$stub.c" ); copy "$cwd/t/tools/dev/headerizer/testlib/list.in" => $srcc or croak "Unable to copy"; my $incdir = File::Spec->catpath( $tdir, 'include', 'parrot' ); mkpath( $incdir, 0, 0777 ); - my $inch = File::Spec->catfile( $incdir, 'list.h' ); + my $inch = File::Spec->catfile( $incdir, "$stub.h" ); copy "$cwd/t/tools/dev/headerizer/testlib/list_h.in" => $inch or croak "Unable to copy"; @@ -270,6 +280,7 @@ my $cwd = cwd(); chdir $cwd or croak "Unable to chdir back after testing"; } +# .pmc source file; sourcefiles_with_statics { my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or croak "Unable to chdir during testing"; @@ -307,6 +318,47 @@ my $cwd = cwd(); chdir $cwd or croak "Unable to chdir back after testing"; } +# is_ignorable +{ + my $tdir = tempdir( CLEANUP => 1 ); + chdir $tdir or croak "Unable to chdir during testing"; + + my $stub = 'nci'; + my $srcdir = File::Spec->catpath( $tdir, 'src', 'pmc' ); + mkpath( $srcdir, 0, 0777 ); + my $srco = File::Spec->catfile( $srcdir, "$stub.o" ); + touchfile($srco); + my $srcc = File::Spec->catfile( $srcdir, "$stub.c" ); + copy "$cwd/t/tools/dev/headerizer/testlib/${stub}_pmc.in" => $srcc + or croak "Unable to copy"; + + $self = Parrot::Headerizer::Object->new(); + isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self->get_sources($srco); + ok( ! keys %{$self->{sourcefiles}}, + "no sourcefiles" ); + ok( keys %{$self->{sourcefiles_with_statics}}, + "sourcefiles_with_statics" ); + ok( ! keys %{$self->{api}}, + "no api" ); + + $self->process_sources(); + { + my ($stdout, $stderr); + capture( + sub { $self->print_final_message; }, + \$stdout, + \$stderr, + ); + like($stdout, qr/Headerization complete/, + "Got expected final message" ); + } + my $text = read_file($srcc); + like( $text, qr/alt void/, + "Got expected result for 'is_ignorable'" ); + chdir $cwd or croak "Unable to chdir back after testing"; +} + pass("Completed all tests in $0"); sub touchfile { diff --git a/t/tools/dev/headerizer/testlib/nci_pmc.in b/t/tools/dev/headerizer/testlib/nci_pmc.in new file mode 100644 index 0000000000..af42ce9d71 --- /dev/null +++ b/t/tools/dev/headerizer/testlib/nci_pmc.in @@ -0,0 +1,474 @@ +/* +Copyright (C) 2001-2010, Parrot Foundation. +$Id$ + +=head1 NAME + +src/pmc/nci.pmc - Native Call Interface + +=head1 DESCRIPTION + +The vtable functions for the native C call functions. + +=head2 Methods + +=over 4 + +=cut + +*/ + +/* HEADERIZER HFILE: none */ +/* HEADERIZER BEGIN: static */ +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ + +PARROT_IGNORABLE_RESULT +static nci_thunk_t /*@alt void@*/ +build_func(PARROT_INTERP, + ARGMOD(Parrot_NCI_attributes *nci_info)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + FUNC_MODIFIES(*nci_info); + +static void pcc_params(PARROT_INTERP, + ARGIN(STRING *sig), + ARGMOD(Parrot_NCI_attributes *nci_info), + size_t sig_length) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*nci_info); + +#define ASSERT_ARGS_build_func __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(nci_info)) +#define ASSERT_ARGS_pcc_params __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(sig) \ + , PARROT_ASSERT_ARG(nci_info)) +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ +/* HEADERIZER END: static */ + +/* + +=item C + +=cut + +*/ + +static void +pcc_params(PARROT_INTERP, ARGIN(STRING *sig), ARGMOD(Parrot_NCI_attributes *nci_info), + size_t sig_length) +{ + ASSERT_ARGS(pcc_params) + + /* NCI and PCC have a 1 to 1 mapping except an + extra char in PCC for invocant and slurpy */ + size_t buf_length = sig_length + 2 + 1; + + /* avoid malloc churn on common signatures */ + char static_buf[16]; + char * const sig_buf = sig_length <= sizeof static_buf ? + static_buf : + (char *)mem_sys_allocate(buf_length); + + size_t j = 0; + size_t i; + + for (i = 0; i < sig_length; ++i) { + const INTVAL c = STRING_ord(interp, sig, i); + + PARROT_ASSERT(j < buf_length - 1); + + switch (c) { + case (INTVAL)'0': /* null ptr or such - doesn't consume a reg */ + break; + case (INTVAL)'f': + case (INTVAL)'N': + case (INTVAL)'d': + sig_buf[j++] = 'N'; + break; + case (INTVAL)'I': /* INTVAL */ + case (INTVAL)'l': /* long */ + case (INTVAL)'i': /* int */ + case (INTVAL)'s': /* short */ + case (INTVAL)'c': /* char */ + sig_buf[j++] = 'I'; + break; + case (INTVAL)'S': + case (INTVAL)'t': /* string, pass a cstring */ + sig_buf[j++] = 'S'; + break; + case (INTVAL)'J': /* interpreter */ + break; + case (INTVAL)'p': /* push pmc->data */ + case (INTVAL)'P': /* push PMC * */ + case (INTVAL)'V': /* push PMC * */ + case (INTVAL)'2': + case (INTVAL)'3': + case (INTVAL)'4': + sig_buf[j++] = 'P'; + break; + case (INTVAL)'v': + /* null return */ + if (j == 0) + sig_buf[j++] = '\0'; + break; + case (INTVAL)'O': /* push PMC * invocant */ + sig_buf[j++] = 'P'; + sig_buf[j++] = 'i'; + break; + case (INTVAL)'@': /* push PMC * slurpy */ + sig_buf[j++] = 'P'; + sig_buf[j++] = 's'; + break; + case (INTVAL)'b': /* buffer (void*) pass Buffer_bufstart(SReg) */ + case (INTVAL)'B': /* buffer (void**) pass &Buffer_bufstart(SReg) */ + sig_buf[j++] = 'S'; + break; + default: + Parrot_ex_throw_from_c_args(interp, NULL, + EXCEPTION_JIT_ERROR, + "Unknown param Signature %c\n", (char)c); + break; + } + } + + PARROT_ASSERT(j < buf_length); + sig_buf[j++] = '\0'; + + + nci_info->pcc_return_signature = + Parrot_str_new(interp, sig_buf, 1); + + nci_info->pcc_params_signature = j > 1 ? + Parrot_str_new(interp, sig_buf + 1, j - 1) : + CONST_STRING(interp, ""); + + if (sig_buf != static_buf) + mem_sys_free(sig_buf); +} + +/* + +=item C + +Actually build the NCI thunk. + +=cut + +*/ + +PARROT_IGNORABLE_RESULT +static nci_thunk_t +build_func(PARROT_INTERP, ARGMOD(Parrot_NCI_attributes *nci_info)) +{ + ASSERT_ARGS(build_func) + + STRING * const key = nci_info->signature; + const size_t key_length = Parrot_str_byte_length(interp, key); + + pcc_params(interp, key, nci_info, key_length); + + /* Arity is length of that string minus one (the return type). */ + nci_info->arity = key_length - 1; + + /* Build call function. */ + nci_info->fb_info = build_call_func(interp, key); + nci_info->func = F2DPTR(VTABLE_get_pointer(interp, nci_info->fb_info)); + + return (nci_thunk_t)nci_info->func; +} + + +pmclass NCI auto_attrs provides invokable { + /* NCI thunk handling attributes */ + /* NCI thunk handling attributes */ + ATTR STRING *signature; /* The signature. */ + ATTR void *func; /* Function pointer to call. */ + ATTR PMC *fb_info; /* Frame-builder info */ + ATTR void *orig_func; /* Function pointer + * used to create func */ + /* Parrot Sub-ish attributes */ + ATTR STRING *pcc_params_signature; + ATTR STRING *pcc_return_signature; + ATTR INTVAL arity; /* Cached arity of the NCI. */ + + /* MMD fields */ + ATTR STRING *long_signature; /* The full signature. */ + ATTR PMC *multi_sig; /* type tuple array (?) */ + +/* + +=item C + +Return the MMD signature PMC, if any or a Null PMC. + +=cut + +*/ + + METHOD get_multisig() { + PMC *sig; + GET_ATTR_multi_sig(INTERP, SELF, sig); + if (PMC_IS_NULL(sig)) + sig = PMCNULL; + RETURN(PMC *sig); + } + +/* + +=item C + +Initializes the NCI with a C function pointer. + +=cut + +*/ + + VTABLE void init() { + PObj_custom_mark_SET(SELF); + } + + VTABLE void *get_pointer() { + return PARROT_NCI(SELF)->orig_func; + } + +/* + +=item C + +Sets the specified function pointer and signature (C<*key>). + +=cut + +*/ + + VTABLE void set_pointer_keyed_str(STRING *key, void *func) { + Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); + + /* Store the original function and signature. */ + SET_ATTR_orig_func(INTERP, SELF, func); + + /* ensure that the STRING signature is constant */ + if (!PObj_constant_TEST(key)) { + char * const key_c = Parrot_str_to_cstring(INTERP, key); + const size_t key_length = Parrot_str_byte_length(interp, key); + key = Parrot_str_new_init(interp, key_c, key_length, + Parrot_default_encoding_ptr, PObj_constant_FLAG); + Parrot_str_free_cstring(key_c); + } + + nci_info->signature = key; + } + +/* + +=item C + +Mark any referenced strings and PMCs. + +=cut + +*/ + VTABLE void mark() { + if (PARROT_NCI(SELF)) { + Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); + + Parrot_gc_mark_PMC_alive(interp, nci_info->fb_info); + Parrot_gc_mark_PMC_alive(interp, nci_info->multi_sig); + + Parrot_gc_mark_STRING_alive(interp, nci_info->signature); + Parrot_gc_mark_STRING_alive(interp, nci_info->long_signature); + Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_params_signature); + Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_return_signature); + } + } + +/* + +=item C + +Creates and returns a clone of the NCI. + +=cut + +*/ + + VTABLE PMC *clone() { + Parrot_NCI_attributes * const nci_info_self = PARROT_NCI(SELF); + Parrot_NCI_attributes *nci_info_ret; + void *orig_func; + + PMC * const ret = Parrot_pmc_new(INTERP, SELF->vtable->base_type); + nci_info_ret = PARROT_NCI(ret); + + /* FIXME if data is malloced (JIT/i386!) then we need + * the length of data here, to memcpy it + * ManagedStruct or Buffer? + */ + nci_info_ret->func = nci_info_self->func; + nci_info_ret->fb_info = nci_info_self->fb_info; + nci_info_ret->orig_func = nci_info_self->orig_func; + nci_info_ret->signature = nci_info_self->signature; + nci_info_ret->pcc_params_signature = nci_info_self->pcc_params_signature; + nci_info_ret->pcc_return_signature = nci_info_self->pcc_params_signature; + nci_info_ret->arity = nci_info_self->arity; + PObj_get_FLAGS(ret) = PObj_get_FLAGS(SELF); + + return ret; + } + +/* + +=item C + +Returns whether the NCI is defined. + +=cut + +*/ + + VTABLE INTVAL defined() { + Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); + return nci_info->orig_func != NULL; + } + +/* + +=item C + +Calls the associated C function, returning C<*next>. If the invocant is a +class, the PMC arguments are shifted down. + +=cut + +*/ + + VTABLE opcode_t *invoke(void *next) { + Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); + nci_thunk_t func; + PMC *fb_info; + char *sig_str; + void *orig_func; + PMC *cont; + + GET_ATTR_orig_func(INTERP, SELF, orig_func); + func = (nci_thunk_t)D2FPTR(nci_info->func); + + GET_ATTR_fb_info(INTERP, SELF, fb_info); + + if (!func) { + /* build the thunk only when necessary */ + func = build_func(interp, nci_info); + + if (!func) + Parrot_ex_throw_from_c_args(INTERP, NULL, + EXCEPTION_INVALID_OPERATION, + "attempt to call NULL function"); + } + + func(INTERP, SELF, fb_info); + cont = INTERP->current_cont; + + /* + * If the NCI function was tailcalled, the return result + * is already passed back to the caller of this frame + * - see Parrot_init_ret_nci(). We therefore invoke the + * return continuation here, which gets rid of this frame + * and returns the real return address + */ + if (cont && cont != NEED_CONTINUATION + && (PObj_get_FLAGS(cont) & SUB_FLAG_TAILCALL)) { + cont = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp)); + next = VTABLE_invoke(INTERP, cont, next); + } + + return (opcode_t *)next; + } + +/* + +=item C + +Returns the function pointer as an integer. + +=cut + +*/ + + VTABLE INTVAL get_integer() { + Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); + if (!nci_info->func) + build_func(INTERP, nci_info); + return (INTVAL)nci_info->func; + } + +/* + +=item C + +Returns the boolean value of the pointer. + +=cut + +*/ + + VTABLE INTVAL get_bool() { + Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); + return (0 != (INTVAL)nci_info->orig_func); + } + +/* + +=item C + +Return the arity of the NCI (the number of arguments). + +=cut + +*/ + METHOD arity() { + Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); + INTVAL arity = 0; + + if (nci_info) { + if (!nci_info->func) + build_func(INTERP, nci_info); + if (nci_info->func) { + arity = nci_info->arity; + RETURN(INTVAL arity); + } + } + + Parrot_ex_throw_from_c_args(INTERP, NULL, + EXCEPTION_INVALID_OPERATION, + "You cannot get the arity of an undefined NCI."); + } +} + +/* + +=back + +=head1 SEE ALSO + +F. + +=head1 HISTORY + +Initial revision by sean 2002/08/04. + +=cut + +*/ + +/* + * Local variables: + * c-file-style: "parrot" + * End: + * vim: expandtab shiftwidth=4: + */ From 2aa5bc9f14814720a66d8aadb27b1015a983b95a Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sun, 28 Nov 2010 22:04:21 -0500 Subject: [PATCH 024/102] Add tests for Parrot::Headerizer::Functions::shim_test(). --- lib/Parrot/Headerizer/Functions.pm | 1 - t/tools/dev/headerizer/01_functions.t | 100 +++++++++++++++++++++++++- 2 files changed, 97 insertions(+), 4 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index a4628adb67..614d5f6da8 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -252,7 +252,6 @@ sub asserts_from_args { # my @modified_args = shim_test($func, \@args); sub shim_test { my ($func, $argsref) = @_; -print STDERR Dumper [ $func, $argsref ]; my @args = @{$argsref}; for my $arg (@args) { if ( $arg =~ m{SHIM\((.+)\)} ) { diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index ff5dfb60cb..3d93314d64 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -263,10 +263,104 @@ ok( exists $asserts{'PARROT_ASSERT_ARG(item)'}, "Got expected assert" ); ok( exists $asserts{'PARROT_ASSERT_ARG(interp)'}, "Got expected assert" ); ok( exists $asserts{'PARROT_ASSERT_ARG(_abcDEF123)'}, "Got expected assert" ); -# my @modified_args = shim_test($func, \@args); +my ($var, $args_ref, $funcs_ref, $expected); +my @modified_args; +# shim_test +$var = 'something'; +$args_ref = [ + "SHIM($var)", + 'ARGIN(STRING *sig)', +]; +$funcs_ref = { + 'macros' => [], + 'return_type' => 'void', + 'is_api' => undef, + 'is_inline' => undef, + 'is_static' => 'static', + 'args' => $args_ref, + 'name' => 'pcc_params', + 'file' => 'src/pmc/nci.c', + 'is_ignorable' => 0 +}; +$expected = [ + "SHIM($var)", + $args_ref->[1], +]; +@modified_args = shim_test($funcs_ref, $args_ref); +is_deeply( [ @modified_args ], $expected, + "Got expected args back from shim_test()" ); + +$var = 'something *else'; +$args_ref = [ + "SHIM($var)", + 'ARGIN(STRING *sig)', +]; +$funcs_ref = { + 'macros' => [], + 'return_type' => 'void', + 'is_api' => undef, + 'is_inline' => undef, + 'is_static' => undef, + 'args' => $args_ref, + 'name' => 'pcc_params', + 'file' => 'src/pmc/nci.c', + 'is_ignorable' => 0 +}; +$expected = [ + "SHIM($var)", + $args_ref->[1], +]; +@modified_args = shim_test($funcs_ref, $args_ref); +is_deeply( [ @modified_args ], $expected, + "Got expected args back from shim_test()" ); + +$var = 'something'; +$args_ref = [ + "SHIM($var)", + 'ARGIN(STRING *sig)', +]; +$funcs_ref = { + 'macros' => [], + 'return_type' => 'void', + 'is_api' => undef, + 'is_inline' => undef, + 'is_static' => undef, + 'args' => $args_ref, + 'name' => 'pcc_params', + 'file' => 'src/pmc/nci.c', + 'is_ignorable' => 0 +}; +$expected = [ + "NULLOK($var)", + $args_ref->[1], +]; +@modified_args = shim_test($funcs_ref, $args_ref); +is_deeply( [ @modified_args ], $expected, + "Got expected args back from shim_test()" ); + +$var = 'something'; +$args_ref = [ + "SHAM($var)", + 'ARGIN(STRING *sig)', +]; +$funcs_ref = { + 'macros' => [], + 'return_type' => 'void', + 'is_api' => undef, + 'is_inline' => undef, + 'is_static' => undef, + 'args' => $args_ref, + 'name' => 'pcc_params', + 'file' => 'src/pmc/nci.c', + 'is_ignorable' => 0 +}; +$expected = $args_ref; +@modified_args = shim_test($funcs_ref, $args_ref); +is_deeply( [ @modified_args ], $expected, + "Got expected args back from shim_test()" ); # add_asserts_to_declarations() -my $funcs_ref = [ +$funcs_ref = [ { 'macros' => [ 'PARROT_EXPORT' @@ -287,7 +381,7 @@ my $funcs_ref = [ ]; my $decls_ref = []; my @decls = add_asserts_to_declarations($funcs_ref, $decls_ref); -my $expected = <<'EXP'; +$expected = <<'EXP'; #define ASSERT_ARGS_Parrot_list_append_and_append_and_append \ __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(list) \ From df600839226d5dc422ea2b120544ed13147ca6dc Mon Sep 17 00:00:00 2001 From: jkeenan Date: Mon, 29 Nov 2010 22:35:24 -0500 Subject: [PATCH 025/102] Refactor some code from within Parrot::Headerizer::Object::replace_headerized_declarations() into Parrot::Headerizer::Functions::add_headerizer_markers(). Code itself is working, but not correctly tested yet in 01_functions.t --- lib/Parrot/Headerizer/Functions.pm | 28 +++++++++ lib/Parrot/Headerizer/Object.pm | 34 ++++++---- t/tools/dev/headerizer/01_functions.t | 51 +++++++++++++++ .../dev/headerizer/testlib/function_decls.in | 62 +++++++++++++++++++ 4 files changed, 164 insertions(+), 11 deletions(-) create mode 100644 t/tools/dev/headerizer/testlib/function_decls.in diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index 614d5f6da8..d9fa7d2b34 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -14,6 +14,7 @@ our @EXPORT_OK = qw( asserts_from_args shim_test add_asserts_to_declarations + add_headerizer_markers ); =head1 NAME @@ -291,6 +292,33 @@ sub add_asserts_to_declarations { return @{ $decls_ref }; } +=pod + + return add_headerizer_markers( { + function_decls => \@function_decls, + sourcefile => $sourcefile, + hfile => $hfile, + code => $source_code, + } ); + +=cut + +sub add_headerizer_markers { + my $args = shift; + + my $function_decls = join( "\n" => @{ $args->{function_decls} }); + my $STARTMARKER = qr{/\* HEADERIZER BEGIN: $args->{sourcefile} \*/\n}; + my $ENDMARKER = qr{/\* HEADERIZER END: $args->{sourcefile} \*/\n?}; + my $DO_NOT_TOUCH = q{/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */}; + + $args->{code} =~ + s{($STARTMARKER)(?:.*?)($ENDMARKER)} + {$1$DO_NOT_TOUCH\n\n$function_decls\n$DO_NOT_TOUCH\n$2}s + or die "Need begin/end HEADERIZER markers for $args->{sourcefile} in $args->{hfile}\n"; + + return $args->{code}; +} + 1; # Local Variables: diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 362f8d638d..ddc8e4d50e 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -26,6 +26,7 @@ of C-language files. use strict; use warnings; +use Data::Dumper;$Data::Dumper::Indent=1; use Scalar::Util qw( reftype ); use lib qw( lib ); use Parrot::Config; @@ -36,6 +37,7 @@ use Parrot::Headerizer::Functions qw( asserts_from_args shim_test add_asserts_to_declarations + add_headerizer_markers ); =item C @@ -528,19 +530,29 @@ sub replace_headerized_declarations { } @funcs; my @function_decls = $self->make_function_decls(@funcs); - my $function_decls = join( "\n", @function_decls ); - my $STARTMARKER = qr{/\* HEADERIZER BEGIN: $sourcefile \*/\n}; - my $ENDMARKER = qr{/\* HEADERIZER END: $sourcefile \*/\n?}; - my $DO_NOT_TOUCH = q{/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */}; - - $source_code =~ - s{($STARTMARKER)(?:.*?)($ENDMARKER)} - {$1$DO_NOT_TOUCH\n\n$function_decls\n$DO_NOT_TOUCH\n$2}s - or die "Need begin/end HEADERIZER markers for $sourcefile in $hfile\n"; - - return $source_code; +# my $function_decls = join( "\n", @function_decls ); +# my $STARTMARKER = qr{/\* HEADERIZER BEGIN: $sourcefile \*/\n}; +# my $ENDMARKER = qr{/\* HEADERIZER END: $sourcefile \*/\n?}; +# my $DO_NOT_TOUCH = q{/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */}; +# +# $source_code =~ +# s{($STARTMARKER)(?:.*?)($ENDMARKER)} +# {$1$DO_NOT_TOUCH\n\n$function_decls\n$DO_NOT_TOUCH\n$2}s +# or die "Need begin/end HEADERIZER markers for $sourcefile in $hfile\n"; +# +# return $source_code; + + my $markers_args = { + function_decls => \@function_decls, + sourcefile => $sourcefile, + hfile => $hfile, + code => $source_code, + }; +#print STDERR Dumper $markers_args; + return add_headerizer_markers( $markers_args ); } + sub make_function_decls { my $self = shift; my @funcs = @_; diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index 3d93314d64..e125c53c72 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -9,6 +9,8 @@ use Test::More qw(no_plan); # tests => 38; use Carp; use Cwd; use File::Copy; +use File::Path qw( mkpath ); +use File::Spec; use File::Temp qw( tempdir ); use lib qw( lib ); use Parrot::Config; @@ -20,6 +22,7 @@ use Parrot::Headerizer::Functions qw( asserts_from_args shim_test add_asserts_to_declarations + add_headerizer_markers ); use IO::CaptureOutput qw| capture |; @@ -390,8 +393,56 @@ $expected .= ' , PARROT_ASSERT_ARG(item))'; is( $decls[0], $expected, "Got expected declaration from add_asserts_to_declarations()" ); +# add_headerizer_markers +#{ +# my $tdir = tempdir( CLEANUP => 1 ); +# chdir $tdir or croak "Unable to chdir during testing"; +# +# my $stub = 'list'; +# my $srcdir = File::Spec->catpath( $tdir, 'src' ); +# mkpath( $srcdir, 0, 0777 ); +# my $srco = File::Spec->catfile( $srcdir, "$stub.o" ); +# touchfile($srco); +# my $srcc = File::Spec->catfile( $srcdir, "$stub.c" ); +# copy "$cwd/t/tools/dev/headerizer/testlib/list.in" => $srcc +# or croak "Unable to copy"; +# my $incdir = File::Spec->catpath( $tdir, 'include', 'parrot' ); +# mkpath( $incdir, 0, 0777 ); +# my $inch = File::Spec->catfile( $incdir, "$stub.h" ); +# copy "$cwd/t/tools/dev/headerizer/testlib/list_h.in" => $inch +# or croak "Unable to copy"; +# +# my $source_code = read_file($srcc); +# my $function_decls_file = "$tdir/function_decls"; +# copy "$cwd/t/tools/dev/headerizer/testlib/function_decls.in" => +# $function_decls_file or croak "Unable to copy"; +# my $intext = read_file($function_decls_file); +# my @function_decls; +# ( @function_decls ) = $intext =~ m/'([^,][^']*?)'/gs; +# +# TEST IS NOT SET UP PROPERLY YET. +# +# my $headerized_source = add_headerizer_markers( { +# function_decls => \@function_decls, +# sourcefile => $srcc, +# hfile => $inch, +# code => $source_code, +# } ); +#print STDERR $headerized_source; +# +# chdir $cwd or croak "Unable to chdir back after testing"; +#} + pass("Completed all tests in $0"); +sub touchfile { + my $filename = shift; + open my $IN, '>', $filename or croak "Unable to open for writing"; + print $IN "\n"; + close $IN or croak "Unable to close after writing"; + return 1; +} + ################### DOCUMENTATION ################### =head1 NAME diff --git a/t/tools/dev/headerizer/testlib/function_decls.in b/t/tools/dev/headerizer/testlib/function_decls.in new file mode 100644 index 0000000000..9a31d9777e --- /dev/null +++ b/t/tools/dev/headerizer/testlib/function_decls.in @@ -0,0 +1,62 @@ +'PARROT_EXPORT +void Parrot_list_append(SHIM_INTERP, + ARGMOD(Linked_List *list), + ARGMOD(List_Item_Header *item)) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*list) + FUNC_MODIFIES(*item); +', + 'PARROT_EXPORT +INTVAL Parrot_list_check(SHIM_INTERP, ARGIN(Linked_List *list)) + __attribute__nonnull__(2); +', + 'PARROT_EXPORT +INTVAL Parrot_list_contains(SHIM_INTERP, + ARGIN(Linked_List *list), + ARGIN(List_Item_Header *item)) + __attribute__nonnull__(2) + __attribute__nonnull__(3); +', + 'PARROT_EXPORT +void Parrot_list_destroy(SHIM_INTERP, ARGMOD(Linked_List* list)) + __attribute__nonnull__(2) + FUNC_MODIFIES(* list); +', + 'PARROT_EXPORT +PARROT_CANNOT_RETURN_NULL +struct Linked_List* Parrot_list_new(SHIM_INTERP); +', + 'PARROT_EXPORT +PARROT_CAN_RETURN_NULL +List_Item_Header* Parrot_list_pop(PARROT_INTERP, ARGIN(Linked_List *list)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); +', + 'PARROT_EXPORT +PARROT_CAN_RETURN_NULL +List_Item_Header* Parrot_list_remove(SHIM_INTERP, + ARGMOD(Linked_List *list), + ARGMOD(List_Item_Header *item)) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*list) + FUNC_MODIFIES(*item); +', + '#define ASSERT_ARGS_Parrot_list_append __attribute__unused__ int _ASSERT_ARGS_CHECK = (\\ + PARROT_ASSERT_ARG(list) \\ + , PARROT_ASSERT_ARG(item))', + '#define ASSERT_ARGS_Parrot_list_check __attribute__unused__ int _ASSERT_ARGS_CHECK = (\\ + PARROT_ASSERT_ARG(list))', + '#define ASSERT_ARGS_Parrot_list_contains __attribute__unused__ int _ASSERT_ARGS_CHECK = (\\ + PARROT_ASSERT_ARG(list) \\ + , PARROT_ASSERT_ARG(item))', + '#define ASSERT_ARGS_Parrot_list_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\\ + PARROT_ASSERT_ARG(list))', + '#define ASSERT_ARGS_Parrot_list_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)', + '#define ASSERT_ARGS_Parrot_list_pop __attribute__unused__ int _ASSERT_ARGS_CHECK = (\\ + PARROT_ASSERT_ARG(interp) \\ + , PARROT_ASSERT_ARG(list))', + '#define ASSERT_ARGS_Parrot_list_remove __attribute__unused__ int _ASSERT_ARGS_CHECK = (\\ + PARROT_ASSERT_ARG(list) \\ + , PARROT_ASSERT_ARG(item))' From 6cc3b2ced92047d4b2bc51ba014328bcdb70c412 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Mon, 29 Nov 2010 22:38:52 -0500 Subject: [PATCH 026/102] Delete commented-out code. --- lib/Parrot/Headerizer/Functions.pm | 1 - lib/Parrot/Headerizer/Object.pm | 14 +------------- 2 files changed, 1 insertion(+), 14 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index d9fa7d2b34..1fab81b25d 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -270,7 +270,6 @@ sub shim_test { sub add_asserts_to_declarations { my ($funcs_ref, $decls_ref) = @_; -#print STDERR Dumper $funcs_ref; foreach my $func (@{ $funcs_ref }) { my $assert = "#define ASSERT_ARGS_" . $func->{name}; if(length($func->{name}) > 29) { diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index ddc8e4d50e..81477cd4ff 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -530,25 +530,13 @@ sub replace_headerized_declarations { } @funcs; my @function_decls = $self->make_function_decls(@funcs); -# my $function_decls = join( "\n", @function_decls ); -# my $STARTMARKER = qr{/\* HEADERIZER BEGIN: $sourcefile \*/\n}; -# my $ENDMARKER = qr{/\* HEADERIZER END: $sourcefile \*/\n?}; -# my $DO_NOT_TOUCH = q{/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */}; -# -# $source_code =~ -# s{($STARTMARKER)(?:.*?)($ENDMARKER)} -# {$1$DO_NOT_TOUCH\n\n$function_decls\n$DO_NOT_TOUCH\n$2}s -# or die "Need begin/end HEADERIZER markers for $sourcefile in $hfile\n"; -# -# return $source_code; - my $markers_args = { function_decls => \@function_decls, sourcefile => $sourcefile, hfile => $hfile, code => $source_code, }; -#print STDERR Dumper $markers_args; + return add_headerizer_markers( $markers_args ); } From 5195fb148d2cc7c5193c88260b179dceed3a58bc Mon Sep 17 00:00:00 2001 From: jkeenan Date: Tue, 30 Nov 2010 22:21:03 -0500 Subject: [PATCH 027/102] Refactor some code from Parrot::Headerizer::make_function_decls() into Parrot::Headerizer::Functions::handle_modified_args(). Test the new function in 01_functions.t. --- lib/Parrot/Headerizer/Functions.pm | 21 ++++++++++ lib/Parrot/Headerizer/Object.pm | 20 +++------- t/tools/dev/headerizer/01_functions.t | 55 +++++++++++++++++++++++++++ 3 files changed, 81 insertions(+), 15 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index 1fab81b25d..418f52a190 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -13,6 +13,7 @@ our @EXPORT_OK = qw( qualify_sourcefile asserts_from_args shim_test + handle_modified_args add_asserts_to_declarations add_headerizer_markers ); @@ -268,6 +269,26 @@ sub shim_test { return @args; } +sub handle_modified_args { + my ($decl, $modified_args_ref) = @_; + my @modified_args = @{ $modified_args_ref }; + my $multiline = 0; + my $argline = join( ", ", @modified_args ); + if ( length( $decl . $argline ) <= 75 ) { + $decl = "$decl$argline)"; + } + else { + if ( $modified_args[0] =~ /^(?:(?:SHIM|PARROT)_INTERP|Interp)\b/ ) { + $decl .= ( shift @modified_args ); + $decl .= "," if @modified_args; + } + $argline = join( ",", map { "\n\t$_" } @modified_args ); + $decl = "$decl$argline)"; + $multiline = 1; + } + return ($decl, $multiline); +} + sub add_asserts_to_declarations { my ($funcs_ref, $decls_ref) = @_; foreach my $func (@{ $funcs_ref }) { diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 81477cd4ff..6bd635c520 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -36,6 +36,7 @@ use Parrot::Headerizer::Functions qw( qualify_sourcefile asserts_from_args shim_test + handle_modified_args add_asserts_to_declarations add_headerizer_markers ); @@ -547,8 +548,6 @@ sub make_function_decls { my @decls; foreach my $func (@funcs) { - my $multiline = 0; - my $alt_void = ' '; # Splint can't handle /*@alt void@*/ on pointers, although this page @@ -570,19 +569,9 @@ sub make_function_decls { my @modified_args = shim_test($func, \@args); - my $argline = join( ", ", @modified_args ); - if ( length( $decl . $argline ) <= 75 ) { - $decl = "$decl$argline)"; - } - else { - if ( $modified_args[0] =~ /^((SHIM|PARROT)_INTERP|Interp)\b/ ) { - $decl .= ( shift @modified_args ); - $decl .= "," if @modified_args; - } - $argline = join( ",", map { "\n\t$_" } @modified_args ); - $decl = "$decl$argline)"; - $multiline = 1; - } + my $multiline; + ($decl, $multiline) = handle_modified_args( + $decl, \@modified_args); my $attrs = join( "", map { "\n\t\t$_" } @attrs ); if ($attrs) { @@ -689,6 +678,7 @@ sub print_warnings { } } + =back =cut diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index e125c53c72..56f7d1a796 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -21,6 +21,7 @@ use Parrot::Headerizer::Functions qw( qualify_sourcefile asserts_from_args shim_test + handle_modified_args add_asserts_to_declarations add_headerizer_markers ); @@ -362,6 +363,60 @@ $expected = $args_ref; is_deeply( [ @modified_args ], $expected, "Got expected args back from shim_test()" ); +# handle_modified_args() +my ($decl_in, $decl_out, $multiline); + +$decl_in = 'void Parrot_list_append('; +@modified_args = qw( alpha beta gamma ); +($decl_out, $multiline) = handle_modified_args( + $decl_in, \@modified_args); +is( $decl_out, $decl_in . 'alpha, beta, gamma)', + "Got expected portion of declaration (short)" ); +ok( ! $multiline, "Short portion of declaration means no multiline" ); + +$decl_in = 'void Parrot_list_append('; +@modified_args = ( + 'FOOBAR EXTRAORDINARY', + 'ARGMOD(Linked_List *list)', + 'ARGMOD(List_Item_Header *item)', +); +$expected = $decl_in . + "\n\t$modified_args[0]" . ',' . + "\n\t$modified_args[1]" . ',' . + "\n\t$modified_args[2]" . ')'; +($decl_out, $multiline) = handle_modified_args( + $decl_in, \@modified_args); +is( $decl_out, $expected, + "Got expected portion of declaration (long)" ); +ok( $multiline, "Long portion of declaration means multiline" ); + +$decl_in = 'void Parrot_list_append('; +@modified_args = ( + 'SHIM_INTERP', + 'ARGMOD(Linked_List *list)', + 'ARGMOD(List_Item_Header *item)', +); +$expected = $decl_in . + $modified_args[0] . ',' . + "\n\t$modified_args[1]" . ',' . + "\n\t$modified_args[2]" . ')'; +($decl_out, $multiline) = handle_modified_args( + $decl_in, \@modified_args); +is( $decl_out, $expected, + "Got expected portion of declaration (long SHIM)" ); +ok( $multiline, "Long portion of declaration means multiline" ); + +$decl_in = 'void Parrot_list_append('; +@modified_args = ( + 'SHIM_INTERP INCURABLY_EXTREMELY_EXTRAORDINARILY_ARGMOD(Linked_List *list)', +); +$expected = "$decl_in$modified_args[0])"; +($decl_out, $multiline) = handle_modified_args( + $decl_in, \@modified_args); +is( $decl_out, $expected, + "Got expected portion of declaration (long SHIM one arg)" ); +ok( $multiline, "Long portion of declaration means multiline" ); + # add_asserts_to_declarations() $funcs_ref = [ { From dd3c6c9290b9302f89bb52e171c48b255dec35b3 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Wed, 1 Dec 2010 22:08:11 -0500 Subject: [PATCH 028/102] Refactor more code into testable subroutines, place them into Functions.pm, test them in 01_functions.t. --- lib/Parrot/Headerizer/Functions.pm | 30 ++++++++++++++ lib/Parrot/Headerizer/Object.pm | 15 ++----- t/tools/dev/headerizer/01_functions.t | 60 +++++++++++++++++++++++++++ 3 files changed, 94 insertions(+), 11 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index 418f52a190..995b33c261 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -15,6 +15,8 @@ our @EXPORT_OK = qw( shim_test handle_modified_args add_asserts_to_declarations + add_newline_if_multiline + func_modifies add_headerizer_markers ); @@ -289,6 +291,13 @@ sub handle_modified_args { return ($decl, $multiline); } +# $decl .= $multiline ? ";\n" : ";"; +sub add_newline_if_multiline { + my ($decl, $multiline) = @_; + $decl .= $multiline ? ";\n" : ";"; + return $decl; +} + sub add_asserts_to_declarations { my ($funcs_ref, $decls_ref) = @_; foreach my $func (@{ $funcs_ref }) { @@ -312,6 +321,27 @@ sub add_asserts_to_declarations { return @{ $decls_ref }; } +=pod + + @mods = func_modifies($arg, \@mods); + +=cut + +sub func_modifies { + my ($arg, $modsref) = @_; + my @mods = @{$modsref}; + if ( $arg =~ m{ARG(?:MOD|OUT)(?:_NULLOK)?\((.+?)\)} ) { + my $modified = $1; + if ( $modified =~ s/.*\*/*/ ) { + # We're OK + } + else { + $modified =~ s/.* (\w+)$/$1/ or die qq{Unable to figure out the modified parm out of "$modified"}; + } + push( @mods, "FUNC_MODIFIES($modified)" ); + } + return @mods; +} =pod return add_headerizer_markers( { diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 6bd635c520..9ec803b92c 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -37,7 +37,9 @@ use Parrot::Headerizer::Functions qw( asserts_from_args shim_test handle_modified_args + add_newline_if_multiline add_asserts_to_declarations + func_modifies add_headerizer_markers ); @@ -581,7 +583,7 @@ sub make_function_decls { my @macros = @{ $func->{macros} }; $multiline = 1 if @macros; - $decl .= $multiline ? ";\n" : ";"; + $decl = add_newline_if_multiline($decl, $multiline); $decl = join( "\n", @macros, $decl ); $decl =~ s/\t/ /g; push( @decls, $decl ); @@ -605,16 +607,7 @@ sub attrs_from_args { my $n = 0; for my $arg (@args) { ++$n; - if ( $arg =~ m{ARG(?:MOD|OUT)(?:_NULLOK)?\((.+?)\)} ) { - my $modified = $1; - if ( $modified =~ s/.*\*/*/ ) { - # We're OK - } - else { - $modified =~ s/.* (\w+)$/$1/ or die qq{Unable to figure out the modified parm out of "$modified"}; - } - push( @mods, "FUNC_MODIFIES($modified)" ); - } + @mods = func_modifies($arg, \@mods); if ( $arg =~ m{(ARGIN|ARGOUT|ARGMOD|ARGFREE_NOTNULL|NOTNULL)\(} || $arg eq 'PARROT_INTERP' ) { push( @attrs, "__attribute__nonnull__($n)" ); } diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index 56f7d1a796..c7d2da1913 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -22,7 +22,9 @@ use Parrot::Headerizer::Functions qw( asserts_from_args shim_test handle_modified_args + add_newline_if_multiline add_asserts_to_declarations + func_modifies add_headerizer_markers ); @@ -417,6 +419,20 @@ is( $decl_out, $expected, "Got expected portion of declaration (long SHIM one arg)" ); ok( $multiline, "Long portion of declaration means multiline" ); +# add_newline_if_multiline() +$decl_in = 'alpha'; +$multiline = 1; +$decl_out = add_newline_if_multiline($decl_in, $multiline); +is( $decl_out, "alpha;\n", + "Got expected value from add_newline_if_multiline()" ); + +$decl_in = 'alpha'; +$multiline = 0; +$decl_out = add_newline_if_multiline($decl_in, $multiline); +is( $decl_out, "alpha;", + "Got expected value from add_newline_if_multiline()" ); + + # add_asserts_to_declarations() $funcs_ref = [ { @@ -448,6 +464,50 @@ $expected .= ' , PARROT_ASSERT_ARG(item))'; is( $decls[0], $expected, "Got expected declaration from add_asserts_to_declarations()" ); +# func_modifies() +my ($arg, @mods, @mods_out); +$arg = 'ARGMOD(List_Item_Header *item)'; +@mods = ( 'FUNC_MODIFIES(*list)' ); +$expected = [ + 'FUNC_MODIFIES(*list)', + 'FUNC_MODIFIES(*item)', +]; +@mods_out = func_modifies($arg, \@mods); +is_deeply( \@mods_out, $expected, + "Got expected output of func_modifies()" ); + +$arg = 'foobar'; +@mods = ( 'FUNC_MODIFIES(*list)' ); +$expected = [ + 'FUNC_MODIFIES(*list)', +]; +@mods_out = func_modifies($arg, \@mods); +is_deeply( \@mods_out, $expected, + "Got expected output of func_modifies()" ); + +$arg = 'ARGMOD_NULLOK(List_Item_Header alpha)'; +@mods = ( 'FUNC_MODIFIES(*list)' ); +$expected = [ + 'FUNC_MODIFIES(*list)', + 'FUNC_MODIFIES(alpha)', +]; +@mods_out = func_modifies($arg, \@mods); +is_deeply( \@mods_out, $expected, + "Got expected output of func_modifies()" ); + +eval { + $arg = 'ARGMOD_NULLOK(List_Item_Header)'; + @mods = ( 'FUNC_MODIFIES(*list)' ); + $expected = [ + 'FUNC_MODIFIES(*list)', + 'FUNC_MODIFIES(alpha)', + ]; + @mods_out = func_modifies($arg, \@mods); +}; +like($@, qr/Unable to figure out the modified/, + "Got expected error message for func_modifies()" ); + + # add_headerizer_markers #{ # my $tdir = tempdir( CLEANUP => 1 ); From 277b983086570a22a6814123150cc1b9a8780c7a Mon Sep 17 00:00:00 2001 From: jkeenan Date: Thu, 2 Dec 2010 21:55:57 -0500 Subject: [PATCH 029/102] Refactor some code out of Object.pm into new Functions.pm subroutine handle_split_declaration(). Write tests for all execution paths of that subroutine. --- lib/Parrot/Headerizer/Functions.pm | 41 ++++++++++++++++++++++++++- lib/Parrot/Headerizer/Object.pm | 31 +++++++------------- t/tools/dev/headerizer/01_functions.t | 22 +++++++++++++- 3 files changed, 71 insertions(+), 23 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index 995b33c261..7f9fa20064 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -11,6 +11,7 @@ our @EXPORT_OK = qw( read_file write_file qualify_sourcefile + handle_split_declaration asserts_from_args shim_test handle_modified_args @@ -224,6 +225,39 @@ sub qualify_sourcefile { return ($sourcefile, $source_code, $hfile); } +=pod + + my $split_decl = handle_split_declaration( + $function_decl, + $line_len, + ); + +=cut + +sub handle_split_declaration { + my ($function_decl, $line_len) = @_; + my @doc_chunks = split /\s+/, $function_decl; + my $split_decl = ''; + my @line; + while (@doc_chunks) { + my $chunk = shift @doc_chunks; + if (length(join(' ', @line, $chunk)) <= $line_len) { + push @line, $chunk; + } + else { + $split_decl .= join(' ', @line) . "\n"; + @line=($chunk); + } + } + if (@line) { + $split_decl .= join(' ', @line) . "\n"; + } + + $split_decl =~ s/\n$//; + + return $split_decl; +} + sub asserts_from_args { my @args = @_; my @asserts; @@ -253,7 +287,12 @@ sub asserts_from_args { return (@asserts); } -# my @modified_args = shim_test($func, \@args); +=pod + + my @modified_args = shim_test($func, \@args); + +=cut + sub shim_test { my ($func, $argsref) = @_; my @args = @{$argsref}; diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 9ec803b92c..84dd3eab8f 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -34,6 +34,7 @@ use Parrot::Headerizer::Functions qw( read_file write_file qualify_sourcefile + handle_split_declaration asserts_from_args shim_test handle_modified_args @@ -391,28 +392,15 @@ sub generate_documentation_signature { # Wrap long lines. my $line_len = 80; - return $function_decl if length($function_decl)<= $line_len; - - my @doc_chunks = split /\s+/, $function_decl; - my $split_decl = ''; - my @line; - while (@doc_chunks) { - my $chunk = shift @doc_chunks; - if (length(join(' ', @line, $chunk)) <= $line_len) { - push @line, $chunk; - } - else { - $split_decl .= join(' ', @line) . "\n"; - @line=($chunk); - } + if (length($function_decl)<= $line_len) { + return $function_decl; } - if (@line) { - $split_decl .= join(' ', @line) . "\n"; + else { + return handle_split_declaration( + $function_decl, + $line_len, + ); } - - $split_decl =~ s/\n$//; - - return $split_decl; } =item C @@ -495,7 +483,8 @@ sub process_sources { for my $cfile ( sort keys %{$sourcefiles} ) { my @funcs = @{ $sourcefiles->{$cfile} }; @funcs = grep { not $_->{is_static} } @funcs; # skip statics - $header = $self->replace_headerized_declarations( $header, $cfile, $hfile, @funcs ); + $header = $self->replace_headerized_declarations( + $header, $cfile, $hfile, @funcs ); } write_file( $hfile, $header ); diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index c7d2da1913..e4114cf209 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -19,6 +19,7 @@ use Parrot::Headerizer::Functions qw( read_file write_file qualify_sourcefile + handle_split_declaration asserts_from_args shim_test handle_modified_args @@ -231,6 +232,25 @@ like($@, qr/$ofile doesn't look like an object file/, is( $hfile, 'none', "As expected, no header file" ); } +my ($function_decl, $line_len, $expected); +my @first_list = qw( + alpha beta gamma delta epsilon zeta eta theta + iota kappa lambda mu nu xi omicron +); +my @second_list = qw( pi rho sigma tau ); +$line_len = 80; +$function_decl = join(' ' => @first_list); +$expected = $function_decl; +is( handle_split_declaration( $function_decl, $line_len ), + $expected, + "function declaration was exactly $line_len characters long" ); + +$function_decl = join(' ' => (@first_list, @second_list)); +$expected = join(' ' => @first_list) . "\n" . join(' ' => @second_list); +is( handle_split_declaration( $function_decl, $line_len ), + $expected, + "function declaration exceeded $line_len characters and so was split" ); + # asserts_from_args() my (@args, %asserts); @args = ( @@ -269,7 +289,7 @@ ok( exists $asserts{'PARROT_ASSERT_ARG(item)'}, "Got expected assert" ); ok( exists $asserts{'PARROT_ASSERT_ARG(interp)'}, "Got expected assert" ); ok( exists $asserts{'PARROT_ASSERT_ARG(_abcDEF123)'}, "Got expected assert" ); -my ($var, $args_ref, $funcs_ref, $expected); +my ($var, $args_ref, $funcs_ref); my @modified_args; # shim_test $var = 'something'; From 92f34715d5f0ba7a1c9806e81b11a60f10fa7ae4 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Thu, 2 Dec 2010 22:04:08 -0500 Subject: [PATCH 030/102] Eliminate an implicit, but unreachable branch in handle_split_declaration(). --- lib/Parrot/Headerizer/Functions.pm | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index 7f9fa20064..af30492386 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -249,10 +249,7 @@ sub handle_split_declaration { @line=($chunk); } } - if (@line) { - $split_decl .= join(' ', @line) . "\n"; - } - + $split_decl .= join(' ', @line) . "\n"; $split_decl =~ s/\n$//; return $split_decl; From e76c132ace788fc8a3e88e502da047be52ced015 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Fri, 3 Dec 2010 21:22:05 -0500 Subject: [PATCH 031/102] Refactor two blocks of code out of function_components_from_declaration(). Place in Functions.pm. Test them in 01_functions.t. --- lib/Parrot/Headerizer/Functions.pm | 41 ++++++++++++ lib/Parrot/Headerizer/Object.pm | 22 +++++-- t/tools/dev/headerizer/01_functions.t | 89 +++++++++++++++++++++++++++ 3 files changed, 146 insertions(+), 6 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index af30492386..8e1b9475ed 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -11,6 +11,8 @@ our @EXPORT_OK = qw( read_file write_file qualify_sourcefile + no_both_PARROT_EXPORT_and_PARROT_INLINE + no_both_static_and_PARROT_EXPORT handle_split_declaration asserts_from_args shim_test @@ -225,6 +227,45 @@ sub qualify_sourcefile { return ($sourcefile, $source_code, $hfile); } +=pod + + no_both_PARROT_EXPORT_and_PARROT_INLINE( { + file => $file, + name => $name, + parrot_inline => $parrot_inline, + parrot_api => $parrot_api, + } ); + +=cut + +sub no_both_PARROT_EXPORT_and_PARROT_INLINE { + my $args = shift; + my $death = + "$args->{file} $args->{name}: Can't have both PARROT_EXPORT and PARROT_INLINE"; + die $death if $args->{parrot_inline} && $args->{parrot_api}; + return; +} + +=pod + + ($return_type, $is_static) = no_both_static_and_PARROT_EXPORT( { + file => $file, + name => $name, + return_type => $return_type, + parrot_api => $parrot_api, + } ); + +=cut + +sub no_both_static_and_PARROT_EXPORT { + my $args = shift; + my $is_static = 0; + $is_static = $2 if $args->{return_type} =~ s/^((static)\s+)?//i; + my $death = "$args->{file} $args->{name}: Impossible to have both static and PARROT_EXPORT"; + die $death if $args->{parrot_api} && $is_static; + return ($args->{return_type}, $is_static); +} + =pod my $split_decl = handle_split_declaration( diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 84dd3eab8f..67592ea079 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -34,6 +34,8 @@ use Parrot::Headerizer::Functions qw( read_file write_file qualify_sourcefile + no_both_PARROT_EXPORT_and_PARROT_INLINE + no_both_static_and_PARROT_EXPORT handle_split_declaration asserts_from_args shim_test @@ -303,7 +305,12 @@ sub function_components_from_declaration { my $name = $1; $args = $2; - die "Can't have both PARROT_EXPORT and PARROT_INLINE on $name\n" if $parrot_inline && $parrot_api; + no_both_PARROT_EXPORT_and_PARROT_INLINE( { + file => $file, + name => $name, + parrot_inline => $parrot_inline, + parrot_api => $parrot_api, + } ); my @args = split( /\s*,\s*/, $args ); for (@args) { @@ -314,12 +321,15 @@ sub function_components_from_declaration { or die "Bad args in $proto"; } - my $is_ignorable = 0; - my $is_static = 0; - $is_static = $2 if $return_type =~ s/^((static)\s+)?//i; - - die "$file $name: Impossible to have both static and PARROT_EXPORT" if $parrot_api && $is_static; + my $is_static; + ($return_type, $is_static) = no_both_static_and_PARROT_EXPORT( { + file => $file, + name => $name, + return_type => $return_type, + parrot_api => $parrot_api, + } ); + my $is_ignorable = 0; my %macros; for my $macro (@macros) { $macros{$macro} = 1; diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index e4114cf209..850dd33bde 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -19,6 +19,8 @@ use Parrot::Headerizer::Functions qw( read_file write_file qualify_sourcefile + no_both_PARROT_EXPORT_and_PARROT_INLINE + no_both_static_and_PARROT_EXPORT handle_split_declaration asserts_from_args shim_test @@ -232,6 +234,93 @@ like($@, qr/$ofile doesn't look like an object file/, is( $hfile, 'none', "As expected, no header file" ); } +my ($name, $parrot_inline, $parrot_api); +{ + local $@ = ''; + $filename = 'foobar'; + $name = 'alpha'; + $parrot_inline = 1; + $parrot_api = 0; + no_both_PARROT_EXPORT_and_PARROT_INLINE( { + file => $filename, + name => $name, + parrot_inline => $parrot_inline, + parrot_api => $parrot_api, + } ); + ok(! $@, "PARROT_EXPORT and PARROT_INLINE not both true: No 'die' message recorded, as expected" ); +} + +{ + local $@ = ''; + $filename = 'foobar'; + $name = 'alpha'; + $parrot_inline = 1; + $parrot_api = 1; + eval { + no_both_PARROT_EXPORT_and_PARROT_INLINE( { + file => $filename, + name => $name, + parrot_inline => $parrot_inline, + parrot_api => $parrot_api, + } ); + }; + like($@, qr/$filename $name: Can't have both PARROT_EXPORT and PARROT_INLINE/, + "PARROT_EXPORT and PARROT_INLINE both true: Got expected 'die' message" ); +} + +# no_both_static_and_PARROT_EXPORT +my ($return_type_in, $return_type_out, $is_static); +{ + local $@ = ''; + $filename = 'foobar'; + $name = 'alpha'; + $return_type_in = 'int'; + $parrot_api = 0; + ($return_type_out, $is_static) = no_both_static_and_PARROT_EXPORT( { + file => $filename, + name => $name, + return_type => $return_type_in, + parrot_api => $parrot_api, + } ); + is($return_type_out, $return_type_in, "Return type unaltered"); + ok(! $is_static, "Not static" ); +} + +{ + local $@ = ''; + $filename = 'foobar'; + $name = 'alpha'; + $return_type_in = 'static gamma'; + $parrot_api = 0; + ($return_type_out, $is_static) = no_both_static_and_PARROT_EXPORT( { + file => $filename, + name => $name, + return_type => $return_type_in, + parrot_api => $parrot_api, + } ); + is($return_type_out, 'gamma', "Return type altered"); + ok($is_static, "Is static" ); +} + +{ + local $@ = ''; + $filename = 'foobar'; + $name = 'alpha'; + $return_type_in = 'static gamma'; + $parrot_api = 1; + eval { + ($return_type_out, $is_static) = no_both_static_and_PARROT_EXPORT( { + file => $filename, + name => $name, + return_type => $return_type_in, + parrot_api => $parrot_api, + } ); + }; + like($@, qr/$filename $name: Impossible to have both static and PARROT_EXPORT/, + "Both static and PARROT_EXPORT: Got expected 'die' message" ); +} + +# handle_split_declaration() my ($function_decl, $line_len, $expected); my @first_list = qw( alpha beta gamma delta epsilon zeta eta theta From 5045bf7d9ff91a3f23dba0543d65c2399862860b Mon Sep 17 00:00:00 2001 From: jkeenan Date: Fri, 3 Dec 2010 21:56:05 -0500 Subject: [PATCH 032/102] Refactor one block of code out of function_components_from_declaration(). Place in Functions.pm. Test it in 01_functions.t. --- lib/Parrot/Headerizer/Functions.pm | 22 +++++++++++++++++++- lib/Parrot/Headerizer/Object.pm | 18 +++++++++-------- t/tools/dev/headerizer/01_functions.t | 29 ++++++++++++++++++++++++++- 3 files changed, 59 insertions(+), 10 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index 8e1b9475ed..9a2987f032 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -12,6 +12,7 @@ our @EXPORT_OK = qw( write_file qualify_sourcefile no_both_PARROT_EXPORT_and_PARROT_INLINE + validate_prototype_args no_both_static_and_PARROT_EXPORT handle_split_declaration asserts_from_args @@ -243,7 +244,26 @@ sub no_both_PARROT_EXPORT_and_PARROT_INLINE { my $death = "$args->{file} $args->{name}: Can't have both PARROT_EXPORT and PARROT_INLINE"; die $death if $args->{parrot_inline} && $args->{parrot_api}; - return; + return 1; +} + +=pod + + validate_prototype_args( $args, $proto ); + +=cut + +sub validate_prototype_args { + my ($args, $proto) = @_; + my @args = split( /\s*,\s*/, $args ); + for (@args) { + /\S+\s+\S+/ + || ( $_ eq '...' ) + || ( $_ eq 'void' ) + || ( $_ =~ /(PARROT|NULLOK|SHIM)_INTERP/ ) + or die "Bad args in $proto"; + } + return 1; } =pod diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 67592ea079..68328b4128 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -35,6 +35,7 @@ use Parrot::Headerizer::Functions qw( write_file qualify_sourcefile no_both_PARROT_EXPORT_and_PARROT_INLINE + validate_prototype_args no_both_static_and_PARROT_EXPORT handle_split_declaration asserts_from_args @@ -312,14 +313,15 @@ sub function_components_from_declaration { parrot_api => $parrot_api, } ); - my @args = split( /\s*,\s*/, $args ); - for (@args) { - /\S+\s+\S+/ - || ( $_ eq '...' ) - || ( $_ eq 'void' ) - || ( $_ =~ /(PARROT|NULLOK|SHIM)_INTERP/ ) - or die "Bad args in $proto"; - } +# my @args = split( /\s*,\s*/, $args ); +# for (@args) { +# /\S+\s+\S+/ +# || ( $_ eq '...' ) +# || ( $_ eq 'void' ) +# || ( $_ =~ /(PARROT|NULLOK|SHIM)_INTERP/ ) +# or die "Bad args in $proto"; +# } + validate_prototype_args( $args, $proto ); my $is_static; ($return_type, $is_static) = no_both_static_and_PARROT_EXPORT( { diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index 850dd33bde..ed4788a4bb 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -20,6 +20,7 @@ use Parrot::Headerizer::Functions qw( write_file qualify_sourcefile no_both_PARROT_EXPORT_and_PARROT_INLINE + validate_prototype_args no_both_static_and_PARROT_EXPORT handle_split_declaration asserts_from_args @@ -34,7 +35,7 @@ use Parrot::Headerizer::Functions qw( use IO::CaptureOutput qw| capture |; my $cwd = cwd(); -my @ofiles; +my (@ofiles, $rv); # process_argv() eval { @@ -250,6 +251,7 @@ my ($name, $parrot_inline, $parrot_api); ok(! $@, "PARROT_EXPORT and PARROT_INLINE not both true: No 'die' message recorded, as expected" ); } +# no_both_PARROT_EXPORT_and_PARROT_INLINE { local $@ = ''; $filename = 'foobar'; @@ -268,6 +270,31 @@ my ($name, $parrot_inline, $parrot_api); "PARROT_EXPORT and PARROT_INLINE both true: Got expected 'die' message" ); } +# validate_prototype_args +my ($args, $proto); +{ + local $@ = ''; + $args = join(' , ' => ( + 'alpha beta', + '...', + 'void', + 'PARROT_INTERP(interp)', + 'NULLOK_INTERP(interp)', + 'SHIM_INTERP', + ) ); + $proto = 'myprototype'; + $rv = validate_prototype_args( $args, $proto ); + ok($rv, 'validate_prototype_args() returned true value'); + ok(! $@, "No error message recorded"); + + $args .= ' , single'; + eval { + $rv = validate_prototype_args( $args, $proto ); + }; + like($@, qr/Bad args in $proto/, + "Detected invalid prototype arg"); +} + # no_both_static_and_PARROT_EXPORT my ($return_type_in, $return_type_out, $is_static); { From b8cf4e4448bdd0981e90d2c9c8e7b7edc3fb4c33 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Fri, 3 Dec 2010 21:59:13 -0500 Subject: [PATCH 033/102] Fix syntax error. --- lib/Parrot/Headerizer/Functions.pm | 4 ++-- lib/Parrot/Headerizer/Object.pm | 10 +--------- t/tools/dev/headerizer/01_functions.t | 5 ++--- 3 files changed, 5 insertions(+), 14 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index 9a2987f032..2ef187246d 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -249,7 +249,7 @@ sub no_both_PARROT_EXPORT_and_PARROT_INLINE { =pod - validate_prototype_args( $args, $proto ); + @args = validate_prototype_args( $args, $proto ); =cut @@ -263,7 +263,7 @@ sub validate_prototype_args { || ( $_ =~ /(PARROT|NULLOK|SHIM)_INTERP/ ) or die "Bad args in $proto"; } - return 1; + return @args; } =pod diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 68328b4128..30668036d1 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -313,15 +313,7 @@ sub function_components_from_declaration { parrot_api => $parrot_api, } ); -# my @args = split( /\s*,\s*/, $args ); -# for (@args) { -# /\S+\s+\S+/ -# || ( $_ eq '...' ) -# || ( $_ eq 'void' ) -# || ( $_ =~ /(PARROT|NULLOK|SHIM)_INTERP/ ) -# or die "Bad args in $proto"; -# } - validate_prototype_args( $args, $proto ); + my @args = validate_prototype_args( $args, $proto ); my $is_static; ($return_type, $is_static) = no_both_static_and_PARROT_EXPORT( { diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index ed4788a4bb..2db0961075 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -283,13 +283,12 @@ my ($args, $proto); 'SHIM_INTERP', ) ); $proto = 'myprototype'; - $rv = validate_prototype_args( $args, $proto ); - ok($rv, 'validate_prototype_args() returned true value'); + my @args_out = validate_prototype_args( $args, $proto ); ok(! $@, "No error message recorded"); $args .= ' , single'; eval { - $rv = validate_prototype_args( $args, $proto ); + @args_out = validate_prototype_args( $args, $proto ); }; like($@, qr/Bad args in $proto/, "Detected invalid prototype arg"); From 8ffe7735a029626f30e06649dcd4f538e7bb45a4 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sat, 4 Dec 2010 11:33:19 -0500 Subject: [PATCH 034/102] [codingstd] Fix trailing whitespace and POD formatting errors. --- lib/Parrot/Headerizer/Object.pm | 47 ++++++++++++--------------- t/tools/dev/headerizer/01_functions.t | 12 +++---- t/tools/dev/headerizer/02_methods.t | 2 +- 3 files changed, 27 insertions(+), 34 deletions(-) diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 30668036d1..33b09b1f62 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -18,9 +18,7 @@ Parrot::Headerizer::Object - Parrot Header Generation functionality C knows how to extract all kinds of information out of C-language files. -=head2 Class Methods - -=over 4 +=head1 METHODS =cut @@ -47,7 +45,7 @@ use Parrot::Headerizer::Functions qw( add_headerizer_markers ); -=item C +=head2 C Constructor of headerizer objects. @@ -100,27 +98,27 @@ sub get_sources { my %api; # Walk the object files and find corresponding source (either .c or .pmc) for my $ofile (@ofiles) { - + # Skip files in the src/ops/ subdirectory. next if $ofile =~ m/^\Qsrc$PConfig{slash}ops\E/ || # if run by hand... $ofile =~ m{^src/ops}; # ... or by makefile - + $ofile =~ s/\\/\//g; - + my $is_yacc = ($ofile =~ /\.y$/); if ( !$is_yacc ) { my $sfile = $ofile; $sfile =~ s/\Q$PConfig{o}\E$/.s/; next if -f $sfile; } - + my ($sourcefile, $source_code, $hfile) = qualify_sourcefile( { ofile => $ofile, PConfig => \%PConfig, is_yacc => $is_yacc, } ); - + my @decls; if ( $self->{macro_match} ) { @decls = $self->extract_function_declarations( $source_code ); @@ -129,7 +127,7 @@ sub get_sources { @decls = $self->extract_function_declarations_and_update_source( $sourcefile ); } - + for my $decl (@decls) { my $components = $self->function_components_from_declaration( $sourcefile, $decl ); @@ -149,7 +147,7 @@ sub get_sources { $self->{api} = \%api; } -=item C +=head2 C $headerizer->extract_function_declarations($text) @@ -254,7 +252,7 @@ sub extract_function_declarations_and_update_source { return @func_declarations; } -=item C +=head2 C $file => the filename $proto => the function declaration @@ -360,7 +358,7 @@ sub function_components_from_declaration { }; } -=item C +=head2 C Given an extracted function signature, return a modified version suitable for inclusion in POD documentation. @@ -407,7 +405,7 @@ sub generate_documentation_signature { } } -=item C +=head2 C $headerizer->valid_macro( $macro ) @@ -422,7 +420,7 @@ sub valid_macro { return exists $self->{valid_macros}{$macro}; } -=item C +=head2 C $headerizer->valid_macros() @@ -438,7 +436,7 @@ sub valid_macros { return @macros; } -=item C +=head2 C Headerizer-specific ways of complaining if something went wrong. @@ -481,27 +479,27 @@ sub process_sources { # Update all the .h files for my $hfile ( sort keys %sourcefiles ) { my $sourcefiles = $sourcefiles{$hfile}; - + my $header = read_file($hfile); - + for my $cfile ( sort keys %{$sourcefiles} ) { my @funcs = @{ $sourcefiles->{$cfile} }; @funcs = grep { not $_->{is_static} } @funcs; # skip statics $header = $self->replace_headerized_declarations( $header, $cfile, $hfile, @funcs ); } - + write_file( $hfile, $header ); } - + # Update all the .c files in place for my $cfile ( sort keys %sourcefiles_with_statics ) { my @funcs = @{ $sourcefiles_with_statics{$cfile} }; @funcs = grep { $_->{is_static} } @funcs; - + my $source = read_file($cfile); $source = $self->replace_headerized_declarations( $source, 'static', $cfile, @funcs ); - + write_file( $cfile, $source ); } $self->{message} = "Headerization complete."; @@ -664,11 +662,6 @@ sub print_warnings { } } - -=back - -=cut - 1; # Local Variables: diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index 2db0961075..918a2aee43 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -84,7 +84,7 @@ is(@ofiles, 3, "Got expected number of ofiles"); is($lines_read[2], 'world', "Got third line"); chdir $cwd or die "Unable to chdir: $!"; } - + my $filename = 'foobar'; eval { read_file($filename); @@ -105,7 +105,7 @@ eval { }; like($@, qr/$ofile doesn't look like an object file/, "Got expected die message for non-object, non-yacc file" ); - + # Testing Needs We don't really need a .o file, we just need its name. # However, we do need one .c file and one .pmc file. In order to have the # codingstd tests skip these, we should name them .in and then copy them into @@ -147,7 +147,7 @@ like($@, qr/$ofile doesn't look like an object file/, is_yacc => 0, } ); is( $sourcefile, $expected_cfile, "Got expected C source file" ); - like( $source_code, qr/This file has 'none'/, + like( $source_code, qr/This file has 'none'/, "Got expected source code" ); is( $hfile, 'none', "As expected, no header file" ); } @@ -189,7 +189,7 @@ like($@, qr/$ofile doesn't look like an object file/, } ); chdir $cwd; is( $sourcefile, $expected_cfile, "Got expected C source file" ); - like( $source_code, qr/This file has a valid HEADERIZER HFILE/, + like( $source_code, qr/This file has a valid HEADERIZER HFILE/, "Got expected source code" ); is( $hfile, "$stub.h", "Got expected header file" ); } @@ -212,7 +212,7 @@ like($@, qr/$ofile doesn't look like an object file/, } ); chdir $cwd; is( $sourcefile, $expected_cfile, "Got expected PMC file" ); - like( $source_code, qr/This file has a valid HEADERIZER HFILE/, + like( $source_code, qr/This file has a valid HEADERIZER HFILE/, "Got expected source code" ); is( $hfile, "$stub.h", "Got expected header file" ); } @@ -705,7 +705,7 @@ sub touchfile { =head1 DESCRIPTION -The files in this directory test the publicly callable subroutines found in +The files in this directory test the publicly callable subroutines found in F. By doing so, they help test the functionality of the F utility. diff --git a/t/tools/dev/headerizer/02_methods.t b/t/tools/dev/headerizer/02_methods.t index 7a1b3f5fd5..dd7aeadf69 100644 --- a/t/tools/dev/headerizer/02_methods.t +++ b/t/tools/dev/headerizer/02_methods.t @@ -381,7 +381,7 @@ sub touchfile { =head1 DESCRIPTION -The files in this directory test the publicly callable subroutines found in +The files in this directory test the publicly callable subroutines found in F. By doing so, they help test the functionality of the F utility. From 3fbc7cb26e83b8ecd85fe136d0c920bbca7ac05f Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sat, 4 Dec 2010 12:28:15 -0500 Subject: [PATCH 035/102] Refactor some code into replace_pod_item(). Place that subroutine in Functions.pm and test it. --- lib/Parrot/Headerizer/Functions.pm | 23 +++++++++ lib/Parrot/Headerizer/Object.pm | 11 ++-- t/tools/dev/headerizer/01_functions.t | 73 +++++++++++++++++++++++++-- 3 files changed, 100 insertions(+), 7 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index 2ef187246d..4648ee6231 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -11,6 +11,7 @@ our @EXPORT_OK = qw( read_file write_file qualify_sourcefile + replace_pod_item no_both_PARROT_EXPORT_and_PARROT_INLINE validate_prototype_args no_both_static_and_PARROT_EXPORT @@ -228,6 +229,28 @@ sub qualify_sourcefile { return ($sourcefile, $source_code, $hfile); } +=pod + + $text = replace_pod_item( { + text => $text, + name => $name, + heading => $heading, + cfile_name => $cfile_name, + } ); + +=cut + +sub replace_pod_item { + my $args = shift; + $args->{text} =~ s/=item C<[^>]*\b$args->{name}\b[^>]*>\n+/$args->{heading}\n\n/sm + or do { + warn "$args->{cfile_name}: $args->{name} has no POD\n" + # lexer funcs don't have to have POD + unless $args->{name} =~ /^yy/; + }; + return $args->{text}; +} + =pod no_both_PARROT_EXPORT_and_PARROT_INLINE( { diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 33b09b1f62..2e3354fc9f 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -32,6 +32,7 @@ use Parrot::Headerizer::Functions qw( read_file write_file qualify_sourcefile + replace_pod_item no_both_PARROT_EXPORT_and_PARROT_INLINE validate_prototype_args no_both_static_and_PARROT_EXPORT @@ -240,10 +241,12 @@ sub extract_function_declarations_and_update_source { my $name = $specs->{name}; my $heading = $self->generate_documentation_signature($decl); - - $text =~ s/=item C<[^>]*\b$name\b[^>]*>\n+/$heading\n\n/sm or do { - warn "$cfile_name: $name has no POD\n" unless $name =~ /^yy/; # lexer funcs don't have to have POD - } + $text = replace_pod_item( { + text => $text, + name => $name, + heading => $heading, + cfile_name => $cfile_name, + } ); } open( my $fhout, '>', $cfile_name ) or die "Can't create $cfile_name: $!"; print {$fhout} $text; diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t index 918a2aee43..5b487aa8f5 100644 --- a/t/tools/dev/headerizer/01_functions.t +++ b/t/tools/dev/headerizer/01_functions.t @@ -19,6 +19,7 @@ use Parrot::Headerizer::Functions qw( read_file write_file qualify_sourcefile + replace_pod_item no_both_PARROT_EXPORT_and_PARROT_INLINE validate_prototype_args no_both_static_and_PARROT_EXPORT @@ -35,7 +36,7 @@ use Parrot::Headerizer::Functions qw( use IO::CaptureOutput qw| capture |; my $cwd = cwd(); -my (@ofiles, $rv); +my (@ofiles, $rv, $expected); # process_argv() eval { @@ -235,7 +236,73 @@ like($@, qr/$ofile doesn't look like an object file/, is( $hfile, 'none', "As expected, no header file" ); } -my ($name, $parrot_inline, $parrot_api); +# replace_pod_item() +my ($text_in, $text_out, $name, $heading, $cfile_name); +{ + $name = 'Parrot_list_destroy'; + $text_in = "alpha\n=item C< $name >\n\n"; + $heading = 'item C'; + $cfile_name = 'src/list.c'; + $expected = "alpha\n$heading\n\n"; + $text_out = replace_pod_item( { + text => $text_in, + name => $name, + heading => $heading, + cfile_name => $cfile_name, + } ); + is( $text_out, $expected, + "POD heading transformed as expected" ); +} + +{ + $name = 'Parrot_list_destroy'; + $text_in = "alpha\n=item C\n\n"; + $heading = 'item C'; + $cfile_name = 'src/list.c'; + { + my ($stdout, $stderr); + capture( + sub { + $text_out = replace_pod_item( { + text => $text_in, + name => $name, + heading => $heading, + cfile_name => $cfile_name, + } ); + }, + \$stdout, + \$stderr, + ); + like($stderr, qr/$cfile_name: $name has no POD/, + "Got expected warning"); + } +} + +{ + $name = 'yy_Parrot_list_destroy'; + $text_in = "alpha\n=item C\n\n"; + $heading = 'item C'; + $cfile_name = 'src/list.c'; + { + my ($stdout, $stderr); + capture( + sub { + $text_out = replace_pod_item( { + text => $text_in, + name => $name, + heading => $heading, + cfile_name => $cfile_name, + } ); + }, + \$stdout, + \$stderr, + ); + ok(! $stderr, "yacc files exempt from POD requirement"); + } +} + +# no_both_PARROT_EXPORT_and_PARROT_INLINE() +my ($text, $parrot_inline, $parrot_api); { local $@ = ''; $filename = 'foobar'; @@ -347,7 +414,7 @@ my ($return_type_in, $return_type_out, $is_static); } # handle_split_declaration() -my ($function_decl, $line_len, $expected); +my ($function_decl, $line_len); my @first_list = qw( alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu xi omicron From 880b3e23dec717ca2bb9ba6ad9a8fa4402679162 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Tue, 7 Dec 2010 23:06:02 -0500 Subject: [PATCH 036/102] Test more execution paths in attrs_from_args(). --- t/tools/dev/headerizer/02_methods.t | 99 +++++++++++++++++++++++++++++ 1 file changed, 99 insertions(+) diff --git a/t/tools/dev/headerizer/02_methods.t b/t/tools/dev/headerizer/02_methods.t index dd7aeadf69..1b8b94b33e 100644 --- a/t/tools/dev/headerizer/02_methods.t +++ b/t/tools/dev/headerizer/02_methods.t @@ -359,6 +359,105 @@ $self->squawk($file, $func, $error[1]); chdir $cwd or croak "Unable to chdir back after testing"; } +# attrs_from_args() +{ + my $tdir = tempdir( CLEANUP => 1 ); + chdir $tdir or croak "Unable to chdir during testing"; + + my $stub = 'list'; + my $srcdir = File::Spec->catpath( $tdir, 'src' ); + mkpath( $srcdir, 0, 0777 ); + my $srco = File::Spec->catfile( $srcdir, "$stub.o" ); + touchfile($srco); + my $srcc = File::Spec->catfile( $srcdir, "$stub.c" ); + copy "$cwd/t/tools/dev/headerizer/testlib/list.in" => $srcc + or croak "Unable to copy"; + my $incdir = File::Spec->catpath( $tdir, 'include', 'parrot' ); + mkpath( $incdir, 0, 0777 ); + my $inch = File::Spec->catfile( $incdir, "$stub.h" ); + copy "$cwd/t/tools/dev/headerizer/testlib/list_h.in" => $inch + or croak "Unable to copy"; + + $self = Parrot::Headerizer::Object->new(); + isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self->get_sources($srco); + ok( keys %{$self->{sourcefiles}}, + "sourcefiles" ); + ok( ! keys %{$self->{sourcefiles_with_statics}}, + "no sourcefiles_with_statics" ); + ok( ! keys %{$self->{api}}, + "no api" ); + + my ($func, $arg); + $func = { + 'name' => 'alpha', + 'file' => 'my_sourcefile.c', + }; + $arg = '*beta'; + $self->attrs_from_args($func, ($arg)); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + like($stdout, qr/$func->{file}/s, + "attrs_from_args(): Got expected warning for unprotected argument"); + like($stdout, qr/$func->{name}:/s, + "attrs_from_args(): Got expected warning for unprotected argument"); + like($stdout, qr/1 warnings/s, + "attrs_from_args(): Got expected warning for unprotected argument"); + $self->{warnings} = {}; + } +} + +{ + my $tdir = tempdir( CLEANUP => 1 ); + chdir $tdir or croak "Unable to chdir during testing"; + + my $stub = 'list'; + my $srcdir = File::Spec->catpath( $tdir, 'src' ); + mkpath( $srcdir, 0, 0777 ); + my $srco = File::Spec->catfile( $srcdir, "$stub.o" ); + touchfile($srco); + my $srcc = File::Spec->catfile( $srcdir, "$stub.c" ); + copy "$cwd/t/tools/dev/headerizer/testlib/list.in" => $srcc + or croak "Unable to copy"; + my $incdir = File::Spec->catpath( $tdir, 'include', 'parrot' ); + mkpath( $incdir, 0, 0777 ); + my $inch = File::Spec->catfile( $incdir, "$stub.h" ); + copy "$cwd/t/tools/dev/headerizer/testlib/list_h.in" => $inch + or croak "Unable to copy"; + + $self = Parrot::Headerizer::Object->new(); + isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self->get_sources($srco); + ok( keys %{$self->{sourcefiles}}, + "sourcefiles" ); + ok( ! keys %{$self->{sourcefiles_with_statics}}, + "no sourcefiles_with_statics" ); + ok( ! keys %{$self->{api}}, + "no api" ); + + my ($func, $arg); + $func = { + 'name' => 'yy_alpha', + 'file' => 'my_sourcefile.c', + }; + $arg = '*beta'; + $self->attrs_from_args($func, ($arg)); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + ok(! $stdout, "No warnings from lexer auto-generated functions"); + } +} + pass("Completed all tests in $0"); sub touchfile { From b1f035b3bb873603be4ead1ea52aed25e986cb22 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Tue, 7 Dec 2010 23:09:58 -0500 Subject: [PATCH 037/102] Return from tempdir gracefully. --- t/tools/dev/headerizer/02_methods.t | 2 ++ 1 file changed, 2 insertions(+) diff --git a/t/tools/dev/headerizer/02_methods.t b/t/tools/dev/headerizer/02_methods.t index 1b8b94b33e..7c5dd981d9 100644 --- a/t/tools/dev/headerizer/02_methods.t +++ b/t/tools/dev/headerizer/02_methods.t @@ -410,6 +410,7 @@ $self->squawk($file, $func, $error[1]); "attrs_from_args(): Got expected warning for unprotected argument"); $self->{warnings} = {}; } + chdir $cwd or croak "Unable to chdir back after testing"; } { @@ -456,6 +457,7 @@ $self->squawk($file, $func, $error[1]); ); ok(! $stdout, "No warnings from lexer auto-generated functions"); } + chdir $cwd or croak "Unable to chdir back after testing"; } pass("Completed all tests in $0"); From 3129b838eaad7e79e7bf6c0adf23b700e225a4e3 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Wed, 8 Dec 2010 21:29:45 -0500 Subject: [PATCH 038/102] Refactor some code from within Parrot::Headerizer::Object into internal method check_pointer_return_type(). Test it in 02_methods.t. Replace repetitive test setup code with a subroutine. --- lib/Parrot/Headerizer/Object.pm | 45 +++- t/tools/dev/headerizer/02_methods.t | 347 +++++++++++++++++++++++----- 2 files changed, 328 insertions(+), 64 deletions(-) diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 2e3354fc9f..631a12ad61 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -335,18 +335,12 @@ sub function_components_from_declaration { $is_ignorable = 1; } } - if ( $return_type =~ /\*/ ) { - if ( !$macros{PARROT_CAN_RETURN_NULL} && !$macros{PARROT_CANNOT_RETURN_NULL} ) { - if ( $name !~ /^yy/ ) { # Don't complain about lexer-created functions - $self->squawk( $file, $name, - 'Returns a pointer, but no PARROT_CAN(NOT)_RETURN_NULL macro found.' ); - } - } - elsif ( $macros{PARROT_CAN_RETURN_NULL} && $macros{PARROT_CANNOT_RETURN_NULL} ) { - $self->squawk( $file, $name, - q{Can't have both PARROT_CAN_RETURN_NULL and PARROT_CANNOT_RETURN_NULL together.} ); - } - } + $self->check_pointer_return_type( { + return_type => $return_type, + macros => \%macros, + name => $name, + file => $file, + } ); return { file => $file, @@ -361,6 +355,33 @@ sub function_components_from_declaration { }; } +=head2 C + + $self->check_pointer_return_type( { + return_type => $return_type, + macros => \%macros, + name => $name, + file => $file, + } ); + +=cut + +sub check_pointer_return_type { + my ($self, $args) = @_; + if ( $args->{return_type} =~ /\*/ ) { + if ( !$args->{macros}->{PARROT_CAN_RETURN_NULL} && !$args->{macros}->{PARROT_CANNOT_RETURN_NULL} ) { + if ( $args->{name} !~ /^yy/ ) { # Don't complain about lexer-created functions + $self->squawk( $args->{file}, $args->{name}, + 'Returns a pointer, but no PARROT_CAN(NOT)_RETURN_NULL macro found.' ); + } + } + elsif ( $args->{macros}->{PARROT_CAN_RETURN_NULL} && $args->{macros}->{PARROT_CANNOT_RETURN_NULL} ) { + $self->squawk( $args->{file}, $args->{name}, + q{Can't have both PARROT_CAN_RETURN_NULL and PARROT_CANNOT_RETURN_NULL together.} ); + } + } +} + =head2 C Given an extracted function signature, return a modified diff --git a/t/tools/dev/headerizer/02_methods.t b/t/tools/dev/headerizer/02_methods.t index 7c5dd981d9..4746624b53 100644 --- a/t/tools/dev/headerizer/02_methods.t +++ b/t/tools/dev/headerizer/02_methods.t @@ -187,19 +187,7 @@ $self->squawk($file, $func, $error[1]); my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or croak "Unable to chdir during testing"; - my $stub = 'list'; - my $srcdir = File::Spec->catpath( $tdir, 'src' ); - mkpath( $srcdir, 0, 0777 ); - my $srco = File::Spec->catfile( $srcdir, "$stub.o" ); - touchfile($srco); - my $srcc = File::Spec->catfile( $srcdir, "$stub.c" ); - copy "$cwd/t/tools/dev/headerizer/testlib/list.in" => $srcc - or croak "Unable to copy"; - my $incdir = File::Spec->catpath( $tdir, 'include', 'parrot' ); - mkpath( $incdir, 0, 0777 ); - my $inch = File::Spec->catfile( $incdir, "$stub.h" ); - copy "$cwd/t/tools/dev/headerizer/testlib/list_h.in" => $inch - or croak "Unable to copy"; + my $srco = setup_src_list_test($cwd, $tdir); $self = Parrot::Headerizer::Object->new(); isa_ok( $self, 'Parrot::Headerizer::Object' ); @@ -230,19 +218,7 @@ $self->squawk($file, $func, $error[1]); my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or croak "Unable to chdir during testing"; - my $stub = 'list'; - my $srcdir = File::Spec->catpath( $tdir, 'src' ); - mkpath( $srcdir, 0, 0777 ); - my $srco = File::Spec->catfile( $srcdir, "$stub.o" ); - touchfile($srco); - my $srcc = File::Spec->catfile( $srcdir, "$stub.c" ); - copy "$cwd/t/tools/dev/headerizer/testlib/list.in" => $srcc - or croak "Unable to copy"; - my $incdir = File::Spec->catpath( $tdir, 'include', 'parrot' ); - mkpath( $incdir, 0, 0777 ); - my $inch = File::Spec->catfile( $incdir, "$stub.h" ); - copy "$cwd/t/tools/dev/headerizer/testlib/list_h.in" => $inch - or croak "Unable to copy"; + my $srco = setup_src_list_test($cwd, $tdir); my $macro = 'PARROT_CAN_RETURN_NULL'; $self = Parrot::Headerizer::Object->new( { @@ -364,19 +340,7 @@ $self->squawk($file, $func, $error[1]); my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or croak "Unable to chdir during testing"; - my $stub = 'list'; - my $srcdir = File::Spec->catpath( $tdir, 'src' ); - mkpath( $srcdir, 0, 0777 ); - my $srco = File::Spec->catfile( $srcdir, "$stub.o" ); - touchfile($srco); - my $srcc = File::Spec->catfile( $srcdir, "$stub.c" ); - copy "$cwd/t/tools/dev/headerizer/testlib/list.in" => $srcc - or croak "Unable to copy"; - my $incdir = File::Spec->catpath( $tdir, 'include', 'parrot' ); - mkpath( $incdir, 0, 0777 ); - my $inch = File::Spec->catfile( $incdir, "$stub.h" ); - copy "$cwd/t/tools/dev/headerizer/testlib/list_h.in" => $inch - or croak "Unable to copy"; + my $srco = setup_src_list_test($cwd, $tdir); $self = Parrot::Headerizer::Object->new(); isa_ok( $self, 'Parrot::Headerizer::Object' ); @@ -417,19 +381,7 @@ $self->squawk($file, $func, $error[1]); my $tdir = tempdir( CLEANUP => 1 ); chdir $tdir or croak "Unable to chdir during testing"; - my $stub = 'list'; - my $srcdir = File::Spec->catpath( $tdir, 'src' ); - mkpath( $srcdir, 0, 0777 ); - my $srco = File::Spec->catfile( $srcdir, "$stub.o" ); - touchfile($srco); - my $srcc = File::Spec->catfile( $srcdir, "$stub.c" ); - copy "$cwd/t/tools/dev/headerizer/testlib/list.in" => $srcc - or croak "Unable to copy"; - my $incdir = File::Spec->catpath( $tdir, 'include', 'parrot' ); - mkpath( $incdir, 0, 0777 ); - my $inch = File::Spec->catfile( $incdir, "$stub.h" ); - copy "$cwd/t/tools/dev/headerizer/testlib/list_h.in" => $inch - or croak "Unable to copy"; + my $srco = setup_src_list_test($cwd, $tdir); $self = Parrot::Headerizer::Object->new(); isa_ok( $self, 'Parrot::Headerizer::Object' ); @@ -460,6 +412,279 @@ $self->squawk($file, $func, $error[1]); chdir $cwd or croak "Unable to chdir back after testing"; } +{ + my $tdir = tempdir( CLEANUP => 1 ); + chdir $tdir or croak "Unable to chdir during testing"; + + my $srco = setup_src_list_test($cwd, $tdir); + + $self = Parrot::Headerizer::Object->new(); + isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self->get_sources($srco); + ok( keys %{$self->{sourcefiles}}, + "sourcefiles" ); + ok( ! keys %{$self->{sourcefiles_with_statics}}, + "no sourcefiles_with_statics" ); + ok( ! keys %{$self->{api}}, + "no api" ); + + my ($func, $arg); + $func = { + 'name' => 'alpha', + 'file' => 'my_sourcefile.c', + }; + $arg = 'const *beta ARGMOD'; + $self->attrs_from_args($func, ($arg)); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + like($stdout, qr/$func->{file}/s, + "attrs_from_args(): Got expected warning for const clash"); + like($stdout, qr/$func->{name}:/s, + "attrs_from_args(): Got expected warning for const clash"); + like($stdout, qr/1 warnings/s, + "attrs_from_args(): Got expected warning for const clash"); + } + $self->{warnings} = {}; + + $arg = 'const **beta ARGMOD'; + $self->attrs_from_args($func, ($arg)); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + ok(! $stdout, "No warnings in double asterisk case"); + } + $self->{warnings} = {}; + + $arg = '*beta ARGMOD'; + $self->attrs_from_args($func, ($arg)); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + ok(! $stdout, "No warnings in non-const case"); + } + $self->{warnings} = {}; + + $arg = 'const *beta ARGIN'; + $self->attrs_from_args($func, ($arg)); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + ok(! $stdout, "No warnings in non-ARGMOD/ARGOUT case"); + } + $self->{warnings} = {}; + + $arg = 'const beta ARGOUT'; + $self->attrs_from_args($func, ($arg)); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + ok(! $stdout, "No warnings in non-asterisk case"); + } + $self->{warnings} = {}; + + chdir $cwd or croak "Unable to chdir back after testing"; +} + +# check_pointer_return_type() +{ + my $tdir = tempdir( CLEANUP => 1 ); + chdir $tdir or croak "Unable to chdir during testing"; + + my $srco = setup_src_list_test($cwd, $tdir); + + $self = Parrot::Headerizer::Object->new(); + isa_ok( $self, 'Parrot::Headerizer::Object' ); + + my ($return_type, %macros, $name, $file); + + $return_type = '*pointer'; + %macros = (); + $name = 'somefunc'; + $file = 'my_sourcefile.c'; + $self->check_pointer_return_type( { + return_type => $return_type, + macros => \%macros, + name => $name, + file => $file, + } ); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + like($stdout, qr/$file/s, + "check_pointer_return_type(): Got expected warning for missing macro"); + like($stdout, qr/$name:/s, + "check_pointer_return_type(): Got expected warning for missing macro"); + like($stdout, qr/1 warnings/s, + "check_pointer_return_type(): Got expected warning for missing macro"); + } + $self->{warnings} = {}; + + $return_type = '*pointer'; + %macros = (); + $name = 'yy_somefunc'; + $file = 'my_yacc'; + $self->check_pointer_return_type( { + return_type => $return_type, + macros => \%macros, + name => $name, + file => $file, + } ); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + ok(! $stdout, "No warnings, as expected: yacc case"); + } + $self->{warnings} = {}; + + $return_type = '*pointer'; + %macros = ( PARROT_CAN_RETURN_NULL => 1); + $name = 'somefunc'; + $file = 'my_sourcefile.c'; + $self->check_pointer_return_type( { + return_type => $return_type, + macros => \%macros, + name => $name, + file => $file, + } ); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + ok(! $stdout, "No warnings, as expected"); + } + $self->{warnings} = {}; + + $return_type = '*pointer'; + %macros = ( PARROT_CANNOT_RETURN_NULL => 1); + $name = 'somefunc'; + $file = 'my_sourcefile.c'; + $self->check_pointer_return_type( { + return_type => $return_type, + macros => \%macros, + name => $name, + file => $file, + } ); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + ok(! $stdout, "No warnings, as expected"); + } + $self->{warnings} = {}; + + $return_type = '*pointer'; + %macros = ( PARROT_CANNOT_RETURN_NULL => 1); + $name = 'somefunc'; + $file = 'my_sourcefile.c'; + $self->check_pointer_return_type( { + return_type => $return_type, + macros => \%macros, + name => $name, + file => $file, + } ); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + ok(! $stdout, "No warnings, as expected"); + } + $self->{warnings} = {}; + + $return_type = '*pointer'; + %macros = ( + PARROT_CAN_RETURN_NULL => 1, + PARROT_CANNOT_RETURN_NULL => 1, + ); + $name = 'somefunc'; + $file = 'my_sourcefile.c'; + $self->check_pointer_return_type( { + return_type => $return_type, + macros => \%macros, + name => $name, + file => $file, + } ); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + like($stdout, qr/$file/s, + "check_pointer_return_type(): Got expected warning for contradictory macros"); + like($stdout, qr/$name:/s, + "check_pointer_return_type(): Got expected warning for contradictory macros"); + like($stdout, qr/Can't have both/s, + "check_pointer_return_type(): Got expected warning for contradictory macros"); + } + $self->{warnings} = {}; + + $return_type = 'not_a_pointer'; + %macros = ( + PARROT_CAN_RETURN_NULL => 1, + PARROT_CANNOT_RETURN_NULL => 1, + ); + $name = 'somefunc'; + $file = 'my_sourcefile.c'; + $self->check_pointer_return_type( { + return_type => $return_type, + macros => \%macros, + name => $name, + file => $file, + } ); + { + my ($stdout, $stderr); + capture( + sub { $self->print_warnings(); }, + \$stdout, + \$stderr, + ); + ok(! $stdout, "No warnings, as expected"); + } + $self->{warnings} = {}; + + chdir $cwd or croak "Unable to chdir back after testing"; +} + + pass("Completed all tests in $0"); sub touchfile { @@ -470,6 +695,24 @@ sub touchfile { return 1; } +sub setup_src_list_test { + my ($cwd, $tdir) = @_; + my $stub = 'list'; + my $srcdir = File::Spec->catpath( $tdir, 'src' ); + mkpath( $srcdir, 0, 0777 ); + my $srco = File::Spec->catfile( $srcdir, "$stub.o" ); + touchfile($srco); + my $srcc = File::Spec->catfile( $srcdir, "$stub.c" ); + copy "$cwd/t/tools/dev/headerizer/testlib/list.in" => $srcc + or croak "Unable to copy"; + my $incdir = File::Spec->catpath( $tdir, 'include', 'parrot' ); + mkpath( $incdir, 0, 0777 ); + my $inch = File::Spec->catfile( $incdir, "$stub.h" ); + copy "$cwd/t/tools/dev/headerizer/testlib/list_h.in" => $inch + or croak "Unable to copy"; + return $srco; +} + ################### DOCUMENTATION ################### =head1 NAME From 86406d0673dcb254fc06d5e4fb00ce64bf28965b Mon Sep 17 00:00:00 2001 From: Andy Lester Date: Wed, 8 Dec 2010 23:12:05 -0600 Subject: [PATCH 039/102] consting and PARROT_xxx annotations --- include/parrot/list.h | 14 +++++++------- src/list.c | 26 ++++++++++++++------------ 2 files changed, 21 insertions(+), 19 deletions(-) diff --git a/include/parrot/list.h b/include/parrot/list.h index 01121fd06b..9e28835e59 100644 --- a/include/parrot/list.h +++ b/include/parrot/list.h @@ -105,13 +105,15 @@ void Parrot_list_append(SHIM_INTERP, FUNC_MODIFIES(*item); PARROT_EXPORT -INTVAL Parrot_list_check(SHIM_INTERP, ARGIN(Linked_List *list)) +PARROT_CONST_FUNCTION +INTVAL Parrot_list_check(SHIM_INTERP, ARGIN(const Linked_List *list)) __attribute__nonnull__(2); PARROT_EXPORT +PARROT_PURE_FUNCTION INTVAL Parrot_list_contains(SHIM_INTERP, - ARGIN(Linked_List *list), - ARGIN(List_Item_Header *item)) + ARGIN(const Linked_List *list), + ARGIN(const List_Item_Header *item)) __attribute__nonnull__(2) __attribute__nonnull__(3); @@ -126,8 +128,7 @@ struct Linked_List* Parrot_list_new(SHIM_INTERP); PARROT_EXPORT PARROT_CAN_RETURN_NULL -List_Item_Header* Parrot_list_pop(PARROT_INTERP, ARGIN(Linked_List *list)) - __attribute__nonnull__(1) +List_Item_Header* Parrot_list_pop(SHIM_INTERP, ARGIN(Linked_List *list)) __attribute__nonnull__(2); PARROT_EXPORT @@ -152,8 +153,7 @@ List_Item_Header* Parrot_list_remove(SHIM_INTERP, PARROT_ASSERT_ARG(list)) #define ASSERT_ARGS_Parrot_list_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (0) #define ASSERT_ARGS_Parrot_list_pop __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ - PARROT_ASSERT_ARG(interp) \ - , PARROT_ASSERT_ARG(list)) + PARROT_ASSERT_ARG(list)) #define ASSERT_ARGS_Parrot_list_remove __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(list) \ , PARROT_ASSERT_ARG(item)) diff --git a/src/list.c b/src/list.c index 52b67c9941..35fc9f7b30 100644 --- a/src/list.c +++ b/src/list.c @@ -43,7 +43,7 @@ Parrot_list_new(SHIM_INTERP) { ASSERT_ARGS(Parrot_list_new) - Linked_List *res = (Linked_List*)mem_sys_allocate_zeroed(sizeof (Linked_List)); + Linked_List * const res = (Linked_List*)mem_sys_allocate_zeroed(sizeof (Linked_List)); return res; } @@ -119,8 +119,8 @@ Parrot_list_remove(SHIM_INTERP, ARGMOD(Linked_List *list), ARGMOD(List_Item_Head { ASSERT_ARGS(Parrot_list_remove) - List_Item_Header *next = item->next; - List_Item_Header *prev = item->prev; + List_Item_Header * const next = item->next; + List_Item_Header * const prev = item->prev; PARROT_ASSERT(list == item->owner); @@ -153,11 +153,11 @@ Pop an item off the list - i.e. get the first item in the list and remove it. PARROT_EXPORT PARROT_CAN_RETURN_NULL List_Item_Header* -Parrot_list_pop(PARROT_INTERP, ARGIN(Linked_List *list)) +Parrot_list_pop(SHIM_INTERP, ARGIN(Linked_List *list)) { ASSERT_ARGS(Parrot_list_pop) - List_Item_Header *ret = list->first; + List_Item_Header * const ret = list->first; if (ret) LIST_REMOVE(list, ret); return ret; @@ -165,7 +165,7 @@ Parrot_list_pop(PARROT_INTERP, ARGIN(Linked_List *list)) /* -=item C +=item C Check the validity of the list @@ -174,12 +174,13 @@ Check the validity of the list */ PARROT_EXPORT +PARROT_CONST_FUNCTION INTVAL -Parrot_list_check(SHIM_INTERP, ARGIN(Linked_List *list)) +Parrot_list_check(SHIM_INTERP, ARGIN(const Linked_List *list)) { ASSERT_ARGS(Parrot_list_check) - List_Item_Header *tmp = list->first; + const List_Item_Header *tmp = list->first; size_t counter = 0; while (tmp) { @@ -195,8 +196,8 @@ Parrot_list_check(SHIM_INTERP, ARGIN(Linked_List *list)) /* -=item C +=item C Returns True if the is in the list @@ -205,12 +206,13 @@ Returns True if the is in the list */ PARROT_EXPORT +PARROT_PURE_FUNCTION INTVAL -Parrot_list_contains(SHIM_INTERP, ARGIN(Linked_List *list), ARGIN(List_Item_Header *item)) +Parrot_list_contains(SHIM_INTERP, ARGIN(const Linked_List *list), ARGIN(const List_Item_Header *item)) { ASSERT_ARGS(Parrot_list_contains) - List_Item_Header *tmp = list->first; + const List_Item_Header *tmp = list->first; #ifndef NDEBUG if (item->owner != list) From 44e2ba5b68d1b067bceb0223c8e66d7709b14f6f Mon Sep 17 00:00:00 2001 From: Nolan Lum Date: Thu, 9 Dec 2010 16:29:20 -0500 Subject: [PATCH 040/102] Fix bug in String PMC with extraneous multimethod. Increase code coverage of String PMC tests. --- CREDITS | 5 +++++ src/pmc/string.pmc | 4 ---- t/pmc/string.t | 36 +++++++++++++++++++++++++++++++++++- 3 files changed, 40 insertions(+), 5 deletions(-) diff --git a/CREDITS b/CREDITS index a317e4e2f0..6d5997f69e 100644 --- a/CREDITS +++ b/CREDITS @@ -798,6 +798,11 @@ U: nwellnhof N: Nikolay Ananiev D: Win32 build fix +N: Nolan Lum +E: nol888@gmail.com +D: Test coverage improvement. +U: Yuki`N + N: Norman Nunley D: Shaving a Ponie E: nnunley@gmail.com diff --git a/src/pmc/string.pmc b/src/pmc/string.pmc index bcd2847c18..9cfa55591c 100644 --- a/src/pmc/string.pmc +++ b/src/pmc/string.pmc @@ -245,10 +245,6 @@ they match. return (INTVAL)(STRING_equal(INTERP, str_val, v)); } - MULTI INTVAL is_equal(PMC *value) { - return SELF.is_equal(value); - } - /* =item C diff --git a/t/pmc/string.t b/t/pmc/string.t index 6adbd4d748..5c0708ff3a 100644 --- a/t/pmc/string.t +++ b/t/pmc/string.t @@ -18,7 +18,7 @@ Tests the C PMC. .sub main :main .include 'test_more.pir' - plan(148) + plan(153) set_or_get_strings() setting_integers() @@ -61,6 +61,7 @@ Tests the C PMC. assign_null_string() access_keyed() exists_keyed() + test_unescape() # END_OF_TESTS .end @@ -619,6 +620,14 @@ OK4: ok( $I0, 'ne_str "0(Integer), "ABC" -> true' ) is( t, 'TAACGSTAACGS', 'trans' ) is( s, 'atugcsATUGCS', "trans doesn't touch source string") + + $I0 = 1 + push_eh GOOD1 + $P0.'trans'(unicode:"abc", tr_00) + $I0 = 0 +GOOD1: + pop_eh + ok( $I0, 'trans throws exception with non-ascii' ) .end # create tr table at compile-time @@ -681,6 +690,14 @@ loop: $S1 = substr $S0, 3, 3 $I0 = $P0.'is_integer'($S1) ok( $I0, '... substr' ) + + $I0 = 1 + push_eh GOOD1 + $P0.'is_integer'(unicode:"123") + $I0 = 0 +GOOD1: + pop_eh + ok( $I0, 'is_integer throws exception with non-ascii' ) .end .sub instantiate_str @@ -906,6 +923,23 @@ check: is(r, 0, 'exists_keyed negative out of bounds') .end +.sub test_unescape + .local pmc s1, s2 + + s1 = new['String'] + s1 = '\n' + s2 = s1.'unescape'('ascii') + is( s2, "\n", "unescape('\\n') == \"\\n\"" ) + + s1 = '\x41\x42' + s2 = s1.'unescape'('ascii') + is( s2, 'AB', "unescape('\\x41\\x42') == 'AB'" ) + + s1 = '\u0043\u0044' + s2 = s1.'unescape'('ascii') + is( s2, 'CD', "unescape('\\u0043\\u0044') == 'CD'" ) +.end + # Local Variables: # mode: pir # fill-column: 100 From 26c3ed32f7e4a1372c6dbaee1e5b6629abc45a4d Mon Sep 17 00:00:00 2001 From: Nolan Lum Date: Thu, 9 Dec 2010 22:02:08 -0500 Subject: [PATCH 041/102] Change behavior of exception-related tests. --- t/pmc/string.t | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/t/pmc/string.t b/t/pmc/string.t index 5c0708ff3a..9e84c54e88 100644 --- a/t/pmc/string.t +++ b/t/pmc/string.t @@ -621,13 +621,15 @@ OK4: ok( $I0, 'ne_str "0(Integer), "ABC" -> true' ) is( t, 'TAACGSTAACGS', 'trans' ) is( s, 'atugcsATUGCS', "trans doesn't touch source string") + push_eh THROWN $I0 = 1 - push_eh GOOD1 $P0.'trans'(unicode:"abc", tr_00) + goto TEST +THROWN: $I0 = 0 -GOOD1: +TEST: pop_eh - ok( $I0, 'trans throws exception with non-ascii' ) + todo( $I0, 'trans throws exception with non-ascii' ) .end # create tr table at compile-time @@ -691,13 +693,15 @@ loop: $I0 = $P0.'is_integer'($S1) ok( $I0, '... substr' ) + push_eh THROWN $I0 = 1 - push_eh GOOD1 $P0.'is_integer'(unicode:"123") + goto TEST +THROWN: $I0 = 0 -GOOD1: +TEST: pop_eh - ok( $I0, 'is_integer throws exception with non-ascii' ) + todo( $I0, 'is_integer throws exception with non-ascii' ) .end .sub instantiate_str From 67b58a124e53ccb8d61247a89069fafac00d9de5 Mon Sep 17 00:00:00 2001 From: Nolan Lum Date: Fri, 10 Dec 2010 14:52:59 -0500 Subject: [PATCH 042/102] Fix wording. --- t/pmc/string.t | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/t/pmc/string.t b/t/pmc/string.t index 9e84c54e88..588345919c 100644 --- a/t/pmc/string.t +++ b/t/pmc/string.t @@ -629,7 +629,7 @@ THROWN: $I0 = 0 TEST: pop_eh - todo( $I0, 'trans throws exception with non-ascii' ) + todo( $I0, 'trans works with unicode' ) .end # create tr table at compile-time @@ -701,7 +701,7 @@ THROWN: $I0 = 0 TEST: pop_eh - todo( $I0, 'is_integer throws exception with non-ascii' ) + todo( $I0, 'is_integer works with unicode' ) .end .sub instantiate_str From 5c746dba12f7d893e54db700ad2ef08b1f9ad925 Mon Sep 17 00:00:00 2001 From: Peter Lobsinger Date: Thu, 9 Dec 2010 12:20:16 +0800 Subject: [PATCH 043/102] eliminate static numbering of ops static numbers for ops has no meaning. also, opsc generates number automatically now, rendering these completely unecessary. also eliminate a nasty cast (op_func_t* => void** => (void*)() => op_func_t*) --- include/parrot/oplib.h | 12 ------------ src/runcore/main.c | 4 ++-- 2 files changed, 2 insertions(+), 14 deletions(-) diff --git a/include/parrot/oplib.h b/include/parrot/oplib.h index f47eda8bf4..cbe925836c 100644 --- a/include/parrot/oplib.h +++ b/include/parrot/oplib.h @@ -41,18 +41,6 @@ typedef enum { /* when init = true initialize, else de_initialize */ typedef op_lib_t *(*oplib_init_f)(PARROT_INTERP, long init); -/* core.ops special opcode numbers */ -typedef enum { - CORE_OPS_end, /* halt the runloop */ - CORE_OPS_noop, /* do nothing */ - CORE_OPS_check_events, /* explicit event check */ - CORE_OPS_check_events__, /* inserted into op dispatch when an event - got scheduled */ - CORE_OPS_wrapper__ /* inserted by dynop_register for new ops */ - /* 2 more reserved */ -} special_core_ops_enum; - - #endif /* PARROT_OPLIB_H_GUARD */ /* diff --git a/src/runcore/main.c b/src/runcore/main.c index 4aad769dc5..c8a10d8e8b 100644 --- a/src/runcore/main.c +++ b/src/runcore/main.c @@ -416,8 +416,8 @@ enable_event_checking(PARROT_INTERP) cs->op_count, op_func_t); for (i = interp->evc_func_table_size; i < cs->op_count; i++) - interp->evc_func_table[i] = (op_func_t) - D2FPTR(((void**)core_lib->op_func_table)[CORE_OPS_check_events__]); + interp->evc_func_table[i] = + core_lib->op_func_table[PARROT_OP_check_events__]; interp->evc_func_table_size = cs->op_count; } From ead90b8560e3fbe40aecd601f420d1bb53730055 Mon Sep 17 00:00:00 2001 From: Peter Lobsinger Date: Thu, 9 Dec 2010 12:26:47 +0800 Subject: [PATCH 044/102] eliminate op documentation mentioning defunct CORE_OPS_* --- src/ops/core.ops | 6 +----- t/tools/dev/searchops/samples.pm | 2 +- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/src/ops/core.ops b/src/ops/core.ops index da3d3c1e05..db4dc38b2f 100644 --- a/src/ops/core.ops +++ b/src/ops/core.ops @@ -49,7 +49,7 @@ internal use only; don't emit these opcodes. =item B() -Halts the interpreter. (Must be op #0, CORE_OPS_end). See also B. +Halts the interpreter. See also B. =cut @@ -63,26 +63,22 @@ inline op end() :base_core :check_event :flow { =item B() Does nothing other than waste an iota of time and 32 bits of bytecode space. -(Must be op #1, CORE_OPS_noop) =item B() Check the event queue and run event handlers if there are unhandled events. Note: This opcode is mainly for testing. It should not be necessary to ever use it explicitly. -(Must be op #3, CORE_OPS_check_events). =item B() Check the event queue and run event handlers if there are unhandled events. Note: Do B use this opcode. It is for internal use only. -(Must be op #4, CORE_OPS_check_events__). =item B() Internal opcode to wrap unknown ops from loaded opcode libs. Don't use. -(Must be op #5, CORE_OPS_wrapper__). =item B(in STR) diff --git a/t/tools/dev/searchops/samples.pm b/t/tools/dev/searchops/samples.pm index 01111046c6..a9f4d6cc57 100644 --- a/t/tools/dev/searchops/samples.pm +++ b/t/tools/dev/searchops/samples.pm @@ -39,7 +39,7 @@ pseudo-core.ops - Parrot Core Ops =item B() -Halts the interpreter. (Must be op #0, CORE_OPS_end). See also B. +Halts the interpreter. See also B. =cut From 30bb037df3e8793538f58509bebc45f7bc8e2a3a Mon Sep 17 00:00:00 2001 From: Peter Lobsinger Date: Thu, 9 Dec 2010 12:41:13 +0800 Subject: [PATCH 045/102] add some documentation about pluggable framebuilder subsystem --- src/nci/framebuilder.pod | 72 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) create mode 100644 src/nci/framebuilder.pod diff --git a/src/nci/framebuilder.pod b/src/nci/framebuilder.pod new file mode 100644 index 0000000000..7d8093f51d --- /dev/null +++ b/src/nci/framebuilder.pod @@ -0,0 +1,72 @@ +# Copyright (C) 2010, Parrot Foundation. + +=pod + +=head1 NAME + +src/nci/framebuilder.pod - Parrot Native Call Frame Builder API + +=head1 DESCRIPTION + +Parrot's frame builder is fully pluggable at runtime. That is to say, a new implementation of the +frame builder can be installed at any time. + +=head2 REGISTRATION + +Parrot has 2 slots for the frame builder function - a callback PMC and a user data PMC. The +callback PMC is expected to return a valid C native function from its C +vtable. + +The callback for a framebuilder should be registerd in parrot's C array under +C. The user data is likewise registered in C under C. + +=head2 C + +C functions receive an interpreter, the registered frame builder user data, and a +signature string. They are expected to produce a thunk PMC, and throw an exception or return C +on failure. B frame builders should not parse the signature string themselves but +delegate to C to ensure consistency between implementations. + +=head2 Thunk PMCs + +Thunk PMCs, produced by the frame builder callback, are expected to return a valid C +native function from their C vtables. + +C functions receive an interpreter, an NCI PMC, and a thunk PMC. They are expected to +unpack Parrot's PCC arguments and pass them to the native function pointer in the NCI PMC using the +appropriate native function calling conventions and to do the reverse with return values. The exact +details of what operations to perform are specified in the signature supplied to the frame builder +when the thunk is created. + +=head2 The Thunk Cache + +Thunks are generated lazily on demand and cached. Generally, only one thunk will exist for a given +NCI signature. The cache is held in C under C. This cache can be operated on +directly, for example, clearing the cache is possible by running the following PIR code: + + .include 'iglobals.pasm' + .sub 'clear-nci-cache' + $P0 = getinterp + $P0 = $P0[.IGLOBALS_NCI_FUNCS] + $P1 = iter $P0 + loop: + unless $P1 goto end_loop + $S0 = shift $P1 + delete $P0[$S0] + goto loop + end_loop: + .end + +Note however, that this will B remove thunks from NCI PMCs which have already been invoked +(these cache their Thunk PMC locally). + +Another use of direct manipulation of the C cache is nci thunk dynext libraries, +generated by C, which add additional statically compiled thunks to parrot at runtime. + +=head1 WARNING + +The frame builder API is currently in a state of flux. Expected improvements are to isolate frame +builders further from the signature strings and also to reduce the C-bias in the API. + +=cut + From 20ee3ca438c1023663a2fdad2b31d8dc823c2fa0 Mon Sep 17 00:00:00 2001 From: Peter Lobsinger Date: Thu, 9 Dec 2010 12:42:33 +0800 Subject: [PATCH 046/102] mk_manifest_and_skip --- MANIFEST | 1 + 1 file changed, 1 insertion(+) diff --git a/MANIFEST b/MANIFEST index bb111e865a..77974ac894 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1293,6 +1293,7 @@ src/nci/core_thunks.c [] src/nci/core_thunks.nci [] src/nci/extra_thunks.c [] src/nci/extra_thunks.nci [] +src/nci/framebuilder.pod [] src/nci/libffi.c [] src/nci/signatures.c [] src/nci_test.c [] From 29bd61dab261c681798b5b51c0e98c557d879a93 Mon Sep 17 00:00:00 2001 From: Gerd Pokorra Date: Thu, 9 Dec 2010 20:09:58 +0800 Subject: [PATCH 047/102] remove whitespace --- t/pmc/string.t | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/t/pmc/string.t b/t/pmc/string.t index 588345919c..996831a8d0 100644 --- a/t/pmc/string.t +++ b/t/pmc/string.t @@ -92,7 +92,7 @@ Tests the C PMC. set $P0, "0xFFFFFF" set $S0, $P0 is( $S0, "0xFFFFFF", 'String obj set with literal hex string' ) - + new $P1, ['Float'] set $P1, 3.14159 setref $P0, $P1 @@ -381,18 +381,18 @@ TRUE5: nok( $I0, 'uninitialized String is false' ) new $P2, ['Integer'] set $P1, "10" set $P2, 10 - + cmp_num $I0, $P1, $P2 is( $I0, 0, 'cmp_num "10"(String PMC), 10(Integer PMC) = 0' ) - + set $P2, 20 cmp_num $I0, $P1, $P2 is( $I0, -1, 'cmp_num "10", 20 = -1' ) - + set $P2, 5 cmp_num $I0, $P1, $P2 is( $I0, 1, 'cmp_num "10", 5 = 1' ) - + set $P1, "asd" cmp_num $I0, $P1, $P2 is( $I0, -1, 'cmp_num "asd", 5 = -1' ) @@ -450,7 +450,7 @@ TRUE5: nok( $I0, 'uninitialized String is false' ) new $P2, ['Float'] set $P1, "124" set $P2, 124 - + set $I0, 1 eq_num $P2, $P1, OK1 set $I0, 0 @@ -567,18 +567,18 @@ OK4: ok( $I0, 'ne_str "0(Integer), "ABC" -> true' ) .sub test_set_bool new $P0, ['String'] - + set $P0, "1" not $P0 is( $P0, "0", 'not "1" = "0"' ) - + not $P0 is( $P0, "1", 'not "0" = "1"' ) - + set $P0, "false" not $P0 is( $P0, "0", 'not "false" = "0"' ) - + set $P0, 0 not $P0 is( $P0, "1", 'not 0 = "1"' ) From 90a31da69026fb924f1fb0638663cc6f9318b11d Mon Sep 17 00:00:00 2001 From: Christoph Otto Date: Thu, 9 Dec 2010 23:14:34 +0800 Subject: [PATCH 048/102] add md5sum tool using MappedByteArray from Kapace++'s gci task --- examples/pir/md5sum.pir | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) create mode 100644 examples/pir/md5sum.pir diff --git a/examples/pir/md5sum.pir b/examples/pir/md5sum.pir new file mode 100644 index 0000000000..36f702f9ad --- /dev/null +++ b/examples/pir/md5sum.pir @@ -0,0 +1,21 @@ +.sub main + .param pmc argv + load_bytecode "Digest/MD5.pbc" + .local pmc mba + .local string filename + + set filename, argv[1] + $S0 = "Creating new MappedByteArray, and opening " . filename + say $S0 + mba = new 'MappedByteArray' + mba.'open'(filename) + + say 'getting the data from the Mapped Byte Array...' + $I1 = elements mba + $S0 = mba.'get_string'(0, $I1, 'binary') + + $P1 = _md5sum($S0) + $S0 = _md5_hex($P1) + say $S0 + .end + From d1ea164f5e8693cf1c7fc7e857ac007009d9c1e6 Mon Sep 17 00:00:00 2001 From: sygi Date: Thu, 9 Dec 2010 23:44:34 +0800 Subject: [PATCH 049/102] polish translation of README Signed-off-by: Jonathan "Duke" Leto --- README.polski | 185 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 185 insertions(+) create mode 100644 README.polski diff --git a/README.polski b/README.polski new file mode 100644 index 0000000000..0879d4d245 --- /dev/null +++ b/README.polski @@ -0,0 +1,185 @@ +To jest Parrot, versja 2.10.1 +----------------------------- + +Prawa autorskie (C) Parrot należą do 2001-2010, Parrot Foundation. + +INFORMACJA O LICENCJI +--------------------- + +Ten kod jest rozpowszechniany na warunkach licencji Artistic License 2.0. +Więcej szczegółów znajduje się w pliku LICENCE, gdzie można znaleść cały +tekst licencji. + +PRZEGLĄD +-------- +Parrot jest maszyną wirtualną, zaprojektowaną aby efektywnie kompilować +i wykonywać kod języków dynamicznych. + +WYMAGANIA +--------- + +Potrzebujesz kompilatora języka C, linker, i oczywiście program make. + +Jeśli będziesz linkował z biblioteką ICU, musisz ją ściągnąć i zainstalować +przed konfigurowaniem Parrot. Pobierz ją z http://site.icu-project.org/download + +Potrzebujesz również Perl 5.8.4 lub nowszego, i Storable 2.12 lub nowszego, +aby uruchamiać różne skrypty konfiguracji i budowania. + +Na większości platform, które od początku wspieramy, Parrot powinien zbudować +się sam. Lista głównych platform znajduje się w docs/parrot.pod. Plik PLATFORMS +przechowuje informacje dotyczące raportów z platform, na których Parrot +został zbudowany i testowany. + +JAK UZYSKAĆ PARROT Z GITHUB +--------------------------- +I. Zainstaluj Git. + +Linux: +Metoda instalacji zależy od twojej dystrybucji. Aby zainstalować powinieneś +uruchomić (jako root, albo sudo ): + +Na Ubuntu/Debianie (oparte na apt): + + apt-get install git-core + +Na Red Hat/Fedorze (oparte na rpm): + + yum install git + +Na Gentoo (portage): + + emerge -av dev-vcs/git + +Windows: +Są 2 porty Git na Windows: + +msysgit http://code.google.com/p/msysgit/downloads/list +TortoiseGit http://code.google.com/p/tortoisegit/downloads/list + +Macintosh OS X: + +Przeszukanie internetu pozwoli znaleść wiele różnych instalatorów git dla +Mac OS X, w tym: + + http://help.github.com/mac-git-installation/ + +II. Uzyskanie Parrot z github.com + +Aby ściągnąć kopię repozytorium Git Parrota: + + git clone git://github.com/parrot/parrot.git + +Ta komenda domyślnie ustawi gałąź na master. Aby utworzyć lokalną gałąź, +która śledzi gałąź "some_branch": + + git checkout -b --track some_branch origin/some_branch + +Wszystkie powyższe adresy URL służą jedynie do ściągania danych. Jeśli jesteś +deweloperem jądra Parrot, użyj adresu, który pozwoli na odczytywanie i zapis: + + git clone git@github.com:parrot/parrot.git + +Możesz zobaczyć listę wszystkich gałęzi na http://github.com/parrot/parrot + +INSTRUKCJE +---------- + +Na początek, wypakuj tarballa Parrot (jeśli to czytasz, to prawdopodobnie +już to zrobiłeś) i wpisz + + perl Configure.pl + +aby uruchomić skrypt Configure. Skrypt ten wypakowuje konfigurację +z uruchomionego programu perl5. Możliwe, że będziesz musiał jawnie pokazać +Configure.pl którego kompilatora i linkera ma użyć. Na przykład, aby +kompilować pliki C za pomocą 'cc', pliki C++ za pomocą 'CC', a linkować +wszystko za pomocą 'CC', należy wpisać + + perl Configure.pl --cc=cc --cxx=CC --link=CC --ld=CC + +Zajrzyj do "perl Configure.pl --help", aby poznać więcej opcji i do +docs/configuration.pod po więcej szczegółów. + +W systemach podobnych do HPUX, które nie posiadają inet_pton, należy uruchomić + + perl Configure.pl --define=inet_aton + +Działający Configure.pl wygeneruje nagłówek config.h, moduł Parrot:Config, +pliki zależne od platformy i wiele plików Makefile. + +Plik "myconfig" posiada przegląd ustawień konfiguracji. + +Następnie, uruchom make. (Configure.pl powie, którą wersję make poleca dla twojego systemu) + +Teraz interpreter powinien budować program. Jeśli budujesz bibliotekę ICU +(co jest domyślne dla większości systemów), powinieneś w zamian użyć +GNU make (lub czegoś, co jest z nim kompatybilne). + +Możesz przetestować Parrot za pomocą "make test". Możesz uruchomić testy +równolegle za pomocą "make TEST_JOBS=3 test". + +Możesz uruchomić pełną gamę testów za pomocą + + make fulltest + +Uwaga: plik PLATFORMS zawiera informacje o tym, jakich błędów +powinieneś się spodziewać. + +Możesz zainstalować Parrot za pomocą: + + make install + +Domyślnie, ta komenda instaluje w /usr/local, a plik wykonywalny Parrot +umieszcza w /usr/local/bin. Jeśli chcesz zainstalować Parrot w innym miejscu, +użyj: + + perl Configure.pl --prefix=/home/joe/bird + make install + +Ale zwróć uwagę na to, że biblioteki dynamiczne nie będą znalezione dla +niestandardowych lokalizacji, chyba że ustawisz LD_LIBRARY_PATH, albo coś +podobnego. + +Zajrzyj do docs/parrot.pod i docs/intro.pod, aby dowiedzieć się, co dalej. +Jeśli masz jakiekolwiek problemy, spójrz do rodziału "How To Submit A +Bug Report" w docs/submissions.pod. Te dokumenty są w formacie POD. +Możesz je obejrzeć za pomocą komendy: + + perldoc -F docs/intro.pod + +ZMIANY +------ + +Dokumentacja zmian zauważalnych przez użytkownika pomiędzy tą, +a poprzednimi wersjami znajduje się w pliku NEWS. + +LISTY DYSKUSYJNE +---------------- + +Lista dyskusyjna użytkowników Parrot to parrot-users@lists.parrot.org. +Dołącz do niej poprzez wypełnienie formularza +http://lists.parrot.org/mailman/listinfo/parrot-users . +Lista dyskusyjna jest dostępna pod adresem +http://lists.parrot.org/pipermail/parrot-users/ . + +Aby uzyskać informację na temat dyskusji deweloperskich, spójrz +w docs/gettingstarted.pod. + +PRZEKAZANIE OPINII, PATCHA, itd. +-------------------------------- + +Zajrzyj do docs/submissions.pod, aby uzyskać więcej informacji na temat +zgłaszania błędów i wysyłania patchy. + +STRONY INTERNETOWE +------------------ + +Następujące strony przechowują wszelkie informacje o Parrot, jakie mogą +być Ci potrzebne: + http://www.parrot.org/ + http://trac.parrot.org/ + http://docs.parrot.org/ + +Miłej zabawy, + The Parrot Team. From 8d97c3bbe09b15effcdee2b4f2f84e67fc57d370 Mon Sep 17 00:00:00 2001 From: sygi Date: Fri, 10 Dec 2010 00:28:59 +0800 Subject: [PATCH 050/102] tiny corrects Signed-off-by: Jonathan "Duke" Leto --- README.polski | 77 ++++++++++++++++++++++++++------------------------- 1 file changed, 39 insertions(+), 38 deletions(-) diff --git a/README.polski b/README.polski index 0879d4d245..ce0140c24b 100644 --- a/README.polski +++ b/README.polski @@ -1,43 +1,44 @@ -To jest Parrot, versja 2.10.1 +To jest Parrot, wersja 2.10.1 ----------------------------- -Prawa autorskie (C) Parrot należą do 2001-2010, Parrot Foundation. +Prawa autorskie (C) Parrota należą do 2001-2010, Parrot Foundation. INFORMACJA O LICENCJI --------------------- Ten kod jest rozpowszechniany na warunkach licencji Artistic License 2.0. -Więcej szczegółów znajduje się w pliku LICENCE, gdzie można znaleść cały +Więcej szczegółów znajduje się w pliku LICENCE, gdzie można znaleźć cały tekst licencji. -PRZEGLĄD --------- -Parrot jest maszyną wirtualną, zaprojektowaną aby efektywnie kompilować +OPIS +---- + +Parrot jest maszyną wirtualną, zaprojektowaną, aby efektywnie kompilować i wykonywać kod języków dynamicznych. WYMAGANIA --------- -Potrzebujesz kompilatora języka C, linker, i oczywiście program make. +Potrzebujesz kompilator języka C, linker, i oczywiście program make. Jeśli będziesz linkował z biblioteką ICU, musisz ją ściągnąć i zainstalować -przed konfigurowaniem Parrot. Pobierz ją z http://site.icu-project.org/download +przed konfigurowaniem Parrota. Pobierz ją z http://site.icu-project.org/download -Potrzebujesz również Perl 5.8.4 lub nowszego, i Storable 2.12 lub nowszego, +Potrzebujesz również Perla 5.8.4 lub nowszego, i Storable 2.12 lub nowszego, aby uruchamiać różne skrypty konfiguracji i budowania. -Na większości platform, które od początku wspieramy, Parrot powinien zbudować -się sam. Lista głównych platform znajduje się w docs/parrot.pod. Plik PLATFORMS -przechowuje informacje dotyczące raportów z platform, na których Parrot -został zbudowany i testowany. +Na większości z platform, które wspieramy od początku, Parrot powinien zbudować +się sam. Lista wspieranych platform znajduje się w docs/parrot.pod. +Plik PLATFORMS przechowuje informacje dotyczące raportów z platform, na +których Parrot był zbudowany i testowany. JAK UZYSKAĆ PARROT Z GITHUB --------------------------- I. Zainstaluj Git. Linux: -Metoda instalacji zależy od twojej dystrybucji. Aby zainstalować powinieneś -uruchomić (jako root, albo sudo ): +Metoda instalacji zależy od twojej dystrybucji. Instalacja rozpocznie się po +wpisaniu (jako root, albo sudo ): Na Ubuntu/Debianie (oparte na apt): @@ -59,7 +60,7 @@ TortoiseGit http://code.google.com/p/tortoisegit/downloads/list Macintosh OS X: -Przeszukanie internetu pozwoli znaleść wiele różnych instalatorów git dla +Przejrzenie internetu pozwoli znaleźć wiele różnych instalatorów git dla Mac OS X, w tym: http://help.github.com/mac-git-installation/ @@ -76,7 +77,7 @@ która śledzi gałąź "some_branch": git checkout -b --track some_branch origin/some_branch Wszystkie powyższe adresy URL służą jedynie do ściągania danych. Jeśli jesteś -deweloperem jądra Parrot, użyj adresu, który pozwoli na odczytywanie i zapis: +deweloperem jądra Parrot, użyj adresu, który pozwoli na odczyt i zapis: git clone git@github.com:parrot/parrot.git @@ -85,12 +86,12 @@ Możesz zobaczyć listę wszystkich gałęzi na http://github.com/parrot/parrot INSTRUKCJE ---------- -Na początek, wypakuj tarballa Parrot (jeśli to czytasz, to prawdopodobnie +Na początek, wypakuj tarballa Parrota (jeśli to czytasz, to prawdopodobnie już to zrobiłeś) i wpisz perl Configure.pl -aby uruchomić skrypt Configure. Skrypt ten wypakowuje konfigurację +aby uruchomić skrypt Configure. Skrypt ten odczyta konfigurację z uruchomionego programu perl5. Możliwe, że będziesz musiał jawnie pokazać Configure.pl którego kompilatora i linkera ma użyć. Na przykład, aby kompilować pliki C za pomocą 'cc', pliki C++ za pomocą 'CC', a linkować @@ -98,25 +99,25 @@ wszystko za pomocą 'CC', należy wpisać perl Configure.pl --cc=cc --cxx=CC --link=CC --ld=CC -Zajrzyj do "perl Configure.pl --help", aby poznać więcej opcji i do +Uruchom "perl Configure.pl --help", aby poznać więcej opcji i do docs/configuration.pod po więcej szczegółów. W systemach podobnych do HPUX, które nie posiadają inet_pton, należy uruchomić perl Configure.pl --define=inet_aton -Działający Configure.pl wygeneruje nagłówek config.h, moduł Parrot:Config, +Configure.pl wygeneruje nagłówek config.h, moduł Parrot:Config, pliki zależne od platformy i wiele plików Makefile. Plik "myconfig" posiada przegląd ustawień konfiguracji. -Następnie, uruchom make. (Configure.pl powie, którą wersję make poleca dla twojego systemu) +Następnie uruchom make. (Configure.pl poda, którą wersję make'a zaleca dla twojego systemu) -Teraz interpreter powinien budować program. Jeśli budujesz bibliotekę ICU -(co jest domyślne dla większości systemów), powinieneś w zamian użyć -GNU make (lub czegoś, co jest z nim kompatybilne). +Teraz interpreter powinien zbudować program. Jeśli budujesz bibliotekę ICU +(co jest domyślne dla większości systemów), powinieneś użyć GNU make +(lub czegoś, co jest z nim kompatybilne). -Możesz przetestować Parrot za pomocą "make test". Możesz uruchomić testy +Możesz przetestować Parrota za pomocą "make test". Możesz uruchomić testy równolegle za pomocą "make TEST_JOBS=3 test". Możesz uruchomić pełną gamę testów za pomocą @@ -130,19 +131,19 @@ Możesz zainstalować Parrot za pomocą: make install -Domyślnie, ta komenda instaluje w /usr/local, a plik wykonywalny Parrot -umieszcza w /usr/local/bin. Jeśli chcesz zainstalować Parrot w innym miejscu, +Domyślnie, ta komenda instaluje Parrota w /usr/local, a jego plik wykonywalny +umieszcza w /usr/local/bin. Jeśli chcesz zainstalować Parrota w innym miejscu, użyj: perl Configure.pl --prefix=/home/joe/bird make install -Ale zwróć uwagę na to, że biblioteki dynamiczne nie będą znalezione dla -niestandardowych lokalizacji, chyba że ustawisz LD_LIBRARY_PATH, albo coś -podobnego. +Zwróć uwagę na to, że biblioteki dynamiczne nie będą znalezione +w niestandardowych lokalizacjach, chyba że ustawisz LD_LIBRARY_PATH, +albo coś podobnego. Zajrzyj do docs/parrot.pod i docs/intro.pod, aby dowiedzieć się, co dalej. -Jeśli masz jakiekolwiek problemy, spójrz do rodziału "How To Submit A +Jeśli masz jakiekolwiek problemy, spójrz do rozdziału "How To Submit A Bug Report" w docs/submissions.pod. Te dokumenty są w formacie POD. Możesz je obejrzeć za pomocą komendy: @@ -151,7 +152,7 @@ Możesz je obejrzeć za pomocą komendy: ZMIANY ------ -Dokumentacja zmian zauważalnych przez użytkownika pomiędzy tą, +Spis zmian zauważalnych przez użytkownika pomiędzy tą, a poprzednimi wersjami znajduje się w pliku NEWS. LISTY DYSKUSYJNE @@ -163,19 +164,19 @@ http://lists.parrot.org/mailman/listinfo/parrot-users . Lista dyskusyjna jest dostępna pod adresem http://lists.parrot.org/pipermail/parrot-users/ . -Aby uzyskać informację na temat dyskusji deweloperskich, spójrz -w docs/gettingstarted.pod. +Aby uzyskać informację na temat list dyskusyjnych deweloperów, zajrzyj +do docs/gettingstarted.pod. PRZEKAZANIE OPINII, PATCHA, itd. -------------------------------- -Zajrzyj do docs/submissions.pod, aby uzyskać więcej informacji na temat -zgłaszania błędów i wysyłania patchy. +Zajrzyj do docs/submissions.pod po więcej informacji na temat +zgłaszania błędów i wysyłania patchów. STRONY INTERNETOWE ------------------ -Następujące strony przechowują wszelkie informacje o Parrot, jakie mogą +Następujące strony przechowują wszelkie informacje o Parrocie, jakie mogą być Ci potrzebne: http://www.parrot.org/ http://trac.parrot.org/ From d5eb9a4b1ea5341d0210bf1c422f72d11a61dbeb Mon Sep 17 00:00:00 2001 From: "Jonathan \"Duke\" Leto" Date: Fri, 10 Dec 2010 17:39:53 +0800 Subject: [PATCH 051/102] Add NEWS item about README translations --- NEWS | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS b/NEWS index 96e16936d2..d91b3e4b28 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,9 @@ New in 2.11.0 - Languages + PIRC - left the nest and is currently at https://github.com/parrot/pirc/ + + Community + - README translated into the following languages: + Polish New in 2.10.0 - Core From 6878f9102bafb66fb8620a05401fc2524a7fa6ca Mon Sep 17 00:00:00 2001 From: sygi Date: Fri, 10 Dec 2010 00:34:39 +0800 Subject: [PATCH 052/102] tiny corrects Signed-off-by: Jonathan "Duke" Leto --- README.polski | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.polski b/README.polski index ce0140c24b..db4423a626 100644 --- a/README.polski +++ b/README.polski @@ -25,7 +25,7 @@ Jeśli będziesz linkował z biblioteką ICU, musisz ją ściągnąć i zainstal przed konfigurowaniem Parrota. Pobierz ją z http://site.icu-project.org/download Potrzebujesz również Perla 5.8.4 lub nowszego, i Storable 2.12 lub nowszego, -aby uruchamiać różne skrypty konfiguracji i budowania. +aby uruchamiać różne skrypty służące do konfiguracji i budowania. Na większości z platform, które wspieramy od początku, Parrot powinien zbudować się sam. Lista wspieranych platform znajduje się w docs/parrot.pod. From 4a805892f3350391400520b519546addf81ea2d2 Mon Sep 17 00:00:00 2001 From: Nolan Lum Date: Fri, 10 Dec 2010 16:56:14 -0500 Subject: [PATCH 053/102] Bring Integer PMC test suite code coverage to 100%. --- t/pmc/integer.t | 510 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 502 insertions(+), 8 deletions(-) diff --git a/t/pmc/integer.t b/t/pmc/integer.t index c16236040f..ce51ae3147 100644 --- a/t/pmc/integer.t +++ b/t/pmc/integer.t @@ -15,10 +15,12 @@ Tests the Integer PMC. =cut +.loadlib 'sys_ops' + .sub 'test' :main .include 'test_more.pir' - plan(61) + plan(137) test_init() test_basic_math() test_truthiness_and_definedness() @@ -31,13 +33,19 @@ Tests the Integer PMC. test_istrue_isfalse() test_if_unless() test_add() + test_sub() + test_mul() + test_div() test_arithmetic() + test_mod() + test_neg() test_get_as_base() test_get_as_base10() test_get_as_base_various() test_get_as_base_bounds_check() test_cmp_subclass() test_cmp_RT59336() + test_cmp_num() .end .sub test_init @@ -71,25 +79,61 @@ CODE .sub test_basic_math .local pmc int_1 int_1 = new ['Integer'] - is(int_1,0) + is(int_1, 0, 'Integer PMC creation') int_1 = 1 - is(int_1,1) + is(int_1, 1, '... set') int_1 += 777777 int_1 -= 777776 - is(int_1,2) + is(int_1, 2, '... add/sub') int_1 *= -333333 int_1 /= -222222 - is(int_1,3) + is(int_1, 3, '... mul/div') inc int_1 inc int_1 dec int_1 - is(int_1,4) + is(int_1, 4, '... inc/dec') neg int_1 dec int_1 neg int_1 - is(int_1,5) -.end + is(int_1, 5, '... neg') + + throws_substring(<<'CODE', 'Integer overflow', 'mul integer overflow') + .sub main + .include "errors.pasm" + errorson .PARROT_ERRORS_OVERFLOW_FLAG + + $P0 = new ['Integer'] + $P0 = 2048 + $P0 *= 2048 + $P0 *= 2048 + say $P0 + .end +CODE + .include 'sysinfo.pasm' + .local pmc bigint_1 + int_1 = new ['Integer'] + bigint_1 = new ['BigInt'] + + $I0 = sysinfo .SYSINFO_PARROT_INTMIN + int_1 = $I0 + bigint_1 = int_1 - 1 + + dec int_1 + $P0 = typeof int_1 + is(int_1, bigint_1, 'dec integer overflow promotion') + is($P0, 'BigInt', 'dec integer overflow type check') + + int_1 = new ['Integer'] + int_1 = -57494 + int_1 = abs int_1 + is(int_1, 57494, 'absolute value, assignment') + + int_1 = new ['Integer'] + int_1 = 6 + abs int_1 + is(int_1, 6, 'absolute value, in-place') +.end .sub test_truthiness_and_definedness .local pmc int_1 @@ -300,6 +344,288 @@ fin: add $P2, $P1, $P0 set $S0, $P2 is($S0,50) + + new $P0, ['Integer'] + set $P0, 1073741824 + add $P0, $P0, 1073741824 + is($P0, 2147483648, 'add integer overflow') + + new $P0, ['Integer'] + new $P1, ['Complex'] + set $P0, 20 + set $P1, 4 + add $P0, $P1 + is($P0, "4+0i", 'add complex number') + + new $P0, ['Integer'] + new $P1, ['Float'] + set $P0, 31 + set $P1, 20.1 + add $P0, $P1 + is($P0, 51, 'add DEFAULT') + + new $P0, ['Integer'] + set $P0, 2 + add $P0, 3.14159 + add $P0, 5.75 + is($P0, 10, 'add_float') +.end + +.sub test_sub + $P0 = new ['BigInt'] + $P0 = 424124 + $P1 = new ['Integer'] + $P1 = 424125 + sub $P1, $P1, $P0 + is($P1, 1, 'BigInt sub (no exception)') + + $P0 = new ['Float'] + $P0 = 3.1 + $P1 = new ['Integer'] + $P1 = 10 + sub $P1, $P1, $P0 + is($P1, 6.9, 'DEFAULT sub') + + $P0 = new ['Integer'] + $P0 = -1073741824 + sub $P0, $P0, 1073741825 + is($P0, -2147483649, 'BigInt sub overflow') + + $P0 = new ['Integer'] + $P0 = -1073741824 + sub $P0, 1073741825 + is($P0, -2147483649, 'i_subtract_int overflow') + + $P0 = new ['Integer'] + $P1 = new ['Integer'] + $P0 = -1073741824 + $P1 = 1073741825 + sub $P0, $P1 + is($P0, -2147483649, 'i_subtract overflow') + + $P0 = new ['Integer'] + $P0 = 5 + sub $P0, 4.5 + is($P0, .5, 'i_subtract_float') + + $P0 = new ['Integer'] + $P1 = new ['Complex'] + $P0 = 0 + $P1 = "4+2i" + sub $P0, $P1 + is($P0, "-4-2i", 'subtract Complex number') + + $P0 = new ['Integer'] + $P1 = new ['Float'] + $P0 = 5 + $P1 = 4.5 + sub $P0, $P1 + is($P0, .5, 'subtract DEFAULT multimethod') +.end + +.sub test_mul + $P0 = new ['Integer'] + $P1 = new ['String'] + $P0 = 1 + $P1 = "256" + mul $P0, $P0, $P1 + is($P0, 256, 'multiply Integer PMC by String PMC') + + $P1 = new ['Float'] + $P0 = 2 + $P1 = 3.14 + mul $P0, $P0, $P1 + is($P0, 6, 'multiply Integer PMC by Float PMC') + + $P1 = new ['Integer'] + $P1 = 4 + mul $P0, $P1 + is($P0, 24, 'i_multiply Integer PMC by Integer PMC') + + $P0 = new ['Integer'] + $P1 = new ['BigInt'] + $P2 = new ['Integer'] + $P0 = 24 + $P1 = 2 + $P2 = 48 + mul $P0, $P1 + $I0 = iseq $P0, $P2 + todo($I0, 'i_multiply Integer PMC by BigInt PMC', 'unresolved bug, see TT #1887') + + $P0 = new ['Integer'] + $P1 = new ['Complex'] + $P2 = new ['Complex'] + $P0 = 2 + $P1 = "2+4i" + $P2 = "4+8i" + mul $P0, $P1 + $I0 = iseq $P0, $P2 + todo($I0, 'i_multiply Integer PMC by Complex PMC', 'unresolved bug, see TT #1887') + + $P0 = new ['Integer'] + $P1 = new ['Float'] + $P0 = 2 + $P1 = 3.5 + mul $P0, $P1 + is($P0, 7, 'i_multiply Integer PMC by DEFAULT') + + $P0 = new ['Integer'] + $P0 = 1073741824 + mul $P0, 2 + $P1 = typeof $P0 + is($P0, 2147483648, 'i_multiply_int overflow promotion') + is($P1, 'BigInt', 'i_multiple_int overflow type check') + + $P0 = new ['Integer'] + $P0 = 2 + mul $P0, 5.5 + is($P0, 11, 'i_multiply_float') +.end + +.sub test_div + $P0 = new ['Integer'] + $P1 = new ['BigInt'] + $P0 = 50 + $P1 = 25 + $P2 = div $P0, $P1 + $P3 = typeof $P2 + is($P2, 2, 'divide overflow promotion') + is($P3, 'BigInt', 'divide overflow type check') + + throws_substring(<<'CODE', 'float division by zero', 'divide by 0 (Float PMC)') + .sub main + $P0 = new ['Integer'] + $P1 = new ['Float'] + $P0 = 50 + $P1 = 0 + $P2 = div $P0, $P1 + say $P2 + .end +CODE + + $P0 = new ['Integer'] + $P1 = new ['BigInt'] + $P0 = 50 + $P1 = 25 + div $P0, $P1 + $P2 = typeof $P0 + is($P0, 2, 'i_divide overflow promotion') + is($P2, 'BigInt', 'i_divide overflow type check') + + $P0 = new ['Integer'] + $P1 = new ['Float'] + $P0 = 50 + $P1 = .5 + div $P0, $P1 + is($P0, 100, 'i_divide DEFAULT multi') + + throws_substring(<<'CODE', 'float division by zero', 'i_divide by 0 (Float PMC)') + .sub main + $P0 = new ['Integer'] + $P1 = new ['Float'] + $P0 = 50 + $P1 = 0 + div $P0, $P1 + say $P0 + .end +CODE + + $P0 = new ['Integer'] + $P1 = new ['BigInt'] + $P0 = 10 + $P1 = 7 + $P0 = fdiv $P0, $P1 + $P2 = typeof $P0 + is($P0, 1, 'floor_divide overflow promotion') + is($P2, 'BigInt', 'floor_divide overflow type check') + + throws_substring(<<'CODE', 'float division by zero', 'floor_divide by 0 (Float PMC)') + .sub main + $P0 = new ['Integer'] + $P1 = new ['Float'] + $P0 = 50 + $P1 = 0 + $P0 = fdiv $P0, $P1 + say $P0 + .end +CODE + + throws_substring(<<'CODE', 'float division by zero', 'floor_divide by 0 (FLOATVAL)') + .sub main + $P0 = new ['Integer'] + $P0 = 50 + $P0 = fdiv $P0, 0.0 + say $P0 + .end +CODE + + $P0 = new ['Integer'] + $P0 = 22 + $P0 = fdiv $P0, 7 + is($P0, 3, 'floor_divide INTVAL') + + throws_substring(<<'CODE', 'float division by zero', 'floor_divide by 0 (INTVAL)') + .sub main + $P0 = new ['Integer'] + $P0 = 50 + $P0 = fdiv $P0, 0 + say $P0 + .end +CODE + + $P0 = new ['Integer'] + $P1 = new ['BigInt'] + $P0 = 20 + $P1 = 9 + fdiv $P0, $P1 + $P2 = typeof $P0 + is($P0, 2, 'i_floor_divide overflow promotion') + is($P2, 'BigInt', 'i_floor_divide overflow type check') + + $P0 = new ['Integer'] + $P1 = new ['Float'] + $P0 = 20 + $P1 = 2.3 + fdiv $P0, $P1 + is($P0, 8, 'i_floor_divide DEFAULT multi') + + throws_substring(<<'CODE', 'float division by zero', 'i_floor_divide by 0 (DEFAULT)') + .sub main + $P0 = new ['Integer'] + $P1 = new ['Float'] + $P0 = 50 + $P1 = 0 + fdiv $P0, $P1 + say $P0 + .end +CODE + + $P0 = 20 + fdiv $P0, 7 + is($P0, 2, 'i_floor_divide INTVAL multi') + + throws_substring(<<'CODE', 'float division by zero', 'i_floor_divide by 0 INTVAL multi') + .sub main + $P0 = new ['Integer'] + $P0 = 50 + fdiv $P0, 0 + say $P0 + .end +CODE + + $P0 = 20 + fdiv $P0, 2.3 + is($P0, 8, 'i_floor_divide FLOATVAL multi') + + throws_substring(<<'CODE', 'float division by zero', 'i_floor_divide by 0 FLOATVAL multi') + .sub main + $P0 = new ['Integer'] + $P0 = 50 + fdiv $P0, 0.0 + say $P0 + .end +CODE + .end .sub test_arithmetic @@ -322,6 +648,125 @@ fin: is($P2,0) .end +.sub test_mod + $P0 = new ['Integer'] + $P1 = new ['BigInt'] + $P0 = 7 + $P1 = 5 + $P0 = mod $P0, $P1 + $P2 = typeof $P0 + is($P0, 2, 'modulus overflow promotion') + is($P2, 'BigInt', 'modulus overflow type check') + + throws_substring(<<'CODE', 'int modulus by zero', 'modulus by 0 DEFAULT multi') + .sub main + $P0 = new ['Integer'] + $P1 = new ['Float'] + $P0 = 7 + $P1 = 0 + $P0 = mod $P0, $P1 + say $P0 + .end +CODE + + $P0 = new ['Integer'] + $P0 = 7 + $P0 = mod $P0, 4 + is($P0, 3, 'modulus INTVAL multi') + + throws_substring(<<'CODE', 'int modulus by zero', 'modulus by 0 INTVAL multi') + .sub main + $P0 = new ['Integer'] + $P0 = 7 + $P0 = mod $P0, 0 + say $P0 + .end +CODE + throws_substring(<<'CODE', 'int modulus by zero', 'modulus by 0 FLOATVAL multi') + .sub main + $P0 = new ['Integer'] + $P0 = 7 + $P0 = mod $P0, 0.0 + say $P0 + .end +CODE + + $P0 = new ['Integer'] + $P1 = new ['BigInt'] + $P0 = 7 + $P1 = 5 + mod $P0, $P1 + $P2 = typeof $P0 + is($P0, 2, 'i_modulus overflow promotion') + is($P2, 'BigInt', 'i_modulus overflow type check') + + $P0 = new ['Integer'] + $P1 = new ['Float'] + $P0 = 7 + $P1 = 5 + mod $P0, $P1 + is($P0, 2, 'i_modulus DEFAULT multi') + + throws_substring(<<'CODE', 'int modulus by zero', 'i_modulus by 0 DEFAULT multi') + .sub main + $P0 = new ['Integer'] + $P1 = new ['Float'] + $P0 = 7 + $P1 = 0 + mod $P0, $P1 + say $P0 + .end +CODE + + $P0 = new ['Integer'] + $P0 = 7 + mod $P0, 4 + is($P0, 3, 'i_modulus INTVAL multi') + $P0 = 7 + mod $P0, 3.0 + is($P0, 1, 'i_modulus FLOATVAL multi') + + throws_substring(<<'CODE', 'int modulus by zero', 'i_modulus by 0 INTVAL multi') + .sub main + $P0 = new ['Integer'] + $P0 = 7 + mod $P0, 0 + say $P0 + .end +CODE + throws_substring(<<'CODE', 'int modulus by zero', 'i_modulus by 0 FLOATVAL multi') + .sub main + $P0 = new ['Integer'] + $P0 = 7 + mod $P0, 0.0 + say $P0 + .end +CODE +.end + +.sub test_neg + .include 'sysinfo.pasm' + + $P0 = new ['Integer'] + $P1 = new ['BigInt'] + + $I0 = sysinfo .SYSINFO_PARROT_INTMIN + + $P0 = $I0 + $P1 = $I0 + neg $P1 + + $P0 = neg $P0 + $P2 = typeof $P0 + is($P0, $P1, 'neg integer overflow promotion') + is($P2, 'BigInt', 'neg integer overflow type check') + + $P0 = new ['Integer'] + $P0 = -3 + neg $P0 + is($P0, 3, 'i_neg') +.end + .sub test_get_as_base $P0 = new ['Integer'] @@ -412,6 +857,55 @@ pass2: fin: .end +.sub test_cmp_num + $P0 = new ['Integer'] + $P1 = new ['String'] + $P0 = 23 + $P1 = "23.4" + + $I0 = cmp_num $P0, $P1 + is($I0, -1, 'cmp_num 23(Integer PMC), "23.4"(String PMC) = -1') + $P1 = "23e-2" + $I0 = cmp_num $P0, $P1 + is($I0, 1, 'cmp_num 23(Integer PMC), "23e-2"(String PMC) = 1') + $P1 = "23" + $I0 = cmp_num $P0, $P1 + is($I0, 0, 'cmp_num 23(Integer PMC), "23"(String PMC) = 0') + + $P0 = -32 + $P1 = "0" + $I0 = cmp_num $P0, $P1 + is($I0, -1, 'cmp_num -32(Integer PMC), "0"(String PMC) = -1') + $P0 = 0 + $I0 = cmp_num $P0, $P1 + is($I0, 0, 'cmp_num 0(Integer PMC), "0"(String PMC) = 0') + $P0 = 245 + $I0 = cmp_num $P0, $P1 + is($I0, 1, 'cmp_num 245(Integer PMC), "0"(String PMC) = 1') + + $P1 = new ['Float'] + $P1 = 2.6 + $I0 = cmp_num $P0, $P1 + is($I0, 1, 'cmp_num 245(Integer PMC), 2.6(Float PMC) = 1') + $P1 = 553.2 + $I0 = cmp_num $P0, $P1 + is($I0, -1, 'cmp_num 245(Integer PMC), 553.2(Float PMC) = -1') + $P1 = 245 + $I0 = cmp_num $P0, $P1 + is($I0, 0, 'cmp_num 245(Integer PMC), 245(Float PMC) = 0') + + $P1 = new ['Integer'] + $P1 = 300 + $I0 = cmp_num $P0, $P1 + is($I0, -1, 'cmp_num 245(Integer PMC), 300(Integer PMC) = -1') + $P1 = 2 + $I0 = cmp_num $P0, $P1 + is($I0, 1, 'cmp_num 245(Integer PMC), 2(Integer PMC) = 1') + $P1 = 245 + $I0 = cmp_num $P0, $P1 + is($I0, 0, 'cmp_num 245(Integer PMC), 245(Integer PMC) = 0') +.end + # Local Variables: # mode: pir # fill-column: 100 From 4a00f74d007c35735b062786afa9b2ae28aee581 Mon Sep 17 00:00:00 2001 From: "Jonathan \"Duke\" Leto" Date: Fri, 10 Dec 2010 16:33:24 -0800 Subject: [PATCH 054/102] [doc] Spanish translation of README by pitoco++ This is a Spanish translation of our README by a Google Code-In student. Thanks to all the mentors that helped the student improve this translation, especially NotFound++. --- MANIFEST | 1 + NEWS | 6 +- README.espanol | 183 +++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 188 insertions(+), 2 deletions(-) create mode 100644 README.espanol diff --git a/MANIFEST b/MANIFEST index 137b2e00b1..958ccaa7a7 100644 --- a/MANIFEST +++ b/MANIFEST @@ -23,6 +23,7 @@ NEWS [main]doc PBC_COMPAT [main]doc PLATFORMS [devel]doc README [devel]doc +README.espanol [] README.polski [] README_cygwin.pod [devel]doc README_win32.pod [devel]doc diff --git a/NEWS b/NEWS index d91b3e4b28..8a0b3932b9 100644 --- a/NEWS +++ b/NEWS @@ -7,8 +7,10 @@ New in 2.11.0 + PIRC - left the nest and is currently at https://github.com/parrot/pirc/ + Community - - README translated into the following languages: - Polish + - Our README was translated into the following languages, + by Google Code-In students and mentors: + Polish README.polski + Spanish README.espanol New in 2.10.0 - Core diff --git a/README.espanol b/README.espanol new file mode 100644 index 0000000000..1c33a433dc --- /dev/null +++ b/README.espanol @@ -0,0 +1,183 @@ +LÉASE +------------------------ + +Esta es la versión Parrot, 2.10.1 +----------------------------- + +Parrot Copyright (C) 2001-2010, Parrot Foundation. + + +INFORMACIÓN DE LICENCIA +------------------- + +Este código se distribuye bajo los términos de la Licencia Artística 2.0. +Para más detalles, vea el texto completo de la licencia en el archivo de licencia. + +RESUMEN +-------- +Parrot es una máquina virtual diseñada para compilar y ejecutar de manera eficiente +bytecode para lenguajes dinámicos. + +REQUISITOS PREVIOS +------------- + +Necesitas un compilador de C, enlazador, y por supuesto, un programa. + +Si va a vincular con la biblioteca de la ICU tienes que descargarlo e instalarlo +antes de configurar Parrot. Lo puedes obtener desde el sitio http://site.icu-project.org/download + +También necesitas Perl 5.8.4 o posterior, y Storable 2.12 o más reciente +para el funcionamiento de diversos configura y crea secuencias de comandos. + +Para la mayoría de las plataformas que nos están apoyando inicialmente, Parrot debe construir +afuera de la caja. docs / parrot.pod listas de las plataformas principales. PLATAFORMAS proporcionan +informes sobre las plataformas en las que Parrot ha sido construido y probado. + +COMO CONSEGUIR PARROT DESDE GITHUB +----------------------------- +I. Tienes que instalar Git. + +Linux: +El método depende de su distribución. Para instalar se debe ejecutar (como root o sudo ): + +En Ubuntu/Debian (apt-based): + + apt-get install git-core + +En Red Hat, Fedora (rpm-based): + + yum install git + +En Gentoo (portage): + + emerge-av dev-vcs/git + +Windows: +Hay dos puertos de Git en Windows: + +msysgit http://code.google.com/p/msysgit/downloads/list +TortoiseGit http://code.google.com/p/tortoisegit/downloads/list + +Macintosh OS X: + +Una búsqueda en Internet localizara una variedad de instaladores de git para Mac OS X, +http://help.github.com/mac-git-installation/ + +II. Para obtener Parrot desde Github.com + +Para obtener una copia del repositorio Git Parrot: + + git clone git://github.com/parrot/parrot.git +Esto echa un vistazo a la Branch principal de forma predeterminada. Para crear una sección local +que sigue la sucursal "some_branch": + + git checkout -b --track some_branch origin/some_branch + +Todas las URL anteriores son de sólo lectura. Si eres es un desarrollador principal Parrot, a + +continuación, +utiliza la lectura y escritura URL: + + git clone git@github.com:parrot/parrot.git + +Puede ver la lista de Branch en http://github.com/parrot/parrot + +INSTRUCCIONES +------------ +Por ahora, descomprime el archivo tar Parrot, (si estás leyendo esto, +probablemente ya lo ha hecho) y escriba + + + perl Configure.pl + +para ejecutar el script de configuración. La secuencia de comandos Configure.pl extrae la + +configuración +de la ejecución programa Perl5. Puede que tenga que decirle explícitamente a Configure.pl +que compilador y enlazador debe de usar Por ejemplo, para compilar archivos de C con 'cc', +C++ archivos con "CC", y todo vínculo con "CC", escribiría + + perl Configure.pl --cc=cc --cxx=CC --link=CC --ld=CC + +Consulte "perl Configure.pl - help" para obtener más opciones y docs / configuration.pod +para más detalles. + +Para los sistemas como HP / UX que no tienen inet_pton por favor, ejecuta + + perl Configure.pl --define=inet_aton + +Ejecutando Config.pl generará un encabezado config.h, al modulo Parrot::Config +, los archivos de la plataforma y muchos Makefiles + +El archivo "myconfig" tiene una visión general de la configuración. + +A continuación, ejecuta make. (Configure.pl le dirá qué versión de make +recomienda para su sistema.) + +Ahora, el intérprete debe construir. Si estas construyendo la biblioteca de la ICU +(Este es el defecto en la mayoría de sistemas), es necesario utilizar GNU Make en lugar +(O algo compatible con él). + +Puede probar Parrot ejecutando "make test". Puedes ejecutar las pruebas en paralelo +con "make TEST_JOBS = 3 prueba". + +Puedes ejecutar la suite de pruebas con + +make fulltest + +Nota: PLATAFORMAS contiene notas acerca de si se esperan fallas de prueba +en tu sistema + +Puedes instalar Parrot con: + + make install + +De forma predeterminada, se instala en /usr/local, con el ejecutable de Parrot en +/usr/local/bin. Si desea instalar Parrot en otro lugar de uso: + + perl Configure.pl --prefix=/home/joe/bird + make install + +Pero ten en cuenta que bibliotecas dinámicas no se pueden encontrar en lugares no estándar +a menos que establezca LD_LIBRARY_PATH o algo similar. + +vea docs/parrot.pod and docs/intro.pod para dónde ir desde aquí. Si encuentras cualquier problema, + +consulta la sección "Cómo presentar una informe de errores" en +docs/submissions.pod. Estos documentos están en formato POD. puede ver estos +archivos con el comando: + + perldoc -F docs/intro.pod + +CAMBIOS +------- + +Para obtener documentación sobre los cambios visibles para el usuario entre esta versión y la +versiones anteriores, consulta NOTICIAS. + +LISTAS DE CORREO +------------- + +La lista de correo de usuarios Parrot es parrot-users@lists.parrot.org. Subscribase llenando el + +formulario en http://lists.parrot.org/mailman/listinfo/parrot-users . +La lista se archiva en http://lists.parrot.org/pipermail/parrot-users/. + +Para debates de desarollo vea la información en docs/gettingstarted.pod. + +COMENTARIOS, PARCHES, etc. +----------------------- + +Vea docs / submissions.pod para obtener más información sobre cómo informar errores y +el envío de parches. + +SITIOS WEB +--------- + +Los siguientes sitios web contienen toda la información que necesitas sobre Parrot: + http://www.parrot.org/ + http://trac.parrot.org/ + http://docs.parrot.org/ + + Que se diviertan, + El equipo de Parrot. \ No newline at end of file From 674c5f6dd5aa4d5e65813d81cb6664be477527f3 Mon Sep 17 00:00:00 2001 From: "Jonathan \"Duke\" Leto" Date: Fri, 10 Dec 2010 16:40:23 -0800 Subject: [PATCH 055/102] [doc] News tweaks --- NEWS | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index 8a0b3932b9..c97b06ed72 100644 --- a/NEWS +++ b/NEWS @@ -2,15 +2,19 @@ New in 2.11.0 - Core + Just In Time native call frame generation using LibFFI + PIR op find_codepoint is no longer experimental, it is now supported - + Several public functions in libparrot have been brought up to standard naming conventions. + + Several public functions in libparrot have been brought up to standard + naming conventions. - Languages + PIRC - left the nest and is currently at https://github.com/parrot/pirc/ + Community - - Our README was translated into the following languages, + - Our README was translated into the following languages by Google Code-In students and mentors: Polish README.polski Spanish README.espanol +- Documentation +- Tests + + Test coverage increase on PMCs: String, Integer New in 2.10.0 - Core From 7f15ac0ca358ef29594a510ef0d782d4438bd165 Mon Sep 17 00:00:00 2001 From: NotFound Date: Sat, 11 Dec 2010 02:06:43 +0100 Subject: [PATCH 056/102] add some casts to avoid pointer comparaison warnings --- src/gc/fixed_allocator.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/gc/fixed_allocator.c b/src/gc/fixed_allocator.c index 6fd87ed8c6..18b46c3927 100644 --- a/src/gc/fixed_allocator.c +++ b/src/gc/fixed_allocator.c @@ -437,10 +437,10 @@ allocate_new_pool_arena(ARGMOD(Pool_Allocator *pool)) pool->num_free_objects += num_items; pool->total_objects += num_items; - if (pool->lo_arena_ptr > new_arena) + if (pool->lo_arena_ptr > (void *)new_arena) pool->lo_arena_ptr = new_arena; - if (pool->hi_arena_ptr < (char *)new_arena + GC_FIXED_SIZE_POOL_SIZE) + if ((char *)pool->hi_arena_ptr < (char *)new_arena + GC_FIXED_SIZE_POOL_SIZE) pool->hi_arena_ptr = (char *)new_arena + GC_FIXED_SIZE_POOL_SIZE; } From 7621fbed169f5da8fbc473fcd886d0589cc4474c Mon Sep 17 00:00:00 2001 From: Christoph Otto Date: Fri, 10 Dec 2010 17:04:13 -0800 Subject: [PATCH 057/102] add post-receive script for gci task --- tools/dev/github_post_receive.pl | 99 ++++++++++++++++++++++++++++++++ 1 file changed, 99 insertions(+) create mode 100644 tools/dev/github_post_receive.pl diff --git a/tools/dev/github_post_receive.pl b/tools/dev/github_post_receive.pl new file mode 100644 index 0000000000..4e4fcb3124 --- /dev/null +++ b/tools/dev/github_post_receive.pl @@ -0,0 +1,99 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use CGI; +use JSON::Any; +use Mail::Sendmail; +use Tie::Function; + +use DateTime::Format::ISO8601; +use DateTime::TimeZone::Local; + +my $q = CGI->new; +print $q->header; + +if( my $p = $q->param('payload') ) { + $p = JSON::Any->new->decode( $p ); + #use Data::Dumper; + #warn Dumper $p; + + #tie my %short, 'Tie::Function' => sub { substr( shift(), 0, 8 ) }; + + my $commits = + join '', + map { + my %c = %$_; + $c{timestamp} = eval { fmt_time($c{timestamp}) } || $c{timestamp}; + my @file_changes = + map ' '.join(' ', @$_), + sort { $a->[1] cmp $b->[1] } + ( ( map ['A',$_], @{$c{added} } ), + ( map ['D',$_], @{$c{removed} } ), + ( map ['M',$_], @{$c{modified}} ), + ); + my $file_change_count = @file_changes; + $file_change_count = "$file_change_count ".($file_change_count > 1 ? 'files changed' : 'file changed'); + my $file_changes = join "\n", @file_changes; + + $c{message} = indent($c{message}); + + < +Date: $c{timestamp} + +$c{message} + +$file_changes + $file_change_count + +EOF + } @{$p->{commits}}; + + my $head = $p->{ref}; + $head =~ s|refs/heads/||; + + my $commit_cnt = scalar @{$p->{commits}}; + $commit_cnt = "$commit_cnt ".( $commit_cnt > 1 ? 'commits' : 'commit' ); + + my %mail = ( From => 'github-commits@bugs.sgn.cornell.edu', + Subject => "[$p->{repository}{owner}{name}/$p->{repository}{name}($head)] $commit_cnt - GitHub", + Message => <{after} +Home: $p->{repository}->{url} +Browse: $p->{repository}->{url}/tree/$head +Commits: $p->{repository}->{url}/commits/$head +------------------ + +$commits +EOF + ); + + my @send_list = ( 'parrot-commits@lists.parrot.org' ); + foreach my $to ( @send_list ) { + sendmail( %mail, To => $to ) + or warn "error sending to $to: $Mail::Sendmail::error"; + } + + #print "OK. Log says:\n", $Mail::Sendmail::log; +} + +sub short_commitname { + my $c = shift; + return substr( $c, 0, 8 ); +} + +sub indent { + my $m = shift; + chomp $m; + $m =~ s/\n/\n /g; + return " $m"; +} + +sub fmt_time { + my $d = DateTime::Format::ISO8601->parse_datetime( shift ); + $d->set_time_zone(DateTime::TimeZone::Local->TimeZone() ); + return $d->strftime(q|%a %m/%d/%y, %I:%m %p %Z|); +} From 8024efa79e082a93dec83e2cfee8c6c0e5d5a399 Mon Sep 17 00:00:00 2001 From: Christoph Otto Date: Fri, 10 Dec 2010 17:08:41 -0800 Subject: [PATCH 058/102] add minimal POD --- tools/dev/github_post_receive.pl | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tools/dev/github_post_receive.pl b/tools/dev/github_post_receive.pl index 4e4fcb3124..ba1526977c 100644 --- a/tools/dev/github_post_receive.pl +++ b/tools/dev/github_post_receive.pl @@ -10,6 +10,16 @@ use DateTime::Format::ISO8601; use DateTime::TimeZone::Local; +=head1 NAME + +tools/dev/github_post_receive.pl + +=head1 DESCRIPTION + +a post-receive script to send commit diffs to parrot developers + +=cut + my $q = CGI->new; print $q->header; From e0b878471329103c0301bce37e871118b3b5f598 Mon Sep 17 00:00:00 2001 From: Whiteknight Date: Fri, 10 Dec 2010 20:14:27 -0500 Subject: [PATCH 059/102] move all the BigInt tests out into their own functions and group them together --- t/pmc/integer.t | 249 +++++++++++++++++++++++++++--------------------- 1 file changed, 141 insertions(+), 108 deletions(-) diff --git a/t/pmc/integer.t b/t/pmc/integer.t index ce51ae3147..58ac806bc2 100644 --- a/t/pmc/integer.t +++ b/t/pmc/integer.t @@ -46,6 +46,13 @@ Tests the Integer PMC. test_cmp_subclass() test_cmp_RT59336() test_cmp_num() + + #test_autopromotion_to_BigInt() + #test_sub_BigInt() + #test_mul_BigInt() + #test_div_BigInt() + #test_mod_BigInt() + #test_neg_BigInt() .end .sub test_init @@ -101,38 +108,52 @@ CODE .sub main .include "errors.pasm" errorson .PARROT_ERRORS_OVERFLOW_FLAG - + $P0 = new ['Integer'] $P0 = 2048 $P0 *= 2048 $P0 *= 2048 - say $P0 .end CODE + int_1 = new ['Integer'] + int_1 = -57494 + int_1 = abs int_1 + is(int_1, 57494, 'absolute value, assignment') + + int_1 = new ['Integer'] + int_1 = 6 + abs int_1 + is(int_1, 6, 'absolute value, in-place') +.end + +.sub test_autopromotion_to_BigInt + push_eh _dont_have_bigint_library .include 'sysinfo.pasm' .local pmc bigint_1 + .local pmc int_1 + int_1 = new ['Integer'] bigint_1 = new ['BigInt'] - + $I0 = sysinfo .SYSINFO_PARROT_INTMIN int_1 = $I0 bigint_1 = int_1 - 1 - + pop_eh + dec int_1 $P0 = typeof int_1 is(int_1, bigint_1, 'dec integer overflow promotion') is($P0, 'BigInt', 'dec integer overflow type check') - - int_1 = new ['Integer'] - int_1 = -57494 - int_1 = abs int_1 - is(int_1, 57494, 'absolute value, assignment') - - int_1 = new ['Integer'] - int_1 = 6 - abs int_1 - is(int_1, 6, 'absolute value, in-place') + + goto _have_bigint_library + _dont_have_bigint_library: + pop_eh + + # TODO: What should we do here? + ok(1, "no bigint library") + ok(1, "no bigint library") + _have_bigint_library: .end .sub test_truthiness_and_definedness @@ -356,14 +377,14 @@ fin: set $P1, 4 add $P0, $P1 is($P0, "4+0i", 'add complex number') - + new $P0, ['Integer'] new $P1, ['Float'] set $P0, 31 set $P1, 20.1 add $P0, $P1 is($P0, 51, 'add DEFAULT') - + new $P0, ['Integer'] set $P0, 2 add $P0, 3.14159 @@ -371,14 +392,16 @@ fin: is($P0, 10, 'add_float') .end -.sub test_sub +.sub test_sub_BigInt $P0 = new ['BigInt'] $P0 = 424124 $P1 = new ['Integer'] $P1 = 424125 sub $P1, $P1, $P0 is($P1, 1, 'BigInt sub (no exception)') - +.end + +.sub test_sub $P0 = new ['Float'] $P0 = 3.1 $P1 = new ['Integer'] @@ -390,31 +413,31 @@ fin: $P0 = -1073741824 sub $P0, $P0, 1073741825 is($P0, -2147483649, 'BigInt sub overflow') - + $P0 = new ['Integer'] $P0 = -1073741824 sub $P0, 1073741825 is($P0, -2147483649, 'i_subtract_int overflow') - + $P0 = new ['Integer'] $P1 = new ['Integer'] $P0 = -1073741824 $P1 = 1073741825 sub $P0, $P1 is($P0, -2147483649, 'i_subtract overflow') - + $P0 = new ['Integer'] $P0 = 5 sub $P0, 4.5 is($P0, .5, 'i_subtract_float') - + $P0 = new ['Integer'] $P1 = new ['Complex'] $P0 = 0 $P1 = "4+2i" sub $P0, $P1 is($P0, "-4-2i", 'subtract Complex number') - + $P0 = new ['Integer'] $P1 = new ['Float'] $P0 = 5 @@ -430,28 +453,18 @@ fin: $P1 = "256" mul $P0, $P0, $P1 is($P0, 256, 'multiply Integer PMC by String PMC') - + $P1 = new ['Float'] $P0 = 2 $P1 = 3.14 mul $P0, $P0, $P1 is($P0, 6, 'multiply Integer PMC by Float PMC') - + $P1 = new ['Integer'] $P1 = 4 mul $P0, $P1 is($P0, 24, 'i_multiply Integer PMC by Integer PMC') - $P0 = new ['Integer'] - $P1 = new ['BigInt'] - $P2 = new ['Integer'] - $P0 = 24 - $P1 = 2 - $P2 = 48 - mul $P0, $P1 - $I0 = iseq $P0, $P2 - todo($I0, 'i_multiply Integer PMC by BigInt PMC', 'unresolved bug, see TT #1887') - $P0 = new ['Integer'] $P1 = new ['Complex'] $P2 = new ['Complex'] @@ -461,28 +474,42 @@ fin: mul $P0, $P1 $I0 = iseq $P0, $P2 todo($I0, 'i_multiply Integer PMC by Complex PMC', 'unresolved bug, see TT #1887') - + $P0 = new ['Integer'] $P1 = new ['Float'] $P0 = 2 $P1 = 3.5 mul $P0, $P1 is($P0, 7, 'i_multiply Integer PMC by DEFAULT') - + + + + $P0 = new ['Integer'] + $P0 = 2 + mul $P0, 5.5 + is($P0, 11, 'i_multiply_float') +.end + +.sub test_mul_BigInt + $P0 = new ['Integer'] + $P1 = new ['BigInt'] + $P2 = new ['Integer'] + $P0 = 24 + $P1 = 2 + $P2 = 48 + mul $P0, $P1 + $I0 = iseq $P0, $P2 + todo($I0, 'i_multiply Integer PMC by BigInt PMC', 'unresolved bug, see TT #1887') + $P0 = new ['Integer'] $P0 = 1073741824 mul $P0, 2 $P1 = typeof $P0 is($P0, 2147483648, 'i_multiply_int overflow promotion') is($P1, 'BigInt', 'i_multiple_int overflow type check') - - $P0 = new ['Integer'] - $P0 = 2 - mul $P0, 5.5 - is($P0, 11, 'i_multiply_float') .end -.sub test_div +.sub test_div_BigInt $P0 = new ['Integer'] $P1 = new ['BigInt'] $P0 = 50 @@ -491,7 +518,36 @@ fin: $P3 = typeof $P2 is($P2, 2, 'divide overflow promotion') is($P3, 'BigInt', 'divide overflow type check') - + + $P0 = new ['Integer'] + $P1 = new ['BigInt'] + $P0 = 50 + $P1 = 25 + div $P0, $P1 + $P2 = typeof $P0 + is($P0, 2, 'i_divide overflow promotion') + is($P2, 'BigInt', 'i_divide overflow type check') + + $P0 = new ['Integer'] + $P1 = new ['BigInt'] + $P0 = 10 + $P1 = 7 + $P0 = fdiv $P0, $P1 + $P2 = typeof $P0 + is($P0, 1, 'floor_divide overflow promotion') + is($P2, 'BigInt', 'floor_divide overflow type check') + + $P0 = new ['Integer'] + $P1 = new ['BigInt'] + $P0 = 20 + $P1 = 9 + fdiv $P0, $P1 + $P2 = typeof $P0 + is($P0, 2, 'i_floor_divide overflow promotion') + is($P2, 'BigInt', 'i_floor_divide overflow type check') +.end + +.sub test_div throws_substring(<<'CODE', 'float division by zero', 'divide by 0 (Float PMC)') .sub main $P0 = new ['Integer'] @@ -503,22 +559,13 @@ fin: .end CODE - $P0 = new ['Integer'] - $P1 = new ['BigInt'] - $P0 = 50 - $P1 = 25 - div $P0, $P1 - $P2 = typeof $P0 - is($P0, 2, 'i_divide overflow promotion') - is($P2, 'BigInt', 'i_divide overflow type check') - $P0 = new ['Integer'] $P1 = new ['Float'] $P0 = 50 $P1 = .5 div $P0, $P1 is($P0, 100, 'i_divide DEFAULT multi') - + throws_substring(<<'CODE', 'float division by zero', 'i_divide by 0 (Float PMC)') .sub main $P0 = new ['Integer'] @@ -529,16 +576,7 @@ CODE say $P0 .end CODE - - $P0 = new ['Integer'] - $P1 = new ['BigInt'] - $P0 = 10 - $P1 = 7 - $P0 = fdiv $P0, $P1 - $P2 = typeof $P0 - is($P0, 1, 'floor_divide overflow promotion') - is($P2, 'BigInt', 'floor_divide overflow type check') - + throws_substring(<<'CODE', 'float division by zero', 'floor_divide by 0 (Float PMC)') .sub main $P0 = new ['Integer'] @@ -558,12 +596,12 @@ CODE say $P0 .end CODE - + $P0 = new ['Integer'] $P0 = 22 $P0 = fdiv $P0, 7 is($P0, 3, 'floor_divide INTVAL') - + throws_substring(<<'CODE', 'float division by zero', 'floor_divide by 0 (INTVAL)') .sub main $P0 = new ['Integer'] @@ -572,23 +610,14 @@ CODE say $P0 .end CODE - - $P0 = new ['Integer'] - $P1 = new ['BigInt'] - $P0 = 20 - $P1 = 9 - fdiv $P0, $P1 - $P2 = typeof $P0 - is($P0, 2, 'i_floor_divide overflow promotion') - is($P2, 'BigInt', 'i_floor_divide overflow type check') - + $P0 = new ['Integer'] $P1 = new ['Float'] $P0 = 20 $P1 = 2.3 fdiv $P0, $P1 is($P0, 8, 'i_floor_divide DEFAULT multi') - + throws_substring(<<'CODE', 'float division by zero', 'i_floor_divide by 0 (DEFAULT)') .sub main $P0 = new ['Integer'] @@ -599,11 +628,11 @@ CODE say $P0 .end CODE - + $P0 = 20 fdiv $P0, 7 is($P0, 2, 'i_floor_divide INTVAL multi') - + throws_substring(<<'CODE', 'float division by zero', 'i_floor_divide by 0 INTVAL multi') .sub main $P0 = new ['Integer'] @@ -612,11 +641,11 @@ CODE say $P0 .end CODE - + $P0 = 20 fdiv $P0, 2.3 is($P0, 8, 'i_floor_divide FLOATVAL multi') - + throws_substring(<<'CODE', 'float division by zero', 'i_floor_divide by 0 FLOATVAL multi') .sub main $P0 = new ['Integer'] @@ -625,7 +654,7 @@ CODE say $P0 .end CODE - + .end .sub test_arithmetic @@ -648,7 +677,7 @@ CODE is($P2,0) .end -.sub test_mod +.sub test_mod_BigInt $P0 = new ['Integer'] $P1 = new ['BigInt'] $P0 = 7 @@ -657,7 +686,18 @@ CODE $P2 = typeof $P0 is($P0, 2, 'modulus overflow promotion') is($P2, 'BigInt', 'modulus overflow type check') - + + $P0 = new ['Integer'] + $P1 = new ['BigInt'] + $P0 = 7 + $P1 = 5 + mod $P0, $P1 + $P2 = typeof $P0 + is($P0, 2, 'i_modulus overflow promotion') + is($P2, 'BigInt', 'i_modulus overflow type check') +.end + +.sub test_mod throws_substring(<<'CODE', 'int modulus by zero', 'modulus by 0 DEFAULT multi') .sub main $P0 = new ['Integer'] @@ -668,12 +708,12 @@ CODE say $P0 .end CODE - + $P0 = new ['Integer'] $P0 = 7 $P0 = mod $P0, 4 is($P0, 3, 'modulus INTVAL multi') - + throws_substring(<<'CODE', 'int modulus by zero', 'modulus by 0 INTVAL multi') .sub main $P0 = new ['Integer'] @@ -690,23 +730,14 @@ CODE say $P0 .end CODE - - $P0 = new ['Integer'] - $P1 = new ['BigInt'] - $P0 = 7 - $P1 = 5 - mod $P0, $P1 - $P2 = typeof $P0 - is($P0, 2, 'i_modulus overflow promotion') - is($P2, 'BigInt', 'i_modulus overflow type check') - + $P0 = new ['Integer'] $P1 = new ['Float'] $P0 = 7 $P1 = 5 mod $P0, $P1 is($P0, 2, 'i_modulus DEFAULT multi') - + throws_substring(<<'CODE', 'int modulus by zero', 'i_modulus by 0 DEFAULT multi') .sub main $P0 = new ['Integer'] @@ -717,7 +748,7 @@ CODE say $P0 .end CODE - + $P0 = new ['Integer'] $P0 = 7 mod $P0, 4 @@ -725,7 +756,7 @@ CODE $P0 = 7 mod $P0, 3.0 is($P0, 1, 'i_modulus FLOATVAL multi') - + throws_substring(<<'CODE', 'int modulus by zero', 'i_modulus by 0 INTVAL multi') .sub main $P0 = new ['Integer'] @@ -744,23 +775,25 @@ CODE CODE .end -.sub test_neg +.sub test_neg_BigInt .include 'sysinfo.pasm' - + $P0 = new ['Integer'] $P1 = new ['BigInt'] - + $I0 = sysinfo .SYSINFO_PARROT_INTMIN - + $P0 = $I0 $P1 = $I0 neg $P1 - + $P0 = neg $P0 $P2 = typeof $P0 is($P0, $P1, 'neg integer overflow promotion') is($P2, 'BigInt', 'neg integer overflow type check') - +.end + +.sub test_neg $P0 = new ['Integer'] $P0 = -3 neg $P0 @@ -862,7 +895,7 @@ fin: $P1 = new ['String'] $P0 = 23 $P1 = "23.4" - + $I0 = cmp_num $P0, $P1 is($I0, -1, 'cmp_num 23(Integer PMC), "23.4"(String PMC) = -1') $P1 = "23e-2" @@ -882,7 +915,7 @@ fin: $P0 = 245 $I0 = cmp_num $P0, $P1 is($I0, 1, 'cmp_num 245(Integer PMC), "0"(String PMC) = 1') - + $P1 = new ['Float'] $P1 = 2.6 $I0 = cmp_num $P0, $P1 @@ -893,7 +926,7 @@ fin: $P1 = 245 $I0 = cmp_num $P0, $P1 is($I0, 0, 'cmp_num 245(Integer PMC), 245(Float PMC) = 0') - + $P1 = new ['Integer'] $P1 = 300 $I0 = cmp_num $P0, $P1 From a52658a6bcfdd84097b4e0d785539ddee3f7eb87 Mon Sep 17 00:00:00 2001 From: Whiteknight Date: Fri, 10 Dec 2010 20:20:18 -0500 Subject: [PATCH 060/102] detect if we don't have BigInt, and skip the tests otherwise --- t/pmc/integer.t | 38 ++++++++++++++++++++++++++++++++------ 1 file changed, 32 insertions(+), 6 deletions(-) diff --git a/t/pmc/integer.t b/t/pmc/integer.t index 58ac806bc2..a4cbbc47ef 100644 --- a/t/pmc/integer.t +++ b/t/pmc/integer.t @@ -47,12 +47,38 @@ Tests the Integer PMC. test_cmp_RT59336() test_cmp_num() - #test_autopromotion_to_BigInt() - #test_sub_BigInt() - #test_mul_BigInt() - #test_div_BigInt() - #test_mod_BigInt() - #test_neg_BigInt() + $I0 = has_bigint() + unless $I0 goto no_bigint + test_autopromotion_to_BigInt() + test_sub_BigInt() + test_mul_BigInt() + test_div_BigInt() + test_mod_BigInt() + test_neg_BigInt() + goto done_bigint_tests + no_bigint: + skip_n_bigint_tests(20) + done_bigint_tests: +.end + +.sub has_bigint + push_eh _dont_have_bigint + $P0 = new ['BigInt'] + pop_eh + .return(1) + _dont_have_bigint: + pop_eh + .return(0) +.end + +.sub skip_n_bigint_tests + .param int n + loop_top: + if n == 0 goto _done + skip("No BigInt library") + n = n - 1 + goto loop_top + _done: .end .sub test_init From 41af763a9838a49ab7f812f0db8bffba48249d3d Mon Sep 17 00:00:00 2001 From: Nolan Lum Date: Fri, 10 Dec 2010 20:24:06 -0500 Subject: [PATCH 061/102] Remove trailing whitespace. --- t/pmc/integer.t | 101 ++++++++++++++++++++++++------------------------ 1 file changed, 50 insertions(+), 51 deletions(-) diff --git a/t/pmc/integer.t b/t/pmc/integer.t index ce51ae3147..3f46a22111 100644 --- a/t/pmc/integer.t +++ b/t/pmc/integer.t @@ -101,7 +101,7 @@ CODE .sub main .include "errors.pasm" errorson .PARROT_ERRORS_OVERFLOW_FLAG - + $P0 = new ['Integer'] $P0 = 2048 $P0 *= 2048 @@ -114,25 +114,25 @@ CODE .local pmc bigint_1 int_1 = new ['Integer'] bigint_1 = new ['BigInt'] - + $I0 = sysinfo .SYSINFO_PARROT_INTMIN int_1 = $I0 bigint_1 = int_1 - 1 - + dec int_1 $P0 = typeof int_1 is(int_1, bigint_1, 'dec integer overflow promotion') is($P0, 'BigInt', 'dec integer overflow type check') - + int_1 = new ['Integer'] int_1 = -57494 int_1 = abs int_1 is(int_1, 57494, 'absolute value, assignment') - + int_1 = new ['Integer'] int_1 = 6 abs int_1 - is(int_1, 6, 'absolute value, in-place') + is(int_1, 6, 'absolute value, in-place') .end .sub test_truthiness_and_definedness @@ -356,14 +356,14 @@ fin: set $P1, 4 add $P0, $P1 is($P0, "4+0i", 'add complex number') - + new $P0, ['Integer'] new $P1, ['Float'] set $P0, 31 set $P1, 20.1 add $P0, $P1 is($P0, 51, 'add DEFAULT') - + new $P0, ['Integer'] set $P0, 2 add $P0, 3.14159 @@ -378,7 +378,7 @@ fin: $P1 = 424125 sub $P1, $P1, $P0 is($P1, 1, 'BigInt sub (no exception)') - + $P0 = new ['Float'] $P0 = 3.1 $P1 = new ['Integer'] @@ -390,31 +390,31 @@ fin: $P0 = -1073741824 sub $P0, $P0, 1073741825 is($P0, -2147483649, 'BigInt sub overflow') - + $P0 = new ['Integer'] $P0 = -1073741824 sub $P0, 1073741825 is($P0, -2147483649, 'i_subtract_int overflow') - + $P0 = new ['Integer'] $P1 = new ['Integer'] $P0 = -1073741824 $P1 = 1073741825 sub $P0, $P1 is($P0, -2147483649, 'i_subtract overflow') - + $P0 = new ['Integer'] $P0 = 5 sub $P0, 4.5 is($P0, .5, 'i_subtract_float') - + $P0 = new ['Integer'] $P1 = new ['Complex'] $P0 = 0 $P1 = "4+2i" sub $P0, $P1 is($P0, "-4-2i", 'subtract Complex number') - + $P0 = new ['Integer'] $P1 = new ['Float'] $P0 = 5 @@ -430,13 +430,13 @@ fin: $P1 = "256" mul $P0, $P0, $P1 is($P0, 256, 'multiply Integer PMC by String PMC') - + $P1 = new ['Float'] $P0 = 2 $P1 = 3.14 mul $P0, $P0, $P1 is($P0, 6, 'multiply Integer PMC by Float PMC') - + $P1 = new ['Integer'] $P1 = 4 mul $P0, $P1 @@ -451,7 +451,7 @@ fin: mul $P0, $P1 $I0 = iseq $P0, $P2 todo($I0, 'i_multiply Integer PMC by BigInt PMC', 'unresolved bug, see TT #1887') - + $P0 = new ['Integer'] $P1 = new ['Complex'] $P2 = new ['Complex'] @@ -461,21 +461,21 @@ fin: mul $P0, $P1 $I0 = iseq $P0, $P2 todo($I0, 'i_multiply Integer PMC by Complex PMC', 'unresolved bug, see TT #1887') - + $P0 = new ['Integer'] $P1 = new ['Float'] $P0 = 2 $P1 = 3.5 mul $P0, $P1 is($P0, 7, 'i_multiply Integer PMC by DEFAULT') - + $P0 = new ['Integer'] $P0 = 1073741824 mul $P0, 2 $P1 = typeof $P0 is($P0, 2147483648, 'i_multiply_int overflow promotion') is($P1, 'BigInt', 'i_multiple_int overflow type check') - + $P0 = new ['Integer'] $P0 = 2 mul $P0, 5.5 @@ -491,7 +491,7 @@ fin: $P3 = typeof $P2 is($P2, 2, 'divide overflow promotion') is($P3, 'BigInt', 'divide overflow type check') - + throws_substring(<<'CODE', 'float division by zero', 'divide by 0 (Float PMC)') .sub main $P0 = new ['Integer'] @@ -511,14 +511,14 @@ CODE $P2 = typeof $P0 is($P0, 2, 'i_divide overflow promotion') is($P2, 'BigInt', 'i_divide overflow type check') - + $P0 = new ['Integer'] $P1 = new ['Float'] $P0 = 50 $P1 = .5 div $P0, $P1 is($P0, 100, 'i_divide DEFAULT multi') - + throws_substring(<<'CODE', 'float division by zero', 'i_divide by 0 (Float PMC)') .sub main $P0 = new ['Integer'] @@ -529,7 +529,7 @@ CODE say $P0 .end CODE - + $P0 = new ['Integer'] $P1 = new ['BigInt'] $P0 = 10 @@ -538,7 +538,7 @@ CODE $P2 = typeof $P0 is($P0, 1, 'floor_divide overflow promotion') is($P2, 'BigInt', 'floor_divide overflow type check') - + throws_substring(<<'CODE', 'float division by zero', 'floor_divide by 0 (Float PMC)') .sub main $P0 = new ['Integer'] @@ -558,12 +558,12 @@ CODE say $P0 .end CODE - + $P0 = new ['Integer'] $P0 = 22 $P0 = fdiv $P0, 7 is($P0, 3, 'floor_divide INTVAL') - + throws_substring(<<'CODE', 'float division by zero', 'floor_divide by 0 (INTVAL)') .sub main $P0 = new ['Integer'] @@ -572,7 +572,7 @@ CODE say $P0 .end CODE - + $P0 = new ['Integer'] $P1 = new ['BigInt'] $P0 = 20 @@ -581,14 +581,14 @@ CODE $P2 = typeof $P0 is($P0, 2, 'i_floor_divide overflow promotion') is($P2, 'BigInt', 'i_floor_divide overflow type check') - + $P0 = new ['Integer'] $P1 = new ['Float'] $P0 = 20 $P1 = 2.3 fdiv $P0, $P1 is($P0, 8, 'i_floor_divide DEFAULT multi') - + throws_substring(<<'CODE', 'float division by zero', 'i_floor_divide by 0 (DEFAULT)') .sub main $P0 = new ['Integer'] @@ -599,11 +599,11 @@ CODE say $P0 .end CODE - + $P0 = 20 fdiv $P0, 7 is($P0, 2, 'i_floor_divide INTVAL multi') - + throws_substring(<<'CODE', 'float division by zero', 'i_floor_divide by 0 INTVAL multi') .sub main $P0 = new ['Integer'] @@ -612,11 +612,11 @@ CODE say $P0 .end CODE - + $P0 = 20 fdiv $P0, 2.3 is($P0, 8, 'i_floor_divide FLOATVAL multi') - + throws_substring(<<'CODE', 'float division by zero', 'i_floor_divide by 0 FLOATVAL multi') .sub main $P0 = new ['Integer'] @@ -625,7 +625,6 @@ CODE say $P0 .end CODE - .end .sub test_arithmetic @@ -657,7 +656,7 @@ CODE $P2 = typeof $P0 is($P0, 2, 'modulus overflow promotion') is($P2, 'BigInt', 'modulus overflow type check') - + throws_substring(<<'CODE', 'int modulus by zero', 'modulus by 0 DEFAULT multi') .sub main $P0 = new ['Integer'] @@ -668,12 +667,12 @@ CODE say $P0 .end CODE - + $P0 = new ['Integer'] $P0 = 7 $P0 = mod $P0, 4 is($P0, 3, 'modulus INTVAL multi') - + throws_substring(<<'CODE', 'int modulus by zero', 'modulus by 0 INTVAL multi') .sub main $P0 = new ['Integer'] @@ -690,7 +689,7 @@ CODE say $P0 .end CODE - + $P0 = new ['Integer'] $P1 = new ['BigInt'] $P0 = 7 @@ -699,14 +698,14 @@ CODE $P2 = typeof $P0 is($P0, 2, 'i_modulus overflow promotion') is($P2, 'BigInt', 'i_modulus overflow type check') - + $P0 = new ['Integer'] $P1 = new ['Float'] $P0 = 7 $P1 = 5 mod $P0, $P1 is($P0, 2, 'i_modulus DEFAULT multi') - + throws_substring(<<'CODE', 'int modulus by zero', 'i_modulus by 0 DEFAULT multi') .sub main $P0 = new ['Integer'] @@ -717,7 +716,7 @@ CODE say $P0 .end CODE - + $P0 = new ['Integer'] $P0 = 7 mod $P0, 4 @@ -725,7 +724,7 @@ CODE $P0 = 7 mod $P0, 3.0 is($P0, 1, 'i_modulus FLOATVAL multi') - + throws_substring(<<'CODE', 'int modulus by zero', 'i_modulus by 0 INTVAL multi') .sub main $P0 = new ['Integer'] @@ -746,21 +745,21 @@ CODE .sub test_neg .include 'sysinfo.pasm' - + $P0 = new ['Integer'] $P1 = new ['BigInt'] - + $I0 = sysinfo .SYSINFO_PARROT_INTMIN - + $P0 = $I0 $P1 = $I0 neg $P1 - + $P0 = neg $P0 $P2 = typeof $P0 is($P0, $P1, 'neg integer overflow promotion') is($P2, 'BigInt', 'neg integer overflow type check') - + $P0 = new ['Integer'] $P0 = -3 neg $P0 @@ -862,7 +861,7 @@ fin: $P1 = new ['String'] $P0 = 23 $P1 = "23.4" - + $I0 = cmp_num $P0, $P1 is($I0, -1, 'cmp_num 23(Integer PMC), "23.4"(String PMC) = -1') $P1 = "23e-2" @@ -882,7 +881,7 @@ fin: $P0 = 245 $I0 = cmp_num $P0, $P1 is($I0, 1, 'cmp_num 245(Integer PMC), "0"(String PMC) = 1') - + $P1 = new ['Float'] $P1 = 2.6 $I0 = cmp_num $P0, $P1 @@ -893,7 +892,7 @@ fin: $P1 = 245 $I0 = cmp_num $P0, $P1 is($I0, 0, 'cmp_num 245(Integer PMC), 245(Float PMC) = 0') - + $P1 = new ['Integer'] $P1 = 300 $I0 = cmp_num $P0, $P1 From 8bcc66e402200f0d7876f0964ca447c8591ec0bd Mon Sep 17 00:00:00 2001 From: Tony Young Date: Sat, 11 Dec 2010 11:29:35 +1300 Subject: [PATCH 062/102] Moved various files from /src to /frontend --- MANIFEST | 8 +-- config/gen/makefiles/root.in | 72 +++++++++---------- {src => frontend/parrot}/main.c | 0 .../parrot_debugger/main.c | 0 src/pbc_dump.c => frontend/pbc_dump/main.c | 0 src/pbc_merge.c => frontend/pbc_merge/main.c | 0 6 files changed, 40 insertions(+), 40 deletions(-) rename {src => frontend/parrot}/main.c (100%) rename src/parrot_debugger.c => frontend/parrot_debugger/main.c (100%) rename src/pbc_dump.c => frontend/pbc_dump/main.c (100%) rename src/pbc_merge.c => frontend/pbc_merge/main.c (100%) diff --git a/MANIFEST b/MANIFEST index 958ccaa7a7..7228529ad3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -901,6 +901,10 @@ ext/nqp-rx/t/p6regex/rx_modifiers [test] ext/nqp-rx/t/p6regex/rx_quantifiers [test] ext/nqp-rx/t/p6regex/rx_subrules [test] ext/nqp-rx/t/p6regex/rx_syntax [test] +frontend/parrot/main.c [] +frontend/parrot_debugger/main.c [] +frontend/pbc_dump/main.c [] +frontend/pbc_merge/main.c [] include/parrot/atomic.h [main]include include/parrot/atomic/fallback.h [main]include include/parrot/atomic/gcc_pcc.h [main]include @@ -1287,7 +1291,6 @@ src/libnci_test.def [] src/library.c [] src/list.c [] src/longopt.c [] -src/main.c [] src/misc.c [] src/multidispatch.c [] src/namespace.c [] @@ -1320,10 +1323,7 @@ src/packfile.c [] src/packfile/byteorder.h [] src/packfile/pf_items.c [] src/packout.c [] -src/parrot_debugger.c [] src/pbc_disassemble.c [] -src/pbc_dump.c [] -src/pbc_merge.c [] src/pmc.c [] src/pmc/addrregistry.pmc [] src/pmc/arrayiterator.pmc [] diff --git a/config/gen/makefiles/root.in b/config/gen/makefiles/root.in index a1a52893d1..8b58270279 100644 --- a/config/gen/makefiles/root.in +++ b/config/gen/makefiles/root.in @@ -591,7 +591,7 @@ MAKE = @make_c@ .SUFFIXES : .c .S .s .pmc .dump $(O) .str .pir .pbc .c$(O) : # suffix rule (limited support) - $(CC) $(CFLAGS) @optimize@ $(CC_WARN) -I$(@D) @cc_o_out@$@ -c $< + $(CC) $(CFLAGS) @optimize@ $(CC_WARN) -I$(@D) -Isrc/ @cc_o_out@$@ -c $< #UNLESS(win32):.s$(O) : # suffix rule (limited support) #UNLESS(win32): $(CC) $(CFLAGS) @optimize@ $(CC_WARN) -I$(@D) @cc_o_out@$@ -c $< @@ -857,11 +857,11 @@ runtime/parrot/include/config.fpmc : myconfig config_lib.pir \ runtime/parrot/include/datatypes.pasm $(MINIPARROT) $(MINIPARROT) -Iruntime/parrot/include config_lib.pir > $@ -$(PARROT) : src/main$(O) $(GEN_HEADERS) $(LIBPARROT) \ +$(PARROT) : frontend/parrot/main$(O) $(GEN_HEADERS) $(LIBPARROT) \ src/parrot_config$(O) \ $(MINIPARROT) $(LINK) @ld_out@$@ \ - src/main$(O) src/parrot_config$(O) \ + frontend/parrot/main$(O) src/parrot_config$(O) \ @rpath_blib@ $(ALL_PARROT_LIBS) $(LINKFLAGS) $(LINK_DYNAMIC) #IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;1 @@ -885,17 +885,17 @@ $(PARROT_CONFIG) : $(DEV_TOOLS_DIR)/parrot-config.pir $(PARROT) $(PBC_TO_EXE) $(PARROT) -o parrot_config.pbc $(DEV_TOOLS_DIR)/parrot-config.pir $(PARROT) pbc_to_exe.pbc parrot_config.pbc -$(MINIPARROT) : src/main$(O) $(GEN_HEADERS) $(LIBPARROT) \ +$(MINIPARROT) : frontend/parrot/main$(O) $(GEN_HEADERS) $(LIBPARROT) \ src/null_config$(O) - $(LINK) @ld_out@$@ src/main$(O) src/null_config$(O) \ + $(LINK) @ld_out@$@ frontend/parrot/main$(O) src/null_config$(O) \ @rpath_blib@ $(ALL_PARROT_LIBS) $(LINKFLAGS) #IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;1 -$(INSTALLABLEPARROT) : src/main$(O) $(GEN_HEADERS) $(LIBPARROT) \ +$(INSTALLABLEPARROT) : frontend/parrot/main$(O) $(GEN_HEADERS) $(LIBPARROT) \ src/install_config$(O) \ $(PARROT) $(LINK) @ld_out@$@ \ - src/main$(O) src/install_config$(O) \ + frontend/parrot/main$(O) src/install_config$(O) \ @rpath_lib@ $(ALL_PARROT_LIBS) $(LINKFLAGS) #IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;1 @@ -1023,20 +1023,20 @@ $(INSTALLABLEPROVE) : parrot-prove.pbc $(PBC_TO_EXE) src/install_config$(O) # Parrot Debugger # -src/parrot_debugger$(O) : $(PARROT_H_HEADERS) src/parrot_debugger.c \ +frontend/parrot_debugger/main$(O) : $(PARROT_H_HEADERS) frontend/parrot_debugger/main.c \ $(INC_DIR)/embed.h \ $(INC_DIR)/runcore_api.h -$(PDB) : src/parrot_debugger$(O) src/parrot_config$(O) $(LIBPARROT) +$(PDB) : frontend/parrot_debugger/main$(O) src/parrot_config$(O) $(LIBPARROT) $(LINK) @ld_out@$@ \ - src/parrot_debugger$(O) \ + frontend/parrot_debugger/main$(O) \ src/parrot_config$(O) \ @rpath_blib@ $(ALL_PARROT_LIBS) $(LINKFLAGS) #IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;1 -$(INSTALLABLEPDB) : src/parrot_debugger$(O) $(LIBPARROT) src/parrot_config$(O) +$(INSTALLABLEPDB) : frontend/parrot_debugger/main$(O) $(LIBPARROT) src/parrot_config$(O) $(LINK) @ld_out@$@ \ - src/parrot_debugger$(O) \ + frontend/parrot_debugger/main$(O) \ src/parrot_config$(O) \ @rpath_lib@ $(ALL_PARROT_LIBS) $(LINKFLAGS) #IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;1 @@ -1067,24 +1067,24 @@ $(INSTALLABLEDIS) : src/pbc_disassemble$(O) \ src/packdump$(O) : $(PARROT_H_HEADERS) include/pmc/pmc_sub.h \ include/pmc/pmc_key.h src/packdump.c -$(PDUMP) : src/pbc_dump$(O) src/packdump$(O) $(LIBPARROT) +$(PDUMP) : frontend/pbc_dump/main$(O) src/packdump$(O) $(LIBPARROT) $(LINK) @ld_out@$@ \ - src/pbc_dump$(O) \ + frontend/pbc_dump/main$(O) \ src/packdump$(O) @rpath_blib@ $(ALL_PARROT_LIBS) $(LINKFLAGS) #IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;1 -src/pbc_dump$(O) : \ +frontend/pbc_dump/main$(O) : \ $(INC_DIR)/embed.h \ $(INC_DIR)/oplib/ops.h \ $(INC_DIR)/oplib/core_ops.h \ $(PARROT_H_HEADERS) \ $(INC_DIR)/runcore_api.h \ - src/pbc_dump.c + frontend/pbc_dump/main.c -$(INSTALLABLEPDUMP) : src/pbc_dump$(O) src/packdump$(O) \ +$(INSTALLABLEPDUMP) : frontend/pbc_dump/main$(O) src/packdump$(O) \ src/install_config$(O) $(LIBPARROT) $(LINK) @ld_out@$@ \ - src/pbc_dump$(O) \ + frontend/pbc_dump/main$(O) \ src/packdump$(O) \ @rpath_lib@ $(ALL_PARROT_LIBS) $(LINKFLAGS) #IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;1 @@ -1095,16 +1095,16 @@ $(INSTALLABLEPDUMP) : src/pbc_dump$(O) src/packdump$(O) \ # Parrot Bytecode File Merger # -$(PBC_MERGE) : src/pbc_merge$(O) $(LIBPARROT) src/parrot_config$(O) +$(PBC_MERGE) : frontend/pbc_merge/main$(O) $(LIBPARROT) src/parrot_config$(O) $(LINK) @ld_out@$@ \ - src/pbc_merge$(O) \ + frontend/pbc_merge/main$(O) \ src/parrot_config$(O) \ @rpath_blib@ $(ALL_PARROT_LIBS) $(LINK_DYNAMIC) $(LINKFLAGS) #IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;1 -$(INSTALLABLEPBC_MERGE) : src/pbc_merge$(O) $(LIBPARROT) $(INSTALLABLECONFIG) +$(INSTALLABLEPBC_MERGE) : frontend/pbc_merge/main$(O) $(LIBPARROT) $(INSTALLABLECONFIG) $(LINK) @ld_out@$@ \ - src/pbc_merge$(O) \ + frontend/pbc_merge/main$(O) \ src/install_config$(O) \ @rpath_lib@ $(ALL_PARROT_LIBS) $(LINKFLAGS) #IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;1 @@ -1537,13 +1537,13 @@ src/io/win32$(O) : $(PARROT_H_HEADERS) src/io/io_private.h \ src/gc/alloc_memory$(O) : $(PARROT_H_HEADERS) src/gc/alloc_memory.c -src/main$(O) : \ +frontend/parrot/main$(O) : \ $(INC_DIR)/imcc.h \ $(PARROT_H_HEADERS) \ $(INC_DIR)/embed.h \ $(INC_DIR)/runcore_api.h \ src/gc/gc_private.h \ - src/main.c \ + frontend/parrot/main.c \ src/gc/variable_size_pool.h src/multidispatch$(O) : \ @@ -1707,9 +1707,9 @@ src/string/encoding/ucs4$(O) : $(PARROT_H_HEADERS) \ src/string/encoding/shared.h \ src/string/unicode.h -src/pbc_merge$(O) : \ +frontend/pbc_merge/main$(O) : \ $(INC_DIR)/embed.h \ - src/pbc_merge.c \ + frontend/pbc_merge/main.c \ include/pmc/pmc_sub.h \ $(INC_DIR)/oplib/ops.h \ $(INC_DIR)/oplib/core_ops.h \ @@ -2062,12 +2062,12 @@ prog-clean : parrot-prove.pbc parrot-prove.c parrot-prove$(O) parrot-prove$(EXE) \ parrot_config$(EXE) parrot_config.c parrot_config$(O) parrot_config.pbc \ compilers/imcc/main$(O) \ - $(PDUMP) src/pbc_dump$(O) src/packdump$(O) \ - $(PDB) src/parrot_debugger$(O) \ - $(PBC_MERGE) src/pbc_merge$(O) \ + $(PDUMP) frontend/pbc_dump/main$(O) src/packdump$(O) \ + $(PDB) frontend/parrot_debugger/main$(O) \ + $(PBC_MERGE) frontend/pbc_merge/main$(O) \ $(DIS) src/pbc_disassemble$(O) $(RM_F) \ - src/main$(O) \ + frontend/parrot/main$(O) \ src/null_config$(O) \ src/parrot_config$(O) \ src/install_config$(O) \ @@ -2100,9 +2100,9 @@ archclean: dynext-clean $(INSTALLABLECONFIG) \ $(INSTALLABLENQP) \ compilers/imcc/main$(O) \ - $(PDUMP) src/pbc_dump$(O) src/packdump$(O) \ - $(PDB) src/parrot_debugger$(O) \ - $(PBC_MERGE) src/pbc_merge$(O) \ + $(PDUMP) frontend/pbc_dump/main$(O) src/packdump$(O) \ + $(PDB) frontend/parrot_debugger/main$(O) \ + $(PBC_MERGE) frontend/pbc_merge/main$(O) \ $(DIS) src/pbc_disassemble$(O) \ $(PARROT_CONFIG) parrot_config$(O) parrot_config.c \ src/parrot_config$(O) parrot_config.pbc \ @@ -2216,7 +2216,7 @@ status : patch : git diff -LINTABLE_CFILES = `echo src/main$(O) $(O_FILES) src/parrot_config$(O) | $(PERL) -pe @PQ@s/\.o/\.c/g@PQ@` +LINTABLE_CFILES = `echo frontend/parrot/main$(O) $(O_FILES) src/parrot_config$(O) | $(PERL) -pe @PQ@s/\.o/\.c/g@PQ@` lint : sunlint @@ -2728,9 +2728,9 @@ cagecritic: HEADERIZER_O_FILES = \ $(O_FILES) \ - src/main$(O) \ + frontend/parrot/main$(O) \ src/packdump$(O) \ - src/pbc_merge$(O) \ + frontend/pbc_merge/main$(O) \ headerizer : src/core_pmcs.c $(HEADERIZER) $(HEADERIZER_O_FILES) compilers/imcc/imcc.y diff --git a/src/main.c b/frontend/parrot/main.c similarity index 100% rename from src/main.c rename to frontend/parrot/main.c diff --git a/src/parrot_debugger.c b/frontend/parrot_debugger/main.c similarity index 100% rename from src/parrot_debugger.c rename to frontend/parrot_debugger/main.c diff --git a/src/pbc_dump.c b/frontend/pbc_dump/main.c similarity index 100% rename from src/pbc_dump.c rename to frontend/pbc_dump/main.c diff --git a/src/pbc_merge.c b/frontend/pbc_merge/main.c similarity index 100% rename from src/pbc_merge.c rename to frontend/pbc_merge/main.c From 9099987ad7072de7ea8f9654df3cf0daead18c61 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Fri, 10 Dec 2010 21:21:40 -0500 Subject: [PATCH 063/102] [codingstd] No trailing whitespace. --- t/pmc/string.t | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/t/pmc/string.t b/t/pmc/string.t index 996831a8d0..d6cffcdd14 100644 --- a/t/pmc/string.t +++ b/t/pmc/string.t @@ -620,7 +620,7 @@ OK4: ok( $I0, 'ne_str "0(Integer), "ABC" -> true' ) is( t, 'TAACGSTAACGS', 'trans' ) is( s, 'atugcsATUGCS', "trans doesn't touch source string") - + push_eh THROWN $I0 = 1 $P0.'trans'(unicode:"abc", tr_00) @@ -692,7 +692,7 @@ loop: $S1 = substr $S0, 3, 3 $I0 = $P0.'is_integer'($S1) ok( $I0, '... substr' ) - + push_eh THROWN $I0 = 1 $P0.'is_integer'(unicode:"123") @@ -929,16 +929,16 @@ check: .sub test_unescape .local pmc s1, s2 - + s1 = new['String'] s1 = '\n' s2 = s1.'unescape'('ascii') is( s2, "\n", "unescape('\\n') == \"\\n\"" ) - + s1 = '\x41\x42' s2 = s1.'unescape'('ascii') is( s2, 'AB', "unescape('\\x41\\x42') == 'AB'" ) - + s1 = '\u0043\u0044' s2 = s1.'unescape'('ascii') is( s2, 'CD', "unescape('\\u0043\\u0044') == 'CD'" ) From dcb971396baf8149d8f0cabb042d8dc7e790e13a Mon Sep 17 00:00:00 2001 From: NotFound Date: Sat, 11 Dec 2010 03:23:55 +0100 Subject: [PATCH 064/102] DRY a bit Hash PMC --- src/pmc/hash.pmc | 87 +++++++++++++++++++++++++++++++----------------- 1 file changed, 56 insertions(+), 31 deletions(-) diff --git a/src/pmc/hash.pmc b/src/pmc/hash.pmc index d0a7fb715c..88a25d3d93 100644 --- a/src/pmc/hash.pmc +++ b/src/pmc/hash.pmc @@ -51,6 +51,14 @@ These are the vtable functions for the Hash PMC. /* HEADERIZER BEGIN: static */ /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ +PARROT_DOES_NOT_RETURN +static void cannot_autovivify_nested(PARROT_INTERP) + __attribute__nonnull__(1); + +PARROT_DOES_NOT_RETURN +static void entry_type_must_be_pmc(PARROT_INTERP) + __attribute__nonnull__(1); + PARROT_CANNOT_RETURN_NULL PARROT_WARN_UNUSED_RESULT static PMC* get_next_hash(PARROT_INTERP, @@ -61,6 +69,10 @@ static PMC* get_next_hash(PARROT_INTERP, __attribute__nonnull__(3) FUNC_MODIFIES(*hash); +#define ASSERT_ARGS_cannot_autovivify_nested __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp)) +#define ASSERT_ARGS_entry_type_must_be_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp)) #define ASSERT_ARGS_get_next_hash __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ PARROT_ASSERT_ARG(interp) \ , PARROT_ASSERT_ARG(hash) \ @@ -88,8 +100,7 @@ get_next_hash(PARROT_INTERP, ARGMOD(Hash *hash), ARGIN(void *key)) HashBucket *bucket; if (hash->entry_type != enum_type_PMC) - Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, - "Hash entry type must be PMC for multipart keys."); + entry_type_must_be_pmc(interp); bucket = parrot_hash_get_bucket(interp, hash, key); @@ -468,8 +479,7 @@ Returns the integer value for the element at C<*key>. return hash_value_to_int(INTERP, hash, b->value); if (hash->entry_type != enum_type_PMC) - Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, - "Hash entry type must be PMC for multipart keys."); + entry_type_must_be_pmc(INTERP); /* Recursively call to enclosed aggregate */ return VTABLE_get_integer_keyed(INTERP, (PMC *)b->value, key); @@ -502,9 +512,7 @@ Returns the integer value for the element at C<*key>. else { PMC * const next_hash = get_next_hash(INTERP, hash, hash_key); if (PMC_IS_NULL(next_hash)) - Parrot_ex_throw_from_c_args(INTERP, NULL, - EXCEPTION_INVALID_OPERATION, - "Cannot autovivify nested hashes"); + cannot_autovivify_nested(INTERP); VTABLE_set_integer_keyed(INTERP, next_hash, key, value); } } @@ -593,8 +601,7 @@ Returns the floating-point value for the element at C<*key>. return hash_value_to_number(INTERP, hash, b->value); if (hash->entry_type != enum_type_PMC) - Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, - "Hash entry type must be PMC for multipart keys."); + entry_type_must_be_pmc(INTERP); return VTABLE_get_number_keyed(INTERP, (PMC *)b->value, key); } @@ -658,8 +665,7 @@ Returns the string value for the element at C<*key>. return hash_value_to_string(INTERP, hash, b->value); if (hash->entry_type != enum_type_PMC) - Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, - "Hash entry type must be PMC for multipart keys."); + entry_type_must_be_pmc(INTERP); /* Recursively call to enclosed aggregate */ return VTABLE_get_string_keyed(INTERP, (PMC *)b->value, key); @@ -697,9 +703,7 @@ Returns the string value for the element at C<*key>. else { PMC * const next_hash = get_next_hash(INTERP, hash, hash_key); if (PMC_IS_NULL(next_hash)) - Parrot_ex_throw_from_c_args(INTERP, NULL, - EXCEPTION_INVALID_OPERATION, - "Cannot autovivify nested hashes"); + cannot_autovivify_nested(INTERP); VTABLE_set_string_keyed(INTERP, next_hash, key, value); } } @@ -806,8 +810,7 @@ Returns the PMC value for the element at C<*key>. return hash_value_to_pmc(INTERP, hash, b->value); if (hash->entry_type != enum_type_PMC) - Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, - "Hash entry type must be PMC for multipart keys."); + entry_type_must_be_pmc(INTERP); /* Recursively call to enclosed aggregate */ return VTABLE_get_pmc_keyed(INTERP, (PMC *)b->value, key); @@ -840,9 +843,7 @@ Returns the PMC value for the element at C<*key>. else { PMC * const next_hash = get_next_hash(INTERP, hash, hash_key); if (PMC_IS_NULL(next_hash)) - Parrot_ex_throw_from_c_args(INTERP, NULL, - EXCEPTION_INVALID_OPERATION, - "Cannot autovivify nested hashes"); + cannot_autovivify_nested(INTERP); VTABLE_set_number_keyed(INTERP, next_hash, key, value); } } @@ -902,9 +903,7 @@ Sets C as the value for C<*key>. else { PMC * const next_hash = get_next_hash(INTERP, hash, hash_key); if (PMC_IS_NULL(next_hash)) - Parrot_ex_throw_from_c_args(INTERP, NULL, - EXCEPTION_INVALID_OPERATION, - "Cannot autovivify nested hashes"); + cannot_autovivify_nested(INTERP); VTABLE_set_pmc_keyed(INTERP, next_hash, key, value); } } @@ -979,9 +978,7 @@ Returns whether a key C<*key> exists in the hash. return 1; if (h->entry_type != enum_type_PMC) - Parrot_ex_throw_from_c_args(INTERP, NULL, - EXCEPTION_INVALID_OPERATION, - "Hash entry type must be PMC for multipart keys."); + entry_type_must_be_pmc(INTERP); return VTABLE_exists_keyed(INTERP, (PMC *)b->value, key); } @@ -1031,9 +1028,7 @@ Returns whether the value for C<*key> is defined. return VTABLE_defined(INTERP, hash_value_to_pmc(INTERP, h, b->value)); if (h->entry_type != enum_type_PMC) - Parrot_ex_throw_from_c_args(INTERP, NULL, - EXCEPTION_INVALID_OPERATION, - "Hash entry type must be PMC for multipart keys."); + entry_type_must_be_pmc(INTERP); return VTABLE_defined_keyed(INTERP, (PMC *)b->value, key); } @@ -1078,9 +1073,7 @@ Deletes the element associated with C<*key>. } if (h->entry_type != enum_type_PMC) - Parrot_ex_throw_from_c_args(INTERP, NULL, - EXCEPTION_INVALID_OPERATION, - "Hash entry type must be PMC for multipart keys."); + entry_type_must_be_pmc(INTERP); VTABLE_delete_keyed(INTERP, (PMC *)b->value, key); } @@ -1221,6 +1214,38 @@ Used to unarchive the hash. =back +=head1 Auxiliar functions + +=over 4 + +=item C + +=item C + +*/ + +PARROT_DOES_NOT_RETURN +static void +entry_type_must_be_pmc(PARROT_INTERP) +{ + Parrot_ex_throw_from_c_args(interp, NULL, + EXCEPTION_INVALID_OPERATION, + "Hash entry type must be PMC for multipart keys."); +} + +PARROT_DOES_NOT_RETURN +static void +cannot_autovivify_nested(PARROT_INTERP) +{ + Parrot_ex_throw_from_c_args(interp, NULL, + EXCEPTION_INVALID_OPERATION, + "Cannot autovivify nested hashes"); +} + +/* + +=back + =head1 SEE ALSO F. From e5fa363853c0008ca8f755ceb707e40d34417947 Mon Sep 17 00:00:00 2001 From: NotFound Date: Sat, 11 Dec 2010 03:31:17 +0100 Subject: [PATCH 065/102] forgot to add ASSERT_ARGS in dcb9713 --- src/pmc/hash.pmc | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/pmc/hash.pmc b/src/pmc/hash.pmc index 88a25d3d93..0f314f8369 100644 --- a/src/pmc/hash.pmc +++ b/src/pmc/hash.pmc @@ -1228,6 +1228,7 @@ PARROT_DOES_NOT_RETURN static void entry_type_must_be_pmc(PARROT_INTERP) { + ASSERT_ARGS(entry_type_must_be_pmc) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Hash entry type must be PMC for multipart keys."); @@ -1237,6 +1238,7 @@ PARROT_DOES_NOT_RETURN static void cannot_autovivify_nested(PARROT_INTERP) { + ASSERT_ARGS(cannot_autovivify_nested) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Cannot autovivify nested hashes"); From 4db8296b8bde6b3c989d13f3f6b61089c24557f1 Mon Sep 17 00:00:00 2001 From: "Michael H. Hind" Date: Sat, 11 Dec 2010 02:30:56 +0000 Subject: [PATCH 066/102] re-generate MANIFEST --- MANIFEST | 1 + 1 file changed, 1 insertion(+) diff --git a/MANIFEST b/MANIFEST index 7228529ad3..b2a962e820 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2090,6 +2090,7 @@ tools/dev/gen_charset_tables.pl [] tools/dev/gen_class.pl [] tools/dev/gen_makefile.pl [devel] tools/dev/gen_valgrind_suppressions.pl [] +tools/dev/github_post_receive.pl [] tools/dev/headerizer.pl [] tools/dev/install_dev_files.pl [] tools/dev/install_doc_files.pl [] From 6f9f528c01897d85f4bb63ed70364b114db4a826 Mon Sep 17 00:00:00 2001 From: "Michael H. Hind" Date: Sat, 11 Dec 2010 02:55:02 +0000 Subject: [PATCH 067/102] fix codetest failures add copyright line and add coda fix platform-specific perl shebang line replace hard tabs --- tools/dev/github_post_receive.pl | 59 ++++++++++++++++++-------------- 1 file changed, 34 insertions(+), 25 deletions(-) diff --git a/tools/dev/github_post_receive.pl b/tools/dev/github_post_receive.pl index ba1526977c..4badd0aef1 100644 --- a/tools/dev/github_post_receive.pl +++ b/tools/dev/github_post_receive.pl @@ -1,4 +1,6 @@ -#!/usr/bin/env perl +#! perl +# Copyright (C) 2010, Parrot Foundation. + use strict; use warnings; @@ -18,7 +20,7 @@ =head1 DESCRIPTION a post-receive script to send commit diffs to parrot developers -=cut +=cut my $q = CGI->new; print $q->header; @@ -31,24 +33,24 @@ =head1 DESCRIPTION #tie my %short, 'Tie::Function' => sub { substr( shift(), 0, 8 ) }; my $commits = - join '', - map { - my %c = %$_; - $c{timestamp} = eval { fmt_time($c{timestamp}) } || $c{timestamp}; - my @file_changes = - map ' '.join(' ', @$_), - sort { $a->[1] cmp $b->[1] } - ( ( map ['A',$_], @{$c{added} } ), - ( map ['D',$_], @{$c{removed} } ), - ( map ['M',$_], @{$c{modified}} ), - ); - my $file_change_count = @file_changes; - $file_change_count = "$file_change_count ".($file_change_count > 1 ? 'files changed' : 'file changed'); - my $file_changes = join "\n", @file_changes; - - $c{message} = indent($c{message}); - - <[1] cmp $b->[1] } + ( ( map ['A',$_], @{$c{added} } ), + ( map ['D',$_], @{$c{removed} } ), + ( map ['M',$_], @{$c{modified}} ), + ); + my $file_change_count = @file_changes; + $file_change_count = "$file_change_count ".($file_change_count > 1 ? 'files changed' : 'file changed'); + my $file_changes = join "\n", @file_changes; + + $c{message} = indent($c{message}); + + < @@ -69,8 +71,8 @@ =head1 DESCRIPTION $commit_cnt = "$commit_cnt ".( $commit_cnt > 1 ? 'commits' : 'commit' ); my %mail = ( From => 'github-commits@bugs.sgn.cornell.edu', - Subject => "[$p->{repository}{owner}{name}/$p->{repository}{name}($head)] $commit_cnt - GitHub", - Message => < "[$p->{repository}{owner}{name}/$p->{repository}{name}($head)] $commit_cnt - GitHub", + Message => <{after} Home: $p->{repository}->{url} Browse: $p->{repository}->{url}/tree/$head @@ -79,12 +81,12 @@ =head1 DESCRIPTION $commits EOF - ); + ); my @send_list = ( 'parrot-commits@lists.parrot.org' ); foreach my $to ( @send_list ) { - sendmail( %mail, To => $to ) - or warn "error sending to $to: $Mail::Sendmail::error"; + sendmail( %mail, To => $to ) + or warn "error sending to $to: $Mail::Sendmail::error"; } #print "OK. Log says:\n", $Mail::Sendmail::log; @@ -107,3 +109,10 @@ sub fmt_time { $d->set_time_zone(DateTime::TimeZone::Local->TimeZone() ); return $d->strftime(q|%a %m/%d/%y, %I:%m %p %Z|); } + +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4: From 864c42fa53b26fe19c192a8ba8eb442e7ece0f24 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Fri, 10 Dec 2010 22:15:56 -0500 Subject: [PATCH 068/102] Begin to standardize the POD in this file. --- lib/Parrot/Headerizer/Object.pm | 303 +++++++++++++++++++++++++++++--- 1 file changed, 274 insertions(+), 29 deletions(-) diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 631a12ad61..b2bab7197d 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -5,18 +5,29 @@ package Parrot::Headerizer::Object; =head1 NAME -Parrot::Headerizer::Object - Parrot Header Generation functionality +Parrot::Headerizer::Object - Parrot header generation functionality =head1 SYNOPSIS use Parrot::Headerizer::Object; - my $headerizer = Parrot::Headerizer::Object->new(); + $headerizer = Parrot::Headerizer::Object->new( { + macro_match => $macro_match, # optional + } ); + + $headerizer->get_sources(@ofiles); + $headerizer->process_sources(); + $headerizer->print_final_message(); + $headerizer->print_warnings(); + + @function_decls = $headerizer->extract_function_declarations($buf); + $escaped_decl = $headerizer->generate_documentation_signature($function_decl); =head1 DESCRIPTION C knows how to extract all kinds of information out -of C-language files. +of C-language files. Its methods are used in F and +F. =head1 METHODS @@ -48,8 +59,26 @@ use Parrot::Headerizer::Functions qw( =head2 C +=over 4 + +=item * Purpose + Constructor of headerizer objects. +=item * Arguments + + $headerizer = Parrot::Headerizer::Object->new( { + macro_match => $macro_match, # optional + } ); + +None mandatory, but optionally takes a hash reference. + +=item * Return Value + +Parrot::Headerizer::Object object. + +=back + =cut sub new { @@ -91,6 +120,27 @@ sub new { return bless $args, $class; } +=over 4 + +=item * Purpose + +Identify the source code files which need to have header informationn +extracted. + +=item * Arguments + + $headerizer->get_sources(@ofiles); + +List of names of C object (C<.o>) files. + +=item * Return Value + +No defined return value. + +=back + +=cut + sub get_sources { my $self = shift; my @ofiles = @_; @@ -150,11 +200,27 @@ sub get_sources { =head2 C - $headerizer->extract_function_declarations($text) +=over 4 + +=item * Purpose Extracts the function declarations from the text argument, and returns an array of strings containing the function declarations. +=item * Arguments + + @function_decls = $headerizer->extract_function_declarations($text) + +String holding the slurped-in content of a source code file. + +=item * Return Value + +List of strings holding function declarations. + +=item * Comment + +=back + =cut sub extract_function_declarations { @@ -220,10 +286,29 @@ sub extract_function_declarations { return @funcs; } -=head2 extract_function_declaration_and_update_source( $cfile_name ) +=head2 C + +=over 4 + +=item * Purpose -Extract all the function declarations from the C file specified by -I<$cfile_name>, and update the comment blocks within. +Extract all the function declarations from a source code file and update the +comment blocks within it. + +=item * Arguments + + @function_declarations = + $headerizer->extract_function_declaration_and_update_source($cfile_name); + +String holding source code filename. + +=item * Return Value + +List of strings holding function declarations. + +=item * Comment + +=back =cut @@ -257,20 +342,32 @@ sub extract_function_declarations_and_update_source { =head2 C -$file => the filename -$proto => the function declaration +=over 4 -Returns an anonymous hash of function components: +=item * Purpose - file => $file, - name => $name, - args => \@args, - macros => \@macros, - is_static => $is_static, - is_inline => $parrot_inline, - is_api => $parrot_api, - is_ignorable => $is_ignorable, - return_type => $return_type, +Create a data structure in which information about a particular function can +be looked up. + +=item * Arguments + +List of two strings, the filename and the function declaration. + +=item * Return Value + +Returns a reference to a hash of these function components: + + file + name + args + macros + is_static + is_inline + is_api + is_ignorable + return_type + +=back =cut @@ -357,13 +454,30 @@ sub function_components_from_declaration { =head2 C - $self->check_pointer_return_type( { +=over 4 + +=item * Purpose + +Performs some validation in the case where a function's return value is a +pointer. + +=item * Arguments + + $headerizer->check_pointer_return_type( { return_type => $return_type, macros => \%macros, name => $name, file => $file, } ); +Reference to a hash with the four elements listed above. + +=item * Return Value + +No defined return value. + +=back + =cut sub check_pointer_return_type { @@ -382,11 +496,27 @@ sub check_pointer_return_type { } } -=head2 C +=head2 C + +=over 4 + +=item * Purpose Given an extracted function signature, return a modified version suitable for inclusion in POD documentation. +=item * Arguments + + $heading = $headerizer->generate_documentation_signature($decl); + +String holding a function declaration. + +=item * Return Value + +String holding a function header, split over multiple lines as needed. + +=back + =cut sub generate_documentation_signature { @@ -431,9 +561,23 @@ sub generate_documentation_signature { =head2 C +=over 4 + +=item * Purpose + +Tests the validity of a given macro. + +=item * Arguments + $headerizer->valid_macro( $macro ) -Returns a boolean saying whether I<$macro> is a valid C macro. +String holding a macro. + +=item * Return Value + +Boolean: true value for valid macro; false value for invalid macro. + +=back =cut @@ -446,9 +590,23 @@ sub valid_macro { =head2 C - $headerizer->valid_macros() +=over 4 -Returns a list of all the valid C macros. +=item * Purpose + +Identify all valid macros whose names are of the form C. + +=item * Arguments + + @marcros = $headerizer->valid_macros(); + +None. + +=item * Return Value + +List of all the valid C macros. + +=back =cut @@ -460,13 +618,32 @@ sub valid_macros { return @macros; } -=head2 C +=head2 C -Headerizer-specific ways of complaining if something went wrong. +=over 4 + +=item * Purpose -$file => filename -$func => function name -$error => error message text +Builds a data structure with headerizer-specific ways of complaining if +something went wrong. + +=item * Arguments + + $headerizer->squawk($file, $func, $error); + +List of 3 arguments: the file containing the error; the function containing +the error; the text of the error message. + +=item * Return Value + +Undefined value. + +=item * Comment + +C does not print any warnings or errors itself. Use +C to report those. + +=back =cut @@ -481,6 +658,27 @@ sub squawk { return; } +=head2 C + +=over 4 + +=item * Purpose + +Once the source files needing headerization have been identified, this method +serves as a wrapper around that headerization. + +=item * Arguments + +None. + +=item * Return Value + +None. + +=back + +=cut + sub process_sources { my ($self) = @_; my %sourcefiles = %{$self->{sourcefiles}}; @@ -530,6 +728,20 @@ sub process_sources { } } +=head2 C + +=over 4 + +=item * Purpose + +=item * Arguments + +=item * Return Value + +=back + +=cut + sub replace_headerized_declarations { my $self = shift; my $source_code = shift; @@ -558,6 +770,19 @@ sub replace_headerized_declarations { return add_headerizer_markers( $markers_args ); } +=head2 C + +=over 4 + +=item * Purpose + +=item * Arguments + +=item * Return Value + +=back + +=cut sub make_function_decls { my $self = shift; @@ -609,6 +834,20 @@ sub make_function_decls { return @decls; } +=head2 C + +=over 4 + +=item * Purpose + +=item * Arguments + +=item * Return Value + +=back + +=cut + sub attrs_from_args { my $self = shift; my $func = shift; @@ -652,10 +891,16 @@ sub print_final_message { =item * Purpose +Print all warnings accumulated in the course of the headerization process. + =item * Arguments +None. + =item * Return Value +Implicitly returns true value upon success. + =item * Comment =back From db760d28c7579e72bcf185e8afb9ec76b23013a7 Mon Sep 17 00:00:00 2001 From: Nolan Lum Date: Fri, 10 Dec 2010 21:23:24 -0500 Subject: [PATCH 069/102] Refactor packfile core files. Modify makefile templates to account for change. packfile.c -> api.c pmc_freeze.c -> object_serialization.c packout.c -> output.c --- MANIFEST | 6 ++--- config/gen/makefiles/docs.in | 6 ++--- config/gen/makefiles/root.in | 22 +++++++++---------- src/{packfile.c => packfile/api.c} | 2 +- .../object_serialization.c} | 2 +- src/{packout.c => packfile/output.c} | 0 6 files changed, 19 insertions(+), 19 deletions(-) rename src/{packfile.c => packfile/api.c} (99%) rename src/{pmc_freeze.c => packfile/object_serialization.c} (99%) rename src/{packout.c => packfile/output.c} (100%) diff --git a/MANIFEST b/MANIFEST index 958ccaa7a7..d28afa3b4a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1316,10 +1316,11 @@ src/ops/string.ops [] src/ops/sys.ops [] src/ops/var.ops [] src/packdump.c [] -src/packfile.c [] +src/packfile/api.c [] src/packfile/byteorder.h [] +src/packfile/object_serialization.c [] +src/packfile/output.c [] src/packfile/pf_items.c [] -src/packout.c [] src/parrot_debugger.c [] src/pbc_disassemble.c [] src/pbc_dump.c [] @@ -1411,7 +1412,6 @@ src/pmc/threadinterpreter.pmc [] src/pmc/timer.pmc [] src/pmc/undef.pmc [] src/pmc/unmanagedstruct.pmc [] -src/pmc_freeze.c [] src/pointer_array.c [] src/runcore/cores.c [] src/runcore/main.c [] diff --git a/config/gen/makefiles/docs.in b/config/gen/makefiles/docs.in index 8c4b9aa0ff..b1eb1bdf2f 100644 --- a/config/gen/makefiles/docs.in +++ b/config/gen/makefiles/docs.in @@ -39,9 +39,9 @@ doc-prep: $(MKPATH) ops $(TOUCH) doc-prep -packfile-c.pod: ../src/packfile.c -#IF(new_perldoc): $(PERLDOC_BIN) -ud packfile-c.pod ../src/packfile.c -#ELSE: $(PERLDOC_BIN) -u ../src/packfile.c > packfile-c.pod +packfile-c.pod: ../src/packfile/api.c +#IF(new_perldoc): $(PERLDOC_BIN) -ud packfile-c.pod ../src/packfile/api.c +#ELSE: $(PERLDOC_BIN) -u ../src/packfile/api.c > packfile-c.pod clean: $(RM_F) packfile-c.pod $(POD) doc-prep diff --git a/config/gen/makefiles/root.in b/config/gen/makefiles/root.in index a1a52893d1..c858e481c0 100644 --- a/config/gen/makefiles/root.in +++ b/config/gen/makefiles/root.in @@ -495,10 +495,8 @@ INTERP_O_FILES = \ #IF(has_core_nci_thunks): src/nci/core_thunks$(O) \ #IF(has_extra_nci_thunks): src/nci/extra_thunks$(O) \ src/oo$(O) \ - src/packfile$(O) \ - src/packout$(O) \ src/platform$(O) \ - src/pmc_freeze$(O) \ + src/packfile/object_serialization$(O) \ src/pmc$(O) \ src/runcore/main$(O) \ src/runcore/cores$(O) \ @@ -513,6 +511,8 @@ INTERP_O_FILES = \ src/utils$(O) \ src/vtables$(O) \ src/warnings$(O) \ + src/packfile/api$(O) \ + src/packfile/output$(O) \ src/packfile/pf_items$(O) \ @TEMP_atomic_o@ \ @TEMP_gc_o@ \ @@ -700,10 +700,10 @@ STR_FILES = \ #IF(has_core_nci_thunks): src/nci/core_thunks.str \ #IF(has_extra_nci_thunks): src/nci/extra_thunks.str \ src/nci/signatures.str \ - src/packfile.str \ + src/packfile/api.str \ + src/packfile/object_serialization.str \ src/packfile/pf_items.str \ src/pmc.str \ - src/pmc_freeze.str \ src/oo.str \ src/runcore/cores.str \ src/runcore/main.str \ @@ -1295,7 +1295,7 @@ src/namespace$(O) : $(PARROT_H_HEADERS) src/namespace.str src/namespace.c \ src/pmc$(O) : include/pmc/pmc_class.h src/pmc.c \ src/pmc.str $(PARROT_H_HEADERS) -src/pmc_freeze$(O) : $(PARROT_H_HEADERS) src/pmc_freeze.str src/pmc_freeze.c +src/packfile/object_serialization$(O) : $(PARROT_H_HEADERS) src/packfile/object_serialization.str src/packfile/object_serialization.c src/hash$(O) : $(PARROT_H_HEADERS) src/hash.c @@ -1555,9 +1555,9 @@ src/multidispatch$(O) : \ include/pmc/pmc_nci.h \ include/pmc/pmc_sub.h -src/packfile$(O) : \ - src/packfile.str \ - src/packfile.c \ +src/packfile/api$(O) : \ + src/packfile/api.str \ + src/packfile/api.c \ include/pmc/pmc_sub.h \ include/pmc/pmc_key.h \ include/pmc/pmc_parrotlibrary.h \ @@ -1577,14 +1577,14 @@ src/packfile$(O) : \ $(PARROT_H_HEADERS) \ $(INC_DIR)/runcore_api.h +src/packfile/output$(O) : $(PARROT_H_HEADERS) include/pmc/pmc_key.h src/packfile/output.c + src/packfile/pf_items$(O) : \ $(PARROT_H_HEADERS) \ src/packfile/byteorder.h \ src/packfile/pf_items.str \ src/packfile/pf_items.c -src/packout$(O) : $(PARROT_H_HEADERS) include/pmc/pmc_key.h src/packout.c - src/parrot$(O) : $(GENERAL_H_FILES) src/runcore/cores$(O) : src/runcore/cores.str \ diff --git a/src/packfile.c b/src/packfile/api.c similarity index 99% rename from src/packfile.c rename to src/packfile/api.c index eb5ce784cb..485b0e2e6e 100644 --- a/src/packfile.c +++ b/src/packfile/api.c @@ -30,7 +30,7 @@ about the structure of the frozen bytecode. #include "parrot/dynext.h" #include "parrot/runcore_api.h" #include "../compilers/imcc/imc.h" -#include "packfile.str" +#include "api.str" #include "pmc/pmc_sub.h" #include "pmc/pmc_key.h" #include "pmc/pmc_callcontext.h" diff --git a/src/pmc_freeze.c b/src/packfile/object_serialization.c similarity index 99% rename from src/pmc_freeze.c rename to src/packfile/object_serialization.c index 0383065e74..29b5b4e457 100644 --- a/src/pmc_freeze.c +++ b/src/packfile/object_serialization.c @@ -23,7 +23,7 @@ individual action vtable (freeze/thaw) is then called for all todo-PMCs. #include "parrot/parrot.h" #include "pmc/pmc_callcontext.h" -#include "pmc_freeze.str" +#include "object_serialization.str" /* when thawing a string longer then this size, we first do a GC run and then * block GC - the system can't give us more headers */ diff --git a/src/packout.c b/src/packfile/output.c similarity index 100% rename from src/packout.c rename to src/packfile/output.c From e69f9bf8558c2188eea5ec19d638d8abb379a798 Mon Sep 17 00:00:00 2001 From: Christoph Otto Date: Fri, 10 Dec 2010 23:22:19 -0800 Subject: [PATCH 070/102] add some new files to .gitignore --- .gitignore | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.gitignore b/.gitignore index 370079b042..9ac0153448 100644 --- a/.gitignore +++ b/.gitignore @@ -238,6 +238,10 @@ /ext/Parrot-Embed/t/*.pbc # generated from svn:ignore of 'ext/nqp-rx/src/stage0/' /ext/nqp-rx/src/stage0/nqp-setting.pir +/frontend/parrot/main.o +/frontend/parrot_debugger/main.o +/frontend/pbc_dump/main.o +/frontend/pbc_merge/main.o # generated from svn:ignore of 'include/parrot/' /include/parrot/*.tmp /include/parrot/config.h From 352d6105577f413a6713d5e42cb9f2d62b51cb7b Mon Sep 17 00:00:00 2001 From: NotFound Date: Sat, 11 Dec 2010 12:07:48 +0100 Subject: [PATCH 071/102] avoid encoding exceptions in OS.readdir on non-windows platforms --- src/dynpmc/os.pmc | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/dynpmc/os.pmc b/src/dynpmc/os.pmc index ede818dc9c..acf8f1aa4e 100644 --- a/src/dynpmc/os.pmc +++ b/src/dynpmc/os.pmc @@ -495,7 +495,18 @@ reads entries from a directory. } while ((dirent = readdir(dir)) != NULL) { - VTABLE_push_string(INTERP, array, Parrot_str_new(INTERP, dirent->d_name, 0)); + /* We don't have yet a good way to know what encoding should be + * used. In the meantime, use binary when there is any non ascii + * character */ + const char *const name = dirent->d_name; + STR_VTABLE *encoding; + size_t l = strlen(name); + size_t i; + for (i = 0; i < l; ++i) + if ((unsigned char)name[i] > 127) + break; + encoding = i == l ? Parrot_ascii_encoding_ptr : Parrot_binary_encoding_ptr; + VTABLE_push_string(INTERP, array, Parrot_str_new_init(INTERP, name, l, encoding, 0)); } closedir(dir); From 7d8623c4186f61cd79c461a3b73a59089c8f2ccc Mon Sep 17 00:00:00 2001 From: "Michael H. Hind" Date: Sat, 11 Dec 2010 13:49:29 +0000 Subject: [PATCH 072/102] re-generate MANIFEST.SKIP --- MANIFEST.SKIP | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index 0965dc6137..5fc10a6d1f 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -1,6 +1,6 @@ # ex: set ro: # $Id$ -# generated by tools/dev/mk_manifest_and_skip.pl Mon Nov 15 22:12:26 2010 UT +# generated by tools/dev/mk_manifest_and_skip.pl # # This file should contain a transcript of the svn:ignore properties # of the directories in the Parrot subversion repository. (Needed for @@ -304,6 +304,14 @@ ^/ext/Parrot-Embed/t/.*\.pbc/ ^/ext/nqp-rx/src/stage0/nqp-setting\.pir$ ^/ext/nqp-rx/src/stage0/nqp-setting\.pir/ +^/frontend/parrot/main\.o$ +^/frontend/parrot/main\.o/ +^/frontend/parrot_debugger/main\.o$ +^/frontend/parrot_debugger/main\.o/ +^/frontend/pbc_dump/main\.o$ +^/frontend/pbc_dump/main\.o/ +^/frontend/pbc_merge/main\.o$ +^/frontend/pbc_merge/main\.o/ ^/include/parrot/.*\.tmp$ ^/include/parrot/.*\.tmp/ ^/include/parrot/config\.h$ From 62ea3480b7503046432c89bde11c988945b32f5e Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sat, 11 Dec 2010 10:47:59 -0500 Subject: [PATCH 073/102] All methods in P::H::Object.pm now have some documentation in POD format. --- lib/Parrot/Headerizer/Object.pm | 99 +++++++++++++++++++++++++++++---- 1 file changed, 88 insertions(+), 11 deletions(-) diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index b2bab7197d..00226aade7 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -63,15 +63,22 @@ use Parrot::Headerizer::Functions qw( =item * Purpose -Constructor of headerizer objects. +Constructor of headerizer object. The object is initialized with a list of +valid C macros. =item * Arguments + $headerizer = Parrot::Headerizer::Object->new(); + +No mandatory arguments, but one special use-case takes a hash reference. + $headerizer = Parrot::Headerizer::Object->new( { macro_match => $macro_match, # optional } ); -None mandatory, but optionally takes a hash reference. +Currently, the only meaningful element in that hash reference is +C. See C below for discussion of how that is +used. =item * Return Value @@ -124,8 +131,9 @@ sub new { =item * Purpose -Identify the source code files which need to have header informationn -extracted. +Identify the source code files which need to have header information +extracted. The header information is extracted and stored inside the +headerizer object in appropriate ways. =item * Arguments @@ -219,6 +227,9 @@ List of strings holding function declarations. =item * Comment +Called within C, but also called on its own within +F. + =back =cut @@ -308,6 +319,10 @@ List of strings holding function declarations. =item * Comment +Called within C. Wraps around +C but differs from that method by generating +signatures, correcting POD, etc. + =back =cut @@ -346,7 +361,7 @@ sub extract_function_declarations_and_update_source { =item * Purpose -Create a data structure in which information about a particular function can +Creates a data structure in which information about a particular function can be looked up. =item * Arguments @@ -367,6 +382,12 @@ Returns a reference to a hash of these function components: is_ignorable return_type +=item * Comment + +Currently called within both +C and +C. + =back =cut @@ -483,13 +504,15 @@ No defined return value. sub check_pointer_return_type { my ($self, $args) = @_; if ( $args->{return_type} =~ /\*/ ) { - if ( !$args->{macros}->{PARROT_CAN_RETURN_NULL} && !$args->{macros}->{PARROT_CANNOT_RETURN_NULL} ) { + if ( !$args->{macros}->{PARROT_CAN_RETURN_NULL} && + !$args->{macros}->{PARROT_CANNOT_RETURN_NULL} ) { if ( $args->{name} !~ /^yy/ ) { # Don't complain about lexer-created functions $self->squawk( $args->{file}, $args->{name}, 'Returns a pointer, but no PARROT_CAN(NOT)_RETURN_NULL macro found.' ); } } - elsif ( $args->{macros}->{PARROT_CAN_RETURN_NULL} && $args->{macros}->{PARROT_CANNOT_RETURN_NULL} ) { + elsif ( $args->{macros}->{PARROT_CAN_RETURN_NULL} && + $args->{macros}->{PARROT_CANNOT_RETURN_NULL} ) { $self->squawk( $args->{file}, $args->{name}, q{Can't have both PARROT_CAN_RETURN_NULL and PARROT_CANNOT_RETURN_NULL together.} ); } @@ -665,7 +688,8 @@ sub squawk { =item * Purpose Once the source files needing headerization have been identified, this method -serves as a wrapper around that headerization. +serves as a wrapper around that headerization. Both C<.h> and C<.c> files are +handled. =item * Arguments @@ -675,6 +699,13 @@ None. None. +=item * Comment + +If a hash reference with an element named C was passed to +C, C merely prints to C a list of files and +functions using the macro named as the value of that element. No +headerization or revision of headers is performed. + =back =cut @@ -697,7 +728,8 @@ sub process_sources { my $s = $nfuncs == 1 ? '' : 's'; $self->{message} = "$nfuncs $self->{macro_match} function$s"; } - else { # Normal headerization and updating + # Normal headerization and updating + else { # Update all the .h files for my $hfile ( sort keys %sourcefiles ) { my $sourcefiles = $sourcefiles{$hfile}; @@ -734,6 +766,7 @@ sub process_sources { =item * Purpose + =item * Arguments =item * Return Value @@ -776,10 +809,22 @@ sub replace_headerized_declarations { =item * Purpose +Composes proper function declarations. + =item * Arguments + @function_decls = $self->make_function_decls(@funcs); + +List of functions. + =item * Return Value +List of function declarations. + +=item * Comment + +Called within C. + =back =cut @@ -840,10 +885,23 @@ sub make_function_decls { =item * Purpose +Adds to headers strings of the form C<__attribute__nonnull__(1)>. + =item * Arguments + @attrs = $headerizer->attrs_from_args( $func, @args ); + +List whose first element is a hash reference holding characteristics about a +given function, followed by list of arguments. + =item * Return Value +List. + +=item * Comment + +Called within C. + =back =cut @@ -878,6 +936,27 @@ sub attrs_from_args { return (@attrs,@mods); } +=head2 C + +=over 4 + +=item * Purpose + +Prints a concluding message whose content reflects either normal headerization +or macro matching. + +=item * Arguments + +None. + +=item * Return Value + +Implicitly returns true value upon success. + +=back + +=cut + sub print_final_message { my $self = shift; if ($self->{message} ne '') { @@ -901,8 +980,6 @@ None. Implicitly returns true value upon success. -=item * Comment - =back =cut From fd8c59a30f27a85990f28f7cbe4f60b9fecde3e5 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sat, 11 Dec 2010 13:38:19 -0500 Subject: [PATCH 074/102] Add documentation in POD format to all functions in P::H::Functions.pm. Add author credits to headerizer.pl. --- lib/Parrot/Headerizer/Functions.pm | 267 +++++++++++++++++++++++++++-- lib/Parrot/Headerizer/Object.pm | 1 - tools/dev/headerizer.pl | 9 + 3 files changed, 258 insertions(+), 19 deletions(-) diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm index 4648ee6231..1a59f7d8a2 100644 --- a/lib/Parrot/Headerizer/Functions.pm +++ b/lib/Parrot/Headerizer/Functions.pm @@ -5,7 +5,6 @@ package Parrot::Headerizer::Functions; use strict; use warnings; use base qw( Exporter ); -use Data::Dumper;$Data::Dumper::Indent=1; our @EXPORT_OK = qw( process_argv read_file @@ -32,11 +31,22 @@ Parrot::Headerizer::Functions - Functions used in headerizer programs =head1 SYNOPSIS use Parrot::Headerizer::Functions qw( - print_headerizer_warnings + process_argv read_file write_file qualify_sourcefile + replace_pod_item + no_both_PARROT_EXPORT_and_PARROT_INLINE + validate_prototype_args + no_both_static_and_PARROT_EXPORT + handle_split_declaration asserts_from_args + shim_test + handle_modified_args + add_asserts_to_declarations + add_newline_if_multiline + func_modifies + add_headerizer_markers ); =head1 DESCRIPTION @@ -52,7 +62,7 @@ F. =item * Purpose -Validate list of object files provided as arguments. +Validate (mostly, deduplicate) list of names of object files provided as arguments. =item * Arguments @@ -62,9 +72,8 @@ List of files specified on the command-line. =item * Return Value -Validated list of object files. - -=item * Comment +Deduplicated list of object files. Dies if no filenames were specified as +arguments. =back @@ -229,7 +238,16 @@ sub qualify_sourcefile { return ($sourcefile, $source_code, $hfile); } -=pod +=head2 C + +=over 4 + +=item * Purpose + +In the course of headerizing, replaces a POD C<=item>-type line with a heading +created by C. + +=item * Arguments $text = replace_pod_item( { text => $text, @@ -238,6 +256,12 @@ sub qualify_sourcefile { cfile_name => $cfile_name, } ); +=item * Return Value + +String holding modified text of file. + +=back + =cut sub replace_pod_item { @@ -251,7 +275,16 @@ sub replace_pod_item { return $args->{text}; } -=pod +=head2 C + +=over 4 + +=item * Purpose + +Checks that a given Parrot function cannot simultaneously have both of the +macros in the function's name. + +=item * Arguments no_both_PARROT_EXPORT_and_PARROT_INLINE( { file => $file, @@ -260,6 +293,12 @@ sub replace_pod_item { parrot_api => $parrot_api, } ); +=item * Return Value + +Returns true value upon success. + +=back + =cut sub no_both_PARROT_EXPORT_and_PARROT_INLINE { @@ -270,10 +309,22 @@ sub no_both_PARROT_EXPORT_and_PARROT_INLINE { return 1; } -=pod +=head2 C + +=over 4 + +=item * Purpose + +Performs some validation on prototype arguments. + +=item * Arguments @args = validate_prototype_args( $args, $proto ); +=item * Return Value + +=back + =cut sub validate_prototype_args { @@ -289,7 +340,16 @@ sub validate_prototype_args { return @args; } -=pod +=head2 C + +=over 4 + +=item * Purpose + +Checks that a given function cannot be simultaneously labelled as both static +and C. + +=item * Arguments ($return_type, $is_static) = no_both_static_and_PARROT_EXPORT( { file => $file, @@ -298,6 +358,13 @@ sub validate_prototype_args { parrot_api => $parrot_api, } ); +=item * Return Value + +List of two items: String holding the return type; Boolean indicating whether +function is static or not. + +=back + =cut sub no_both_static_and_PARROT_EXPORT { @@ -309,13 +376,28 @@ sub no_both_static_and_PARROT_EXPORT { return ($args->{return_type}, $is_static); } -=pod +=head2 C + +=over 4 + +=item * Purpose + +Reformats declarations with appropriate line breaks to avoid long, unwieldy +lines. + +=item * Arguments - my $split_decl = handle_split_declaration( + $split_decl = handle_split_declaration( $function_decl, $line_len, ); +=item * Return Value + +String holding declaration, broken into shorter lines as needed. + +=back + =cut sub handle_split_declaration { @@ -339,6 +421,32 @@ sub handle_split_declaration { return $split_decl; } +=head2 C + +=over 4 + +=item * Purpose + +Compose assertions to be added to headers. + +=item * Arguments + + @asserts = asserts_from_args( @this_functions_args ); + +List of function arguments. + +=item * Return Value + +List of strings holding assertions to be added to that function's header. + +=item * Comment + +Called within C. + +=back + +=cut + sub asserts_from_args { my @args = @_; my @asserts; @@ -368,9 +476,26 @@ sub asserts_from_args { return (@asserts); } -=pod +=head2 C + +=over 4 + +=item * Purpose - my @modified_args = shim_test($func, \@args); +Determine whether an argument needs to include C or . + +=item * Arguments + + @modified_args = shim_test($func, \@args); + +List of two elements: hash reference holding function characteristics; +reference to array holding list of arguments. + +=item * Return Value + +List of modified arguments. + +=back =cut @@ -391,6 +516,30 @@ sub shim_test { return @args; } +=head2 C + +=over 4 + +=item * Purpose + +Performs some modifications of arguments. + +=item * Arguments + + ($decl, $multiline) = handle_modified_args($decl, \@modified_args); + +List of two arguments: string holding a declaration; reference to an array of +modified arguments. + +=item * Return Value + +List of two elements: String holding declaration, modified as needed; Boolean +indicating whether declaration runs over more than one line (multiline) or not. + +=back + +=cut + sub handle_modified_args { my ($decl, $modified_args_ref) = @_; my @modified_args = @{ $modified_args_ref }; @@ -411,13 +560,60 @@ sub handle_modified_args { return ($decl, $multiline); } -# $decl .= $multiline ? ";\n" : ";"; +=head2 C + +=over 4 + +=item * Purpose + +Guarantee proper formatting of multiline declarations. + +=item * Arguments + + $decl = add_newline_if_multiline($decl, $multiline); + +List of two arguments: String holding declaration; scalar holding Boolean +indicating whether declaration runs over more than one line or not. + +=item * Return Value + +String holding the declaration, with an additional newline added as needed. + +=back + +=cut + sub add_newline_if_multiline { my ($decl, $multiline) = @_; $decl .= $multiline ? ";\n" : ";"; return $decl; } +=head2 C + +=over 4 + +=item * Purpose + +Formulates an assertion, where needed. Currently, assertions begin like this: + + #define ASSERT_ARGS_ + +=item * Arguments + + @decls = add_asserts_to_declarations( \@funcs, \@decls ); + +List of two arguments: Reference to array of hash references holding +characteristics of functions; reference to array of declarations. + +=item * Return Value + +List of strings holding declarations. + +=back + +=cut + sub add_asserts_to_declarations { my ($funcs_ref, $decls_ref) = @_; foreach my $func (@{ $funcs_ref }) { @@ -441,10 +637,27 @@ sub add_asserts_to_declarations { return @{ $decls_ref }; } -=pod +=head2 C + +=over 4 + +=item * Purpose + +Add C where needed. + +=item * Arguments @mods = func_modifies($arg, \@mods); +List of two items: String holding function text; reference to array of +modifications. + +=item * Return Value + +Augmented list of modifications. + +=back + =cut sub func_modifies { @@ -462,15 +675,33 @@ sub func_modifies { } return @mods; } -=pod - return add_headerizer_markers( { + +=head2 C + +=over 4 + +=item * Purpose + +Takes headerizer markers in source code files (like C and +C) and formulates appropriate variants to be placed in the +headerfile. + +=item * Arguments + + $source_code = add_headerizer_markers( { function_decls => \@function_decls, sourcefile => $sourcefile, hfile => $hfile, code => $source_code, } ); +=item * Return Value + +String holding modified source code. + +=back + =cut sub add_headerizer_markers { diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm index 00226aade7..92623a6781 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer/Object.pm @@ -48,7 +48,6 @@ use Parrot::Headerizer::Functions qw( validate_prototype_args no_both_static_and_PARROT_EXPORT handle_split_declaration - asserts_from_args shim_test handle_modified_args add_newline_if_multiline diff --git a/tools/dev/headerizer.pl b/tools/dev/headerizer.pl index 8846d47b10..0f26a1faef 100644 --- a/tools/dev/headerizer.pl +++ b/tools/dev/headerizer.pl @@ -91,6 +91,15 @@ =head1 COMMAND-LINE OPTIONS $headerizer->print_warnings(); +=head1 AUTHOR + +The original headerizer program was created by Andy Lester in May 2006, with +assistance from Jerry Gay and others. In the last half of 2010, Most of the +code was refactored into F and +F by James E Keenan. + +=cut + # From earlier documentation: # * Generate docs from funcs # * Somehow handle static functions in the source file From 071661ac302628f4d2d256dfcd7b72bc3aa4778c Mon Sep 17 00:00:00 2001 From: chromatic Date: Sat, 11 Dec 2010 11:00:48 -0800 Subject: [PATCH 075/102] Added guidelines for branch merge review. --- docs/project/merge_review_guidelines.pod | 179 +++++++++++++++++++++++ 1 file changed, 179 insertions(+) create mode 100644 docs/project/merge_review_guidelines.pod diff --git a/docs/project/merge_review_guidelines.pod b/docs/project/merge_review_guidelines.pod new file mode 100644 index 0000000000..81d7c6b29b --- /dev/null +++ b/docs/project/merge_review_guidelines.pod @@ -0,0 +1,179 @@ +# Copyright (C) 2010, Parrot Foundation. + +=head1 NAME + +docs/project/merge_review_guidelines.pod - Guidelines for pending merge reviews + +=head1 DESCRIPTION + +To maintain Parrot's standards of quality, we evaluate each branch proposed for +merging to trunk in terms of several criteria. Not every criterion applies to +every branch; these guidelines are guidelines to which we apply our best +judgment. As well, these guidelines are not exhaustive. + +=head2 Documentation + +The purpose of the branch governs the amount and type of documentation it +requires. Documentation falls into three broad categories: + +=over 4 + +=item * User-visible documentation + +How do users (language developers, people running Parrot directly, people +embedding Parrot, people writing PIR, people packaging Parrot) use the feature? +What do they need to know to enable it, how does it work, and what +configuration options are available? + +=item * Design documentation + +How does the feature fit into Parrot as a whole? What design considerations +did you make? Are there patterns you followed, or is there literature to read? + +=item * Developer documentation + +What functions are available, and to whom are they available? What data +structures are present, and what do other developers need to understand about +them? What are areas of future work, and what are invariants that underlie the +whole system? + +=back + +=head2 Testing + +We know that well-tested features work and we know that well-tested features +will continue to work. Under-tested features give us and users much less +confidence. A well-tested branch demonstrates several attributes: + +=over 4 + +=item * Coverage + +A full coverage report from an automated testing tool is very valuable, but in +lieu of that the tests for the branch's feature should pass the eyeball test. +Is everything documented as working tested effectively? If there are gaps in +testing, are they clear? Do they have tickets for cage cleaners and other +volunteers? + +=item * Language Testing + +If your feature affects languages running on Parrot (and what feature +doesn't?), the branch needs testing from a couple of major languages to +demonstrate that it does not harm those languages. If those languages need +changes to accommodate the branch, we must work with the language to schedule +those changes or to review them as per our deprecation policy. + +=item * Platform Testing + +Does your feature work on the platform combinations we support? Be especially +aware of the differences between C and C++ compilers and 32-bit and 64-bit +support, as well as any deviations from POSIX. C should pass on +all of our target platforms. + +=back + +=head2 Deprecation Policy + +We manage incompatible changes of features and interfaces in multiple ways: + +=over 4 + +=item * Replacements for removed features + +If the branch supplants or supersedes an existing feature, follow the +deprecation policy to provide alternatives, shims, compatibility layers, and +whatever other mechanisms the deprecation notice promises. + +=item * New deprecations recorded + +If the branch necessitates new deprecations, the deprecation list needs +sufficient detail to help affected users plan their upgrades. + +=item * Removals marked clearly + +If you've removed any deprecated items, have you marked them as such? + +=item * User-visible exclusions to policy marked and dated clearly + +If you need any exclusions to the deprecation policy, have you asked for and +received them? Have you documented them appropriately? + +=back + +=head2 Roadmap + +Branches may implement features requested on the roadmap in whole or in part. +They may also affect the schedule of other roadmap items. Have you documented +the implications? + +=head2 Code Quality + +Any branch proposed for merging must meet our quality standards in several +areas not previously mentioned: + +=over 4 + +=item * Coding standards + +At a minimum, the code must pass all of our active coding standards tests. It +must also follow our naming conventions and organizational principles. This +means review from other developers. This also means a clean run of C. + +=item * User-visible features + +We have no strict guideline for how user-visible features should work apart +from a few systems (vtables, embedding and extension API). In general, any +public features need review from the user point of view. + +=item * API review + +Internal features for developers also need a review, especially of any +functions or data structures you expose to other parts of Parrot. Where +possible, stick with Parrot conventions, especially for constness and the +avoiding of null parameters. + +=item * Performance characteristics + +How does your branch affect performance on our selected benchmarks? For hosted +languages? Does it have memory leaks? Does it affect memory use or startup +time? We have traditionally let these questions go unanswered, but we can be +more disciplined here. + +=back + +=head2 Integration into Parrot Proper + +Your branch must also integrate into Parrot as well as possible. In +particular: + +=over 4 + +=item * Manage dependencies + +This includes proper dependencies in our configuration and build system for +building the code as well as any external configuration or dependencies. +Certain parts of Parrot core can depend on external tools such as NQP, while +others cannot. + +=item * Identify configuration options + +If your feature adds configuration options, they need documentation and review +outside of the code itself. If your feature depends on configuration options, +it needs explicit testing and documentation. This should be self-evident, but +it is worth detailed review. + +=item * Encapsulation and isolation + +Does your branch respect the encapsulation of other parts of Parrot? Does it +provide its own sensible encapsulation boundaries? If you need to make changes +to other parts of Parrot, should we consider them as a separate branch? + +=back + +=cut + +__END__ +Local Variables: + fill-column:78 +End: From 7713372c2551dc58eb97b62b575b77d55a4752b7 Mon Sep 17 00:00:00 2001 From: chromatic Date: Sat, 11 Dec 2010 11:01:06 -0800 Subject: [PATCH 076/102] Fixed some typos; linked to merge review docs. --- docs/project/git_workflow.pod | 77 ++++++++++++++++++----------------- 1 file changed, 39 insertions(+), 38 deletions(-) diff --git a/docs/project/git_workflow.pod b/docs/project/git_workflow.pod index 82a13c8bb9..eef824545a 100644 --- a/docs/project/git_workflow.pod +++ b/docs/project/git_workflow.pod @@ -8,19 +8,19 @@ docs/project/git_workflow.pod - How to use Git to work on Parrot To minimize the disruption of feature development on language and tool developers, all major changes to Parrot core take place in a branch. Ideally, -branches are short-lived, and contain the smallest set of changes possible. -It is also good practice to have "atomic" commits, in the sense that each -commit does one thing, so that it makes it easier to accept/revert some -things while keeping others. Git provides many powerful tools in the -maintainence of branches. This document aims to provide everything a Parrot -developer needs to know about Git to successfully create a branch, work on -it, keep it in sync with changes on master and finally merge the branch. +branches are short-lived, and contain the smallest set of changes possible. It +is also good practice to have "atomic" commits, in the sense that each commit +does one thing, so that it makes it easier to accept/revert some things while +keeping others. Git provides many powerful tools in the maintenance of +branches. This document aims to provide everything a Parrot developer needs to +know about Git to successfully create a branch, work on it, keep it in sync +with changes on master and finally merge the branch. =head2 Cloning the Git Repository -To get the full version history Parrot, which is called "cloning a repository", -you will use the C command. This will show how to clone the repo from -L : +To get the full version history of Parrot, which is called "cloning a +repository", you will use the C command. This will show how to clone +the repo from L: git clone git://github.com/parrot/parrot.git @@ -60,8 +60,8 @@ branch: git checkout username/foo -If you would like to checkout a branch that already exists, first make sure -to get the lastest commits with: +If you would like to checkout a branch that already exists, first make sure to +get the latest commits with: git fetch @@ -119,9 +119,9 @@ or other branches. =head2 How to commit -Let's say you modified the file foo.c and added the file bar.c and you want to commit -these changes. To add these changes to the staging area (the list of stuff -that will be included in your next commit) : +Let's say you modified the file foo.c and added the file bar.c and you want to +commit these changes. To add these changes to the staging area (the list of +stuff that will be included in your next commit): git add foo.c bar.c @@ -133,14 +133,14 @@ the --force flag: git add --force ports/foo -NOTE: Make sure these files should actually be added. Most files in .gitignore should -never be added, but some, such as some files in "ports/" will need need the --force -flag. +NOTE: Make sure these files should actually be added. Most files in .gitignore +should never be added, but some, such as some files in "ports/" will need need +the --force flag. -Now for actually creating your commit! Since Git is a distributed version control -system, committing code is seperate from sending your changes to a remote server. -Keep this in mind if you are used to Subversion or similar VCS's, where committing -and sending changes are tied together. +Now for actually creating your commit! Since Git is a distributed version +control system, committing code is separate from sending your changes to a +remote server. Keep this in mind if you are used to Subversion or similar +VCS's, where committing and sending changes are tied together. git commit -m "This is an awesome and detailed commit message" @@ -177,21 +177,23 @@ To update your local git index from origin: git fetch -If you are following multiple remotes, you can fetch updates from all of them with +If you are following multiple remotes, you can fetch updates from all of them +with: git fetch --all Note that this command requires a recent (1.7.x.x) version of git. -The command C only modifies the index, not your working copy or staging -area. To update your working copy of the branch bobby/tables +The command C only modifies the index, not your working copy or +staging area. To update your working copy of the branch bobby/tables: git checkout bobby/tables # make sure we are on the branch git rebase origin/bobby/tables # get the latest sql injections -If you have a topic branch and want to pick up the most recent changes in master -since the topic branch diverged, you can merge the master branch into the topic -branch. In this case, we assume the topic branch is called parrot/beak: +If you have a topic branch and want to pick up the most recent changes in +master since the topic branch diverged, you can merge the master branch into +the topic branch. In this case, we assume the topic branch is called +parrot/beak: git checkout parrot/beak # make sure we are on the branch git merge master # merge master into parrot/beak @@ -202,7 +204,8 @@ branch. =head2 Preparing to Merge a Branch Post to parrot-dev@lists.parrot.org letting people know that you're about to -merge a branch. +merge a branch. Follow the guidelines in +L, especially: =over @@ -231,7 +234,7 @@ want tested. =head2 Merging a Branch When you're ready to merge your changes back into master, use the C -command. First, make sure you are on the master branch with +command. First, make sure you are on the master branch with: git checkout master @@ -262,7 +265,7 @@ and mention the branch. Why use "--no-ff" ? This flag mean "no fast forwards". Usually fast forwards are good, but if there is a branch that has all the commits of master, plus a few more, when you merge without --no-ff, there will be no merge commit. -Git is smart enought to "fast forward." But for the purpose of looking at +Git is smart enough to "fast forward." But for the purpose of looking at history, Parrot would like to always have a merge commit for a merge, even if it *could* be fast-forwarded. @@ -336,7 +339,6 @@ pull request, since adding Signed-Off-By lines changes the SHA1's which Github uses to automatically close pull requests. - =head2 Announcing a Merge Send a message to parrot-dev@lists.parrot.org letting people know that your @@ -350,15 +352,14 @@ before merging but couldn't get any response from the responsible person, you may want to include some warning in the announcement that you weren't able to test that piece fully. - =head2 Deleting a Branch -After merging a branch, you will have a local copy of the merged branch, as well -as a copy of the branch on your remote. To remove the local branch: +After merging a branch, you will have a local copy of the merged branch, as +well as a copy of the branch on your remote. To remove the local branch: git branch -d user/foo -To remove the remote branch user/foo on the remote origin : +To remove the remote branch user/foo on the remote origin: git push origin :user/foo @@ -366,8 +367,8 @@ This follows the general pattern of git push origin local_branch_name:remote_branch_name -When local_branch_name is empty, you are pushing "nothing" to the remote branch, -which deletes it. +When local_branch_name is empty, you are pushing "nothing" to the remote +branch, which deletes it. =cut From 22a625f95e3681bc648dd9812de60106259bd3a2 Mon Sep 17 00:00:00 2001 From: Whiteknight Date: Sat, 11 Dec 2010 14:08:55 -0500 Subject: [PATCH 077/102] move src/packdump.c to frontend/pbc_dump/ where it belongs since it is part of that frontend --- MANIFEST | 2 +- config/gen/makefiles/root.in | 18 +++++++++--------- {src => frontend/pbc_dump}/packdump.c | 0 3 files changed, 10 insertions(+), 10 deletions(-) rename {src => frontend/pbc_dump}/packdump.c (100%) diff --git a/MANIFEST b/MANIFEST index 72b76fe62d..2a72758283 100644 --- a/MANIFEST +++ b/MANIFEST @@ -904,6 +904,7 @@ ext/nqp-rx/t/p6regex/rx_syntax [test] frontend/parrot/main.c [] frontend/parrot_debugger/main.c [] frontend/pbc_dump/main.c [] +frontend/pbc_dump/packdump.c [] frontend/pbc_merge/main.c [] include/parrot/atomic.h [main]include include/parrot/atomic/fallback.h [main]include @@ -1318,7 +1319,6 @@ src/ops/set.ops [] src/ops/string.ops [] src/ops/sys.ops [] src/ops/var.ops [] -src/packdump.c [] src/packfile/api.c [] src/packfile/byteorder.h [] src/packfile/object_serialization.c [] diff --git a/config/gen/makefiles/root.in b/config/gen/makefiles/root.in index 4708027574..26334ac676 100644 --- a/config/gen/makefiles/root.in +++ b/config/gen/makefiles/root.in @@ -1064,13 +1064,13 @@ $(INSTALLABLEDIS) : src/pbc_disassemble$(O) \ # # Parrot Dump # -src/packdump$(O) : $(PARROT_H_HEADERS) include/pmc/pmc_sub.h \ - include/pmc/pmc_key.h src/packdump.c +frontend/pbc_dump/packdump$(O) : $(PARROT_H_HEADERS) include/pmc/pmc_sub.h \ + include/pmc/pmc_key.h frontend/pbc_dump/packdump.c -$(PDUMP) : frontend/pbc_dump/main$(O) src/packdump$(O) $(LIBPARROT) +$(PDUMP) : frontend/pbc_dump/main$(O) frontend/pbc_dump/packdump$(O) $(LIBPARROT) $(LINK) @ld_out@$@ \ frontend/pbc_dump/main$(O) \ - src/packdump$(O) @rpath_blib@ $(ALL_PARROT_LIBS) $(LINKFLAGS) + frontend/pbc_dump/packdump$(O) @rpath_blib@ $(ALL_PARROT_LIBS) $(LINKFLAGS) #IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;1 frontend/pbc_dump/main$(O) : \ @@ -1081,11 +1081,11 @@ frontend/pbc_dump/main$(O) : \ $(INC_DIR)/runcore_api.h \ frontend/pbc_dump/main.c -$(INSTALLABLEPDUMP) : frontend/pbc_dump/main$(O) src/packdump$(O) \ +$(INSTALLABLEPDUMP) : frontend/pbc_dump/main$(O) frontend/pbc_dump/packdump$(O) \ src/install_config$(O) $(LIBPARROT) $(LINK) @ld_out@$@ \ frontend/pbc_dump/main$(O) \ - src/packdump$(O) \ + frontend/pbc_dump/packdump$(O) \ @rpath_lib@ $(ALL_PARROT_LIBS) $(LINKFLAGS) #IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;1 @@ -2062,7 +2062,7 @@ prog-clean : parrot-prove.pbc parrot-prove.c parrot-prove$(O) parrot-prove$(EXE) \ parrot_config$(EXE) parrot_config.c parrot_config$(O) parrot_config.pbc \ compilers/imcc/main$(O) \ - $(PDUMP) frontend/pbc_dump/main$(O) src/packdump$(O) \ + $(PDUMP) frontend/pbc_dump/main$(O) frontend/pbc_dump/packdump$(O) \ $(PDB) frontend/parrot_debugger/main$(O) \ $(PBC_MERGE) frontend/pbc_merge/main$(O) \ $(DIS) src/pbc_disassemble$(O) @@ -2100,7 +2100,7 @@ archclean: dynext-clean $(INSTALLABLECONFIG) \ $(INSTALLABLENQP) \ compilers/imcc/main$(O) \ - $(PDUMP) frontend/pbc_dump/main$(O) src/packdump$(O) \ + $(PDUMP) frontend/pbc_dump/main$(O) frontend/pbc_dump/packdump$(O) \ $(PDB) frontend/parrot_debugger/main$(O) \ $(PBC_MERGE) frontend/pbc_merge/main$(O) \ $(DIS) src/pbc_disassemble$(O) \ @@ -2729,7 +2729,7 @@ cagecritic: HEADERIZER_O_FILES = \ $(O_FILES) \ frontend/parrot/main$(O) \ - src/packdump$(O) \ + frontend/pbc_dump/packdump$(O) \ frontend/pbc_merge/main$(O) \ headerizer : src/core_pmcs.c diff --git a/src/packdump.c b/frontend/pbc_dump/packdump.c similarity index 100% rename from src/packdump.c rename to frontend/pbc_dump/packdump.c From ec3d188f9308676f1c376692092ae5fb4cdd02d6 Mon Sep 17 00:00:00 2001 From: NotFound Date: Sat, 11 Dec 2010 20:15:53 +0100 Subject: [PATCH 078/102] add a note about platform dependence to NCI example ls.pis - TT #1180 --- examples/nci/ls.pir | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/examples/nci/ls.pir b/examples/nci/ls.pir index 724fd5a4d6..182e5be4a5 100644 --- a/examples/nci/ls.pir +++ b/examples/nci/ls.pir @@ -8,6 +8,11 @@ examples/nci/ls.pir - a directory lister List the content of the directory 'docs'. +This program uses the 'dirent' structure, whose content is not fully +standarized, thus may need modifications depending on platform. + +In this encarnation it works on linux i386 and amd64 systems. + =cut .sub _main :main From 7e33b2fd981b40461d1cf6435f7e758db8ccf605 Mon Sep 17 00:00:00 2001 From: "Jonathan \"Duke\" Leto" Date: Sat, 11 Dec 2010 12:11:11 -0800 Subject: [PATCH 079/102] [doc] German translation of our README, wesjdj++ --- MANIFEST | 2 + NEWS | 1 + README.deutsch | 177 +++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 180 insertions(+) create mode 100644 README.deutsch diff --git a/MANIFEST b/MANIFEST index 2a72758283..8243a8582d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -23,6 +23,7 @@ NEWS [main]doc PBC_COMPAT [main]doc PLATFORMS [devel]doc README [devel]doc +README.deutsch [] README.espanol [] README.polski [] README_cygwin.pod [devel]doc @@ -428,6 +429,7 @@ docs/project/core_inclusion.pod [doc] docs/project/debian_packaging_guide.pod [doc] docs/project/git_terminology.pod [doc] docs/project/git_workflow.pod [doc] +docs/project/merge_review_guidelines.pod [doc] docs/project/metacommitter_guide.pod [doc] docs/project/release_manager_guide.pod [doc] docs/project/roles_responsibilities.pod [doc] diff --git a/NEWS b/NEWS index c97b06ed72..5ba2fa6b3c 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,7 @@ New in 2.11.0 by Google Code-In students and mentors: Polish README.polski Spanish README.espanol + German README.deutsch - Documentation - Tests + Test coverage increase on PMCs: String, Integer diff --git a/README.deutsch b/README.deutsch new file mode 100644 index 0000000000..d46fb359bc --- /dev/null +++ b/README.deutsch @@ -0,0 +1,177 @@ +Das ist Parrot, version 2.10.1 +------------------------------ + +Parrot ist Kopiergeschützt (C) 2001-2010, Parrot Foundation. + + +LIZENZ INFORMATION +------------------- + +Dieser Code ist veröffentlicht unter den Bedingungen von Artistic License 2.0. +Für mehr details, lesen sie die Datei LICENSE. + +ÜBERSICHT +-------- +Parrot ist eine virtuelle Maschine gebaut um effektiv +bytecode für dynamisch Sprachen auszuführen. + +ANFORDERUNGEN +------------- + +Du brauchst ein C Kompiler,ein Linker, und natürlich ein make Programm. + +Wenn du mit der ICU library verbinden wirst musst du dies herunterladen und installieren +bevor du Parrot konfigurierst. Dies ist hier verfügbar: http://site.icu-project.org/download + +Du wirst auch Perl 5.8.4 gebrauchen, und Storable 2.12 oder neuer +um einige Konfigurationen auszuführen oder Build Scripts. + +Für alle PLattformen die wir unterstüzen sollte Parrot ohne Änderung +gebrauchbar sein. docs/parrot.pod zeigt unsere unterstützten Plattformen. PLATFORMS stellt +Berichte zur Verfügung über die Plattformen für welche Parrot gebaut wurde. + +WIE MAN PARROT VON GITHUB INSTALLIERT +---------------------------------- +I. Git installieren: + +Linux: +Die Methode ist abhängig auf ihre Distribution. Zum installieren solltest du dies ausführen: (als root oder sudo ): + +Auf Ubuntu/Debian (apt-based): + + apt-get install git-core + +Auf Red Hat, Fedora (rpm-based): + + yum install git + +Auf Gentoo (portage): + + emerge -av dev-vcs/git + +Windows: Es gibt 2 Git Ports auf Windows: + +msysgit http://code.google.com/p/msysgit/downloads/list +TortoiseGit http://code.google.com/p/tortoisegit/downloads/list + +Macintosh OS X: + +Eine Suche auf dem Internet wird eine Menge an Git installers für Mac OS X +finden, unter anderem diese: + + http://help.github.com/mac-git-installation/ + +II. Parrot von github.com holen + +Um eine Kopie der Parrot git Repository zu holen: + + git clone git://github.com/parrot/parrot.git + +Dies wird von Anfang an als Master ausführen. Um ein lokaler Branch zu kreiren +dass den Branch "some_branch" trackt: + + git checkout -b --track some_branch origin/some_branch + +Alle URL die ober erwähnt wurden sind read-only. Wenn du ein Parrot core +Entwickler bist, dann benütze die folgende URL: + + git clone git@github.com:parrot/parrot.git + +Du kannst eine komplette Liste der Branches finden unter: +http://github.com/parrot + +ANLEITUNGEN +------------ + +Für jetzt, packe dein Parrot tarball aus, (wenn du dies liest, hast du das +wahrscheinlich schon gemacht) und schreibe: + + perl Configure.pl + +um den Configure Script auszuführen. Der Configure.pl Script nimmt Konfiguration +heraus vom laufenden perl5 Programm Du must dem Konfiguration erklären genau +welche Compiler Und Linker zu benutzen. Zum Beispiel, Compile C Dateien mit 'cc', +C++ Dateien mit 'CC', und verbindet alles zumsammen mit 'CC', würdest du +schreiben: + + perl Configure.pl --cc=cc --cxx=CC --link=CC --ld=CC + +Siehe "perl Configure.pl --help" für mehr Optionen und docs/configuration.pod +für mehr Details. + +Für Systeme wie HPUX die nicht inet_pton haben, fürhe dies aus: + + perl Configure.pl --define=inet_aton + +Configure.pl ausführen wird einen config.h Header configurieren, ein Parrot::Config +Model, Plattform Dateien und viele Makefiles. + +Die Datei "myconfig" hat eine Übersicht über Konfiguration Einstellungen. +Als nächstes, führe make aus. (Configure.pl wird dir sagen welche Version von make it +für dein System optimiert ist.) + +Als nächstes soll der Build gemacht werden. Wenn du den ICU Library machst, +(Dies ist default bei den meisten Systemen), brauchst du GNU make +(oder etwas kompatibel damit). + +Du kannst Parrot ausführen indem du "make test" ausführst. Du kannst die Tests mit +"make TEST_JOBS=3 test" gleichzeitig ausführen. + +Du kannst den ganzen Test Suite ausführen: + + make fulltest + +Merke: PLATFORMS beinhaltet Notzizen ob die Tests auf deinem System +erfolgreich sein werden + +Du kannst Parrot installieren mit: + + make install + +Bei default installiert dies bei /usr/local, mit dem Parrot Programm in +/usr/local/bin. Wenn du Parrot irgendwo anderst installieren willst, benützte: + + perl Configure.pl --prefix=/home/joe/bird + make install + +Merke dir dass dynamische libs nicht gefunden werden für nicht-standarde +Orte ausser du LD_LIBRARY_PATH benützt oder etwas ähnliches. + +Schaue bei docs/parrot.pod and docs/intro.pod wie du von hier weitermachen sollst. Wenn du +irgendwelche Probleme hast, siehe den Abteil "How To Submit A Bug Report" in +docs/submissions.pod. Diese Dokumente sind in POD format. Du kannst diese +Dateien sehen mit dem Command: + + perldoc -F docs/intro.pod + +ÄNDERUNGEN +---------- + +Für Dokumentationen über die user-sichtbare Änderungen zwischen dieser Version und +alte Versionen, siehe NEWS. + +MAILING LISTEN +-------------- + +Die Parrot user Mailing Liste ist parrot-users@lists.parrot.org. Abonniere mit dem Formular bei +http://lists.parrot.org/mailman/listinfo/parrot-users . +Die Liste ist archived bei http://lists.parrot.org/pipermail/parrot-users/ . + +Für Entwickler Diskussionen siehe die Information bei docs/gettingstarted.pod. + +BERICHTE, PATCHES, usw. +----------------------- + +Siehe ocs/submissions.pod für mehr Information über wie man Bugs und Patches +reportiert. + +WEBSEITEN +--------- + +Die folgenden Webseiten haben Information über Parrot: + http://www.parrot.org/ + http://trac.parrot.org/ + http://docs.parrot.org/ + +Viel Spass, + The Parrot Team. From 31ca7a23abfc9601eab05ca4cdbc380607c7d6a8 Mon Sep 17 00:00:00 2001 From: Andy Lester Date: Sat, 11 Dec 2010 21:34:26 -0600 Subject: [PATCH 080/102] updated headers for headerizing --- include/parrot/packfile.h | 534 ++++++++++++++++++++++++++++++++++++ include/parrot/pmc_freeze.h | 124 +++++++++ 2 files changed, 658 insertions(+) diff --git a/include/parrot/packfile.h b/include/parrot/packfile.h index 106253a773..d1dff1a4ed 100644 --- a/include/parrot/packfile.h +++ b/include/parrot/packfile.h @@ -1052,6 +1052,540 @@ opcode_t* PF_store_string(ARGOUT(opcode_t *cursor), ARGIN(const STRING *s)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: src/packfile/pf_items.c */ +/* HEADERIZER BEGIN: frontend/pbc_dump/packdump.c */ +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ + +PARROT_EXPORT +void PackFile_ConstTable_dump(PARROT_INTERP, + ARGIN(const PackFile_ConstTable *self)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +#define ASSERT_ARGS_PackFile_ConstTable_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self)) +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ +/* HEADERIZER END: frontend/pbc_dump/packdump.c */ + +/* HEADERIZER BEGIN: src/packfile/api.c */ +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ + +PARROT_EXPORT +void do_sub_pragmas(PARROT_INTERP, + ARGIN(PackFile_ByteCode *self), + pbc_action_enum_t action, + ARGIN_NULLOK(PMC *eval_pmc)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +void PackFile_add_segment(PARROT_INTERP, + ARGMOD(PackFile_Directory *dir), + ARGMOD(PackFile_Segment *seg)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*dir) + FUNC_MODIFIES(*seg); + +PARROT_EXPORT +void PackFile_Annotations_add_entry(PARROT_INTERP, + ARGMOD(PackFile_Annotations *self), + opcode_t offset, + opcode_t key, + opcode_t type, + opcode_t value) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + FUNC_MODIFIES(*self); + +PARROT_EXPORT +void PackFile_Annotations_add_group(PARROT_INTERP, + ARGMOD(PackFile_Annotations *self), + opcode_t offset) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + FUNC_MODIFIES(*self); + +PARROT_EXPORT +PARROT_CANNOT_RETURN_NULL +PackFile_Segment * PackFile_Annotations_new(PARROT_INTERP, + SHIM(struct PackFile *pf), + SHIM(STRING *name), + NULLOK(int add)) + __attribute__nonnull__(1); + +PARROT_EXPORT +void PackFile_ConstTable_clear(PARROT_INTERP, + ARGMOD(PackFile_ConstTable *self)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + FUNC_MODIFIES(*self); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CAN_RETURN_NULL +const opcode_t * PackFile_ConstTable_unpack(PARROT_INTERP, + ARGIN(PackFile_Segment *seg), + ARGIN(const opcode_t *cursor)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3); + +PARROT_EXPORT +void PackFile_destroy(PARROT_INTERP, ARGMOD(PackFile *pf)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + FUNC_MODIFIES(*pf); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CAN_RETURN_NULL +PackFile_Segment * PackFile_find_segment(PARROT_INTERP, + ARGIN_NULLOK(PackFile_Directory *dir), + ARGIN(const STRING *name), + int sub_dir) + __attribute__nonnull__(1) + __attribute__nonnull__(3); + +PARROT_EXPORT +void PackFile_fixup_subs(PARROT_INTERP, + pbc_action_enum_t what, + ARGIN_NULLOK(PMC *eval)) + __attribute__nonnull__(1); + +PARROT_EXPORT +void PackFile_funcs_register(SHIM_INTERP, + ARGOUT(PackFile *pf), + UINTVAL type, + const PackFile_funcs funcs) + __attribute__nonnull__(2) + FUNC_MODIFIES(*pf); + +PARROT_EXPORT +INTVAL PackFile_map_segments(PARROT_INTERP, + ARGIN(const PackFile_Directory *dir), + PackFile_map_segments_func_t callback, + ARGIN_NULLOK(void *user_data)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CANNOT_RETURN_NULL +PackFile * PackFile_new(PARROT_INTERP, INTVAL is_mapped) + __attribute__nonnull__(1); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CAN_RETURN_NULL +PackFile * PackFile_new_dummy(PARROT_INTERP, ARGIN(STRING *name)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CAN_RETURN_NULL +PackFile_Segment * PackFile_remove_segment_by_name(PARROT_INTERP, + ARGMOD(PackFile_Directory *dir), + ARGIN(STRING *name)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*dir); + +PARROT_EXPORT +void PackFile_Segment_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + FUNC_MODIFIES(*self); + +PARROT_EXPORT +void PackFile_Segment_dump(PARROT_INTERP, ARGIN(PackFile_Segment *self)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CANNOT_RETURN_NULL +PackFile_Segment * PackFile_Segment_new(PARROT_INTERP, + SHIM(PackFile *pf), + SHIM(STRING *name), + NULLOK(int add)) + __attribute__nonnull__(1); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CANNOT_RETURN_NULL +PackFile_Segment * PackFile_Segment_new_seg(PARROT_INTERP, + ARGMOD(PackFile_Directory *dir), + UINTVAL type, + ARGIN(STRING *name), + int add) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(4) + FUNC_MODIFIES(*dir); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CANNOT_RETURN_NULL +opcode_t * PackFile_Segment_pack(PARROT_INTERP, + ARGIN(PackFile_Segment *self), + ARGIN(opcode_t *cursor)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3); + +PARROT_EXPORT +size_t PackFile_Segment_packed_size(PARROT_INTERP, + ARGIN(PackFile_Segment *self)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CAN_RETURN_NULL +const opcode_t * PackFile_Segment_unpack(PARROT_INTERP, + ARGMOD(PackFile_Segment *self), + ARGIN(const opcode_t *cursor)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*self); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +opcode_t PackFile_unpack(PARROT_INTERP, + ARGMOD(PackFile *self), + ARGIN(const opcode_t *packed), + size_t packed_size) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*self); + +PARROT_EXPORT +void Parrot_debug_add_mapping(PARROT_INTERP, + ARGMOD(PackFile_Debug *debug), + opcode_t offset, + ARGIN(const char *filename)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(4) + FUNC_MODIFIES(*debug); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CANNOT_RETURN_NULL +STRING * Parrot_debug_pc_to_filename(PARROT_INTERP, + ARGIN(const PackFile_Debug *debug), + opcode_t pc) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +void Parrot_destroy_constants(PARROT_INTERP) + __attribute__nonnull__(1); + +PARROT_EXPORT +void Parrot_load_bytecode(PARROT_INTERP, + ARGIN_NULLOK(Parrot_String file_str)) + __attribute__nonnull__(1); + +PARROT_EXPORT +void Parrot_load_language(PARROT_INTERP, ARGIN_NULLOK(STRING *lang_name)) + __attribute__nonnull__(1); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CANNOT_RETURN_NULL +PackFile_Debug * Parrot_new_debug_seg(PARROT_INTERP, + ARGMOD(PackFile_ByteCode *cs), + size_t size) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + FUNC_MODIFIES(*cs); + +PARROT_EXPORT +PARROT_IGNORABLE_RESULT +PARROT_CANNOT_RETURN_NULL +PackFile_ByteCode * Parrot_switch_to_cs(PARROT_INTERP, + ARGIN(PackFile_ByteCode *new_cs), + int really) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +void Parrot_switch_to_cs_by_nr(PARROT_INTERP, opcode_t seg) + __attribute__nonnull__(1); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CANNOT_RETURN_NULL +PackFile_ByteCode * PF_create_default_segs(PARROT_INTERP, + ARGIN(STRING *file_name), + int add) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +void default_dump_header(PARROT_INTERP, ARGIN(const PackFile_Segment *self)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +void mark_const_subs(PARROT_INTERP) + __attribute__nonnull__(1); + +void PackFile_Annotations_destroy(PARROT_INTERP, + ARGMOD(PackFile_Segment *seg)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + FUNC_MODIFIES(*seg); + +void PackFile_Annotations_dump(PARROT_INTERP, + ARGIN(const PackFile_Segment *seg)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_CANNOT_RETURN_NULL +PMC * PackFile_Annotations_lookup(PARROT_INTERP, + ARGIN(PackFile_Annotations *self), + opcode_t offset, + ARGIN_NULLOK(STRING *key)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_WARN_UNUSED_RESULT +PARROT_CANNOT_RETURN_NULL +opcode_t * PackFile_Annotations_pack(SHIM_INTERP, + ARGIN(PackFile_Segment *seg), + ARGMOD(opcode_t *cursor)) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*cursor); + +PARROT_WARN_UNUSED_RESULT +PARROT_PURE_FUNCTION +size_t PackFile_Annotations_packed_size(SHIM_INTERP, + ARGIN(PackFile_Segment *seg)) + __attribute__nonnull__(2); + +PARROT_CANNOT_RETURN_NULL +const opcode_t * PackFile_Annotations_unpack(PARROT_INTERP, + ARGMOD(PackFile_Segment *seg), + ARGIN(const opcode_t *cursor)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*seg); + +void Parrot_trace_eprintf(ARGIN(const char *s), ...) + __attribute__nonnull__(1); + +#define ASSERT_ARGS_do_sub_pragmas __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self)) +#define ASSERT_ARGS_PackFile_add_segment __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(dir) \ + , PARROT_ASSERT_ARG(seg)) +#define ASSERT_ARGS_PackFile_Annotations_add_entry \ + __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self)) +#define ASSERT_ARGS_PackFile_Annotations_add_group \ + __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self)) +#define ASSERT_ARGS_PackFile_Annotations_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp)) +#define ASSERT_ARGS_PackFile_ConstTable_clear __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self)) +#define ASSERT_ARGS_PackFile_ConstTable_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(seg) \ + , PARROT_ASSERT_ARG(cursor)) +#define ASSERT_ARGS_PackFile_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(pf)) +#define ASSERT_ARGS_PackFile_find_segment __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(name)) +#define ASSERT_ARGS_PackFile_fixup_subs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp)) +#define ASSERT_ARGS_PackFile_funcs_register __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(pf)) +#define ASSERT_ARGS_PackFile_map_segments __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(dir)) +#define ASSERT_ARGS_PackFile_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp)) +#define ASSERT_ARGS_PackFile_new_dummy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(name)) +#define ASSERT_ARGS_PackFile_remove_segment_by_name \ + __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(dir) \ + , PARROT_ASSERT_ARG(name)) +#define ASSERT_ARGS_PackFile_Segment_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self)) +#define ASSERT_ARGS_PackFile_Segment_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self)) +#define ASSERT_ARGS_PackFile_Segment_new __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp)) +#define ASSERT_ARGS_PackFile_Segment_new_seg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(dir) \ + , PARROT_ASSERT_ARG(name)) +#define ASSERT_ARGS_PackFile_Segment_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self) \ + , PARROT_ASSERT_ARG(cursor)) +#define ASSERT_ARGS_PackFile_Segment_packed_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self)) +#define ASSERT_ARGS_PackFile_Segment_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self) \ + , PARROT_ASSERT_ARG(cursor)) +#define ASSERT_ARGS_PackFile_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self) \ + , PARROT_ASSERT_ARG(packed)) +#define ASSERT_ARGS_Parrot_debug_add_mapping __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(debug) \ + , PARROT_ASSERT_ARG(filename)) +#define ASSERT_ARGS_Parrot_debug_pc_to_filename __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(debug)) +#define ASSERT_ARGS_Parrot_destroy_constants __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp)) +#define ASSERT_ARGS_Parrot_load_bytecode __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp)) +#define ASSERT_ARGS_Parrot_load_language __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp)) +#define ASSERT_ARGS_Parrot_new_debug_seg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(cs)) +#define ASSERT_ARGS_Parrot_switch_to_cs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(new_cs)) +#define ASSERT_ARGS_Parrot_switch_to_cs_by_nr __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp)) +#define ASSERT_ARGS_PF_create_default_segs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(file_name)) +#define ASSERT_ARGS_default_dump_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self)) +#define ASSERT_ARGS_mark_const_subs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp)) +#define ASSERT_ARGS_PackFile_Annotations_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(seg)) +#define ASSERT_ARGS_PackFile_Annotations_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(seg)) +#define ASSERT_ARGS_PackFile_Annotations_lookup __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self)) +#define ASSERT_ARGS_PackFile_Annotations_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(seg) \ + , PARROT_ASSERT_ARG(cursor)) +#define ASSERT_ARGS_PackFile_Annotations_packed_size \ + __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(seg)) +#define ASSERT_ARGS_PackFile_Annotations_unpack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(seg) \ + , PARROT_ASSERT_ARG(cursor)) +#define ASSERT_ARGS_Parrot_trace_eprintf __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(s)) +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ +/* HEADERIZER END: src/packfile/api.c */ + +/* HEADERIZER BEGIN: src/packfile/output.c */ +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CANNOT_RETURN_NULL +opcode_t * PackFile_ConstTable_pack(PARROT_INTERP, + ARGIN(PackFile_Segment *seg), + ARGMOD(opcode_t *cursor)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*cursor); + +PARROT_EXPORT +size_t PackFile_ConstTable_pack_size(PARROT_INTERP, + ARGIN(PackFile_Segment *seg)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +int PackFile_ConstTable_rlookup_num(PARROT_INTERP, + ARGIN(const PackFile_ConstTable *ct), + FLOATVAL n) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +int PackFile_ConstTable_rlookup_str(PARROT_INTERP, + ARGIN(const PackFile_ConstTable *ct), + ARGIN(STRING *s)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3); + +PARROT_EXPORT +void PackFile_pack(PARROT_INTERP, + ARGMOD(PackFile *self), + ARGOUT(opcode_t *cursor)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*self) + FUNC_MODIFIES(*cursor); + +PARROT_EXPORT +opcode_t PackFile_pack_size(PARROT_INTERP, ARGMOD(PackFile *self)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + FUNC_MODIFIES(*self); + +#define ASSERT_ARGS_PackFile_ConstTable_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(seg) \ + , PARROT_ASSERT_ARG(cursor)) +#define ASSERT_ARGS_PackFile_ConstTable_pack_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(seg)) +#define ASSERT_ARGS_PackFile_ConstTable_rlookup_num \ + __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(ct)) +#define ASSERT_ARGS_PackFile_ConstTable_rlookup_str \ + __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(ct) \ + , PARROT_ASSERT_ARG(s)) +#define ASSERT_ARGS_PackFile_pack __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self) \ + , PARROT_ASSERT_ARG(cursor)) +#define ASSERT_ARGS_PackFile_pack_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(self)) +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ +/* HEADERIZER END: src/packfile/output.c */ + #endif /* PARROT_PACKFILE_H_GUARD */ /* diff --git a/include/parrot/pmc_freeze.h b/include/parrot/pmc_freeze.h index 01da07298d..ed5a75b978 100644 --- a/include/parrot/pmc_freeze.h +++ b/include/parrot/pmc_freeze.h @@ -225,6 +225,130 @@ void Parrot_visit_loop_visit(PARROT_INTERP, ARGIN(PMC *info)) /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ /* HEADERIZER END: src/pmc_freeze.c */ +/* HEADERIZER BEGIN: src/packfile/object_serialization.c */ +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CAN_RETURN_NULL +PMC* Parrot_clone(PARROT_INTERP, ARGIN(PMC *pmc)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CANNOT_RETURN_NULL +STRING* Parrot_freeze(PARROT_INTERP, ARGIN(PMC *pmc)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CAN_RETURN_NULL +opcode_t * Parrot_freeze_pbc(PARROT_INTERP, + ARGIN(PMC *pmc), + ARGIN(const PackFile_ConstTable *pf), + ARGIN(opcode_t *cursor)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + __attribute__nonnull__(4); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +UINTVAL Parrot_freeze_pbc_size(PARROT_INTERP, + ARGIN(PMC *pmc), + ARGIN(const PackFile_ConstTable *pf)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +UINTVAL Parrot_freeze_size(PARROT_INTERP, ARGIN(PMC *pmc)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CANNOT_RETURN_NULL +PMC * Parrot_freeze_strings(PARROT_INTERP, ARGIN(PMC *pmc)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CANNOT_RETURN_NULL +PMC * Parrot_thaw(PARROT_INTERP, ARGIN(STRING *image)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CANNOT_RETURN_NULL +PMC* Parrot_thaw_constants(PARROT_INTERP, ARGIN(STRING *image)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +PARROT_EXPORT +PARROT_WARN_UNUSED_RESULT +PARROT_CAN_RETURN_NULL +PMC* Parrot_thaw_pbc(PARROT_INTERP, + ARGIN(PackFile_ConstTable *ct), + ARGMOD(const opcode_t **cursor)) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + FUNC_MODIFIES(*cursor); + +void Parrot_visit_loop_thawfinish(PARROT_INTERP, ARGIN(PMC *info)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +void Parrot_visit_loop_visit(PARROT_INTERP, ARGIN(PMC *info)) + __attribute__nonnull__(1) + __attribute__nonnull__(2); + +#define ASSERT_ARGS_Parrot_clone __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(pmc)) +#define ASSERT_ARGS_Parrot_freeze __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(pmc)) +#define ASSERT_ARGS_Parrot_freeze_pbc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(pmc) \ + , PARROT_ASSERT_ARG(pf) \ + , PARROT_ASSERT_ARG(cursor)) +#define ASSERT_ARGS_Parrot_freeze_pbc_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(pmc) \ + , PARROT_ASSERT_ARG(pf)) +#define ASSERT_ARGS_Parrot_freeze_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(pmc)) +#define ASSERT_ARGS_Parrot_freeze_strings __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(pmc)) +#define ASSERT_ARGS_Parrot_thaw __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(image)) +#define ASSERT_ARGS_Parrot_thaw_constants __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(image)) +#define ASSERT_ARGS_Parrot_thaw_pbc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(ct) \ + , PARROT_ASSERT_ARG(cursor)) +#define ASSERT_ARGS_Parrot_visit_loop_thawfinish __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(info)) +#define ASSERT_ARGS_Parrot_visit_loop_visit __attribute__unused__ int _ASSERT_ARGS_CHECK = (\ + PARROT_ASSERT_ARG(interp) \ + , PARROT_ASSERT_ARG(info)) +/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */ +/* HEADERIZER END: src/packfile/object_serialization.c */ + #endif /* PARROT_PMC_FREEZE_H_GUARD */ /* From bbf140fc8b786c6f79f83aeda2f0998d4b47c4eb Mon Sep 17 00:00:00 2001 From: David Czech Date: Sat, 11 Dec 2010 20:03:17 -0800 Subject: [PATCH 081/102] Getting There on Chunked Encoding... and the other md5 GCI task is in here too. --- md5task/main_m.pir | 20 +++++++++++ md5task/main_nfio.pir | 21 +++++++++++ runtime/parrot/library/LWP/Protocol.pir | 47 +++++++++++++++++++++++-- test_data | 1 + 4 files changed, 86 insertions(+), 3 deletions(-) create mode 100644 md5task/main_m.pir create mode 100644 md5task/main_nfio.pir create mode 100644 test_data diff --git a/md5task/main_m.pir b/md5task/main_m.pir new file mode 100644 index 0000000000..a4ac7a563d --- /dev/null +++ b/md5task/main_m.pir @@ -0,0 +1,20 @@ +.sub main + .param pmc argv + load_bytecode "Digest/MD5.pbc" + .local pmc mba + .local string filename + + set filename, argv[1] + $S0 = "Creating new MappedByteArray, and opening " . filename + say $S0 + mba = new 'MappedByteArray' + mba.'open'(filename) + + say 'getting the data from the Mapped Byte Array...' + $I1 = elements mba + $S0 = mba.'get_string'(0, $I1, 'binary') + + $P1 = _md5sum($S0) + $S0 = _md5_hex($P1) + say $S0 + .end diff --git a/md5task/main_nfio.pir b/md5task/main_nfio.pir new file mode 100644 index 0000000000..9785547a1b --- /dev/null +++ b/md5task/main_nfio.pir @@ -0,0 +1,21 @@ +.loadlib 'io_ops' +.sub main + .param pmc argv + load_bytecode "Digest/MD5.pbc" + .local pmc mba + .local string filename + + set filename, argv[1] + $S0 = "Creating new MappedByteArray, and opening " . filename + say $S0 + say 'getting the data from the Mapped Byte Array...' + + $P0 = new 'FileHandle' + $P0.'open'(filename, 'r') + $P0.'encoding'('binary') + $S0 = $P0.'readall'() + + $P1 = _md5sum($S0) + $S0 = _md5_hex($P1) + say $S0 + .end diff --git a/runtime/parrot/library/LWP/Protocol.pir b/runtime/parrot/library/LWP/Protocol.pir index ec484a48d1..9fd4af5118 100644 --- a/runtime/parrot/library/LWP/Protocol.pir +++ b/runtime/parrot/library/LWP/Protocol.pir @@ -299,6 +299,12 @@ see http://search.cpan.org/~gaas/libwww-perl/ .param pmc headers .param pmc url .param pmc proxy + + # FIXME: + # There should be no Connection header, because in HTTP/1.1 all + # connections are keep-alive by default. + headers['Connection'] = "Keep-Alive" + # Extract 'Host' header .local string host host = url.'authority'() @@ -412,19 +418,39 @@ see http://search.cpan.org/~gaas/libwww-perl/ .sub '_parse_response_content' :method .param pmc response .param string str + .param int chunked $I0 = index str, "\r\n\r\n" if $I0 < 0 goto L1 $I0 += 4 goto L2 L1: $I0 = index str, "\n\n" - if $I0 < 0 goto L3 + if $I0 < 0 goto L4 $I0 += 2 L2: + if chunked == 0 goto L3 + # Proccess chunks into a single block + say "Chunking together" + $S0 = substr str, $I0 # 1000\r\n.data etc + $I1 = index $S0, "\r\n" + $S1 = substr $S0, 0, $I1 + + $P1 = box $S1 + #$S3 = get_number $P1, 16 + say $S3 + $S2 = "Chunk " . $S1 + say $S2 + + $I2 = $P1.'to_int'(16) + say $I2 + $I0 += $I2 + if $I2 != 0 goto L2 + L3: $S0 = substr str, $I0 $P0 = box $S0 setattribute response, 'content', $P0 - L3: + .return ($S0) + L4: .end =item request @@ -435,6 +461,8 @@ see http://search.cpan.org/~gaas/libwww-perl/ .param pmc request .param pmc proxy + .local int chunked + chunked = 0 .local string method method = request.'method'() .local pmc url @@ -511,6 +539,8 @@ see http://search.cpan.org/~gaas/libwww-perl/ header_length = self.'_parse_response_headers'(response, buf) $I0 = response.'is_success'() unless $I0 goto L22 + $S0 = response.'get_header'('Transfer-Encoding') + if $S0 == 'chunked' goto Lchunked $S0 = response.'get_header'('Content-Length') if $S0 == '' goto L21 content_length = $S0 @@ -523,9 +553,20 @@ see http://search.cpan.org/~gaas/libwww-perl/ if $S0 == '' goto L22 push buf, $S0 goto L23 + Lchunked: + # Chunked encoding, so we keep reading until we see a "0\r\n" + say "Handling Chunked Encoding..." + # Chunked=True + chunked = 1 + $S0 = buf + $I0 = index $S0, "\r\n0\r\n" + # If it isn't found, keep recv'ing until we find it. + if $I0 == -1 goto L21 + # Ok, the data has been all sent (except for the footer-headers). + goto L22 L22: sock.'close'() - self.'_parse_response_content'(response, buf) + self.'_parse_response_content'(response, buf, chunked) .return (response) .end diff --git a/test_data b/test_data new file mode 100644 index 0000000000..d6d9d34ca4 --- /dev/null +++ b/test_data @@ -0,0 +1 @@ +blah \ No newline at end of file From 6b61c676a2bdf522d91669d30a1ce3a75a721304 Mon Sep 17 00:00:00 2001 From: Nolan Lum Date: Sun, 12 Dec 2010 01:43:42 -0500 Subject: [PATCH 082/102] Increase Iterator PMC test coverage. --- t/pmc/iterator.t | 180 ++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 179 insertions(+), 1 deletion(-) diff --git a/t/pmc/iterator.t b/t/pmc/iterator.t index fac02b1711..1a1eb544ba 100644 --- a/t/pmc/iterator.t +++ b/t/pmc/iterator.t @@ -6,7 +6,7 @@ use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; -use Parrot::Test tests => 21; +use Parrot::Test tests => 27; =head1 NAME @@ -33,6 +33,184 @@ CODE ok 1 OUTPUT +pasm_output_is( <<'CODE', <<'OUTPUT', "new iter fails (init)" ); + push_eh THROWN + new P0, ['ResizablePMCArray'] + new P1, ['Iterator'], P0 + print "not " +THROWN: + pop_eh + print "ok 1\n" + end +CODE +ok 1 +OUTPUT + +pasm_output_is( <<'CODE', <<'OUTPUT', "keyed access on String and Hash PMCs" ); + new P0, ['String'] + set P0, "I am a very long string." + new P2, ['Integer'] + set P2, 1 + iter P1, P0 + set I0, P1[P2] + eq I0, 32, OK1 + print "not " +OK1:print "ok 1\n" + + set P2, 0 + set I0, P1[P2] + eq I0, 73, OK2 + print "not " +OK2:print "ok 2\n" + + set P2, 5 + set S0, P1[P2] + eq S0, 'a', OK3 + print "not " +OK3:print "ok 3\n" + + new P0, ['Hash'] + set P0['derp'], 3.257 + set P0['herp'], 2 + iter P1, P0 + set P2, 'herp' + set N0, P1[P2] + eq N0, 2, OK4 + print "not " +OK4:print "ok 4\n" + + set P2, 'derp' + set N0, P1[P2] + eq N0, 3.257, OK5 + print "not " +OK5:print "ok 5\n" + end +CODE +ok 1 +ok 2 +ok 3 +ok 4 +ok 5 +OUTPUT + +pasm_output_is( <<'CODE', <<'OUTPUT', "keyed exist and defined on String and Hash PMCs" ); + new P0, ['String'] + set P0, 'somelongstring' + iter P1, P0 + + new P2, ['Integer'] + set P2, 2 + exists I0, P1[P2] + eq I0, 1, OK1 + print "not " +OK1:print "ok 1\n" + + set P2, 20 + exists I0, P1[P2] + eq I0, 0, OK2 + print "not " +OK2:print "ok 2\n" + + defined I0, P1 + eq I0, 1, OK3 + print "not " +OK3:print "ok 3\n" + + + new P0, ['Hash'] + set P0['something'], 'stringg' + set P0['nothing'], 'something' + iter P1, P0 + set P2, 'something' + defined I0, P1[P2] + eq I0, 1, OK4 + print "not " +OK4:print "ok 4\n" + + set P2, 'somenothing' + defined I0, P1[P2] + eq I0, 0, OK5 + print "not " +OK5:print "ok 5\n" + end +CODE +ok 1 +ok 2 +ok 3 +ok 4 +ok 5 +OUTPUT + +pasm_output_is( <<'CODE', <<'OUTPUT', "get_iter" ); + new P0, ['ResizableIntegerArray'] + push P0, 20 + iter P1, P0 + iter P2, P1 + + issame I0, P1, P2 + eq I0, 1, OK + print "not " +OK: print "ok\n" + end +CODE +ok +OUTPUT + +pir_output_is( <<'CODE', <<'OUTPUT', "next()" ); +.sub _main + .local pmc str, str2, iterate + str = new ['String'] + str = '0hey' + iterate = iter str + + str2 = iterate.'next'() + eq str2, '0', OK1 + print "not " +OK1:print "ok 1 - next returns first character\n" + + eq str, '0hey', OK2 + print "not " +OK2:print "ok 2 - does not touch input\n" + + str2 = iterate.'next'() + eq str2, 'h', OK3 + print "not " +OK3:print "ok 3 - next returns second character\n" +.end +CODE +ok 1 - next returns first character +ok 2 - does not touch input +ok 3 - next returns second character +OUTPUT + +TODO: { +pir_output_is( <<'CODE', <<'OUTPUT', "custom subclass, set_integer_native", todo => "subclassing init VTABLE method is not properly overridden." ); + +.sub _main :main + .local pmc myiter, inst + myiter = subclass 'Iterator', 'MyIter' + #myiter = newclass 'MyIter' + inst = new ['MyIter'] + + push_eh THROWN + inst = 1 + print "not " +THROWN: + pop_eh + print "ok\n" +.end + +.namespace ["MyIter"] +.sub init :vtable + print "init\n" + .return() +.end + +CODE +ok +OUTPUT +} + pasm_output_is( <<'CODE', <<'OUTPUT', "int test" ); .include "iterator.pasm" new P0, ['ResizablePMCArray'] # empty array From d22eea0ccaf4a4876d1d011b2d6a291dbe68895d Mon Sep 17 00:00:00 2001 From: David Czech Date: Sun, 12 Dec 2010 00:14:45 -0800 Subject: [PATCH 083/102] Chunked Encoding now working. Need some more testing and review. Perhaps a bit of cleanup, Use registers instead of variables. --- runtime/parrot/library/LWP/Protocol.pir | 68 ++++++++++++++++++------- 1 file changed, 51 insertions(+), 17 deletions(-) diff --git a/runtime/parrot/library/LWP/Protocol.pir b/runtime/parrot/library/LWP/Protocol.pir index 9fd4af5118..1d5ca90c54 100644 --- a/runtime/parrot/library/LWP/Protocol.pir +++ b/runtime/parrot/library/LWP/Protocol.pir @@ -419,6 +419,20 @@ see http://search.cpan.org/~gaas/libwww-perl/ .param pmc response .param string str .param int chunked + + .local int chunk_len + .local int chunk_sum + .local int chunk_len_idx + + .local string data + .local string chunk + .local string chunk_len_hex + .local string final_buffer + + chunk_sum = 0 + final_buffer = '' + + $S0 = str $I0 = index str, "\r\n\r\n" if $I0 < 0 goto L1 $I0 += 4 @@ -427,26 +441,48 @@ see http://search.cpan.org/~gaas/libwww-perl/ $I0 = index str, "\n\n" if $I0 < 0 goto L4 $I0 += 2 + L2: + $S0 = substr str, $I0 if chunked == 0 goto L3 - # Proccess chunks into a single block - say "Chunking together" - $S0 = substr str, $I0 # 1000\r\n.data etc - $I1 = index $S0, "\r\n" - $S1 = substr $S0, 0, $I1 + data = $S0 + Lchunki: + # Step 1) Get Chunk Length + # Find first delimiter, then extract data in between. + chunk_len_idx = index data, "\r\n" + chunk_len_hex = substr data, 0, chunk_len_idx + + # Box chunk_len_hex, and convert to integer (hex digits so radix 16). + $P0 = box chunk_len_hex + chunk_len = $P0.'to_int'(16) + + # Step 1a) If length is 0, return (L22 cleans up and returns) + if chunk_len == 0 goto L22 + + # Step 1b) Chunk-Sum (you heard right, Chunk-Sum) + chunk_sum += chunk_len - $P1 = box $S1 - #$S3 = get_number $P1, 16 - say $S3 - $S2 = "Chunk " . $S1 - say $S2 + # Step 2) Extract chunk into final_buffer + $I1 = chunk_len_idx + 2 + chunk = substr data, $I1, chunk_len + final_buffer = final_buffer . chunk + # Update $S0 for final result (L3 sets $S0 as .content) + $S0 = final_buffer - $I2 = $P1.'to_int'(16) - say $I2 - $I0 += $I2 - if $I2 != 0 goto L2 + # Increment data pointer, then Rinse and Repeat + # We must increment chunk_len by len(chunk_len_hex) + 4 + # to skip over current chunk information and its delimiters, + # so data always points the next chunk_length + chunk_len += chunk_len_idx # The length of the hex string. (the CHUNK_HEX in \r\nCHUNK_HEX\r\n) + chunk_len += 4 # The length of the delimters (the \r\n's in \r\nCHUNK_HEX\r\n) + data = substr data, chunk_len + goto Lchunki + L22: + # Chunk-Sum Sanity check + $I0 = length $S0 + if $I0 == chunk_sum goto L3 + say "Something has gone terribly wrong..." L3: - $S0 = substr str, $I0 $P0 = box $S0 setattribute response, 'content', $P0 .return ($S0) @@ -555,8 +591,6 @@ see http://search.cpan.org/~gaas/libwww-perl/ goto L23 Lchunked: # Chunked encoding, so we keep reading until we see a "0\r\n" - say "Handling Chunked Encoding..." - # Chunked=True chunked = 1 $S0 = buf $I0 = index $S0, "\r\n0\r\n" From c24b8447c6d02510d2272726343f138e3174ead5 Mon Sep 17 00:00:00 2001 From: "Michael H. Hind" Date: Sun, 12 Dec 2010 11:36:07 +0000 Subject: [PATCH 084/102] fix codetest failure - line length --- src/list.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/list.c b/src/list.c index 35fc9f7b30..cfe4597326 100644 --- a/src/list.c +++ b/src/list.c @@ -208,7 +208,8 @@ Returns True if the is in the list PARROT_EXPORT PARROT_PURE_FUNCTION INTVAL -Parrot_list_contains(SHIM_INTERP, ARGIN(const Linked_List *list), ARGIN(const List_Item_Header *item)) +Parrot_list_contains(SHIM_INTERP, + ARGIN(const Linked_List *list), ARGIN(const List_Item_Header *item)) { ASSERT_ARGS(Parrot_list_contains) From f76eee7dc84fd595cb684a34f2603194b6699b14 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sun, 12 Dec 2010 09:21:53 -0500 Subject: [PATCH 085/102] Now that we rely on 'git ls-files' to identify files which are candidates for inclusion in MANIFEST et al., we no longer need to record directories traversed, which means we can remove one TODO-ed test. (This should have no impact on functioning of tools/dev/mk_manifest_and_skip.pl.) --- lib/Parrot/Manifest.pm | 16 ++-------------- t/manifest/01-basic.t | 8 +------- 2 files changed, 3 insertions(+), 21 deletions(-) diff --git a/lib/Parrot/Manifest.pm b/lib/Parrot/Manifest.pm index 6fccc694ba..ca1246e524 100644 --- a/lib/Parrot/Manifest.pm +++ b/lib/Parrot/Manifest.pm @@ -58,13 +58,10 @@ the program invoking Parrot::Manifest, for use in messages. =cut -# ...the results go into $self->{dirs} and $self->{versioned_files} sub new { my $class = shift; my $argsref = shift; - my $self = bless( {}, $class ); - my %data = ( id => '$' . 'Id$', time => scalar gmtime, @@ -79,24 +76,15 @@ sub new { # grab the versioned resources: my @versioned_files; - my @dirs; my @versioned_output = split /\n/, $lsfiles; for my $filename (@versioned_output) { next if $filename =~ m[/\.git|^blib|^ports]; - if ( -d $filename ) { - push @dirs, $filename; - } - else { - push @versioned_files, $filename; - } + push @versioned_files, $filename; } - $data{dirs} = \@dirs; $data{versioned_files} = \@versioned_files; - # initialize the object from the prepared values (Damian, p. 98) - %$self = %data; + return bless( \%data, $class ); - return $self; } =head2 prepare_manifest diff --git a/t/manifest/01-basic.t b/t/manifest/01-basic.t index a1b9445c81..04baea8191 100644 --- a/t/manifest/01-basic.t +++ b/t/manifest/01-basic.t @@ -5,7 +5,7 @@ use strict; use warnings; -use Test::More tests => 13; +use Test::More tests => 12; use Carp; use Cwd; use File::Temp qw( tempdir ); @@ -26,12 +26,6 @@ SKIP: { my $mani = Parrot::Manifest->new( { script => $script, } ); isa_ok( $mani, 'Parrot::Manifest' ); - TODO: { - local $TODO = "fails at the moment after git migration"; - ok( scalar( @{ $mani->{dirs} } ), - "Parrot::Manifest constructor used 'status' command to find at least 1 directory." ); - }; - ok( scalar( @{ $mani->{versioned_files} } ), "Parrot::Manifest constructor used 'status' command to find at least 1 versioned file." ); From 23f2e8d5bdaf9cc9d7951fecd791adbf4a020cd8 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sun, 12 Dec 2010 09:32:37 -0500 Subject: [PATCH 086/102] Add one generated .o file to .gitignore so that it is not reported by 'git status'. Regenerate MANIFEST.SKIP. --- .gitignore | 1 + MANIFEST.SKIP | 2 ++ 2 files changed, 3 insertions(+) diff --git a/.gitignore b/.gitignore index 9ac0153448..0adc57c46b 100644 --- a/.gitignore +++ b/.gitignore @@ -241,6 +241,7 @@ /frontend/parrot/main.o /frontend/parrot_debugger/main.o /frontend/pbc_dump/main.o +/frontend/pbc_dump/packdump.o /frontend/pbc_merge/main.o # generated from svn:ignore of 'include/parrot/' /include/parrot/*.tmp diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index 5fc10a6d1f..2eaf046499 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -310,6 +310,8 @@ ^/frontend/parrot_debugger/main\.o/ ^/frontend/pbc_dump/main\.o$ ^/frontend/pbc_dump/main\.o/ +^/frontend/pbc_dump/packdump\.o$ +^/frontend/pbc_dump/packdump\.o/ ^/frontend/pbc_merge/main\.o$ ^/frontend/pbc_merge/main\.o/ ^/include/parrot/.*\.tmp$ From 6b443535b2d8d995134c245e83689933795896c4 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Sun, 12 Dec 2010 09:40:15 -0500 Subject: [PATCH 087/102] Remove outdated references to 'svn:ignore' from .gitignore. --- .gitignore | 124 ++--------------------------------------------------- 1 file changed, 4 insertions(+), 120 deletions(-) diff --git a/.gitignore b/.gitignore index 0adc57c46b..29a6c4c605 100644 --- a/.gitignore +++ b/.gitignore @@ -1,19 +1,12 @@ # ex: set ro: -# $Id: MANIFEST.SKIP 47057 2010-05-27 15:39:08Z fperrad -# generated by tools/dev/mk_manifest_and_skip.pl Thu May 27 15:25:37 2010 UT +# $Id$ +# generated by tools/dev/mk_manifest_and_skip.pl +# .gitignore # -# This file should contain a transcript of the svn:ignore properties -# of the directories in the Parrot subversion repository. (Needed for -# distributions or in general when svn is not available). -# See docs/submissions.pod on how to recreate this file after SVN -# has been told about new generated files. -# -# Ignore the SVN directories +# Ignore any remaining SVN directories /\B.svn\b - # ports/ should not go into release tarballs /ports -# generated from svn:ignore of './' /*.core /*.def /*.exe @@ -92,12 +85,9 @@ /vc60.pdb /vc70.pdb /vtable.dump -# generated from svn:ignore of 'compilers/data_json/' /compilers/data_json/data_json.pbc -# generated from svn:ignore of 'compilers/data_json/data_json/' /compilers/data_json/data_json/*.pbc /compilers/data_json/data_json/*.pir -# generated from svn:ignore of 'compilers/imcc/' /compilers/imcc/*.flag /compilers/imcc/*.o /compilers/imcc/*.obj @@ -108,28 +98,17 @@ /compilers/imcc/imcparser.c /compilers/imcc/imcparser.h /compilers/imcc/imcparser.output -# generated from svn:ignore of 'compilers/opsc/gen/Ops/' /compilers/opsc/gen/Ops/*.pir -# generated from svn:ignore of 'compilers/opsc/gen/Ops/Compiler/' /compilers/opsc/gen/Ops/Compiler/*.pir -# generated from svn:ignore of 'compilers/opsc/gen/Ops/Trans/' /compilers/opsc/gen/Ops/Trans/*.pir -# generated from svn:ignore of 'compilers/pct/src/PAST/' /compilers/pct/src/PAST/*.pbc -# generated from svn:ignore of 'compilers/pct/src/PCT/' /compilers/pct/src/PCT/*.pbc -# generated from svn:ignore of 'compilers/pct/src/POST/' /compilers/pct/src/POST/*.pbc /compilers/pct/src/POST/Grammar_gen.pir -# generated from svn:ignore of 'compilers/pge/' /compilers/pge/PGE.pbc -# generated from svn:ignore of 'compilers/pge/PGE/' /compilers/pge/PGE/builtins_gen.pir -# generated from svn:ignore of 'compilers/tge/' /compilers/tge/tgc.pbc -# generated from svn:ignore of 'compilers/tge/TGE/' /compilers/tge/TGE/Parser.pir -# generated from svn:ignore of 'docs/' /docs/*.tmp /docs/Makefile /docs/build @@ -137,17 +116,13 @@ /docs/html /docs/packfile-c.pod /docs/packfile-perl.pod -# generated from svn:ignore of 'docs/book/' /docs/book/*.html -# generated from svn:ignore of 'docs/ops/' /docs/ops/*.pod -# generated from svn:ignore of 'editor/' /editor/Makefile /editor/imc.vim /editor/imcc.xml /editor/pir.vim /editor/skeleton.pir -# generated from svn:ignore of 'examples/languages/abc/' /examples/languages/abc/*.c /examples/languages/abc/*.exe /examples/languages/abc/*.iss @@ -158,14 +133,11 @@ /examples/languages/abc/abc /examples/languages/abc/installable_abc /examples/languages/abc/man -# generated from svn:ignore of 'examples/languages/abc/src/' /examples/languages/abc/src/gen_actions.pir /examples/languages/abc/src/gen_builtins.pir /examples/languages/abc/src/gen_grammar.pir -# generated from svn:ignore of 'examples/languages/abc/t/' /examples/languages/abc/t/*_*.out /examples/languages/abc/t/*_*.pir -# generated from svn:ignore of 'examples/languages/squaak/' /examples/languages/squaak/*.c /examples/languages/squaak/*.exe /examples/languages/squaak/*.iss @@ -175,21 +147,16 @@ /examples/languages/squaak/MANIFEST /examples/languages/squaak/installable_squaak /examples/languages/squaak/squaak -# generated from svn:ignore of 'examples/languages/squaak/src/' /examples/languages/squaak/src/gen_*.pir -# generated from svn:ignore of 'examples/mops/' /examples/mops/*.o /examples/mops/mops -# generated from svn:ignore of 'examples/nci/' /examples/nci/*.pbc -# generated from svn:ignore of 'examples/pasm/' /examples/pasm/hello /examples/pasm/hello.c /examples/pasm/hello.exe /examples/pasm/hello.o /examples/pasm/hello.obj /examples/pasm/hello.pbc -# generated from svn:ignore of 'examples/pir/befunge/' /examples/pir/befunge/*.c /examples/pir/befunge/*.exe /examples/pir/befunge/*.iss @@ -199,9 +166,7 @@ /examples/pir/befunge/MANIFEST /examples/pir/befunge/befunge /examples/pir/befunge/installable_befunge -# generated from svn:ignore of 'ext/' /ext/Makefile -# generated from svn:ignore of 'ext/Parrot-Embed/' /ext/Parrot-Embed/*.bs /ext/Parrot-Embed/*.bundle /ext/Parrot-Embed/*.c @@ -231,19 +196,15 @@ /ext/Parrot-Embed/blib /ext/Parrot-Embed/dll.base /ext/Parrot-Embed/pm_to_blib -# generated from svn:ignore of 'ext/Parrot-Embed/lib/Parrot/' /ext/Parrot-Embed/lib/Parrot/*.c /ext/Parrot-Embed/lib/Parrot/*.obj -# generated from svn:ignore of 'ext/Parrot-Embed/t/' /ext/Parrot-Embed/t/*.pbc -# generated from svn:ignore of 'ext/nqp-rx/src/stage0/' /ext/nqp-rx/src/stage0/nqp-setting.pir /frontend/parrot/main.o /frontend/parrot_debugger/main.o /frontend/pbc_dump/main.o /frontend/pbc_dump/packdump.o /frontend/pbc_merge/main.o -# generated from svn:ignore of 'include/parrot/' /include/parrot/*.tmp /include/parrot/config.h /include/parrot/core_pmcs.h @@ -256,11 +217,8 @@ /include/parrot/platform_interface.h /include/parrot/platform_limits.h /include/parrot/vtable.h -# generated from svn:ignore of 'include/pmc/' /include/pmc/*.h -# generated from svn:ignore of 'lib/' /lib/DumbLink.pm -# generated from svn:ignore of 'lib/Parrot/' /lib/Parrot/*.tmp /lib/Parrot/Jit.pm /lib/Parrot/Makefile @@ -270,11 +228,8 @@ /lib/Parrot/PakFile2.c /lib/Parrot/blib /lib/Parrot/pm_to_blib -# generated from svn:ignore of 'lib/Parrot/Config/' /lib/Parrot/Config/Generated.pm -# generated from svn:ignore of 'lib/Parrot/Pmc2c/' /lib/Parrot/Pmc2c/PCCMETHOD_BITS.pm -# generated from svn:ignore of 'runtime/parrot/dynext/' /runtime/parrot/dynext/*.bundle /runtime/parrot/dynext/*.def /runtime/parrot/dynext/*.dll @@ -288,75 +243,44 @@ /runtime/parrot/dynext/*.pdb /runtime/parrot/dynext/*.so /runtime/parrot/dynext/libnci.* -# generated from svn:ignore of 'runtime/parrot/include/' /runtime/parrot/include/*.fpmc /runtime/parrot/include/*.pasm /runtime/parrot/include/*.pbc -# generated from svn:ignore of 'runtime/parrot/languages/' /runtime/parrot/languages/data_json -# generated from svn:ignore of 'runtime/parrot/library/' /runtime/parrot/library/*.pbc /runtime/parrot/library/OpenGL_funcs.pir /runtime/parrot/library/PAST /runtime/parrot/library/config.pir -# generated from svn:ignore of 'runtime/parrot/library/Archive/' /runtime/parrot/library/Archive/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/CGI/' /runtime/parrot/library/CGI/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/Config/' /runtime/parrot/library/Config/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/Configure/' /runtime/parrot/library/Configure/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/Data/' /runtime/parrot/library/Data/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/Data/Dumper/' /runtime/parrot/library/Data/Dumper/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/Digest/' /runtime/parrot/library/Digest/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/Getopt/' /runtime/parrot/library/Getopt/Obj.pbc -# generated from svn:ignore of 'runtime/parrot/library/HTTP/' /runtime/parrot/library/HTTP/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/LWP/' /runtime/parrot/library/LWP/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/MIME/' /runtime/parrot/library/MIME/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/Math/' /runtime/parrot/library/Math/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/NCI/' /runtime/parrot/library/NCI/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/OpenGL/' /runtime/parrot/library/OpenGL/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/PCT/' /runtime/parrot/library/PCT/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/PGE/' /runtime/parrot/library/PGE/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/Parrot/' /runtime/parrot/library/Parrot/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/ProfTest/' /runtime/parrot/library/ProfTest/*.pbc /runtime/parrot/library/ProfTest/*.pir -# generated from svn:ignore of 'runtime/parrot/library/Stream/' /runtime/parrot/library/Stream/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/String/' /runtime/parrot/library/String/Utils.pbc -# generated from svn:ignore of 'runtime/parrot/library/TAP/' /runtime/parrot/library/TAP/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/Tcl/' /runtime/parrot/library/Tcl/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/Test/' /runtime/parrot/library/Test/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/Test/Builder/' /runtime/parrot/library/Test/Builder/*.pbc /runtime/parrot/library/URI/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/YAML/' /runtime/parrot/library/YAML/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/YAML/Dumper/' /runtime/parrot/library/YAML/Dumper/*.pbc -# generated from svn:ignore of 'runtime/parrot/library/YAML/Parser/' /runtime/parrot/library/YAML/Parser/*.pbc -# generated from svn:ignore of 'src/' /src/*.o /src/*.obj /src/*.str @@ -381,13 +305,10 @@ /src/platform.c /src/platform_asm.s /src/revision.c -# generated from svn:ignore of 'src/atomic/' /src/atomic/*.o -# generated from svn:ignore of 'src/call/' /src/call/*.o /src/call/*.obj /src/call/*.str -# generated from svn:ignore of 'src/dynoplibs/' /src/dynoplibs/*.bundle /src/dynoplibs/*.c /src/dynoplibs/*.dll @@ -402,7 +323,6 @@ /src/dynoplibs/*.so /src/dynoplibs/Defines.mak /src/dynoplibs/Rules.mak -# generated from svn:ignore of 'src/dynpmc/' /src/dynpmc/*.bundle /src/dynpmc/*.c /src/dynpmc/*.def @@ -420,29 +340,22 @@ /src/dynpmc/*.obj /src/dynpmc/*.pdb /src/dynpmc/*.so -# generated from svn:ignore of 'src/gc/' /src/gc/*.o /src/gc/*.obj -# generated from svn:ignore of 'src/interp/' /src/interp/*.o /src/interp/*.str -# generated from svn:ignore of 'src/io/' /src/io/*.o /src/io/*.obj /src/io/*.str -# generated from svn:ignore of 'src/nci/' /src/nci/*.o /src/nci/*.obj /src/nci/*.str -# generated from svn:ignore of 'src/ops/' /src/ops/*.c /src/ops/*.o /src/ops/*.obj -# generated from svn:ignore of 'src/packfile/' /src/packfile/*.o /src/packfile/*.obj /src/packfile/*.str -# generated from svn:ignore of 'src/pmc/' /src/pmc/*.c /src/pmc/*.dump /src/pmc/*.h @@ -450,115 +363,86 @@ /src/pmc/*.obj /src/pmc/*.str /src/pmc/*.tmp -# generated from svn:ignore of 'src/runcore/' /src/runcore/*.o /src/runcore/*.obj /src/runcore/*.str -# generated from svn:ignore of 'src/string/' /src/string/*.o /src/string/*.obj /src/string/*.str /src/string/private_cstring.h -# generated from svn:ignore of 'src/string/charset/' /src/string/charset/*.o /src/string/charset/*.obj -# generated from svn:ignore of 'src/string/encoding/' /src/string/encoding/*.o /src/string/encoding/*.obj -# generated from svn:ignore of 't/benchmark/' /t/benchmark/*.pasm /t/benchmark/*.pir -# generated from svn:ignore of 't/compilers/data_json/' /t/compilers/data_json/*.pbc /t/compilers/data_json/*.pir /t/compilers/data_json/*_pbcexe -# generated from svn:ignore of 't/compilers/imcc/' /t/compilers/imcc/*.pbc -# generated from svn:ignore of 't/compilers/imcc/imcpasm/' /t/compilers/imcc/imcpasm/*.pasm /t/compilers/imcc/imcpasm/*.pbc /t/compilers/imcc/imcpasm/*.pir /t/compilers/imcc/imcpasm/*_pbcexe -# generated from svn:ignore of 't/compilers/imcc/reg/' /t/compilers/imcc/reg/*.pasm /t/compilers/imcc/reg/*.pbc /t/compilers/imcc/reg/*.pir /t/compilers/imcc/reg/*_pbcexe* -# generated from svn:ignore of 't/compilers/imcc/syn/' /t/compilers/imcc/syn/*.pasm /t/compilers/imcc/syn/*.pbc /t/compilers/imcc/syn/*.pir /t/compilers/imcc/syn/*_pbcexe* -# generated from svn:ignore of 't/compilers/pct/' /t/compilers/pct/*.pbc /t/compilers/pct/*.pir -# generated from svn:ignore of 't/compilers/pge/' /t/compilers/pge/*.pasm /t/compilers/pge/*.pbc /t/compilers/pge/*.pir /t/compilers/pge/*_pbcexe -# generated from svn:ignore of 't/compilers/pge/p5regex/' /t/compilers/pge/p5regex/*.pir -# generated from svn:ignore of 't/compilers/pge/perl6regex/' /t/compilers/pge/perl6regex/*.pbc /t/compilers/pge/perl6regex/*.pir -# generated from svn:ignore of 't/compilers/tge/' /t/compilers/tge/*.pbc /t/compilers/tge/*.pir /t/compilers/tge/*_pbcexe -# generated from svn:ignore of 't/dynoplibs/' /t/dynoplibs/*.pasm /t/dynoplibs/*.pbc /t/dynoplibs/*.pir -# generated from svn:ignore of 't/dynpmc/' /t/dynpmc/*.pasm /t/dynpmc/*.pbc /t/dynpmc/*.pir /t/dynpmc/*_pbcexe* -# generated from svn:ignore of 't/examples/' /t/examples/*.pasm /t/examples/*.pbc /t/examples/*.pir /t/examples/*_pbcexe* -# generated from svn:ignore of 't/library/' /t/library/*.out /t/library/*.pasm /t/library/*.pbc /t/library/*.pir /t/library/*_pbcexe* -# generated from svn:ignore of 't/native_pbc/' /t/native_pbc/*_pbcexe* -# generated from svn:ignore of 't/oo/' /t/oo/*.pbc /t/oo/*.pir -# generated from svn:ignore of 't/op/' /t/op/*.out /t/op/*.pasm /t/op/*.pbc /t/op/*.pir /t/op/*_pbcexe* -# generated from svn:ignore of 't/op/testlib/' /t/op/testlib/*.pbc -# generated from svn:ignore of 't/perl/' /t/perl/Parrot_Test_1.pasm /t/perl/Parrot_Test_1.pir -# generated from svn:ignore of 't/pmc/' /t/pmc/*.out /t/pmc/*.pasm /t/pmc/*.pbc /t/pmc/*.pir /t/pmc/*_pbcexe* -# generated from svn:ignore of 't/pmc/testlib/' /t/pmc/testlib/*.pbc -# generated from svn:ignore of 't/src/' /t/src/*_* -# generated from svn:ignore of 't/stress/' /t/stress/*.out /t/stress/*.pasm /t/stress/*.pbc /t/stress/*.pir /t/stress/*_pbcexe* -# generated from svn:ignore of 't/tools/' /t/tools/*.pbc /t/tools/*.pir /t/tools/*.stdout From c8712276a2973ad1c672ea5a4772b5745c817545 Mon Sep 17 00:00:00 2001 From: Peter Lobsinger Date: Sun, 12 Dec 2010 11:14:14 -0500 Subject: [PATCH 088/102] skip if sys_ops unavailable --- t/pmc/integer.t | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/t/pmc/integer.t b/t/pmc/integer.t index 2641b641fc..e5353764a0 100644 --- a/t/pmc/integer.t +++ b/t/pmc/integer.t @@ -15,6 +15,16 @@ Tests the Integer PMC. =cut +.sub '' :anon :immediate + $P0 = loadlib 'sys_ops' + $I0 = defined $P0 + if $I0 goto ok + load_bytecode 'Test/Builder.pir' + $P1 = new ['Test';'Builder'] + $P1.'skip_all'("couldn't load sys_ops") + ok: +.end + .loadlib 'sys_ops' .sub 'test' :main From 8d7399024e2e0428eb2375f5544f8c78c4a3f7f4 Mon Sep 17 00:00:00 2001 From: NotFound Date: Sun, 12 Dec 2010 18:44:33 +0100 Subject: [PATCH 089/102] skip only Integer tests that depend on sysops when unavailable --- t/pmc/integer.t | 134 +++++++++++++++++++++++++++++++++++++----------- 1 file changed, 103 insertions(+), 31 deletions(-) diff --git a/t/pmc/integer.t b/t/pmc/integer.t index e5353764a0..3781f7cd57 100644 --- a/t/pmc/integer.t +++ b/t/pmc/integer.t @@ -15,21 +15,15 @@ Tests the Integer PMC. =cut -.sub '' :anon :immediate - $P0 = loadlib 'sys_ops' - $I0 = defined $P0 - if $I0 goto ok - load_bytecode 'Test/Builder.pir' - $P1 = new ['Test';'Builder'] - $P1.'skip_all'("couldn't load sys_ops") - ok: -.end - -.loadlib 'sys_ops' +.const string MAXINT = 'MAXINT' +.const string MININT = 'MININT' +.const string NO_SYSINFO = 'This test requires sysinfo' .sub 'test' :main .include 'test_more.pir' + get_max_min() + plan(141) test_init() test_basic_math() @@ -72,6 +66,50 @@ Tests the Integer PMC. done_bigint_tests: .end +# Get INTVAL max and min values from sysinfo only if the sys_ops lib is +# available and leaving them as zero otherwise (that happens during corestes, +# for example). +# The test that needs the values are skipped based on this. +.sub get_max_min + .local string code + + code = <<'CODE' +.loadlib 'sys_ops' +.include 'sysinfo.pasm' +.sub aux_get_max + .local int m + .local pmc pm + m = sysinfo .SYSINFO_PARROT_INTMAX + pm = box m + set_hll_global 'MAXINT', pm + m = sysinfo .SYSINFO_PARROT_INTMIN + pm = box m + set_hll_global 'MININT', pm +.end +CODE + + .local pmc m + m = box 0 + set_hll_global MAXINT, m + m = box 0 + set_hll_global MININT, m + .local pmc pircomp + push_eh catch + pircomp = compreg 'PIR' + if null pircomp goto done + .local pmc getit + getit = pircomp(code) + getit() + goto done + catch: + .local pmc ex + .get_results(ex) + finalize ex + + done: + pop_eh +.end + .sub has_bigint push_eh _dont_have_bigint $P0 = new ['BigInt'] @@ -141,6 +179,10 @@ CODE neg int_1 is(int_1, 5, '... neg') + $P9 = get_hll_global MININT + $I0 = $P9 + unless $I0 goto skip + throws_substring(<<'CODE', 'Integer overflow', 'mul integer overflow') .sub main @@ -154,7 +196,12 @@ CODE $P0 *= 2 .end CODE + goto more + + skip: + skip(1, NO_SYSINFO) + more: int_1 = new ['Integer'] int_1 = -57494 int_1 = abs int_1 @@ -168,14 +215,16 @@ CODE .sub test_autopromotion_to_BigInt push_eh _dont_have_bigint_library - .include 'sysinfo.pasm' .local pmc bigint_1 .local pmc int_1 int_1 = new ['Integer'] bigint_1 = new ['BigInt'] - $I0 = sysinfo .SYSINFO_PARROT_INTMIN + $P9 = get_hll_global MININT + $I0 = $P9 + unless $I0 goto skip + int_1 = $I0 bigint_1 = int_1 - 1 @@ -192,6 +241,10 @@ CODE ok(1, "no bigint library") ok(1, "no bigint library") _have_bigint_library: + goto end + skip: + skip(2, NO_SYSINFO) + end: .end .sub test_truthiness_and_definedness @@ -390,17 +443,22 @@ fin: .end .sub test_add_BigInt - .include 'sysinfo.pasm' - new $P0, ['Integer'] - new $P1, ['BigInt'] - sysinfo $I0, .SYSINFO_PARROT_INTMAX - set $P0, $I0 - set $P1, $I0 - add $P0, $P0, 1 - add $P1, $P1, 1 - typeof $P2, $P0 - is($P0, $P1, 'add integer overflow promotion') - is($P2, 'BigInt', 'add integer overflow type check') + $P9 = get_hll_global MAXINT + $I0 = $P9 + unless $I0 goto skip + new $P0, ['Integer'] + new $P1, ['BigInt'] + set $P0, $I0 + set $P1, $I0 + add $P0, $P0, 1 + add $P1, $P1, 1 + typeof $P2, $P0 + is($P0, $P1, 'add integer overflow promotion') + is($P2, 'BigInt', 'add integer overflow type check') + goto end + skip: + skip(2, NO_SYSINFO) + end: .end .sub test_add @@ -447,10 +505,11 @@ fin: sub $P1, $P1, $P0 is($P1, 1, 'BigInt sub (no exception)') - .include 'sysinfo.pasm' $P0 = new ['Integer'] $P1 = new ['BigInt'] - $I0 = sysinfo .SYSINFO_PARROT_INTMIN + $P9 = get_hll_global MININT + $I0 = $P9 + unless $I0 goto skip $P0 = $I0 $P1 = $I0 sub $P0, $P0, 1 @@ -474,6 +533,10 @@ fin: typeof $P3, $P0 is($P0, $P1, 'i_subtract overflow promotion') is($P3, 'BigInt', 'i_subtract overflow type check') + goto end + skip: + skip(6, NO_SYSINFO) + end: .end .sub test_sub @@ -557,9 +620,10 @@ fin: $I0 = iseq $P0, $P2 todo($I0, 'i_multiply Integer PMC by BigInt PMC', 'unresolved bug, see TT #1887') - .include 'sysinfo.pasm' $P0 = new ['Integer'] - $I0 = sysinfo .SYSINFO_PARROT_INTMAX + $P9 = get_hll_global MAXINT + $I0 = $P9 + unless $I0 goto skip $P0 = $I0 $P1 = $I0 mul $P0, 2 @@ -567,6 +631,10 @@ fin: $P2 = typeof $P0 is($P0, $P1, 'i_multiply_int overflow promotion') is($P2, 'BigInt', 'i_multiple_int overflow type check') + goto end + skip: + skip(2, NO_SYSINFO) + end: .end .sub test_div_BigInt @@ -836,12 +904,12 @@ CODE .end .sub test_neg_BigInt - .include 'sysinfo.pasm' - $P0 = new ['Integer'] $P1 = new ['BigInt'] - $I0 = sysinfo .SYSINFO_PARROT_INTMIN + $P9 = get_hll_global MININT + $I0 = $P9 + unless $I0 goto skip $P0 = $I0 $P1 = $I0 @@ -851,6 +919,10 @@ CODE $P2 = typeof $P0 is($P0, $P1, 'neg integer overflow promotion') is($P2, 'BigInt', 'neg integer overflow type check') + goto end + skip: + skip(2, NO_SYSINFO) + end: .end .sub test_neg From dd7ff4e50f6883fb096062c28fe7c8987ab202db Mon Sep 17 00:00:00 2001 From: NotFound Date: Mon, 13 Dec 2010 01:06:35 +0100 Subject: [PATCH 090/102] fix a segfaulting bug in method Namespace.export_to --- src/pmc/namespace.pmc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/pmc/namespace.pmc b/src/pmc/namespace.pmc index 66b3953894..7819aac64d 100644 --- a/src/pmc/namespace.pmc +++ b/src/pmc/namespace.pmc @@ -1129,7 +1129,7 @@ NOTE: exporting 'default' set of items is not yet implemented. } else Parrot_ex_throw_from_c_args(INTERP, NULL, 0, - "can't handle argument of type %s", what->vtable->base_type); + "can't handle argument of type %Ss", what->vtable->whoami); } /* From 6f2c9b1ade816db8cd467fb6c6610320c34bbd65 Mon Sep 17 00:00:00 2001 From: NotFound Date: Mon, 13 Dec 2010 01:19:54 +0100 Subject: [PATCH 091/102] regresion test for dd7ff4e --- t/pmc/namespace.t | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/t/pmc/namespace.t b/t/pmc/namespace.t index 64e645c2f1..258e2adc15 100644 --- a/t/pmc/namespace.t +++ b/t/pmc/namespace.t @@ -55,7 +55,7 @@ Although NameSpace.'export_to'() is used in test_more.pir. .sub main :main .include 'test_more.pir' - plan(74) + plan(75) create_namespace_pmc() verify_namespace_type() @@ -599,6 +599,22 @@ CODE .end CODE + errormsg = "can't handle argument of type" + description = "export_to() invalid 'what' type" + throws_substring(<<"CODE", errormsg, description) + .sub 'test' :main + .local pmc nsa, nsb, ar + + # To trigger the condition we need something of an unexpected + # type which elements vtable function does not return 0 + ar = new ['String'] + ar = 'boo' + nsa = get_namespace + nsb = get_namespace ['Foo'] + nsb.'export_to'(nsa, ar) + .end +CODE + errormsg = "exporting default object set not yet implemented" description = 'export_to() with null exports default object set !!!UNSPECIFIED!!!' throws_substring(<<'CODE', errormsg, description) From b3ec6cf554ae6dc8f933a8dc672423ef76979fa9 Mon Sep 17 00:00:00 2001 From: "Michael H. Hind" Date: Mon, 13 Dec 2010 14:07:31 +0000 Subject: [PATCH 092/102] re-generate MANIFEST --- MANIFEST | 3 +++ 1 file changed, 3 insertions(+) diff --git a/MANIFEST b/MANIFEST index 8243a8582d..c351f68b69 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1108,6 +1108,8 @@ lib/Pod/Simple/TranscodeDumb.pm [] lib/Pod/Simple/TranscodeSmart.pm [] lib/Pod/Simple/XHTML.pm [] lib/Pod/Simple/XMLOutStream.pm [] +md5task/main_m.pir [] +md5task/main_nfio.pir [] parrotbug [] runtime/parrot/bin/prove.pir [library] runtime/parrot/dynext/README []doc @@ -2067,6 +2069,7 @@ t/tools/pmc2cutils/05-gen_c.t [test] t/tools/pmc2cutils/08-pmc-pm.t [test] t/tools/pmc2cutils/README []doc t/tools/testdata [test] +test_data [] tools/build/README []doc tools/build/c2str.pl [] tools/build/fixup_gen_file.pl [] From 79595251a932dda08433d336caf56fb2f186b59d Mon Sep 17 00:00:00 2001 From: "Michael H. Hind" Date: Mon, 13 Dec 2010 14:27:41 +0000 Subject: [PATCH 093/102] fix codetest failures add copyright line add pir coda remove trailing spaces some documentati8on would be welcome! --- md5task/main_m.pir | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/md5task/main_m.pir b/md5task/main_m.pir index a4ac7a563d..051389bbef 100644 --- a/md5task/main_m.pir +++ b/md5task/main_m.pir @@ -1,20 +1,28 @@ +# Copyright (C) 2010, Parrot Foundation. + .sub main .param pmc argv load_bytecode "Digest/MD5.pbc" .local pmc mba .local string filename - + set filename, argv[1] $S0 = "Creating new MappedByteArray, and opening " . filename say $S0 - mba = new 'MappedByteArray' + mba = new 'MappedByteArray' mba.'open'(filename) say 'getting the data from the Mapped Byte Array...' $I1 = elements mba $S0 = mba.'get_string'(0, $I1, 'binary') - + $P1 = _md5sum($S0) $S0 = _md5_hex($P1) say $S0 - .end +.end + +# Local Variables: +# mode: pir +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4 ft=pir: From 55c5515f66ef0f57a6d14ebdfa62a61cf6127a8a Mon Sep 17 00:00:00 2001 From: "Michael H. Hind" Date: Mon, 13 Dec 2010 14:29:44 +0000 Subject: [PATCH 094/102] fix codetest failures add copyright line add pir coda remove trailing spaces some documentati8on would be welcome! --- md5task/main_nfio.pir | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/md5task/main_nfio.pir b/md5task/main_nfio.pir index 9785547a1b..cbe0ab79bb 100644 --- a/md5task/main_nfio.pir +++ b/md5task/main_nfio.pir @@ -1,10 +1,12 @@ +# Copyright (C) 2010, Parrot Foundation. + .loadlib 'io_ops' .sub main .param pmc argv load_bytecode "Digest/MD5.pbc" .local pmc mba .local string filename - + set filename, argv[1] $S0 = "Creating new MappedByteArray, and opening " . filename say $S0 @@ -14,8 +16,14 @@ $P0.'open'(filename, 'r') $P0.'encoding'('binary') $S0 = $P0.'readall'() - + $P1 = _md5sum($S0) $S0 = _md5_hex($P1) say $S0 - .end +.end + +# Local Variables: +# mode: pir +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4 ft=pir: From 4e18c2770dd6ff630e7af0ed52c2829b11709f07 Mon Sep 17 00:00:00 2001 From: "Michael H. Hind" Date: Mon, 13 Dec 2010 14:31:11 +0000 Subject: [PATCH 095/102] fix codetest failures - trailing spaces --- runtime/parrot/library/LWP/Protocol.pir | 26 ++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/runtime/parrot/library/LWP/Protocol.pir b/runtime/parrot/library/LWP/Protocol.pir index 1d5ca90c54..c68afcd77f 100644 --- a/runtime/parrot/library/LWP/Protocol.pir +++ b/runtime/parrot/library/LWP/Protocol.pir @@ -299,12 +299,12 @@ see http://search.cpan.org/~gaas/libwww-perl/ .param pmc headers .param pmc url .param pmc proxy - - # FIXME: + + # FIXME: # There should be no Connection header, because in HTTP/1.1 all # connections are keep-alive by default. headers['Connection'] = "Keep-Alive" - + # Extract 'Host' header .local string host host = url.'authority'() @@ -424,14 +424,14 @@ see http://search.cpan.org/~gaas/libwww-perl/ .local int chunk_sum .local int chunk_len_idx - .local string data + .local string data .local string chunk .local string chunk_len_hex .local string final_buffer chunk_sum = 0 final_buffer = '' - + $S0 = str $I0 = index str, "\r\n\r\n" if $I0 < 0 goto L1 @@ -448,27 +448,27 @@ see http://search.cpan.org/~gaas/libwww-perl/ data = $S0 Lchunki: # Step 1) Get Chunk Length - # Find first delimiter, then extract data in between. + # Find first delimiter, then extract data in between. chunk_len_idx = index data, "\r\n" chunk_len_hex = substr data, 0, chunk_len_idx - + # Box chunk_len_hex, and convert to integer (hex digits so radix 16). $P0 = box chunk_len_hex chunk_len = $P0.'to_int'(16) - + # Step 1a) If length is 0, return (L22 cleans up and returns) if chunk_len == 0 goto L22 - + # Step 1b) Chunk-Sum (you heard right, Chunk-Sum) chunk_sum += chunk_len - + # Step 2) Extract chunk into final_buffer $I1 = chunk_len_idx + 2 chunk = substr data, $I1, chunk_len final_buffer = final_buffer . chunk # Update $S0 for final result (L3 sets $S0 as .content) $S0 = final_buffer - + # Increment data pointer, then Rinse and Repeat # We must increment chunk_len by len(chunk_len_hex) + 4 # to skip over current chunk information and its delimiters, @@ -478,10 +478,10 @@ see http://search.cpan.org/~gaas/libwww-perl/ data = substr data, chunk_len goto Lchunki L22: - # Chunk-Sum Sanity check + # Chunk-Sum Sanity check $I0 = length $S0 if $I0 == chunk_sum goto L3 - say "Something has gone terribly wrong..." + say "Something has gone terribly wrong..." L3: $P0 = box $S0 setattribute response, 'content', $P0 From 65b4794692f3f73d157579e9a9a9c1041feaf2a6 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Mon, 13 Dec 2010 18:47:51 -0500 Subject: [PATCH 096/102] Remove some files that were accidentally committed. --- MANIFEST | 3 --- md5task/main_m.pir | 28 ---------------------------- md5task/main_nfio.pir | 29 ----------------------------- test_data | 1 - 4 files changed, 61 deletions(-) delete mode 100644 md5task/main_m.pir delete mode 100644 md5task/main_nfio.pir delete mode 100644 test_data diff --git a/MANIFEST b/MANIFEST index c351f68b69..8243a8582d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1108,8 +1108,6 @@ lib/Pod/Simple/TranscodeDumb.pm [] lib/Pod/Simple/TranscodeSmart.pm [] lib/Pod/Simple/XHTML.pm [] lib/Pod/Simple/XMLOutStream.pm [] -md5task/main_m.pir [] -md5task/main_nfio.pir [] parrotbug [] runtime/parrot/bin/prove.pir [library] runtime/parrot/dynext/README []doc @@ -2069,7 +2067,6 @@ t/tools/pmc2cutils/05-gen_c.t [test] t/tools/pmc2cutils/08-pmc-pm.t [test] t/tools/pmc2cutils/README []doc t/tools/testdata [test] -test_data [] tools/build/README []doc tools/build/c2str.pl [] tools/build/fixup_gen_file.pl [] diff --git a/md5task/main_m.pir b/md5task/main_m.pir deleted file mode 100644 index 051389bbef..0000000000 --- a/md5task/main_m.pir +++ /dev/null @@ -1,28 +0,0 @@ -# Copyright (C) 2010, Parrot Foundation. - -.sub main - .param pmc argv - load_bytecode "Digest/MD5.pbc" - .local pmc mba - .local string filename - - set filename, argv[1] - $S0 = "Creating new MappedByteArray, and opening " . filename - say $S0 - mba = new 'MappedByteArray' - mba.'open'(filename) - - say 'getting the data from the Mapped Byte Array...' - $I1 = elements mba - $S0 = mba.'get_string'(0, $I1, 'binary') - - $P1 = _md5sum($S0) - $S0 = _md5_hex($P1) - say $S0 -.end - -# Local Variables: -# mode: pir -# fill-column: 100 -# End: -# vim: expandtab shiftwidth=4 ft=pir: diff --git a/md5task/main_nfio.pir b/md5task/main_nfio.pir deleted file mode 100644 index cbe0ab79bb..0000000000 --- a/md5task/main_nfio.pir +++ /dev/null @@ -1,29 +0,0 @@ -# Copyright (C) 2010, Parrot Foundation. - -.loadlib 'io_ops' -.sub main - .param pmc argv - load_bytecode "Digest/MD5.pbc" - .local pmc mba - .local string filename - - set filename, argv[1] - $S0 = "Creating new MappedByteArray, and opening " . filename - say $S0 - say 'getting the data from the Mapped Byte Array...' - - $P0 = new 'FileHandle' - $P0.'open'(filename, 'r') - $P0.'encoding'('binary') - $S0 = $P0.'readall'() - - $P1 = _md5sum($S0) - $S0 = _md5_hex($P1) - say $S0 -.end - -# Local Variables: -# mode: pir -# fill-column: 100 -# End: -# vim: expandtab shiftwidth=4 ft=pir: diff --git a/test_data b/test_data deleted file mode 100644 index d6d9d34ca4..0000000000 --- a/test_data +++ /dev/null @@ -1 +0,0 @@ -blah \ No newline at end of file From f123b3079b08e50f1581dcdbb52ee2ae75685ac1 Mon Sep 17 00:00:00 2001 From: jkeenan Date: Mon, 13 Dec 2010 19:18:15 -0500 Subject: [PATCH 097/102] Complete work on http://trac.parrot.org/parrot/ticket/532. Change Parrot::Headerizer::Object back to simply Parrot::Headerizer. --- MANIFEST | 2 +- .../{Headerizer/Object.pm => Headerizer.pm} | 18 +++--- t/codingstd/c_function_docs.t | 4 +- t/codingstd/pmc_docs.t | 4 +- t/tools/dev/headerizer/02_methods.t | 56 +++++++++---------- tools/dev/headerizer.pl | 6 +- 6 files changed, 45 insertions(+), 45 deletions(-) rename lib/Parrot/{Headerizer/Object.pm => Headerizer.pm} (97%) diff --git a/MANIFEST b/MANIFEST index 73e49d2f60..ff9f99b547 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1034,7 +1034,7 @@ lib/Parrot/Harness/DefaultTests.pm [devel]lib lib/Parrot/Harness/Options.pm [devel]lib lib/Parrot/Harness/Smoke.pm [devel]lib lib/Parrot/Headerizer/Functions.pm [devel]lib -lib/Parrot/Headerizer/Object.pm [devel]lib +lib/Parrot/Headerizer.pm [devel]lib lib/Parrot/IO/Directory.pm [devel]lib lib/Parrot/IO/File.pm [devel]lib lib/Parrot/IO/Path.pm [devel]lib diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer.pm similarity index 97% rename from lib/Parrot/Headerizer/Object.pm rename to lib/Parrot/Headerizer.pm index 92623a6781..8069bd96c6 100644 --- a/lib/Parrot/Headerizer/Object.pm +++ b/lib/Parrot/Headerizer.pm @@ -1,17 +1,17 @@ # Copyright (C) 2004-2010, Parrot Foundation. # $Id$ -package Parrot::Headerizer::Object; +package Parrot::Headerizer; =head1 NAME -Parrot::Headerizer::Object - Parrot header generation functionality +Parrot::Headerizer - Parrot header generation functionality =head1 SYNOPSIS - use Parrot::Headerizer::Object; + use Parrot::Headerizer; - $headerizer = Parrot::Headerizer::Object->new( { + $headerizer = Parrot::Headerizer->new( { macro_match => $macro_match, # optional } ); @@ -25,7 +25,7 @@ Parrot::Headerizer::Object - Parrot header generation functionality =head1 DESCRIPTION -C knows how to extract all kinds of information out +C knows how to extract all kinds of information out of C-language files. Its methods are used in F and F. @@ -67,11 +67,11 @@ valid C macros. =item * Arguments - $headerizer = Parrot::Headerizer::Object->new(); + $headerizer = Parrot::Headerizer->new(); No mandatory arguments, but one special use-case takes a hash reference. - $headerizer = Parrot::Headerizer::Object->new( { + $headerizer = Parrot::Headerizer->new( { macro_match => $macro_match, # optional } ); @@ -81,7 +81,7 @@ used. =item * Return Value -Parrot::Headerizer::Object object. +Parrot::Headerizer object. =back @@ -90,7 +90,7 @@ Parrot::Headerizer::Object object. sub new { my ($class, $args) = @_; if (defined $args) { - die "Argument to Parrot::Headerizer::Object must be hashref" + die "Argument to Parrot::Headerizer must be hashref" unless reftype($args) eq 'HASH'; } else { diff --git a/t/codingstd/c_function_docs.t b/t/codingstd/c_function_docs.t index a25c41c011..2b27aba7fa 100644 --- a/t/codingstd/c_function_docs.t +++ b/t/codingstd/c_function_docs.t @@ -8,7 +8,7 @@ use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Config qw(%PConfig); use Parrot::Distribution; -use Parrot::Headerizer::Object; +use Parrot::Headerizer; =head1 NAME @@ -30,7 +30,7 @@ declared. =cut my $DIST = Parrot::Distribution->new; -my $headerizer = Parrot::Headerizer::Object->new; +my $headerizer = Parrot::Headerizer->new; # can not handle .ops or .pmc files yet my @files = grep {/\.(c|h)$/ } @ARGV ? @ARGV : diff --git a/t/codingstd/pmc_docs.t b/t/codingstd/pmc_docs.t index 9c3ee8d2c8..0ce2e08632 100644 --- a/t/codingstd/pmc_docs.t +++ b/t/codingstd/pmc_docs.t @@ -8,7 +8,7 @@ use lib qw( . lib ../lib ../../lib ); use Test::More; use Parrot::Config qw(%PConfig); use Parrot::Distribution; -use Parrot::Headerizer::Object; +use Parrot::Headerizer; =head1 NAME @@ -30,7 +30,7 @@ declared. =cut my $DIST = Parrot::Distribution->new; -my $headerizer = Parrot::Headerizer::Object->new; +my $headerizer = Parrot::Headerizer->new; my @files = @ARGV ? @ARGV : map {s/^$PConfig{build_dir}\///; $_} diff --git a/t/tools/dev/headerizer/02_methods.t b/t/tools/dev/headerizer/02_methods.t index 4746624b53..0071dc6d5b 100644 --- a/t/tools/dev/headerizer/02_methods.t +++ b/t/tools/dev/headerizer/02_methods.t @@ -14,20 +14,20 @@ use File::Temp qw( tempdir ); use Test::More qw(no_plan); # tests => 46; use lib qw( lib ); use Parrot::Headerizer::Functions qw( read_file ); -use Parrot::Headerizer::Object; +use Parrot::Headerizer; use IO::CaptureOutput qw| capture |; my $cwd = cwd(); my $self; -eval { $self = Parrot::Headerizer::Object->new([]); }; -like($@, qr/Argument to Parrot::Headerizer::Object must be hashref/, +eval { $self = Parrot::Headerizer->new([]); }; +like($@, qr/Argument to Parrot::Headerizer must be hashref/, "Got expected error message for bad argument to constructor" ); -$self = Parrot::Headerizer::Object->new({ macro_match => 1}); -isa_ok( $self, 'Parrot::Headerizer::Object' ); +$self = Parrot::Headerizer->new({ macro_match => 1}); +isa_ok( $self, 'Parrot::Headerizer' ); -$self = Parrot::Headerizer::Object->new(); -isa_ok( $self, 'Parrot::Headerizer::Object' ); +$self = Parrot::Headerizer->new(); +isa_ok( $self, 'Parrot::Headerizer' ); ok( $self->valid_macro( 'PARROT_EXPORT' ), "valid_macro() confirmed validity of macro" ); ok(! $self->valid_macro( 'PARROT_FOOBAR' ), @@ -145,8 +145,8 @@ $self->squawk($file, $func, $error[1]); mkpath( $srcopsdir, 0, 0777 ); my $srcopso = File::Spec->catfile( $srcopsdir, 'ops.o' ); touchfile($srcopso); - $self = Parrot::Headerizer::Object->new(); - isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self = Parrot::Headerizer->new(); + isa_ok( $self, 'Parrot::Headerizer' ); $self->get_sources($srcopso); ok( ! keys %{$self->{sourcefiles}}, "Skipped file in src/ops/ -> no sourcefiles" ); @@ -169,8 +169,8 @@ $self->squawk($file, $func, $error[1]); touchfile($srco); my $srcs = File::Spec->catfile( $srcdir, 'other.s' ); touchfile($srcs); - $self = Parrot::Headerizer::Object->new(); - isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self = Parrot::Headerizer->new(); + isa_ok( $self, 'Parrot::Headerizer' ); $self->get_sources($srco); ok( ! keys %{$self->{sourcefiles}}, "Skipped file in src/ -> no sourcefiles" ); @@ -189,8 +189,8 @@ $self->squawk($file, $func, $error[1]); my $srco = setup_src_list_test($cwd, $tdir); - $self = Parrot::Headerizer::Object->new(); - isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self = Parrot::Headerizer->new(); + isa_ok( $self, 'Parrot::Headerizer' ); $self->get_sources($srco); ok( keys %{$self->{sourcefiles}}, "sourcefiles" ); @@ -221,10 +221,10 @@ $self->squawk($file, $func, $error[1]); my $srco = setup_src_list_test($cwd, $tdir); my $macro = 'PARROT_CAN_RETURN_NULL'; - $self = Parrot::Headerizer::Object->new( { + $self = Parrot::Headerizer->new( { macro_match => $macro, } ); - isa_ok( $self, 'Parrot::Headerizer::Object' ); + isa_ok( $self, 'Parrot::Headerizer' ); $self->get_sources($srco); ok( keys %{$self->{sourcefiles}}, "sourcefiles" ); @@ -270,8 +270,8 @@ $self->squawk($file, $func, $error[1]); copy "$cwd/t/tools/dev/headerizer/testlib/${stub}_pmc.in" => $srcc or croak "Unable to copy"; - $self = Parrot::Headerizer::Object->new(); - isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self = Parrot::Headerizer->new(); + isa_ok( $self, 'Parrot::Headerizer' ); $self->get_sources($srco); ok( ! keys %{$self->{sourcefiles}}, "no sourcefiles" ); @@ -308,8 +308,8 @@ $self->squawk($file, $func, $error[1]); copy "$cwd/t/tools/dev/headerizer/testlib/${stub}_pmc.in" => $srcc or croak "Unable to copy"; - $self = Parrot::Headerizer::Object->new(); - isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self = Parrot::Headerizer->new(); + isa_ok( $self, 'Parrot::Headerizer' ); $self->get_sources($srco); ok( ! keys %{$self->{sourcefiles}}, "no sourcefiles" ); @@ -342,8 +342,8 @@ $self->squawk($file, $func, $error[1]); my $srco = setup_src_list_test($cwd, $tdir); - $self = Parrot::Headerizer::Object->new(); - isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self = Parrot::Headerizer->new(); + isa_ok( $self, 'Parrot::Headerizer' ); $self->get_sources($srco); ok( keys %{$self->{sourcefiles}}, "sourcefiles" ); @@ -383,8 +383,8 @@ $self->squawk($file, $func, $error[1]); my $srco = setup_src_list_test($cwd, $tdir); - $self = Parrot::Headerizer::Object->new(); - isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self = Parrot::Headerizer->new(); + isa_ok( $self, 'Parrot::Headerizer' ); $self->get_sources($srco); ok( keys %{$self->{sourcefiles}}, "sourcefiles" ); @@ -418,8 +418,8 @@ $self->squawk($file, $func, $error[1]); my $srco = setup_src_list_test($cwd, $tdir); - $self = Parrot::Headerizer::Object->new(); - isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self = Parrot::Headerizer->new(); + isa_ok( $self, 'Parrot::Headerizer' ); $self->get_sources($srco); ok( keys %{$self->{sourcefiles}}, "sourcefiles" ); @@ -513,8 +513,8 @@ $self->squawk($file, $func, $error[1]); my $srco = setup_src_list_test($cwd, $tdir); - $self = Parrot::Headerizer::Object->new(); - isa_ok( $self, 'Parrot::Headerizer::Object' ); + $self = Parrot::Headerizer->new(); + isa_ok( $self, 'Parrot::Headerizer' ); my ($return_type, %macros, $name, $file); @@ -717,7 +717,7 @@ sub setup_src_list_test { =head1 NAME -02_methods.t - Test functions in Parrot::Headerizer::Object. +02_methods.t - Test functions in Parrot::Headerizer. =head1 SYNOPSIS diff --git a/tools/dev/headerizer.pl b/tools/dev/headerizer.pl index 62dcac943c..9045e453f2 100644 --- a/tools/dev/headerizer.pl +++ b/tools/dev/headerizer.pl @@ -6,7 +6,7 @@ use Getopt::Long; use lib qw( lib ); -use Parrot::Headerizer::Object; +use Parrot::Headerizer; use Parrot::Headerizer::Functions qw( process_argv ); @@ -80,7 +80,7 @@ =head1 COMMAND-LINE OPTIONS ) or exit(1); my @ofiles = process_argv(@ARGV); -my $headerizer = Parrot::Headerizer::Object->new( { +my $headerizer = Parrot::Headerizer->new( { macro_match => $macro_match, } ); @@ -94,7 +94,7 @@ =head1 AUTHOR The original headerizer program was created by Andy Lester in May 2006, with assistance from Jerry Gay and others. In the last half of 2010, Most of the -code was refactored into F and +code was refactored into F and F by James E Keenan. =cut From 07df1ca0fd08b677476cacfd0e8001a832623d1c Mon Sep 17 00:00:00 2001 From: NotFound Date: Tue, 14 Dec 2010 17:19:21 +0100 Subject: [PATCH 098/102] add the throws_type function to Test;More and use it in a new test for Namespace --- runtime/parrot/include/test_more.pir | 2 +- runtime/parrot/library/Test/More.pir | 45 ++++++++++++++++++++++++++++ t/pmc/namespace.t | 13 +++++++- 3 files changed, 58 insertions(+), 2 deletions(-) diff --git a/runtime/parrot/include/test_more.pir b/runtime/parrot/include/test_more.pir index c642773d54..f192a3d707 100644 --- a/runtime/parrot/include/test_more.pir +++ b/runtime/parrot/include/test_more.pir @@ -19,7 +19,7 @@ simple test file written in parrot. .local pmc exports, curr_namespace, test_namespace curr_namespace = get_namespace test_namespace = get_root_namespace [ 'parrot'; 'Test'; 'More' ] - exports = split ' ', 'plan diag ok nok is is_deeply is_null like substring isa_ok skip skip_all isnt todo throws_like lives_ok dies_ok throws_substring done_testing' + exports = split ' ', 'plan diag ok nok is is_deeply is_null like substring isa_ok skip skip_all isnt todo throws_type throws_like lives_ok dies_ok throws_substring done_testing' test_namespace.'export_to'(curr_namespace, exports) diff --git a/runtime/parrot/library/Test/More.pir b/runtime/parrot/library/Test/More.pir index be945d17d2..805bbdbbbb 100644 --- a/runtime/parrot/library/Test/More.pir +++ b/runtime/parrot/library/Test/More.pir @@ -990,6 +990,51 @@ Records a passing test if the PMC passed in is null, fails otherwise. done: .end +=item C Takes PIR code in C and an optional message in C. diff --git a/t/pmc/namespace.t b/t/pmc/namespace.t index 258e2adc15..853e77ec64 100644 --- a/t/pmc/namespace.t +++ b/t/pmc/namespace.t @@ -51,11 +51,13 @@ Although NameSpace.'export_to'() is used in test_more.pir. =cut +.include 'except_types.pasm' + .namespace [] .sub main :main .include 'test_more.pir' - plan(75) + plan(76) create_namespace_pmc() verify_namespace_type() @@ -167,6 +169,12 @@ Although NameSpace.'export_to'() is used in test_more.pir. .end +.sub namespace_lookup_invalidkeytype + $P0 = get_root_namespace + $P2 = new ['Boolean'] + $P0[$P2] = $P2 +.end + .sub keyed_namespace_lookup # Tests to verify behavior of TT #1449 $P0 = get_root_namespace @@ -199,6 +207,9 @@ Although NameSpace.'export_to'() is used in test_more.pir. is($I0, 0, "can lookup namespace by string") # TODO: Get the function from this namespace and call it to verify we have # the correct one. + + .const 'Sub' invalidkey = 'namespace_lookup_invalidkeytype' + throws_type(invalidkey, .EXCEPTION_GLOBAL_NOT_FOUND, 'namespace lookup with invalid key') .end # L From 07d9124b23e2e2f05335ee40b638c1eb96aacea7 Mon Sep 17 00:00:00 2001 From: NotFound Date: Tue, 14 Dec 2010 18:17:36 +0100 Subject: [PATCH 099/102] use appropiate exception types in Namespace.export_to method --- src/pmc/namespace.pmc | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/pmc/namespace.pmc b/src/pmc/namespace.pmc index 7819aac64d..adf3ac4958 100644 --- a/src/pmc/namespace.pmc +++ b/src/pmc/namespace.pmc @@ -1064,11 +1064,11 @@ NOTE: exporting 'default' set of items is not yet implemented. STRING * const s_array = CONST_STRING(INTERP, "array"); if (PMC_IS_NULL(dest)) - Parrot_ex_throw_from_c_args(INTERP, NULL, 0, + Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "destination namespace not specified"); if (PMC_IS_NULL(what) || !VTABLE_elements(INTERP, what)) - Parrot_ex_throw_from_c_args(INTERP, NULL, 0, + Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED, "exporting default object set not yet implemented"); /* if "what" does "hash", we extract string key/value pairs, @@ -1085,7 +1085,7 @@ NOTE: exporting 'default' set of items is not yet implemented. STRING * const src_name = VTABLE_shift_string(INTERP, iter); if (STRING_IS_NULL(src_name) || STRING_IS_EMPTY(src_name)) - Parrot_ex_throw_from_c_args(INTERP, NULL, 0, + Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "source object name not specified"); if (PMC_IS_NULL(VTABLE_get_pmc_keyed_str(INTERP, what, src_name))) { @@ -1100,7 +1100,7 @@ NOTE: exporting 'default' set of items is not yet implemented. object = VTABLE_get_pmc_keyed_str(INTERP, SELF, src_name); if (PMC_IS_NULL(object)) - Parrot_ex_throw_from_c_args(INTERP, NULL, 0, + Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_GLOBAL_NOT_FOUND, "object '%Ss' not found in current namespace", src_name); VTABLE_set_pmc_keyed_str(INTERP, dest, dest_name, object); @@ -1115,20 +1115,20 @@ NOTE: exporting 'default' set of items is not yet implemented. STRING * const name = VTABLE_get_string_keyed_int(INTERP, what, i); if (STRING_IS_NULL(name) || STRING_IS_EMPTY(name)) - Parrot_ex_throw_from_c_args(INTERP, NULL, 0, + Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "object name not specified"); object = VTABLE_get_pmc_keyed_str(INTERP, SELF, name); if (PMC_IS_NULL(object)) - Parrot_ex_throw_from_c_args(INTERP, NULL, 0, + Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_GLOBAL_NOT_FOUND, "object '%Ss' not found in current namespace", name); VTABLE_set_pmc_keyed_str(INTERP, dest, name, object); } } else - Parrot_ex_throw_from_c_args(INTERP, NULL, 0, + Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION, "can't handle argument of type %Ss", what->vtable->whoami); } From 33a5288719cf7b32d61eecdd73a194b64d5a7198 Mon Sep 17 00:00:00 2001 From: NotFound Date: Tue, 14 Dec 2010 18:18:59 +0100 Subject: [PATCH 100/102] more tests for Namespace methods --- t/pmc/namespace.t | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/t/pmc/namespace.t b/t/pmc/namespace.t index 853e77ec64..38daf53ffc 100644 --- a/t/pmc/namespace.t +++ b/t/pmc/namespace.t @@ -57,7 +57,7 @@ Although NameSpace.'export_to'() is used in test_more.pir. .sub main :main .include 'test_more.pir' - plan(76) + plan(78) create_namespace_pmc() verify_namespace_type() @@ -153,6 +153,10 @@ Although NameSpace.'export_to'() is used in test_more.pir. $I0 = isnull $P1 is($I0, 0, "get_class on a NameSpace returns something") + $P9 = $P0.'get_class'() + $I0 = issame $P9, $P1 + ok($I0, "Namespace get_class method gives same result as get_class op") + # Create object from class from NameSpace push_eh eh $P2 = new $P1 @@ -593,6 +597,15 @@ CODE # Test del_var. It will delete any type of thing .end +.sub export_empty_name_in_hash + .local pmc nsa, nsb, h + nsa = get_namespace + nsb = get_namespace ['Foo'] + h = new ['Hash'] + h[''] = 'foo' + nsb.'export_to'(nsa, h) +.end + .sub 'export_to_method' .local string errormsg, description @@ -664,8 +677,12 @@ CODE nsb = get_namespace ['Foo'] nsb.'export_to'(nsa, ar) .end + CODE + .const 'Sub' empty_name_hash = 'export_empty_name_in_hash' + throws_type(empty_name_hash, .EXCEPTION_INVALID_OPERATION, 'export from hash with empty key') + # Things to add: successful export_to with non-empty array, successful # export_to with non-empty hash. both of these things across HLL boundaries From b9e4e7303f7cae984ba3b37069afefe7a51196ff Mon Sep 17 00:00:00 2001 From: NotFound Date: Tue, 14 Dec 2010 18:29:16 +0100 Subject: [PATCH 101/102] fix typos from 07df1ca --- runtime/parrot/library/Test/More.pir | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/runtime/parrot/library/Test/More.pir b/runtime/parrot/library/Test/More.pir index 805bbdbbbb..133467c0bc 100644 --- a/runtime/parrot/library/Test/More.pir +++ b/runtime/parrot/library/Test/More.pir @@ -990,7 +990,7 @@ Records a passing test if the PMC passed in is null, fails otherwise. done: .end -=item C Recores a passing test if calling the invokable throws an exception of the expected type, fails otherwise. @@ -1001,7 +1001,7 @@ expected type, fails otherwise. .param pmc invokable .param int type .param string description :optional - + .local pmc test, ex .local string msg, exmsg .local int extype From aaf01d1530a8ba20440b6a1e57dbfe4e87ab80ac Mon Sep 17 00:00:00 2001 From: Peter Lobsinger Date: Tue, 14 Dec 2010 13:18:15 -0500 Subject: [PATCH 102/102] add Complex PMC deprecation --- DEPRECATED.pod | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/DEPRECATED.pod b/DEPRECATED.pod index f8faabdace..82383e5d00 100644 --- a/DEPRECATED.pod +++ b/DEPRECATED.pod @@ -130,6 +130,12 @@ Used to test the experimental function Parrot_getpid L +=item Complex PMC [eligible in 3.1] + +This perennially broken PMC will be removed. + +L + =back =head1 Opcodes