[svn:parrot] r43582 - in branches/one_make: . lib/Parrot tools/build
jkeenan at svn.parrot.org
jkeenan at svn.parrot.org
Sun Jan 24 17:28:59 UTC 2010
Author: jkeenan
Date: Sun Jan 24 17:28:58 2010
New Revision: 43582
URL: https://trac.parrot.org/parrot/changeset/43582
Log:
Extract subroutines from h2inc.pl and place them in lib/Parrot/H2inc.pm. This makes them potentially reusable and/or testable.
Added:
branches/one_make/lib/Parrot/H2inc.pm (contents, props changed)
- copied, changed from r43581, branches/one_make/lib/Parrot/SearchOps.pm
Modified:
branches/one_make/MANIFEST
branches/one_make/tools/build/h2inc.pl
Modified: branches/one_make/MANIFEST
==============================================================================
--- branches/one_make/MANIFEST Sun Jan 24 15:39:48 2010 (r43581)
+++ branches/one_make/MANIFEST Sun Jan 24 17:28:58 2010 (r43582)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Sat Jan 23 04:05:44 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sun Jan 24 16:40:36 2010 UT
#
# See below for documentation on the format of this file.
#
@@ -1126,6 +1126,7 @@
lib/Parrot/Docs/Section/Tests.pm [devel]lib
lib/Parrot/Docs/Section/Tools.pm [devel]lib
lib/Parrot/Docs/Text2HTML.pm [devel]lib
+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
Copied and modified: branches/one_make/lib/Parrot/H2inc.pm (from r43581, branches/one_make/lib/Parrot/SearchOps.pm)
==============================================================================
--- branches/one_make/lib/Parrot/SearchOps.pm Sun Jan 24 15:39:48 2010 (r43581, copy source)
+++ branches/one_make/lib/Parrot/H2inc.pm Sun Jan 24 17:28:58 2010 (r43582)
@@ -1,224 +1,353 @@
-package Parrot::SearchOps;
-# Copyright (C) 2008, Parrot Foundation.
+package Parrot::H2inc;
+# Copyright (C) 2010, Parrot Foundation.
# $Id$
use strict;
-use warnings;
-
use Exporter;
-use Text::Wrap;
-use lib qw( ./lib );
-use Parrot::Configure::Utils qw( _slurp );
our @ISA = qw( Exporter );
our @EXPORT_OK = qw(
- search_all_ops_files
- help
- usage
+ parse_file
+ perform_directive
+ generate_text
+ print_generated_file
);
-sub search_all_ops_files {
- my ($pattern, $wrap_width, $opsdir) = @_;
- $Text::Wrap::columns = $wrap_width;
- my @opsfiles = glob("$opsdir/*.ops");
-
- my $total_identified = 0;
- foreach my $f (@opsfiles) {
- $total_identified = _search_one_ops_file(
- $pattern, $wrap_width, $total_identified, $f,
- );
- }
- return $total_identified;
-}
+=head1 NAME
-sub _search_one_ops_file {
- my ($pattern, $wrap_width, $total_identified, $f) = @_;
- my $fullpattern = qr/^=item\sB<(\w*$pattern\w*)>\(([^)]*)\)/;
- my @paras = split /\n{2,}/, _slurp($f);
- my %iden_paras = ();
- for (my $i=0; $i<=$#paras; $i++) {
- my $j = $i+1;
- if ( $paras[$i] =~ /$fullpattern/ and $paras[$j]) {
- $iden_paras{$i}{op} = $1;
- $iden_paras{$i}{args} = $2;
- }
- }
- if (keys %iden_paras) {
- my @keys = keys %iden_paras;
- my $seen = scalar @keys;
- $total_identified += $seen;
- _print_name(\@paras, $wrap_width, $seen);
- my @sorted_idx = sort {$a <=> $b} @keys;
- my %remain_paras = map {$_, 1} @keys;
- foreach my $idx (@sorted_idx) {
- if ($remain_paras{$idx}) {
- my $k = _handle_indices(
- \%iden_paras,
- $idx,
- \%remain_paras,
- );
- print fill('', '', ($paras[$k])), "\n\n";
+Parrot::H2inc - Subroutines used in F<tools/build/h2inc.pl>
+
+=head1 DESCRIPTION
+
+This package exports on demand only four subroutines used in
+F<tools/build/h2inc.pl>.
+
+=head1 SUBROUTINES
+
+=head2 C<parse_file()>
+
+=over 4
+
+=item * Arguments
+
+ $directive = parse_file($in_file, $out_file);
+
+List of 2 elements: string holding name of incoming file; string holding name of outgoing file.
+
+=item * Return Value
+
+If successful, returns a hash reference.
+
+=back
+
+=cut
+
+sub parse_file {
+ my ( $in_file, $out_file) = @_;
+
+ my ( @directives, %values, $last_val, $cur, $or_continues );
+ open my $fh, '<', $in_file or die "Can't open $in_file: $!\n";
+ while ( my $line = <$fh> ) {
+ if (
+ $line =~ m!
+ &gen_from_(enum|def) \( ( [^)]* ) \)
+ (?: \s+ prefix \( (\w+) \) )?
+ (?: \s+ subst \( (s/.*?/.*?/[eig]?) \) )?
+ !x
+ )
+ {
+ $cur and die "Missing '&end_gen' in $in_file\n";
+ my $file;
+ foreach (split ' ', $2) {
+ $file = $_ if $out_file =~ /$_$/;
}
+ $cur = {
+ type => $1,
+ file => $file,
+ prefix => defined $3 ? $3 : '',
+ defined $4 ? ( subst => $4 ) : (),
+ };
+ $last_val = -1;
+ }
+ elsif ( $line =~ /&end_gen\b/ ) {
+ $cur or die "Missing &gen_from_(enum|def) in $in_file\n";
+ return $cur if defined $cur->{file};
+ $cur = undef;
}
- }
- return $total_identified;
-}
-sub _print_name {
- my $parasref = shift;
- my $wrap_width = shift;
- my $count = shift;
- NAME: for (my $i=0; $i<=$#$parasref; $i++) {
- my $j = $i+1;
- if ($parasref->[$i] =~ /^=head1\s+NAME/ and $parasref->[$j]) {
- my $str = qq{\n};
- $str .= q{-} x $wrap_width . qq{\n};
- $str .= $parasref->[$j] .
- q< (> .
- $count .
- q< > .
- ($count > 1 ? q<matches> : q<match>) .
- qq<)\n>;
- $str .= q{-} x $wrap_width . qq{\n};
- $str .= qq{\n};
- print $str;
- last NAME;
+ $cur or next;
+
+ if ( $cur->{type} eq 'def' && $line =~ /^\s*#define\s+(\w+)\s+(-?\w+|"[^"]*")/ ) {
+ push @{ $cur->{defs} }, [ $1, $2 ];
+ }
+ elsif ( $cur->{type} eq 'enum' ) {
+ # Special case: enum value is or'd combination of other values
+ if ( $or_continues ) {
+ $or_continues = 0;
+ my $last_def = $cur->{defs}->[-1];
+ my ($k, $v) = @{$last_def};
+ my @or_values = grep {defined $_} $line =~ /^\s*(-?\w+)(?:\s*\|\s*(-?\w+))*/;
+ for my $or (@or_values) {
+ if ( defined $values{$or} ) {
+ $v |= $values{$or};
+ }
+ elsif ( $or =~ /^0/ ) {
+ $v |= oct $or;
+ }
+ }
+ if ($line =~ /\|\s*$/) {
+ $or_continues = 1;
+ }
+ $values{$k} = $last_val = $v;
+ $cur->{defs}->[-1]->[1] = $v;
+ }
+ elsif ( $line =~ /^\s*(\w+)\s*=\s*(-?\w+)\s*\|/ ) {
+ my ( $k, $v ) = ( $1, $2 );
+ my @or_values = ($v, $line =~ /\|\s*(-?\w+)/g);
+ $v = 0;
+ for my $or (@or_values) {
+ if ( defined $values{$or} ) {
+ $v |= $values{$or};
+ }
+ elsif ( $or =~ /^0/ ) {
+ $v |= oct $or;
+ }
+ }
+ if ($line =~ /\|\s*$/) {
+ $or_continues = 1;
+ }
+ $values{$k} = $last_val = $v;
+ push @{ $cur->{defs} }, [ $k, $v ];
+ }
+ elsif ( $line =~ /^\s*(\w+)\s*=\s*(-?\w+)/ ) {
+ my ( $k, $v ) = ( $1, $2 );
+ if ( defined $values{$v} ) {
+ $v = $values{$v};
+ }
+ elsif ( $v =~ /^0/ ) {
+ $v = oct $v;
+ }
+ $values{$k} = $last_val = $v;
+ push @{ $cur->{defs} }, [ $k, $v ];
+ }
+ elsif ( $line =~ m!^\s*(\w+)\s*(?:,\s*)?(?:/\*|$)! ) {
+ my $k = $1;
+ my $v = $values{$k} = ++$last_val;
+ push @{ $cur->{defs} }, [ $k, $v ];
+ }
}
}
+ $cur and die "Missing '&end_gen' in $in_file\n";
+ close $fh or die "Could not close handle to $in_file after reading: $!";
+
+ return;
}
-sub _handle_indices {
- my ($identified_ref, $idx, $remaining_ref) = @_;
- my $j = $idx + 1;
- my $k = $j;
- print qq{$identified_ref->{$idx}{op}($identified_ref->{$idx}{args})\n};
- delete $remaining_ref->{$idx};
- if (defined $identified_ref->{$j}{op} ) {
- $k = _handle_indices(
- $identified_ref,
- $j,
- $remaining_ref,
- );
+=head2 C<perform_directive()>
+
+=over 4
+
+=item * Arguments
+
+ $defs_ref = perform_directive($directive);
+
+Single hash reference (which is the return value from a successful run of
+C<parse_file()>.
+
+=item * Return Value
+
+Array reference.
+
+=back
+
+=cut
+
+sub perform_directive {
+ my ($d) = @_;
+
+ my @defs = prepend_prefix( $d->{prefix}, @{ $d->{defs} } );
+ if ( my $subst = $d->{subst} ) {
+ @defs = transform_name( sub { local $_ = shift; eval $subst; $_ }, @defs );
}
- return $k;
+ return \@defs;
}
-sub usage {
- print <<USAGE;
- perl tools/dev/search-ops.pl [--help] [--all] ops_pattern
-USAGE
-}
+=head2 C<const_to_parrot()>
-sub help {
- usage();
- print <<HELP;
+=over 4
-Given a valid Perl 5 regex as an argument, the script will search inside any
-*.ops file for an opcode name that matches, dumping both its arguments and its
-description. The program must be called from the top-level Parrot directory.
-To dump every op, call '--all' on the command line.
+=item * Arguments
-Example:
-> perl tools/dev/search-ops.pl load
+ $gen = join "\n", const_to_parrot(@defs);
-----------------------------------------------------------------------
-File: core.ops - Parrot Core Ops (2 matches)
-----------------------------------------------------------------------
+List.
-load_bytecode(in STR)
-Load Parrot bytecode from file \$1, and (TODO) search the library path,
-to locate the file.
+=item * Return Value
-loadlib(out PMC, in STR)
-Load a dynamic link library named \$2 and store it in \$1.
+String.
-----------------------------------------------------------------------
-File: debug.ops (1 match)
-----------------------------------------------------------------------
+=back
-debug_load(inconst STR)
-Load a Parrot source file for the current program.
-HELP
+=cut
+
+sub const_to_parrot {
+
+ my $keylen = (sort { $a <=> $b } map { length($_->[0]) } @_ )[-1] ;
+ my $vallen = (sort { $a <=> $b } map { length($_->[1]) } @_ )[-1] ;
+
+ map {sprintf ".macro_const %-${keylen}s %${vallen}s", $_->[0], $_->[1]} @_;
}
-1;
+=head2 C<const_to_perl()>
-=head1 NAME
+=over 4
-Parrot::SearchOps - functions used in tools/dev/search-ops.pl
+=item * Arguments
-=head1 SYNOPSIS
+ $gen = join "\n", const_to_perl(@defs);
- use Parrot::SearchOps qw(
- search_all_ops_files
- usage
- help
- );
+List.
- $total_identified = search_all_ops_files(
- $pattern, $wrap_width, $opsdir
- );
+=item * Return Value
- usage();
+String.
- help();
+=back
-=head1 DESCRIPTION
+=cut
-This package provides functionality for the Perl 5 program
-F<tools/dev/search-ops.pl>, designed to replace the Python program
-F<tools/docs/search-ops.py>. It exports two subroutines on demand.
+sub const_to_perl {
-=head2 C<search_all_ops_files()>
+ my $keylen = (sort { $a <=> $b } map { length($_->[0]) } @_ )[-1] ;
-B<Purpose:> Searches all F<.ops> files in F<src/ops/> for ops codes and their
-descriptions. Those that match the specified pattern are printed to STDOUT.
+ map {sprintf "use constant %-${keylen}s => %s;", $_->[0], $_->[1]} @_;
+}
-B<Arguments:> Three scalars.
+=head2 C<transform_name()>
=over 4
-=item * C<$pattern>
+=item * Arguments
+
+ transform_name( sub { $prefix . $_[0] }, @_ );
+
+List of two or more elements, the first element of which is a subroutine
+reference.
+
+=item * Return Value
+
+List which is a mapping of the transformations executed by the first argument
+upon the remaining arguments.
+
+=back
+
+=cut
+
+sub transform_name {
+ my $action = shift;
+
+ return map { [ $action->( $_->[0] ), $_->[1] ] } @_;
+}
+
+=head2 C<prepend_prefix()>
+
+=over 4
-Perl 5 regular expression. So C<concat> will be matched by both C<concat> and
-C<n_concat>.
+=item * Arguments
-=item * $wrap_width
+ @defs = prepend_prefix $d->{prefix}, @{ $d->{defs} };
-In F<tools/dev/search-ops.pl>, this is set to C<70> characters. Can be varied
-during testing or development.
+List of two or more elements, the first element of which is a string.
-=item * $opsdir
+=item * Return Value
-In F<tools/dev/search-ops.pl>, this is set to F<src/ops/>. Can be varied
-during testing or development.
+List.
=back
-B<Return Value:> Number of times the pattern was matched by ops codes in all
-files.
+=cut
+
+sub prepend_prefix {
+ my $prefix = shift;
+
+ transform_name( sub { $prefix . $_[0] }, @_ );
+}
+
+=head2 C<generate_text()>
+
+=over 4
+
+=item * Argument
+
+ $generated_text = generate_text($directive, \@defs);
+
+List of two arguments: Directive hashref; reference to array of definitions.
+
+=item * Return Value
+
+String holding main text to be printed to new file.
-=head2 C<usage()>
+=back
+
+=cut
-B<Purpose:> Display usage statement for F<tools/dev/search-ops.pl>.
+sub generate_text {
+ my ($directive, $defs_ref) = @_;
-B<Arguments:> None.
+ my $target = $directive->{file};
+ my $generated_text;
+ if ($target =~ /\.pm$/) {
+ $generated_text = join "\n", const_to_perl(@{ $defs_ref });
+ $generated_text .= "\n1;";
+ }
+ else {
+ $generated_text = join "\n", const_to_parrot(@{ $defs_ref });
+ }
+ return $generated_text;
+}
-C<Return Value:> Implicitly returns true upon success.
+=head2 C<print_generated_file()>
-=head2 C<help()>
+=over 4
-B<Purpose:> Display usage statement and more complete help message for F<tools/dev/search-ops.pl>.
+=item * Argument
-B<Arguments:> None.
+ print_generated_file( {
+ in => $in_file,
+ out => $out_file,
+ script => $0,
+ gen => $generated_text,
+ } );
+
+Hash reference. Elements pertain to file being read, file being created,
+calling program (typically, F<tools/build/h2inc.pl>) and string of text to be
+printed to file.
-C<Return Value:> Implicitly returns true upon success.
+=item * Return Value
-=head1 AUTHOR
+Implicitly returns true upon success.
-James E Keenan, adapting Python program written by Bernhard Schmalhofer.
+=back
=cut
+sub print_generated_file {
+ my $args = shift;
+ open my $out_fh, '>', $args->{out} or die "Can't open $args->{out}: $!\n";
+ print $out_fh <<"EOF";
+# DO NOT EDIT THIS FILE.
+#
+# This file is generated automatically from
+# $args->{in} by $args->{script}
+#
+# Any changes made here will be lost.
+#
+$args->{gen}
+EOF
+ close $out_fh;
+}
+
+1;
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
Modified: branches/one_make/tools/build/h2inc.pl
==============================================================================
--- branches/one_make/tools/build/h2inc.pl Sun Jan 24 15:39:48 2010 (r43581)
+++ branches/one_make/tools/build/h2inc.pl Sun Jan 24 17:28:58 2010 (r43582)
@@ -9,10 +9,23 @@
Generate C<.pasm> and C<.pm> files with constants based on C<.h> files.
+Invoked by F<make>. Imports functions from Parrot::H2inc.
+
+=head1 USAGE
+
+ perl tools/build/h2inc.pl <input_file> <output_file>
+
=cut
use strict;
use warnings;
+use lib qw( lib );
+use Parrot::H2inc qw(
+ parse_file
+ perform_directive
+ generate_text
+ print_generated_file
+);
my $usage = "Usage: $0 <input_file> <output_file>\n";
@@ -33,332 +46,6 @@
gen => $generated_text,
} );
-=head1 SUBROUTINES
-
-=head2 C<parse_file()>
-
-=over 4
-
-=item * Arguments
-
- $directive = parse_file($in_file, $out_file);
-
-List of 2 elements: string holding name of incoming file; string holding name of outgoing file.
-
-=item * Return Value
-
-If successful, returns a hash reference.
-
-=back
-
-=cut
-
-sub parse_file {
- my ( $in_file, $out_file) = @_;
-
- my ( @directives, %values, $last_val, $cur, $or_continues );
- open my $fh, '<', $in_file or die "Can't open $in_file: $!\n";
- while ( my $line = <$fh> ) {
- if (
- $line =~ m!
- &gen_from_(enum|def) \( ( [^)]* ) \)
- (?: \s+ prefix \( (\w+) \) )?
- (?: \s+ subst \( (s/.*?/.*?/[eig]?) \) )?
- !x
- )
- {
- $cur and die "Missing '&end_gen' in $in_file\n";
- my $file;
- foreach (split ' ', $2) {
- $file = $_ if $out_file =~ /$_$/;
- }
- $cur = {
- type => $1,
- file => $file,
- prefix => defined $3 ? $3 : '',
- defined $4 ? ( subst => $4 ) : (),
- };
- $last_val = -1;
- }
- elsif ( $line =~ /&end_gen\b/ ) {
- $cur or die "Missing &gen_from_(enum|def) in $in_file\n";
- return $cur if defined $cur->{file};
- $cur = undef;
- }
-
- $cur or next;
-
- if ( $cur->{type} eq 'def' && $line =~ /^\s*#define\s+(\w+)\s+(-?\w+|"[^"]*")/ ) {
- push @{ $cur->{defs} }, [ $1, $2 ];
- }
- elsif ( $cur->{type} eq 'enum' ) {
- # Special case: enum value is or'd combination of other values
- if ( $or_continues ) {
- $or_continues = 0;
- my $last_def = $cur->{defs}->[-1];
- my ($k, $v) = @{$last_def};
- my @or_values = grep {defined $_} $line =~ /^\s*(-?\w+)(?:\s*\|\s*(-?\w+))*/;
- for my $or (@or_values) {
- if ( defined $values{$or} ) {
- $v |= $values{$or};
- }
- elsif ( $or =~ /^0/ ) {
- $v |= oct $or;
- }
- }
- if ($line =~ /\|\s*$/) {
- $or_continues = 1;
- }
- $values{$k} = $last_val = $v;
- $cur->{defs}->[-1]->[1] = $v;
- }
- elsif ( $line =~ /^\s*(\w+)\s*=\s*(-?\w+)\s*\|/ ) {
- my ( $k, $v ) = ( $1, $2 );
- my @or_values = ($v, $line =~ /\|\s*(-?\w+)/g);
- $v = 0;
- for my $or (@or_values) {
- if ( defined $values{$or} ) {
- $v |= $values{$or};
- }
- elsif ( $or =~ /^0/ ) {
- $v |= oct $or;
- }
- }
- if ($line =~ /\|\s*$/) {
- $or_continues = 1;
- }
- $values{$k} = $last_val = $v;
- push @{ $cur->{defs} }, [ $k, $v ];
- }
- elsif ( $line =~ /^\s*(\w+)\s*=\s*(-?\w+)/ ) {
- my ( $k, $v ) = ( $1, $2 );
- if ( defined $values{$v} ) {
- $v = $values{$v};
- }
- elsif ( $v =~ /^0/ ) {
- $v = oct $v;
- }
- $values{$k} = $last_val = $v;
- push @{ $cur->{defs} }, [ $k, $v ];
- }
- elsif ( $line =~ m!^\s*(\w+)\s*(?:,\s*)?(?:/\*|$)! ) {
- my $k = $1;
- my $v = $values{$k} = ++$last_val;
- push @{ $cur->{defs} }, [ $k, $v ];
- }
- }
- }
- $cur and die "Missing '&end_gen' in $in_file\n";
- close $fh or die "Could not close handle to $in_file after reading: $!";
-
- return;
-}
-
-=head2 C<perform_directive()>
-
-=over 4
-
-=item * Arguments
-
- $defs_ref = perform_directive($directive);
-
-Single hash reference (which is the return value from a successful run of
-C<parse_file()>.
-
-=item * Return Value
-
-Array reference.
-
-=back
-
-=cut
-
-sub perform_directive {
- my ($d) = @_;
-
- my @defs = prepend_prefix( $d->{prefix}, @{ $d->{defs} } );
- if ( my $subst = $d->{subst} ) {
- @defs = transform_name( sub { local $_ = shift; eval $subst; $_ }, @defs );
- }
- return \@defs;
-}
-
-=head2 C<const_to_parrot()>
-
-=over 4
-
-=item * Arguments
-
- $gen = join "\n", const_to_parrot(@defs);
-
-List.
-
-=item * Return Value
-
-String.
-
-=back
-
-=cut
-
-sub const_to_parrot {
-
- my $keylen = (sort { $a <=> $b } map { length($_->[0]) } @_ )[-1] ;
- my $vallen = (sort { $a <=> $b } map { length($_->[1]) } @_ )[-1] ;
-
- map {sprintf ".macro_const %-${keylen}s %${vallen}s", $_->[0], $_->[1]} @_;
-}
-
-=head2 C<const_to_perl()>
-
-=over 4
-
-=item * Arguments
-
- $gen = join "\n", const_to_perl(@defs);
-
-List.
-
-=item * Return Value
-
-String.
-
-=back
-
-=cut
-
-sub const_to_perl {
-
- my $keylen = (sort { $a <=> $b } map { length($_->[0]) } @_ )[-1] ;
-
- map {sprintf "use constant %-${keylen}s => %s;", $_->[0], $_->[1]} @_;
-}
-
-=head2 C<transform_name()>
-
-=over 4
-
-=item * Arguments
-
- transform_name( sub { $prefix . $_[0] }, @_ );
-
-List of two or more elements, the first element of which is a subroutine
-reference.
-
-=item * Return Value
-
-List which is a mapping of the transformations executed by the first argument
-upon the remaining arguments.
-
-=back
-
-=cut
-
-sub transform_name {
- my $action = shift;
-
- return map { [ $action->( $_->[0] ), $_->[1] ] } @_;
-}
-
-=head2 C<prepend_prefix()>
-
-=over 4
-
-=item * Arguments
-
- @defs = prepend_prefix $d->{prefix}, @{ $d->{defs} };
-
-List of two or more elements, the first element of which is a string.
-
-=item * Return Value
-
-List.
-
-=back
-
-=cut
-
-sub prepend_prefix {
- my $prefix = shift;
-
- transform_name( sub { $prefix . $_[0] }, @_ );
-}
-
-=head2 C<generate_text()>
-
-=over 4
-
-=item * Argument
-
- $generated_text = generate_text($directive, \@defs);
-
-List of two arguments: Directive hashref; reference to array of definitions.
-
-=item * Return Value
-
-String holding main text to be printed to new file.
-
-=back
-
-=cut
-
-sub generate_text {
- my ($directive, $defs_ref) = @_;
-
- my $target = $directive->{file};
- my $generated_text;
- if ($target =~ /\.pm$/) {
- $generated_text = join "\n", const_to_perl(@{ $defs_ref });
- $generated_text .= "\n1;";
- }
- else {
- $generated_text = join "\n", const_to_parrot(@{ $defs_ref });
- }
- return $generated_text;
-}
-
-=head2 C<print_generated_file()>
-
-=over 4
-
-=item * Argument
-
- print_generated_file( {
- in => $in_file,
- out => $out_file,
- script => $0,
- gen => $generated_text,
- } );
-
-Hash reference. Elements pertain to file being read, file being created,
-calling program (typically, F<tools/build/h2inc.pl>) and string of text to be
-printed to file.
-
-=item * Return Value
-
-Implicitly returns true upon success.
-
-=back
-
-=cut
-
-sub print_generated_file {
- my $args = shift;
- open my $out_fh, '>', $args->{out} or die "Can't open $args->{out}: $!\n";
- print $out_fh <<"EOF";
-# DO NOT EDIT THIS FILE.
-#
-# This file is generated automatically from
-# $args->{in} by $args->{script}
-#
-# Any changes made here will be lost.
-#
-$args->{gen}
-EOF
- close $out_fh;
-}
-
-1;
# Local Variables:
# mode: cperl
More information about the parrot-commits
mailing list