diff --git a/.appveyor.yml b/.appveyor.yml index 40051fc..e9463cb 100755 --- a/.appveyor.yml +++ b/.appveyor.yml @@ -11,10 +11,17 @@ image: # === Basics === -# no install; it's platform-specific +# no install here; it's platform-specific build_script: + # Grab the latest Data::Hopen + - svn export --force https://github.com/hopenbuild/Data-Hopen/trunk/lib + # Thanks to https://stackoverflow.com/a/39317180/2877364 + + # Grab the rest of the dependencies - cpanm --installdeps --notest --verbose . + + # Build it - perl Makefile.PL - cmd: gmake - sh: make @@ -73,3 +80,4 @@ for: # Then, install cpanminus locally so it will be cached. - which cpanm || (curl -L https://cpanmin.us | perl - App::cpanminus) + diff --git a/Changes b/Changes index 0f648c9..680582c 100644 --- a/Changes +++ b/Changes @@ -1,17 +1,20 @@ Revision history for App-hopen -0.000009 2019-??-?? - Split former Build-Hopen into App-hopen and Data-Hopen +0.000010 2019-05-26 + First non-trial release. + Major internal changes. Finished removing Data-Hopen leftovers. -0.000008 2019-02-09 - Tweak File::Glob usage to support Perl 5.14 +0.000009 2019-02-24 (TRIAL RELEASE) + Split former Build-Hopen into App-hopen and Data-Hopen -0.000007 2019-02-08 - First version that can generate a Makefile +0.000008 2019-02-09 (TRIAL RELEASE) + Tweak File::Glob usage to support Perl 5.14 -0.000006 2019-02-06 - Substantially expanded +0.000007 2019-02-08 (TRIAL RELEASE) + First version that can generate a Makefile -0.000003 2018-01-02 - First full trial release +0.000006 2019-02-06 (TRIAL RELEASE) + Substantially expanded +0.000003 2018-01-02 (TRIAL RELEASE) + First full trial release diff --git a/MANIFEST b/MANIFEST index 2f08711..c08d538 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2,11 +2,16 @@ bin/hopen Changes lib/App/hopen.pm lib/App/hopen/AppUtil.pm +lib/App/hopen/Asset.pm lib/App/hopen/BuildSystemGlobals.pm lib/App/hopen/Conventions.pod -lib/App/hopen/G/FilesOp.pm +lib/App/hopen/G/AssetOp.pm +lib/App/hopen/G/Cmd.pm +lib/App/hopen/G/FilesCmd.pm lib/App/hopen/Gen.pm lib/App/hopen/Gen/Make.pm +lib/App/hopen/Gen/Make/AssetGraphNode.pm +lib/App/hopen/Gen/Make/AssetGraphVisitor.pm lib/App/hopen/H.pm lib/App/hopen/HopenFileKit.pm lib/App/hopen/Phase.pod @@ -15,6 +20,8 @@ lib/App/hopen/Phase/Gen.pm lib/App/hopen/Phases.pm lib/App/hopen/T/Gnu.pm lib/App/hopen/T/Gnu/C.pm +lib/App/hopen/T/Gnu/C/CompileCmd.pm +lib/App/hopen/T/Gnu/C/LinkCmd.pm lib/App/hopen/Tool.pm lib/App/hopen/Toolchain.pm lib/App/hopen/Util/BasedPath.pm @@ -25,22 +32,13 @@ MANIFEST.SKIP README Autogenerated README.md Autogenerated support/readme.pl -t/00-load.t -t/001-entity.t -t/002-link.t -t/003-node.t -t/004-goal.t +t/00-load-ah.t t/005-op.t t/006-collect-op.t -t/007-hnew.t -t/008-nameset.t -t/009-hopen-constants.t -t/010-scope-hash.t -t/011-scope-env.t -t/012-scope-nested.t t/020-dag.t -t/021-dag-single-goal.t t/030-util-basedpath.t +t/040-ah-g-assetop.t +t/100-h.t t/200-apputil-basic.t t/dir200/inner.hopen.pl t/dir200/inner/.hopen.pl diff --git a/Makefile.PL b/Makefile.PL index 3556418..d2b6ce2 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,5 +1,5 @@ #!perl -# Makefile.PL for Build::Hopen +# Makefile.PL for App::hopen use 5.014; use strict; use warnings; @@ -9,6 +9,8 @@ use File::Spec; my $VERSION_FROM = File::Spec->catfile(qw(lib App hopen.pm)); my $IS_TRIAL = check_trial(); +my $secure_perl_path = get_perl_filename(); +my @provides = (); # Check if this is a TRIAL version {{{1 sub check_trial { @@ -26,16 +28,18 @@ sub check_trial { } return 0; } #check_trial() + # }}}1 # Module metadata {{{1 -my $provides; eval { require Module::Metadata; - $provides = Module::Metadata->provides(version => '2', dir => 'lib'); + @provides = + (provides => Module::Metadata->provides(version => '2', dir => 'lib')); # Thanks to https://stackoverflow.com/a/28928985/2877364 by LEONT + # for suggesting Module::Metadata. }; -# }}}1 +# }}}1 # Get the filename of the Perl interpreter running this. {{{1 # Modified from perlvar. # The -x test is for cygwin or other systems where $Config{perlpath} has no @@ -49,10 +53,9 @@ sub get_perl_filename { ($secure_perl_path =~ m/$Config{_exe}$/i); } return $secure_perl_path; -} # get_perl_filename() }}}1 - -my $secure_perl_path = get_perl_filename(); +} # get_perl_filename() +# }}}1 # Makefile customization (MY) {{{1 { package MY; @@ -103,7 +106,7 @@ testhere: # Run the tests from lib rather than blib \tprove -lj4 README.md: @{[$VERSION_FROM]} Makefile.PL $make_readme_md -\t"$secure_perl_path" "$make_readme_md" -i "\$<" -o "\$@" -f md +\t"$secure_perl_path" "$make_readme_md" -i "\$<" -o "\$@" -f md --appveyor cxw42/app-hopen --avbadge hopenbuild/app-hopen README: @{[$VERSION_FROM]} Makefile.PL $make_readme_md \t"$secure_perl_path" "$make_readme_md" -i "\$<" -o "\$@" -f text @@ -133,7 +136,9 @@ actually_uninstall_from_vendordirs :: EOT } #postamble() -} #package MY }}}1 +} #package MY + +# }}}1 # Main options for EUMM my %opts = ( @@ -152,13 +157,19 @@ my %opts = ( # - backtracking control verbs (5.010) # - working smartmatch (5.010001) # - stringifying regexes with modifiers (5.014) + # - FH->autoflush without needing IO::Handle (see + # perldoc -f select) (5.014) # In the following, if a specific version is listed, but no explanation # is given, that means we want that version for bugfixes it includes. + # Prereqs commented out with "##" were used at one time but no longer + # appear to be. CONFIGURE_REQUIRES => { 'Config' => '0', 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', + 'strict' => '0', + 'warnings' => '0', }, BUILD_REQUIRES => { 'Getopt::Long' => '0', @@ -173,13 +184,15 @@ my %opts = ( 'rlib' => '0', 'Scalar::Util' => '0', 'Test::Deep' => '0.084', # for superhashof - 'Test::Directory' => '0.02', # for subdirs + ## 'Test::Directory' => '0.02', # for subdirs + 'Test::Exception' => '0', 'Test::More' => '0', # Test::TempDir::Tiny? If so, remove Test::Directory dependency? + 'Test::Warn' => '0.35', # for metadata }, PREREQ_PM => { # Other hopen packages ------------------- - 'Data::Hopen' => '0.000009', + 'Data::Hopen' => '0.000013', # Non-hopen dependencies ----------------- #'Algorithm::Dependency' => '1.106', @@ -195,30 +208,29 @@ my %opts = ( # - Looks like it might be handy. # 0.002+ because that has only core dependencies. - #'Class::Method::Modifiers' => '1.05', # version nums from Antlers - #'Role::Tiny' => '1.000000', + 'Class::Tiny::ConstrainedAccessor' => '0.000010', # custom constraints - 'Class::XPath' => '1.4', + ## 'Class::XPath' => '1.4', 'Config' => '0', 'Cwd' => '0', 'constant' => '0', 'Data::Dumper' => '0', 'Deep::Hash::Utils' => '0.03', # For correct metadata - 'experimental' => '0.009', # For support on perl < 5.15.7 + ## 'experimental' => '0.009', # For support on perl < 5.15.7 'Exporter' => '0', 'feature' => '0', # 'File::Find::Rule' => '0', # - might be nice for finding files 'File::Glob' => '0', #'File::Globstar' => '0.5', # Fewer dependencies 'File::Path::Tiny' => '0.9', + 'File::pushd' => '1.013', 'File::Spec' => '0', 'File::stat' => '0', 'File::Which' => '1.22', # for msys2 support 'Hash::Merge' => '0.299', 'Hash::Ordered' => '0.011', 'Import::Into' => '0', - 'IO::Handle' => '0', 'Getargs::Mixed' => '1.04', # For -undef_ok option 'Getopt::Long' => '2.5', # For long option bugfix 'Graph' => '0.9704', # For latest multiedged support @@ -250,15 +262,22 @@ my %opts = ( # 'Probe::Perl' => '0', # For perl interpreter file location or other info. # Alternative: Padre::Perl + 'Quote::Code' => '1.01', + #'Role::Tiny' => '1.000000', + 'Scalar::Util' => '0', 'Set::Scalar' => '1.27', # For correct metadata - 'Storable' => '3.06', + ## 'Storable' => '3.06', # So it can handle REGEXP - # https://rt.perl.org/Public/Bug/Display.html?id=50608 - 'Sub::ScopeFinalizer' => '0.02', # For correct META.yml + 'String::Print' => '0.92', + ## 'Sub::ScopeFinalizer' => '0.02', # For correct META.yml 'strict' => '0', + 'Type::Tiny' => '1.004004', + + 'vars::i' => '1.06', 'warnings' => '0', }, @@ -267,12 +286,12 @@ my %opts = ( resources => { bugtracker => { - web => 'https://github.com/hopenbuild/Build-Hopen/issues', + web => 'https://github.com/hopenbuild/App-hopen/issues', }, repository => { type => 'git', - url => 'https://github.com/hopenbuild/Build-Hopen.git', - web => 'https://github.com/hopenbuild/Build-Hopen', + url => 'https://github.com/hopenbuild/App-hopen.git', + web => 'https://github.com/hopenbuild/App-hopen', }, }, @@ -285,15 +304,27 @@ my %opts = ( }, }, - $provides ? (provides => $provides) : (), + @provides, }, #META_MERGE dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, - clean => { FILES => 'Build-Hopen-*' }, + clean => { FILES => 'App-hopen-*' }, ); # %opts $opts{META_MERGE}->{release_status} = 'testing' if $IS_TRIAL; +# Some tests run on older versions of EUMM that do not support TEST_REQUIRES. +# This is a workaround, modified from +# https://metacpan.org/source/RJBS/JSON-Typist-0.005/Makefile.PL , +# linked from http://blogs.perl.org/users/neilb/2017/05/specifying-dependencies-for-your-cpan-distribution.html . +# If we are on a version of EUMM that doesn't support TEST_REQUIRES, +# move those dependencies to PREREQ_PM. +unless( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { + $opts{PREREQ_PM}->{$_} = $opts{TEST_REQUIRES}->{$_} + foreach keys %{$opts{TEST_REQUIRES}}; + delete $opts{TEST_REQUIRES}; +} + WriteMakefile(%opts); # vi: set fdm=marker fdl=0: # diff --git a/README b/README index 7564f88..7bc8a65 100644 --- a/README +++ b/README @@ -1,6 +1,9 @@ NAME App::hopen - hopen build system command-line interface + (Note: most features are not yet implemented ;) . However it will + generate a Makefile for a basic "Hello, World" program at this point!) + hopen is a cross-platform software build generator. It makes files you can pass to Make, Ninja, Visual Studio, or other build tools, to compile and link your software. hopen gives you: @@ -26,6 +29,8 @@ USAGE If no destination directory is specified, "/built" is used. + See App::hopen::Conventions for more details. + OPTIONS -a "architecture" Specify the architecture. This is an arbitrary string interpreted by diff --git a/README.md b/README.md index c7089dd..50bb775 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,12 @@ # App::hopen - hopen build system command-line interface +[![Appveyor Badge](https://ci.appveyor.com/api/projects/status/github/hopenbuild/app-hopen?svg=true)](https://ci.appveyor.com/project/cxw42/app-hopen) + +(Note: most features are not yet implemented ;) . However it will generate +a Makefile for a basic `Hello, World` program at this point!) + hopen is a cross-platform software build generator. It makes files you can pass to Make, Ninja, Visual Studio, or other build tools, to compile and link your software. hopen gives you: @@ -25,6 +30,8 @@ If no project directory is specified, the current directory is used. If no destination directory is specified, `/built` is used. +See [App::hopen::Conventions](https://github.com/hopenbuild/App-hopen/blob/master/lib/App/hopen/Conventions.pod) for more details. + # OPTIONS - -a `architecture` diff --git a/lib/App/hopen.pm b/lib/App/hopen.pm index 3242d0d..07c3dd8 100755 --- a/lib/App/hopen.pm +++ b/lib/App/hopen.pm @@ -1,6 +1,6 @@ # App::hopen: Implementation of the hopen(1) program package App::hopen; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; # Imports {{{1 use Data::Hopen::Base; @@ -45,6 +45,9 @@ App::hopen - hopen build system command-line interface =head1 SYNOPSIS +(Note: most features are not yet implemented ;) . However it will generate +a Makefile for a basic C program at this point!) + hopen is a cross-platform software build generator. It makes files you can pass to Make, Ninja, Visual Studio, or other build tools, to compile and link your software. hopen gives you: @@ -80,8 +83,15 @@ If no project directory is specified, the current directory is used. If no destination directory is specified, C<< /built >> is used. +See L for more details. + =head1 INTERNALS +After the C file is processed, cycles are detected and reported as +errors. *(TODO change this to support LaTeX multi-run files?)* Then the DAG +is traversed, and each operation writes the necessary information to the +file being generated. + =cut # }}}1 @@ -102,7 +112,7 @@ my %CMDLINE_OPTS = ( ARCHITECTURE => ['a','|A|architecture|platform=s'], # -A and --platform are for the comfort of folks migrating from CMake - #BUILD => ['build'], # TODO implement this --- if specified, do not + BUILD => ['build'], # If specified, do not # run any phases. Instead, run the # build tool indicated by the generator. @@ -117,6 +127,9 @@ my %CMDLINE_OPTS = ( GENERATOR => ['g', '|G|generator=s', 'Make'], # -G is from CMake # *** This is where the default generator is set *** + # TODO? add an option to pass parameters to the generator? + # E.g., which make(1) to use? Or maybe that should be part of the + # ARCHITECTURE string. #GO => ['go'], # TODO implement this --- if specified, run all phases # and invoke the build tool without requiring the user to @@ -250,6 +263,9 @@ Set to truthy if MY.hopen.pl sets the phase. =cut our $_did_set_phase = false; + # Whether the current hopen file called set_phase() + +my $_hf_pkg_idx = 0; # unique ID for the packages of hopen files sub _execute_hopen_file { # Load and run a single hopen file {{{2 @@ -351,14 +367,14 @@ turned into a C statement (see L) in the generated source. hlog { 'Processing', $fn->{name} }; $file_text = $fn->{text}; $friendly_name = $fn->{name}; - $pkg_name = 'CmdLineE' . $fn->{num}; + $pkg_name = 'CmdLineE' . $fn->{num} . '_' . $_hf_pkg_idx++; $phase_text .= defined($opts{phase}) ? $cannot_set_phase : $set_phase; # -e's can set phase unless --phase was specified } else { hlog { 'Processing', $fn }; $file_text = file($fn)->slurp; - $pkg_name = ($fn =~ s/[^a-zA-Z0-9]/_/gr); + $pkg_name = ($fn =~ s/[^a-zA-Z0-9]/_/gr) . '_' . $_hf_pkg_idx++; $friendly_name = $fn; if( isMYH($fn) and !defined($opts{phase}) ) { @@ -431,7 +447,11 @@ EOT # is defined, make sure it's not a DAG or GraphBuilder. Those should not # be put into the return data. # - # Also, any defined, non-hash + # Also, any defined, non-hash value is ignored, so that we don't + # wind up with lots of hashes like { 1 => 1 }. + # + # If the file_text did expressly return(), whatever it returned will + # be used as-is. Like perlref says, we are not totalitarians. $src .= <empty ? 'empty.' : 'not empty.'), ' Final data is', Dumper($_hrData) } 2; - hlog { Data::Dumper->new([$Build], ['$Build'])->Indent(1)->Dump } 5; + hlog { 'Build graph', '' . $Build->_graph } 5; + hlog { Data::Dumper->new([$Build], ['$Build'])->Indent(1)->Dump } 9; # If there is no build graph, just return the data. This is useful # enough for debugging that I am making it documented behaviour. @@ -543,10 +564,12 @@ be run if it is empty. my $env = Data::Hopen::Scope::Environment->new(name => 'outermost'); my $scope = Data::Hopen::Scope::Hash->new(name => 'from hopen files'); $scope->adopt_hash($_hrData); + $scope->outer($env); # make the environment accessible... + $scope->local(true); # ... but not copied by local-scope calls. # Run the DAG my $result_data = $Build->run(-context => $scope, -phase => $Phase, - -generator => $Generator); + -visitor => $Generator); hlog { Data::Dumper->new([$result_data], ['Build graph result data'])->Indent(1)->Dump } 2; return $result_data; } #_run_phase() }}}2 @@ -558,6 +581,8 @@ sub _inner { # Run a single invocation of hopen(1). {{{2 Do the work for one invocation of hopen(1). Dies on failure. Main() then translates the die() into a print and error return. +The return value of _inner is unspecified and ignored. + =cut my %opts = @_; @@ -569,10 +594,12 @@ translates the die() into a print and error return. } else { say "hopen $VERSION"; } - say "App::hopen in: $INC{'App/hopen.pm'}" if $opts{VERBOSE} >= 1; - return EXIT_OK; + say "App::hopen in: $INC{'App/hopen.pm'}" if $VERBOSE >= 1; + return; } + # = Initialize filesystem-related build-system globals ================== + # Start with the default phase unless one was specified. $Phase = $opts{PHASE} // $PHASES[0]; die "Phase $Phase is not one of the ones I know about (" . @@ -620,7 +647,7 @@ EOT if( $stat->mtime > $myhstat->mtime || $stat->ctime > $myhstat->ctime) { - say "Skipping out-of-date ``$myhopen''" unless $opts{QUIET}; + say "Skipping out-of-date ``$myhopen''" unless $QUIET; $myhopen = undef; last; } @@ -646,10 +673,6 @@ I can't find any hopen project files (.hopen.pl or *.hopen.pl) for project directory ``$proj_dir''. EOT - # = Initialize ========================================================== - - say "From ``$proj_dir'' into ``$dest_dir''" unless $opts{QUIET}; - # Prepare the destination directory if it doesn't exist File::Path::Tiny::mk($dest_dir) or die "Couldn't create $dest_dir: $!"; @@ -657,39 +680,53 @@ EOT # generator and toolset can add initialization operations. $Build = hnew DAG => '__R_main'; + # = Load generator and toolset (and run MYH) ============================ + + say "From ``$proj_dir'' into ``$dest_dir''" unless $QUIET; + # Load MY.hopen.pl first so the results of the Probe phase are # available to the generator and toolset. - if($myhopen) { + if($myhopen && !$opts{BUILD}) { _execute_hopen_file($myhopen, forward_opts(\%opts, {lc=>1}, qw(PHASE QUIET)), ); # TODO support _e_h_f libs option } # Tell the user the initial phase if MY.hopen.pl didn't change it - say "Running $Phase phase" unless $_did_set_phase or $opts{QUIET}; + say "Running $Phase phase" unless $opts{BUILD} or $_did_set_phase or $QUIET; # Load generator - my ($gen, $gen_class); - $gen_class = loadfrom($opts{GENERATOR}, 'App::hopen::Gen::', ''); - die "Can't find generator $opts{GENERATOR}" unless $gen_class; - hlog { "Generator spec ``$opts{GENERATOR}'' -> using generator $gen_class" }; - - $gen = "$gen_class"->new(proj_dir => $proj_dir, dest_dir => $dest_dir, - architecture => $opts{ARCHITECTURE}) - or die "Can't initialize generator"; - $Generator = $gen; + { + my ($gen, $gen_class); + $gen_class = loadfrom($opts{GENERATOR}, 'App::hopen::Gen::', ''); + die "Can't find generator $opts{GENERATOR}" unless $gen_class; + hlog { "Generator spec ``$opts{GENERATOR}'' -> using generator $gen_class" }; + + $gen = "$gen_class"->new(proj_dir => $proj_dir, dest_dir => $dest_dir, + architecture => $opts{ARCHITECTURE}) + or die "Can't initialize generator"; + $Generator = $gen; + } # Load toolset - my $toolset_class; - $opts{TOOLSET} //= $gen->default_toolset; - $toolset_class = loadfrom($opts{TOOLSET}, - 'App::hopen::T::', ''); - die "Can't find toolset $opts{TOOLSET}" unless $toolset_class; + { + my $toolset_class; + $opts{TOOLSET} //= $Generator->default_toolset; + $toolset_class = loadfrom($opts{TOOLSET}, + 'App::hopen::T::', ''); + die "Can't find toolset $opts{TOOLSET}" unless $toolset_class; + + hlog { "Toolset spec ``$opts{TOOLSET}'' -> using toolset $toolset_class" }; + $Toolset = $toolset_class; + } - hlog { "Toolset spec ``$opts{TOOLSET}'' -> using toolset $toolset_class" }; - $Toolset = $toolset_class; + # Handle --build, now that everything's loaded -------------- + if($opts{BUILD}) { + $Generator->run_build(); + return; + } - # = Run the hopen files ================================================= + # = Run the hopen files (except MYH, already run) ======================= my $new_data; if(@$lrHopenFiles) { @@ -714,7 +751,8 @@ EOT # TODO? give the generators a way to stash information that will be # written at the top of MY.hopen.pl. This way, the user may only - # need to edit right at the top of the file, and not also at the + # need to edit right at the top of the file, and not also throughout + # the hashref. my $VAR = '__R_new_data'; my $dumper = Data::Dumper->new([$new_data], [$VAR]); @@ -776,7 +814,9 @@ Command-line runner. Call as C<< App::hopen::Main(\@ARGV) >>. # Option overrides: -q beats -v $opts{VERBOSE} = 0 if $opts{QUIET}; - $QUIET = $opts{QUIET} // false; + $QUIET = !!($opts{QUIET} // false); + delete $opts{QUIET}; + # After this, code only refers to $QUIET for consistency. # Implement verbosity if(!$QUIET && $opts{VERBOSE}) { @@ -784,11 +824,14 @@ Command-line runner. Call as C<< App::hopen::Main(\@ARGV) >>. #hlog { Verbosity => $VERBOSE }; # Under -v, keep stdout and stderr lines in order. - use IO::Handle; - STDOUT->autoflush; - STDERR->autoflush; + STDOUT->autoflush(true); + STDERR->autoflush(true); } + delete @opts{qw(VERBOSE VERBOSE2)}; + # After this, code only refers to $QUIET for consistency. + # After th + # Don't print the source of an eval'ed hopen file unless -vvv or higher. # Need 3 for the "..." that Carp prints when truncating. $Carp::MaxEvalLen = 3 unless $VERBOSE >= 3; diff --git a/lib/App/hopen/AppUtil.pm b/lib/App/hopen/AppUtil.pm index 6764ae6..e24f95d 100755 --- a/lib/App/hopen/AppUtil.pm +++ b/lib/App/hopen/AppUtil.pm @@ -4,7 +4,7 @@ use Data::Hopen qw(:default isMYH MYH); use Data::Hopen::Base; use parent 'Exporter'; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS); BEGIN { @@ -26,7 +26,7 @@ use Path::Class; =head1 NAME -Data::Hopen::AppUtil - utility routines used by Data::Hopen::App +App::hopen::AppUtil - utility routines used by App::hopen =head1 FUNCTIONS diff --git a/lib/App/hopen/Asset.pm b/lib/App/hopen/Asset.pm new file mode 100755 index 0000000..ef96228 --- /dev/null +++ b/lib/App/hopen/Asset.pm @@ -0,0 +1,128 @@ +# App::hopen::Asset - record representing a file to be produced +package App::hopen::Asset; +use Data::Hopen::Base; + +use Path::Class; +# and we use Class::Tiny below. + +our $VERSION = '0.000010'; + +# Docs {{{1 + +=head1 NAME + +App::hopen::Asset - record representing a file to be produced + +=head1 SYNOPSIS + +An asset is something to be produced, e.g., a file on disk or something +else that could be a target in a Makefile. + +=head1 ATTRIBUTES + +=head2 target + +TODO: should on-disk targets be required to be BasedPath instances? + +The name of the asset. Must be one of: + +=over + +=item * + +A L instance, representing a file or directory on disk + +=item * + +An L instance, representing a file or directory +on disk + +=item * + +Something that stringifies to a non-disk target (e.g., a goal). Anything in +this category will be stored as its stringified value, NOT as its original +value. + +=back + +No default, so don't call C<< $obj->target >> until you've assigned a target! + +=head2 made_by + +The L (or subclass) instance that produced this asset. +Used to distinguish assets from different sources. + +=head2 name + +An optional asset name. If you don't specify one, a unique one will be +generated automatically. + +=head1 METHODS + +=cut + +# }}}1 + +# The accessor for the target attribute. +sub target { + my $self = shift; + if (@_) { + my $candidate = shift; + croak "targets must not be falsy" unless $candidate; + if(eval { $candidate->DOES('Path::Class::File') || + $candidate->DOES('Path::Class::Dir') || + $candidate->DOES('App::hopen::Util::BasedPath' ) } + ) { + return $self->{target} = $candidate; + } else { + return $self->{target} = "$candidate"; + } + } elsif ( exists $self->{target} ) { + return $self->{target}; + } else { # No default. + croak "I don't have a target to give you"; + } +} #target() + +# Create the accessor that enforces the restriction on made_by +use Class::Tiny::ConstrainedAccessor [NOBUILD => true], + made_by => [ sub { eval { $_[0]->DOES('App::hopen::G::Cmd') } }, + sub { 'made_by values must implement App::hopen::G::Cmd' } ]; + +# Set up the rest of the class +use Class::Tiny qw(target made_by name); + +=head2 isdisk + +Returns truthy if the L is an on-disk entity, i.e., a +directory or file. + +=cut + +sub isdisk { + my $self = shift or croak 'Need an instance'; + return ($self->target->DOES('Path::Class::File') || + $self->target->DOES('Path::Class::Dir') || + $self->target->DOES('App::hopen::Util::BasedPath') + ); +} #isdisk() + +=head2 BUILD + +Enforces the requirement for C and C. + +=cut + +my $_id_counter; + +sub BUILD { + my ($self) = @_; + $self->name('__R_Asset_' . $_id_counter++) unless $self->name; + $self->target($self->{target}); # Check the custom constraint on target + # by re-setting target. + $self->_check_all_constraints(); # Checks made_by. +} #BUILD() + +1; +__END__ +# vi: set fdm=marker: # diff --git a/lib/App/hopen/BuildSystemGlobals.pm b/lib/App/hopen/BuildSystemGlobals.pm index 108ca07..1f0c9ea 100755 --- a/lib/App/hopen/BuildSystemGlobals.pm +++ b/lib/App/hopen/BuildSystemGlobals.pm @@ -3,7 +3,7 @@ package App::hopen::BuildSystemGlobals; use Data::Hopen; use Data::Hopen::Base; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; use parent 'Exporter'; our @EXPORT; diff --git a/lib/App/hopen/Conventions.pod b/lib/App/hopen/Conventions.pod index aa32ea3..158782d 100755 --- a/lib/App/hopen/Conventions.pod +++ b/lib/App/hopen/Conventions.pod @@ -4,9 +4,9 @@ App::hopen::Conventions - conventions for using hopen(1) as a build system =head1 SYNOPSIS -L is a flexible dataflow processor and task runner. However, its +L is a flexible dataflow processor and task runner. However, its main use case is as a build system (e.g., a Makefile generator). To keep -the core of hopen as flexible as possible, hopen(1) (build-system use cases) +the core of hopen as flexible as possible, L (build system) requires its components to follow the conventions described in this document. These conventions are generally implemented/enforced in L @@ -35,7 +35,7 @@ The generator's job is to arrange for coordinating work that needs to be done. =item Toolset -A collection of operations (L subclasses) that know +A collection of operations (L subclasses) that know how to process specific types of files. Toolsets are responsible for defining the work that the generator will coordinate. @@ -211,17 +211,28 @@ You can do this by running C, if you wish. =head1 INTERNALS -=head2 The build graph +=head2 Overall data flow -Each operation (L subclass) returns, or adds to -the beginning of, a C arrayref. For example: +=over + +=item 1. + +The hopen files run, and generate a command graph. The command graph includes +nodes that implement L. The idea is that the hopen +files specify the I you would run to build your software by hand. + +Each command node, when run, outputs a C arrayref of +L instances. - { - work => [ - { from => ['hello.c'], to => ['hello.o'], - how => ['gcc -c #first -o #out'] }, - { from => ['hello.o'], to => ['hello'], - how => ['gcc #first -o #out'] } - ] - } +=item 2. +The command graph is run, with a generator made available to it. Command nodes +provide asset nodes to the generator and to later command nodes. The asset +nodes implement L. The specific subclass they +implement is determined by the generator. + +=item 3. + +The generator runs the asset graph to output the blueprint files. + +=back diff --git a/lib/App/hopen/G/AssetOp.pm b/lib/App/hopen/G/AssetOp.pm new file mode 100755 index 0000000..06de50e --- /dev/null +++ b/lib/App/hopen/G/AssetOp.pm @@ -0,0 +1,55 @@ +# App::hopen::G::AssetOp - parent class for operations used by a +# generator to build an asset +package App::hopen::G::AssetOp; +use Data::Hopen::Base; +use Quote::Code; + +our $VERSION = '0.000010'; + +use parent 'App::hopen::G::Cmd'; +# we use Class::Tiny below + +use Class::Tiny::ConstrainedAccessor + asset => [ sub { eval { $_[0]->DOES('App::hopen::Asset') } }, + sub { qc'{$_[0]//""} is not an App::hopen::Asset or subclass' } ]; + +use Class::Tiny qw(asset), { + how => undef, +}; + +use App::hopen::Asset; +use Data::Hopen::Util::Data qw(forward_opts); + +# Docs + +=head1 NAME + +App::hopen::G::AssetOp - parent class for operations used by a generator to build an asset + +=head1 SYNOPSIS + +This is an abstract class. Each generator implements its own subclass of +AssetOp for its own use. + +=head1 ATTRIBUTES + +=head2 asset + +An L instance. + +=head2 how + +If defined, a string suitable as input to C in L. + +TODO or a different formatter? + +TODO? require that format specifications call a specified modifier that +will quote file names for shell-specific command-line use. + +=cut + +sub _run { ... } + +1; +__END__ +# vi: set fdm=marker: # diff --git a/lib/App/hopen/G/Cmd.pm b/lib/App/hopen/G/Cmd.pm new file mode 100644 index 0000000..6a82255 --- /dev/null +++ b/lib/App/hopen/G/Cmd.pm @@ -0,0 +1,127 @@ +# App::hopen::G::Cmd - base class for hopen(1) command-graph nodes +package App::hopen::G::Cmd; +use Data::Hopen::Base; +use Quote::Code; + +our $VERSION = '0.000010'; + +use parent 'Data::Hopen::G::Op'; +use Class::Tiny { + made => sub { [] }, +}; + +use Class::Method::Modifiers qw(around); +use Data::Hopen qw(getparameters); + +# Docs {{{1 + +=head1 NAME + +App::hopen::G::Cmd - base class for hopen(1) operation-graph nodes + +=head1 SYNOPSIS + +This is the base class for graph nodes in the command graph of +L. See L. + +=head1 ATTRIBUTES + +=head2 made + +An arrayref of the outputs from this function, which are L +instances. (TODO enforce this requirement.) + +=cut + +# }}}1 + +=head1 FUNCTIONS + +=head2 make + +Adds L instances to L (a L's +asset output). B add the assets to the generator's asset graph, +since the generator is not available as instance data. One or more parameters +or arrayrefs of parameters can be given. Returns a list of the C +instances made. Each parameter can be: + +=over + +=item * + +An L or subclass (in which case +L is updated) + +=item * + +A valid C for an L. + +=back + +=cut + +sub make { + my $self = shift or croak 'Need an instance'; + my @retval; + for my $arg (@_) { + if(ref $arg eq 'ARRAY') { + push @retval, $self->make(@$arg); + } elsif(eval { $arg->DOES('App::hopen::Asset') }) { + $arg->made_by($self); + push @{$self->made}, $arg; + push @retval, $arg; + } else { + my $asset = App::hopen::Asset->new(target=>$arg, made_by=>$self); + push @{$self->made}, $asset; + push @retval, $asset; + } + } #foreach arg + return @retval; +} #make() + +=head2 input_assets + +Returns the assets provided as input via L calls in predecessor nodes. +Only meaningful within C<_run()> (since that's when C<< $self->scope >> +is populated). Returns an arrayref in scalar context or a list in list context. + +=cut + +sub input_assets { + my $self = shift or croak 'Need an instance'; + my $lrSourceFiles; + + my $hrSourceFiles = + $self->scope->find(-name => 'made', -set => '*', -levels => 'local') // {}; + + if(scalar keys %$hrSourceFiles) { + $lrSourceFiles = %$hrSourceFiles{(keys %$hrSourceFiles)[0]}; + } else { + $lrSourceFiles = []; + } + + return $lrSourceFiles unless wantarray; + return @$lrSourceFiles; +} #input_assets() + +=head2 run + +Overrides L to stuff L into the +outputs if it's not already there. Note that this will B +any non-arrayref C output. + +=cut + +around 'run' => sub { + my $orig = shift; + my $self = shift or croak 'Need an instance'; + my $retval = $self->$orig(@_); + + $retval->{made} = $self->made unless ref $retval->{made} eq 'ARRAY'; + # TODO clone? Shallow copy? + return $retval; +}; #run() + +1; +__END__ +# vi: set fdm=marker: # diff --git a/lib/App/hopen/G/FilesCmd.pm b/lib/App/hopen/G/FilesCmd.pm new file mode 100644 index 0000000..c42f7fc --- /dev/null +++ b/lib/App/hopen/G/FilesCmd.pm @@ -0,0 +1,52 @@ +# App::hopen::G::FilesCmd - Cmd that outputs a list of files. +package App::hopen::G::FilesCmd; +use Data::Hopen; +use Data::Hopen::Base; + +our $VERSION = '0.000010'; + +use parent 'App::hopen::G::Cmd'; +use Class::Tiny { + files => sub { [] }, +}; + +use App::hopen::Asset; + +# Docs {{{1 + +=head1 NAME + +Data::Hopen::G::FilesCmd - Cmd that holds a list of files. + +=head1 SYNOPSIS + + my $node = Data::Hopen::G::FilesCmd(files=>['foo.c'], name=>'foo node'); + +Used by L. + +=head1 FUNCTIONS + +=cut + +# }}}1 + +=head2 _run + +Create Ls for the listed files and add them to the +generator's asset graph. +See L. + +=cut + +sub _run { + my ($self, %args) = getparameters('self', [qw(phase visitor ; *)], @_); + + my @assets = $self->make(@{$self->files}); + $args{visitor}->asset($_) foreach @assets; + + return {}; +} #run() + +1; +__END__ +# vi: set fdm=marker: # diff --git a/lib/App/hopen/G/FilesOp.pm b/lib/App/hopen/G/FilesOp.pm deleted file mode 100755 index 64d32cf..0000000 --- a/lib/App/hopen/G/FilesOp.pm +++ /dev/null @@ -1,49 +0,0 @@ -# App::hopen::G::FilesOp - Op that outputs a list of files. -package App::hopen::G::FilesOp; -#use Data::Hopen; -use Data::Hopen::Base; - -our $VERSION = '0.000010'; # TRIAL - -use parent 'Data::Hopen::G::Op'; -use Class::Tiny { - files => sub { [] }, -}; - -# Docs {{{1 - -=head1 NAME - -Data::Hopen::G::FilesOp - Op that holds a list of files. - -=head1 SYNOPSIS - - my $node = Data::Hopen::G::FilesOp(files=>['foo.c'], name=>'foo node'); - -Used by L. - -=head1 FUNCTIONS - -=cut - -# }}}1 - -=head2 run - -Output a C record holding the given names. See -L. - -=cut - -sub _run { - my $self = shift or croak 'Need an instance'; - - return { work => [ { - from => [], how => undef, - to => $self->files - } ] }; -} #run() - -1; -__END__ -# vi: set fdm=marker: # diff --git a/lib/App/hopen/Gen.pm b/lib/App/hopen/Gen.pm index 36cfd82..1394ea4 100644 --- a/lib/App/hopen/Gen.pm +++ b/lib/App/hopen/Gen.pm @@ -1,15 +1,25 @@ # App::hopen::Gen - base class for hopen generators package App::hopen::Gen; -use Data::Hopen; +use Data::Hopen qw(:default $QUIET); use Data::Hopen::Base; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; +use parent 'Data::Hopen::Visitor'; use Class::Tiny qw(proj_dir dest_dir), { architecture => '', + + # private + _assets => undef, # A Data::Hopen::G::DAG of the assets + _assetop_by_asset => sub { +{} }, # Indexed by refaddr($asset) }; +use App::hopen::BuildSystemGlobals; +use Data::Hopen::G::DAG; +use Data::Hopen::Util::Data qw(forward_opts); +use File::pushd qw(pushd); use Path::Class (); +use Scalar::Util qw(refaddr); # Docs {{{1 @@ -36,9 +46,14 @@ the project. (Required) A L instance specifying where the generated output (e.g., blueprint or other files) should be written. +=head2 _assets (Internal) + +A L of L instances representing +the Ls to be created when a build is run. + =head1 FUNCTIONS -A generator (C subclass) is a Visitor. +A generator (C subclass) is a Visitor plus some. B: The generator does not have access to L instances. @@ -48,44 +63,129 @@ That lack of access is the primary distinction between Ops and Links. # }}}1 -=head2 visit_goal +=head2 asset -Do whatever the generator wants to do with a L. -For example, the generator may change the goal's C. -By default, no-op. Usage: +Called by an Op (L subclass) to add an asset +(L instance) to the build. Usage: - $generator->visit_goal($goal); + $Generator->asset([-asset=>]$asset, [-from=>]$from[, [-how=>]$how]); + +If C<$how> is specified, it will be saved in the C for use later. +Later calls with the same asset and a defined C<$how> will overwrite the +C value in the C. Specify 'UNDEF' as the C<$how> to +expressly undefine a C. + +Returns the C. =cut -sub visit_goal { } +sub asset { + my ($self, %args) = getparameters('self', [qw(asset; how)], @_); + hlog { 'Generator adding asset at',refaddr($args{asset}),$args{asset} } 3; -=head2 visit_node + my $existing_op = $self->_assetop_by_asset->{refaddr($args{asset})}; -Do whatever the generator wants to do with a L that -is not a Goal (see L). By default, no-op. Usage: + # Update an existing op + if(defined $existing_op) { + if( ($args{how}//'') eq 'UNDEF') { + $existing_op->how(undef); + } elsif(defined $args{how}) { + $existing_op->how($args{how}); + } + return $existing_op; + } - $generator->visit_node($node) + # Create a new op + my $class = $self->_assetop_class; + eval "require $class"; + my $op = $class->new(name => 'Op:<<' . $args{asset}->target . '>>', + forward_opts(\%args, qw(asset how))); + $self->_assetop_by_asset->{refaddr($args{asset})} = $op; + $self->_assets->add($op); + return $op; +} #asset() + +=head2 connect + +Add a dependency edge between two assets or goals. Any assets must have already +been added using L. Usage: + + $Generator->connect([-from=>]$from, [-to=>$to]); + +TODO add missing assets automatically? =cut -sub visit_node { } +sub connect { + my ($self, %args) = getparameters('self', [qw(from to)], @_); + my %nodes; + + # Get the nodes if we were passed assets. + foreach my $field (qw(from to)) { + if(eval { $args{$field}->DOES('App::hopen::Asset') }) { + $nodes{$field} = $self->_assetop_by_asset->{refaddr($args{$field})}; + } else { + $nodes{$field} = $args{$field}; + } + } + + # TODO better error messages + croak "No From node for asset " . refaddr($args{from}) unless $nodes{from}; + croak "No To node for asset " . refaddr($args{to}) unless $nodes{to}; + $self->_assets->connect($nodes{from}, $nodes{to}); +} #connect() -=head2 finalize +=head2 run_build -Do whatever the generator wants to do to finish up. By default, no-op. -Is provided the L instance as a parameter. Usage: +Runs the build tool for which this generator has created blueprint files. +Runs the tool with the destination directory as the current dir. - $generator->finalize(-phase=>$Phase, -graph=>$dag) +=cut + +sub run_build { + my $self = shift or croak 'Need an instance'; + my $abs_dir = $DestDir->absolute; + # NOTE: You have to call this *before* pushd() or chdir(), because + # it may be a relative path, and absolute() converts with respect + # to cwd at the time of the call. + my $dir = pushd($abs_dir); + say "Building in ${abs_dir}..." unless $QUIET; + $self->_run_build(); +} #run_build() + +=head2 BUILD + +Constructor. =cut -sub finalize { } +sub BUILD { + my ($self, $args) = @_; + + # Enforce the required argument types + croak "Need a project directory (Path::Class::Dir)" + unless eval { $self->proj_dir->DOES('Path::Class::Dir') }; + croak "Need a destination directory (Path::Class::Dir)" + unless eval { $self->dest_dir->DOES('Path::Class::Dir') }; + + # Create the asset graph + $self->_assets(hnew DAG => 'asset graph'); +} #BUILD() + +=head1 FUNCTIONS TO BE IMPLEMENTED BY SUBCLASSES + +=head2 _assetop_class + +(Required) Returns the name of the L subclass that +should be used to represent assets in the C<_assets> graph. + +=cut + +sub _assetop_class { ... } =head2 default_toolset -Returns the package stem of the default toolset for this generator. -Must be implemented by subclasses. +(Required) Returns the package stem of the default toolset for this generator. When a hopen file invokes C, hopen will load C<< Data::Hopen::T::::Foo >>, where C<< >> is the return @@ -98,38 +198,53 @@ so make sure that is a valid package. sub default_toolset { ... } -=head2 also_require +=head2 finalize -Returns the names of the packages, if any, that should be loaded along with -this generator. +(Optional) +Do whatever the generator wants to do to finish up. By default, no-op. +Is provided the L instance as a parameter. Usage: + + $generator->finalize(-phase=>$Phase, -graph=>$dag) =cut -sub also_require { } +sub finalize { } -=head2 run_build +=head2 _run_build -Runs the build tool for which this generator has created blueprint files. +(Optional) +Implementation of L. The default does not die, but does warn(). =cut -sub run_build { +sub _run_build { warn "This generator is not configured to run a build tool. Sorry!"; -} +} #_run_build() -=head2 BUILD +=head2 visit_goal -Enforces the required arguments. +(Optional) +Do whatever the generator wants to do with a L. +For example, the generator may change the goal's C. +By default, no-op. Usage: + + $generator->visit_goal($goal); =cut -sub BUILD { - my ($self, $args) = @_; - croak "Need a project directory (Path::Class::Dir)" - unless eval { $self->proj_dir->DOES('Path::Class::Dir') }; - croak "Need a destination directory (Path::Class::Dir)" - unless eval { $self->dest_dir->DOES('Path::Class::Dir') }; -} #BUILD() +sub visit_goal { } + +=head2 visit_node + +(Optional) +Do whatever the generator wants to do with a L that +is not a Goal (see L). By default, no-op. Usage: + + $generator->visit_node($node) + +=cut + +sub visit_node { } 1; __END__ diff --git a/lib/App/hopen/Gen/Make.pm b/lib/App/hopen/Gen/Make.pm index ffbcaa2..7664674 100755 --- a/lib/App/hopen/Gen/Make.pm +++ b/lib/App/hopen/Gen/Make.pm @@ -2,18 +2,22 @@ package App::hopen::Gen::Make; use Data::Hopen::Base; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; use parent 'App::hopen::Gen'; -use Class::Tiny { - targets => sub { Hash::Ordered->new() } -}; +use Class::Tiny qw(targets); use App::hopen::BuildSystemGlobals; use App::hopen::Phases qw(is_last_phase); use Data::Hopen qw(:default getparameters $QUIET); +use Data::Hopen::Scope::Hash; +use Data::Hopen::Util::Data qw(forward_opts); +use File::Which; use Hash::Ordered; +use App::hopen::Gen::Make::AssetGraphNode; # for $OUTPUT +use App::hopen::Gen::Make::AssetGraphVisitor; + # Docs {{{1 =head1 NAME @@ -38,14 +42,36 @@ A L of the targets, in the order encountered. =head2 visit_goal -Add a target corresponding to the name of the goal. +Add a target corresponding to the name of the goal. Usage: + + $Generator->visit_goal($node, $node_inputs); + +This happens while the command graph is being run. =cut sub visit_goal { - my $self = shift or croak 'Need an instance'; - my $goal = shift or croak 'Need a goal'; - $self->targets->set($goal->name, $goal); + my ($self, %args) = getparameters('self', [qw(goal node_inputs)], @_); + $self->targets->set($args{goal}->name, $args{goal}); + + # --- Add the goal to the asset graph --- + + my $asset_goal = $self->_assets->goal($args{goal}->name); + + # Pull the inputs. TODO refactor out the code in common with + # AhG::Cmd::input_assets(). + my $hrSourceFiles = + $args{node_inputs}->find(-name => 'made', + -set => '*', -levels => 'local') // {}; + die 'No input files to goal ' . $args{goal}->name + unless scalar keys %$hrSourceFiles; + + my $lrSourceFiles = %$hrSourceFiles{(keys %$hrSourceFiles)[0]}; + hlog { 'found inputs to goal', $args{goal}->name, Dumper($lrSourceFiles) } 2; + + # TODO? verify that all the assets are actually in the graph first? + $self->connect($_, $asset_goal) foreach @$lrSourceFiles; + } #visit_goal() #=head2 visit_node @@ -71,6 +97,8 @@ sub finalize { hlog { Finalizing => __PACKAGE__ , '- phase', $args{phase} }; return unless is_last_phase $args{phase}; + hlog { __PACKAGE__, 'Asset graph', '' . $self->_assets->_graph } 3; + # During the Gen phase, create the Makefile open my $fh, '>', $self->dest_dir->file('Makefile') or die "Couldn't create Makefile"; print $fh <proj_dir->absolute]}'' into ``@{[$self->dest_dir->absolute]}'' +.PHONY: first__goal__ + EOT - my $iter = $self->targets->iterator; - # TODO make this more robust and flexible - while( my ($name, $goal) = $iter->() ) { - hlog { __PACKAGE__, 'goal', $name } 2; - say $fh "### Goal $name ###"; - unless(eval { scalar @{$goal->outputs->{work}} }) { - warn "No work for goal $name" unless $QUIET; - next; - } - - my @work = @{$goal->outputs->{work}}; - unshift @work, { to => [$name], from => $work[0]->{to}, how => undef }; - # Make a fake record for the goal. TODO move this to visit_goal? - - hlog { 'Work to do', Dumper(\@work) } 3; - foreach my $item (@work) { - next unless @{$item->{from}}; # no prerequisites => assume it's a file - my @sources; - foreach(@{$item->{from}}) { - hlog { 'Work item', Dumper($_) } 3; - next unless $_; - push @sources, $_->orig->relative($DestDir); - } - - my $dest = $item->{to}->[0]; - $dest = $dest->orig->relative($DestDir) - if $dest->DOES('App::hopen::Util::BasedPath'); - - say $fh $dest, ': ', join(' ', @sources); - say $fh (_expand($item) =~ s/^/\t/gmr); - say $fh ''; - } - - } #foreach goal + # Make sure the first goal is 'all' regardless of order. + print $fh 'first__goal__: ', $args{dag}->default_goal->name, "\n"; + + my $context = Data::Hopen::Scope::Hash->new; + $context->put(App::hopen::Gen::Make::AssetGraphNode::OUTPUT, $fh); + + # Write the Makefile. TODO flip the order. + + $self->_assets->run(-context => $context, + -visitor => App::hopen::Gen::Make::AssetGraphVisitor->new, + forward_opts(\%args, {'-'=>1}, qw(phase)) + ); + close $fh; } #finalize() @@ -126,6 +135,36 @@ which is C (i.e., L). sub default_toolset { 'Gnu' } +=head2 _assetop_class + +The class of asset-graph operations, which in this case is +L. + +=cut + +sub _assetop_class { 'App::hopen::Gen::Make::AssetGraphNode' } + +=head2 _run_build + +Implementation of L. + +=cut + +sub _run_build { + # Look for the make(1) executable. Listing make before gmake since a + # system with both Cygwin and Strawberry Perl installed has cygwin's + # make(1) and Strawberry's gmake(1). + foreach my $candidate (qw[make gmake mingw32-make dmake]) { + my $path = File::Which::which($candidate); + next unless defined $path; + # TODO cd into dest dir + hlog { Running => $path }; + system $path, (); + return; + } + warn "Could not find a 'make' program to run"; +} #_run_build() + =head1 INTERNALS =head2 _expand @@ -156,6 +195,18 @@ sub _expand { return $retval; } #_expand() +=head2 BUILD + +Constructor + +=cut + +sub BUILD { + my ($self, $hrArgs) = @_; + $self->targets(Hash::Ordered->new()); +} #BUILD() + + 1; __END__ # vi: set fdm=marker: # diff --git a/lib/App/hopen/Gen/Make/AssetGraphNode.pm b/lib/App/hopen/Gen/Make/AssetGraphNode.pm new file mode 100644 index 0000000..4e6b39d --- /dev/null +++ b/lib/App/hopen/Gen/Make/AssetGraphNode.pm @@ -0,0 +1,76 @@ +# App::hopen::Gen::Make::AssetGraphNode - AssetOp for Gen::Make +package App::hopen::Gen::Make::AssetGraphNode; +use Data::Hopen qw(getparameters $VERBOSE); +use Data::Hopen::Base; + +our $VERSION = '0.000010'; + +use parent 'App::hopen::G::AssetOp'; +use Class::Tiny; + +use App::hopen::BuildSystemGlobals; # for $DestDir +use Quote::Code; +use String::Print; + +# Docs {{{1 + +=head1 NAME + +App::hopen::Gen::Make::AssetGraphNode - AssetOp for Gen::Make + +=head1 SYNOPSIS + +TODO + +=head1 FUNCTIONS + +=cut + +# }}}1 + +use vars::i '&OUTPUT' => sub { '__R_Makefile' }; + +=head2 _run + +Generate a piece of a Makefile and write it to the filehandle in +C<__R_Makefile>. + +=cut + +sub _run { + my ($self, %args) = getparameters('self', [qw(; phase visitor)], @_); + my $fh = $self->scope->find(OUTPUT); + # TODO deal with multiple inputs being merged in DAG::_run() + + my @inputs = $self->input_assets; + my $output = $self->asset->target->path_wrt($DestDir); + # TODO refactor this processing into a utility module/function + + # Debugging output + if($VERBOSE) { + print $fh qc'\n# Makefile piece from node {$self->name}\n'; + print $fh qc' # {$self->how//""}\n'; + print $fh qc' # Depends on {$_->target}\n' foreach @inputs; + } + + if($self->how) { + my @paths = map { $_->target->path_wrt($DestDir) } @inputs; + my $recipe = $self->how; + # TODO refactor this processing into a utility module/function + $recipe =~ s<#first\b><$paths[0] // ''>ge; # first input + $recipe =~ s<#all\b>ge; # all inputs + $recipe =~ s<#out\b><$output // ''>ge; + print $fh qc_to <<"EOT" +#{$output}: #{join(" ", @paths)} +\t#{$recipe} +EOT + + } + + $self->make($self->asset); + return {}; +} #_run() + +1; +__END__ +# vi: set fdm=marker: # diff --git a/lib/App/hopen/Gen/Make/AssetGraphVisitor.pm b/lib/App/hopen/Gen/Make/AssetGraphVisitor.pm new file mode 100755 index 0000000..d00de9a --- /dev/null +++ b/lib/App/hopen/Gen/Make/AssetGraphVisitor.pm @@ -0,0 +1,70 @@ +# App::hopen::Gen::Make::AssetGraphVisitor - visitor to write goals +package App::hopen::Gen::Make::AssetGraphVisitor; +use Data::Hopen qw(hlog getparameters $VERBOSE); +use Data::Hopen::Base; + +our $VERSION = '0.000010'; + +use parent 'Data::Hopen::Visitor'; +use Class::Tiny; + +use App::hopen::BuildSystemGlobals; # for $DestDir +use App::hopen::Gen::Make::AssetGraphNode; # for $OUTPUT +use Quote::Code; + +# Docs {{{1 + +=head1 NAME + +# App::hopen::Gen::Make::AssetGraphVisitor - visitor to write goals + +=head1 SYNOPSIS + +This is the visitor used when L traverses the +asset graph. Its purpose is to tie the inputs to each goal into that goal. + +=head1 FUNCTIONS + +=cut + +# }}}1 + +=head2 visit_goal + +Write a goal entry to the Makefile being built. +This happens while the asset graph is being run. + +=cut + +sub visit_goal { + my ($self, %args) = getparameters('self', [qw(goal node_inputs)], @_); + my $fh = $args{node_inputs}->find(App::hopen::Gen::Make::AssetGraphNode::OUTPUT); + + # Pull the inputs. TODO refactor out the code in common with + # AhG::Cmd::input_assets(). + my $hrInputs = + $args{node_inputs}->find(-name => 'made', + -set => '*', -levels => 'local') // {}; + die 'No input files to goal ' . $args{goal}->name + unless scalar keys %$hrInputs; + + my $lrInputs = %$hrInputs{(keys %$hrInputs)[0]}; + hlog { __PACKAGE__, 'found inputs to goal', $args{goal}->name, Dumper($lrInputs) } 2; + + my @paths = map { $_->target->path_wrt($DestDir) } @$lrInputs; + print $fh qc'\n# === Makefile goal {$args{goal}->name}\n' if $VERBOSE; + print $fh qc'{$args{goal}->name}: '; + say $fh join ' ', @paths; +} #visit_goal() + +=head2 visit_node + +No-op. + +=cut + +sub visit_node { } + +1; +__END__ +# vi: set fdm=marker: # diff --git a/lib/App/hopen/H.pm b/lib/App/hopen/H.pm index 2266772..4786f0b 100755 --- a/lib/App/hopen/H.pm +++ b/lib/App/hopen/H.pm @@ -2,21 +2,18 @@ package App::hopen::H; use Data::Hopen::Base; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; use parent 'Exporter'; -our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS); -BEGIN { - @EXPORT = qw(); - @EXPORT_OK = qw(files); - %EXPORT_TAGS = ( +use vars::i '@EXPORT' => []; +use vars::i '@EXPORT_OK' => qw(files); +use vars::i '%EXPORT_TAGS' => ( default => [@EXPORT], all => [@EXPORT, @EXPORT_OK] ); -} use App::hopen::BuildSystemGlobals; -use App::hopen::G::FilesOp; +use App::hopen::G::FilesCmd; use App::hopen::Util::BasedPath; use Data::Hopen qw(hlog getparameters); use Data::Hopen::G::GraphBuilder; @@ -42,27 +39,32 @@ L. =head2 files -Creates a DAG node representing a set of input files. Example usage: +Creates a command-graph node representing a set of input files. +Example usage: $Build->H::files('foo.c')->C::compile->C::link('foo')->default_goal; -The node is a L. +The node is an L. The file path is assumed to be relative to the current project directory. TODO handle subdirectories. +Adds each specified file as a separate node in the asset graph. + =cut sub files { my ($builder, %args) = getparameters('self', ['*'], @_); hlog { __PACKAGE__, 'files:', Dumper(\%args) } 3; - my @files = @{$args{'*'} // []}; - @files = map { based_path(path => file($_), base => $ProjDir) } @files; + my $lrFiles = $args{'*'} // []; + my @files = map { based_path(path => file($_), base => $ProjDir) } @$lrFiles; hlog { __PACKAGE__, 'file objects:', @files } 3; - return App::hopen::G::FilesOp->new( + my $files_op = App::hopen::G::FilesCmd->new( files => [ @files ], forward_opts(\%args, 'name') ); + + return $files_op; } #files() make_GraphBuilder 'files'; diff --git a/lib/App/hopen/HopenFileKit.pm b/lib/App/hopen/HopenFileKit.pm index da3b298..06d3f8c 100755 --- a/lib/App/hopen/HopenFileKit.pm +++ b/lib/App/hopen/HopenFileKit.pm @@ -15,7 +15,7 @@ use App::hopen::Phases (); use Data::Hopen qw(:default loadfrom); -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; use parent 'Exporter'; # Exporter-exported symbols {{{1 our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS); @@ -61,7 +61,7 @@ my %_loaded_languages; sub _language_import { # {{{1 -=head2 +=head2 _language_import C routine for the fake "language" package diff --git a/lib/App/hopen/Phase/Check.pm b/lib/App/hopen/Phase/Check.pm index efe0703..dd901f9 100644 --- a/lib/App/hopen/Phase/Check.pm +++ b/lib/App/hopen/Phase/Check.pm @@ -4,7 +4,7 @@ use Data::Hopen; use Data::Hopen::Base; use parent 'Exporter'; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS); BEGIN { diff --git a/lib/App/hopen/Phase/Gen.pm b/lib/App/hopen/Phase/Gen.pm index 656c8ab..5a838aa 100755 --- a/lib/App/hopen/Phase/Gen.pm +++ b/lib/App/hopen/Phase/Gen.pm @@ -4,7 +4,7 @@ use Data::Hopen; use Data::Hopen::Base; #use parent 'Exporter'; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; #use Class::Tiny ;#qw(TODO); diff --git a/lib/App/hopen/Phases.pm b/lib/App/hopen/Phases.pm index bb261fc..1086825 100755 --- a/lib/App/hopen/Phases.pm +++ b/lib/App/hopen/Phases.pm @@ -3,7 +3,7 @@ package App::hopen::Phases; use Data::Hopen; use Data::Hopen::Base; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; use parent 'Exporter'; our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS); diff --git a/lib/App/hopen/T/Gnu.pm b/lib/App/hopen/T/Gnu.pm index b24a9f5..7002e0c 100755 --- a/lib/App/hopen/T/Gnu.pm +++ b/lib/App/hopen/T/Gnu.pm @@ -3,7 +3,7 @@ package App::hopen::T::Gnu; use Data::Hopen; use Data::Hopen::Base; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; #use parent 'Data::Hopen::TODO'; #use Class::Tiny qw(TODO); diff --git a/lib/App/hopen/T/Gnu/C.pm b/lib/App/hopen/T/Gnu/C.pm index 5336dee..56046c7 100755 --- a/lib/App/hopen/T/Gnu/C.pm +++ b/lib/App/hopen/T/Gnu/C.pm @@ -4,20 +4,25 @@ package App::hopen::T::Gnu::C; use Data::Hopen; use Data::Hopen::Base; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; + +use parent 'Exporter'; -use parent 'App::hopen::Tool'; use Class::Tiny qw(op files _cc); use App::hopen::BuildSystemGlobals; # For $DestDir. # TODO make the dirs available to nodes through the context. use App::hopen::Util::BasedPath; + +use App::hopen::T::Gnu::C::CompileCmd; +use App::hopen::T::Gnu::C::LinkCmd; + use Config; use Data::Hopen qw(getparameters); use Data::Hopen::G::GraphBuilder; use Data::Hopen::Util::Data qw(forward_opts); use Data::Hopen::Util::Filename; -use Deep::Hash::Utils qw(deepvalue); +#use Deep::Hash::Utils qw(deepvalue); use File::Which (); use Path::Class; @@ -28,33 +33,20 @@ our $_CC; # Cached compiler name =head1 NAME -Data::Hopen::T::Gnu::C - support for the GNU toolset, C language +App::hopen::T::Gnu::C - support for the GNU toolset, C language =head1 SYNOPSIS In a hopen file: use language 'C'; - my $op = C->new(op=>'compile'); - # Create instances manually - # Or use via Data::Hopen::G::GraphBuilder: + # Use via Data::Hopen::G::GraphBuilder: $Build->H::files(...)->C::compile->default_goal; The inputs come from earlier in the build graph. TODO support specifying compiler arguments. -=head1 ATTRIBUTES - -=head2 op - -What this node is going to do: C or C. - -=head2 files - -Arrayref of which files this node will process. Values are -destination file names. Extensions may be added. - =cut # }}}1 @@ -68,7 +60,7 @@ not C<< name=>'foo' >>). =head2 compile -Create a new with L set to C. Inputs come from the build graph, +Create a new compilation command. Inputs come from the build graph, so parameters other than C<-name> are disregarded (TODO permit specifying compilation options or object-file names). Usage: @@ -79,11 +71,13 @@ compilation options or object-file names). Usage: sub compile { my ($builder, %args) = getparameters('self', [qw(; name)], @_); - my $node = __PACKAGE__->new(op=>'compile', + my $node = App::hopen::T::Gnu::C::CompileCmd->new( + compiler => $_CC, forward_opts(\%args, 'name') ); hlog { __PACKAGE__, 'Built compile node', Dumper($node) } 2; + return $node; # The builder will automatically add it } #compile() @@ -91,92 +85,41 @@ make_GraphBuilder 'compile'; =head2 link -Create a new with L set to C. Pass the name of the -executable. Usage: +Create a new link command. Pass the name of the +executable. Object files are on the incoming asset-graph edges. Usage: use language 'C'; - $builder_or_dag->C::link('file1'[, -name=>'node name'); + $builder_or_dag->C::link([-exe=>]'output_file_name'[, [-name=>]'node name']); + +TODO? Permit specifying that you want C or another linker instead of +using the compiler? =cut sub link { my ($builder, %args) = getparameters('self', [qw(exe; name)], @_); - croak 'Need the name of the executable' unless $args{exe}; my $dest = based_path(path => file($FN->exe($args{exe})), base => $DestDir); - my $node = __PACKAGE__->new( - op=>'link', files => [$dest], + + my $node = App::hopen::T::Gnu::C::LinkCmd->new( + linker => $_CC, + dest => $dest, forward_opts(\%args, 'name') ); hlog { __PACKAGE__, 'Built link node', Dumper($node) } 2; + return $node; } #link() make_GraphBuilder 'link'; -=head1 MEMBER FUNCTIONS - -=head2 _run - -Create the compile or link command lines. - -=cut - -sub _run { - my ($self, %args) = getparameters('self', [qw(phase ; generator *)], @_); - - # Currently we only do things at gen time. - return $self->passthrough(-nocontext=>1) if $args{phase} ne 'Gen'; - - # Find the work up to this point - my $hrOldWork = - $self->scope->find(-name => 'work', -set => '*', -levels => 'local') // {}; - - if($self->op eq 'compile' && scalar keys %$hrOldWork != 1) { - die "C::compile nodes can only take one input at present"; - # TODO relax this requirement - } - my $lrOldWork = %$hrOldWork{(keys %$hrOldWork)[0]}; # list of hashrefs - - hlog { 'found old work', Dumper($lrOldWork) } 2; - my ($lrFrom, @work); - - $lrFrom = deepvalue($lrOldWork, qw(0 to)) // []; # don't autovivify - if($self->op eq 'compile' && @$lrFrom != 1) { - die "C::compile nodes can only take one input filename at present"; - # TODO relax this requirement - } - - # Add the new work - foreach my $file (@{$lrFrom}) { - my $hr = { from => [ $file ] }; - my ($to, $how); - - if($self->op eq 'compile') { - $to = based_path(path => file($FN->obj($file->path)), - base => $DestDir); - $how = $self->_cc . " -c #first -o #out"; - } else { # op eq 'link' - $to = $self->files->[0]; # created by C::link() - $how = $self->_cc . " #first -o #out"; - } - - $hr->{to} = [ $to ]; - $hr->{how} = [ $how ]; - - push @work, $hr; - $lrFrom = [$file]; - } - - # Add the existing work at the end - push @work, @$lrOldWork if @$lrOldWork; +=head1 INTERNALS - return { work => \@work }; -} #run() +=head2 _find_compiler -=head2 BUILD +Find the C compiler. Called when this package is first loaded. -Find the C compiler. +TODO permit the user to specify an alternative compiler to use TODO should this happen when the DAG runs? Maybe toolsets should get the chance to add a node to the beginning of @@ -184,25 +127,20 @@ the graph, before anything else runs. TODO figure this out. =cut -sub BUILD { - my ($self, $args) = @_; - - if($_CC) { # Use the cached one if we already found it - $self->_cc($_CC); - return; - } - - # Look for the compiler +sub _find_compiler { foreach my $candidate ($Config{cc}, qw[cc gcc clang]) { # TODO also c89 or xlc? my $path = File::Which::which($candidate); next unless defined $path; hlog { __PACKAGE__, 'using C compiler', $path }; # Got it - $self->_cc($path); $_CC = $path; last; } -} #BUILD() + + croak "Could not find a C compiler" unless $_CC; +} #_find_compiler() + +BEGIN { _find_compiler; } 1; __END__ diff --git a/lib/App/hopen/T/Gnu/C/CompileCmd.pm b/lib/App/hopen/T/Gnu/C/CompileCmd.pm new file mode 100755 index 0000000..aa5355b --- /dev/null +++ b/lib/App/hopen/T/Gnu/C/CompileCmd.pm @@ -0,0 +1,94 @@ +# App::hopen::T::Gnu::C::CompileCmd - compile C source using the GNU toolset +# TODO RESUME HERE - put .o files in the dest dir +package App::hopen::T::Gnu::C::CompileCmd; +use Data::Hopen; +use Data::Hopen::Base; + +our $VERSION = '0.000010'; + +use parent 'App::hopen::G::Cmd'; +use Class::Tiny qw(compiler); + +use App::hopen::BuildSystemGlobals; # For $DestDir. + # TODO make the dirs available to nodes through the context. +use App::hopen::Util::BasedPath; +use Config; +use Data::Hopen qw(getparameters); +use Data::Hopen::G::GraphBuilder; +#use Data::Hopen::Util::Data qw(forward_opts); +use Data::Hopen::Util::Filename; +use Deep::Hash::Utils qw(deepvalue); +use File::Which (); +use Path::Class; + +my $_FN = Data::Hopen::Util::Filename->new; # for brevity + +# Docs {{{1 + +=head1 NAME + +App::hopen::T::Gnu::C::CompileCmd - compile C source using the GNU toolset + +=head1 SYNOPSIS + +In a hopen file: + + my $cmd = App::hopen::T::Gnu::C::CompileCmd->new( + compiler => '/usr/bin/gcc', + name => 'compilation command' # optional + ); + +The inputs come from earlier in the build graph. +TODO support specifying compiler arguments. + +=head1 ATTRIBUTES + +=head2 compiler + +The compiler to use. TODO is this a full path or just a name? + +=head1 MEMBER FUNCTIONS + +=cut + +# }}}1 + +=head2 _run + +Create the compile command line. + +=cut + +sub _run { + my ($self, %args) = getparameters('self', [qw(phase visitor ; *)], @_); + + # Currently we only do things at gen time. + return $self->passthrough(-nocontext=>1) if $args{phase} ne 'Gen'; + + # Pull the inputs + my $lrSourceFiles = $self->input_assets; + hlog { 'found source files', Dumper($lrSourceFiles) } 2; + + my @objFiles; + foreach my $src (@$lrSourceFiles) { + die "Cannot compile non-file $src" unless $src->isdisk; + + my $to = based_path(path => file($_FN->obj($src->target->path)), + base => $DestDir); + my $how = $self->compiler . " -c #first -o #out"; + my $obj = App::hopen::Asset->new( + target => $to, + made_by => $self, + ); + push @objFiles, $obj; + + $args{visitor}->asset($obj, -how => $how); + $args{visitor}->connect($src, $obj); + } + $self->make(\@objFiles); + return {}; +} #_run() + +1; +__END__ +# vi: set fdm=marker: # diff --git a/lib/App/hopen/T/Gnu/C/LinkCmd.pm b/lib/App/hopen/T/Gnu/C/LinkCmd.pm new file mode 100755 index 0000000..998d511 --- /dev/null +++ b/lib/App/hopen/T/Gnu/C/LinkCmd.pm @@ -0,0 +1,97 @@ +# App::hopen::T::Gnu::C::LinkCmd - link object files using the GNU toolset +package App::hopen::T::Gnu::C::LinkCmd; +use Data::Hopen; +use Data::Hopen::Base; + +our $VERSION = '0.000010'; + +use parent 'App::hopen::G::Cmd'; +use Class::Tiny qw(dest linker); + +use App::hopen::BuildSystemGlobals; # For $DestDir. + # TODO make the dirs available to nodes through the context. +use App::hopen::Util::BasedPath; +use Config; +use Data::Hopen qw(getparameters); +use Data::Hopen::G::GraphBuilder; +#use Data::Hopen::Util::Data qw(forward_opts); +use Data::Hopen::Util::Filename; +use Deep::Hash::Utils qw(deepvalue); +use File::Which (); +use Path::Class; + +my $FN = Data::Hopen::Util::Filename->new; # for brevity +our $_CC; # Cached compiler name + +# Docs {{{1 + +=head1 NAME + +# App::hopen::T::Gnu::C::LinkCmd - link object files using the GNU toolset + +=head1 SYNOPSIS + +In a hopen file: + + my $cmd = App::hopen::T::Gnu::C::LinkCmd->new( + linker => 'gcc', + dest => 'foo.exe', + name => 'some linker node', # optional + ); + +The inputs come from earlier in the build graph. +TODO support specifying linker arguments. + +=head1 ATTRIBUTES + +=head2 linker + +The linker to use. TODO is this a full path or just a name? + +=head2 dest + +The destination file to produce, as an L instance. +TODO? accept string or L instance? + +=head1 MEMBER FUNCTIONS + +=cut + +# }}}1 + +=head2 _run + +Create the link command line. + +=cut + +sub _run { + my ($self, %args) = getparameters('self', [qw(phase visitor ; *)], @_); + + # Currently we only do things at gen time. + return $self->passthrough(-nocontext=>1) if $args{phase} ne 'Gen'; + + # Pull the inputs + my $lrObjFiles = $self->input_assets; + hlog { 'found object files', Dumper($lrObjFiles) } 2; + + my $exe = App::hopen::Asset->new( + target => $self->dest, + made_by => $self, + ); + $args{visitor}->asset($exe, + -how => $self->linker . ' -o #out #all', + ); + + foreach my $obj (@$lrObjFiles) { + die "Cannot link non-file $obj" unless $obj->isdisk; + $args{visitor}->connect($obj, $exe); + } + + $self->make($exe); + return {}; +} #_run() + +1; +__END__ +# vi: set fdm=marker: # diff --git a/lib/App/hopen/TEMPLATE.pm b/lib/App/hopen/TEMPLATE.pm index 0d9c508..0f99a13 100755 --- a/lib/App/hopen/TEMPLATE.pm +++ b/lib/App/hopen/TEMPLATE.pm @@ -3,7 +3,7 @@ package App::hopen::TEMPLATE; use Data::Hopen; use Data::Hopen::Base; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; # TODO if using exporter use parent 'Exporter'; diff --git a/lib/App/hopen/Tool.pm b/lib/App/hopen/Tool.pm index 9347ea1..f714133 100755 --- a/lib/App/hopen/Tool.pm +++ b/lib/App/hopen/Tool.pm @@ -1,11 +1,11 @@ -# App::hopen::Tool - base class for a hopen tool. +# App::hopen::Tool - base class for a hopen tool. DEPRECATED. package App::hopen::Tool; #use Data::Hopen; use Data::Hopen::Base; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; -use parent 'Data::Hopen::G::Op'; +use parent 'App::hopen::G::Cmd'; #use Class::Tiny; # Docs {{{1 @@ -20,8 +20,8 @@ A tool knows how to generate a command or other text that will cause a build system to perform a particular action on a file belonging to a particular language. -A tool is a L, so may interact with the current -generator (L). Moreover, the generator will +A tool is an L, so may interact with the current generator +(L). Moreover, the generator will get a chance to visit the op after it is processed. Maybe TODO: diff --git a/lib/App/hopen/Toolchain.pm b/lib/App/hopen/Toolchain.pm index 5a1256e..f988461 100755 --- a/lib/App/hopen/Toolchain.pm +++ b/lib/App/hopen/Toolchain.pm @@ -3,7 +3,7 @@ package Data::Hopen::Toolchain; use Data::Hopen; use Data::Hopen::Base; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; use Class::Tiny qw(proj_dir dest_dir), { architecture => '', diff --git a/lib/App/hopen/Util/BasedPath.pm b/lib/App/hopen/Util/BasedPath.pm index 87952a4..e4c32cb 100755 --- a/lib/App/hopen/Util/BasedPath.pm +++ b/lib/App/hopen/Util/BasedPath.pm @@ -2,16 +2,21 @@ package App::hopen::Util::BasedPath; use Data::Hopen::Base; -our $VERSION = '0.000010'; # TRIAL +our $VERSION = '0.000010'; use Exporter qw(import); our @EXPORT; BEGIN { @EXPORT = qw(based_path); } -use Class::Tiny qw(path base); +use Class::Tiny qw(path base), +{ + orig_cwd => undef, +}; # TODO add custom accessors for `path` and `base` to enforce the # type of object instances. # What we use +use Cwd; +use Getargs::Mixed; use Path::Class; # Docs {{{1 @@ -42,7 +47,8 @@ The path, as a L or L instance. May not be specified as a string when creating a new object, since there's no reliable way to tell whether a file or directory would be intended. -This must be a relative path. +This must be a relative path, since the whole point of this module is to +combine partial paths! =head2 base @@ -51,6 +57,11 @@ May be specified as a string for convenience; however, C<''> (the empty string) is forbidden (to avoid confusion). Use C for the current directory or C for the root directory. +=head2 orig_cwd + +The working directory at the time the BasedPath instance was created. +This is an absolute path. + =head1 FUNCTIONS =head2 is_file @@ -85,6 +96,23 @@ sub orig { ); } #orig() +=head2 path_wrt + +Returns a C representing the relative path from a given +directory to the original location. (C = With Respect To) Example: + + # In directory "project" + my $based = based_path(path => file('foo'), base => dir('bar')); + $based->orig; # Path::Class::File for bar/foo + $based->path_wrt('..'); # Path::Class::File for project/bar/foo + +=cut + +sub path_wrt { + my ($self, %args) = parameters('self',['whence'], @_); + return $self->orig->relative($args{whence}); +} #path_wrt() + =head2 path_on my $new_path = $based_path->path_on($new_base); @@ -147,16 +175,22 @@ sub BUILD { my ($self) = @_; die 'Need an instance' unless ref $self; + # --- path --- croak "path must be a Path::Class::*" unless $self->path && ($self->path->DOES('Path::Class::Dir') || $self->path->DOES('Path::Class::File')); + croak "path must be relative" unless $self->path->is_relative; + # --- base --- # Accept strings as base for convenience $self->base( dir($self->base) ) if !ref($self->base) && $self->base ne ''; croak "base must be a Path::Class::Dir" unless $self->base && $self->base->DOES('Path::Class::Dir'); + # TODO? make base absolute?? + # --- orig_cwd --- + $self->orig_cwd(dir()->absolute); } #BUILD() diff --git a/t/00-load.t b/t/00-load-ah.t similarity index 69% rename from t/00-load.t rename to t/00-load-ah.t index 97a5bae..a459e5c 100644 --- a/t/00-load.t +++ b/t/00-load-ah.t @@ -5,12 +5,15 @@ use warnings; use Test::More; BEGIN { - plan tests => 2; + plan tests => 3; + use_ok( 'App::hopen' ); use_ok( 'Data::Hopen' ); # "Bail out!" is a magic string per https://books.google.com/books?id=b59cVHsH52kC&pg=PA212&lpg=PA212&dq=perl+%22use_ok%22+bail+out+on+failure&source=bl&ots=OJFLv0wb7e&sig=9FQFij7aOIDaQ0SVT68jR3pJqBE&hl=en&sa=X&ved=2ahUKEwjL5p7_0u7fAhUCqVQKHdheD_QQ6AEwBHoECAUQAQ#v=onepage&q=perl%20%22use_ok%22%20bail%20out%20on%20failure&f=false . # However, BAIL_OUT skips the remaining tests even if not running # under prove(1), which `print "Bail out!\n"` does not. } -diag( "Testing Data::Hopen $Data::Hopen::VERSION, Perl $], $^X" ); -ok($Data::Hopen::VERSION, 'has a VERSION'); +diag( "Testing App::hopen $App::hopen::VERSION, Perl $], $^X" ); +ok($App::hopen::VERSION, 'has a VERSION'); +diag 'App::hopen from ' . $INC{'App/hopen.pm'}; +diag 'Data::Hopen from ' . $INC{'Data/Hopen.pm'}; diff --git a/t/001-entity.t b/t/001-entity.t deleted file mode 100644 index a9d1585..0000000 --- a/t/001-entity.t +++ /dev/null @@ -1,16 +0,0 @@ -#!perl -# 001-entity.t: test Entity -use rlib 'lib'; -use HopenTest; - -BEGIN { - use_ok 'Data::Hopen::G::Entity'; -} - -my $e = Data::Hopen::G::Entity->new(name=>'foo'); -isa_ok($e, 'Data::Hopen::G::Entity'); -is($e->name, 'foo', 'Name was set by constructor'); -$e->name('bar'); -is($e->name, 'bar', 'Name was set by accessor'); - -done_testing(); diff --git a/t/002-link.t b/t/002-link.t deleted file mode 100644 index fc87033..0000000 --- a/t/002-link.t +++ /dev/null @@ -1,20 +0,0 @@ -#!perl -# 002-link.t: test Data::Hopen::G::Link -use rlib 'lib'; -use HopenTest; - -BEGIN { - use_ok 'Data::Hopen::G::Link'; -} - -my $e = Data::Hopen::G::Link->new(name=>'foo'); -isa_ok($e, 'Data::Hopen::G::Link'); -is($e->name, 'foo', 'Name was set by constructor'); -$e->name('bar'); -is($e->name, 'bar', 'Name was set by accessor'); - -#is_deeply($e->ops, [], 'Ops start out empty'); -#is_deeply($e->in, [], 'Inputs start out empty'); -#is_deeply($e->out, [], 'Outputs start out empty'); - -done_testing(); diff --git a/t/003-node.t b/t/003-node.t deleted file mode 100644 index b2a2c41..0000000 --- a/t/003-node.t +++ /dev/null @@ -1,16 +0,0 @@ -#!perl -# 003-node.t: test Data::Hopen::G::Node -use rlib 'lib'; -use HopenTest; - -BEGIN { - use_ok 'Data::Hopen::G::Node'; -} - -my $e = Data::Hopen::G::Node->new(name=>'foo'); -isa_ok($e, 'Data::Hopen::G::Node'); -is($e->name, 'foo', 'Name was set by constructor'); -$e->name('bar'); -is($e->name, 'bar', 'Name was set by accessor'); - -done_testing(); diff --git a/t/004-goal.t b/t/004-goal.t deleted file mode 100644 index 52a3d53..0000000 --- a/t/004-goal.t +++ /dev/null @@ -1,16 +0,0 @@ -#!perl -# 004-goal.t: test Data::Hopen::G::Goal -use rlib 'lib'; -use HopenTest; - -BEGIN { - use_ok 'Data::Hopen::G::Goal'; -} - -my $e = Data::Hopen::G::Goal->new(name=>'foo'); -isa_ok($e, 'Data::Hopen::G::Goal'); -is($e->name, 'foo', 'Name was set by constructor'); -$e->name('bar'); -is($e->name, 'bar', 'Name was set by accessor'); - -done_testing(); diff --git a/t/006-collect-op.t b/t/006-collect-op.t index 4ee21f6..de158fd 100644 --- a/t/006-collect-op.t +++ b/t/006-collect-op.t @@ -26,14 +26,14 @@ is($e->name, 'bar', 'Name was set by accessor'); is_deeply($e->run(-context => Data::Hopen::Scope::Hash->new), {}, 'run() returns {} when inputs are empty'); my $scope = Data::Hopen::Scope::Hash->new; -$scope->add(foo=>1, bar=>2, baz=>{quux=>1337}, quuux=>[1,2,3,[42,43,44]]); +$scope->put(foo=>1, bar=>2, baz=>{quux=>1337}, quuux=>[1,2,3,[42,43,44]]); my $newhr = $e->run(-context => $scope); is_deeply($newhr, $scope->_content, 'run() clones its inputs'); not_identical($scope->_content, $newhr, 'run() returns a clone, not its input'); # Nested scopes: stop at local my $inner_scope = hnew 'Scope::Hash' => 'inner'; -$inner_scope->add(inner=>'yes'); +$inner_scope->put(inner=>'yes'); $inner_scope->local(true); $inner_scope->outer($scope); $newhr = $e->run(-context=>$inner_scope); @@ -51,7 +51,7 @@ not_identical($inner_scope->_content, $newhr, 'levels=1 run() does not clone inn not_identical($scope->_content, $newhr, 'levels=1 run() does not clone outer scope'); my $outer_scope = Data::Hopen::Scope::Hash->new; -$outer_scope->add(outer=>'yep'); +$outer_scope->put(outer=>'yep'); $scope->outer($outer_scope); $newhr = $e->run(-context=>$inner_scope); is_deeply($newhr, {%{$inner_scope->_content}, %{$scope->_content}}, 'levels=1 run() does not get outermost'); diff --git a/t/007-hnew.t b/t/007-hnew.t deleted file mode 100755 index 8491abd..0000000 --- a/t/007-hnew.t +++ /dev/null @@ -1,18 +0,0 @@ -#!perl -# t/007-hnew.t: test hnew() -use rlib 'lib'; -use HopenTest; - -BEGIN { - use_ok 'Data::Hopen'; -} - -my $e = hnew Entity => 'foo'; -isa_ok($e, 'Data::Hopen::G::Entity'); -is($e->name, 'foo', 'Name was set by constructor'); - -$e = hnew 'G::Entity' => 'bar'; -isa_ok($e, 'Data::Hopen::G::Entity'); -is($e->name, 'bar', 'Name was set by constructor'); - -done_testing(); diff --git a/t/008-nameset.t b/t/008-nameset.t deleted file mode 100755 index 6252018..0000000 --- a/t/008-nameset.t +++ /dev/null @@ -1,76 +0,0 @@ -#!perl -# t/007-nameset.t: test Data::Hopen::Util::NameSet -use rlib 'lib'; -use HopenTest; - -BEGIN { - use_ok 'Data::Hopen::Util::NameSet'; -} - -# NOTE: Even though `$s ~~ 'x'` (object first) is supported for now, we don't -# use it. This is to retain compatibility with the 5.27.7-style smartmatch -# if that ever comes back (http://blogs.perl.org/users/leon_timmermans/2017/12/smartmatch-in-5277.html). - -my $s; - -# Run the tests twice: once without add() and once with add(). -for(my $iter=0; $iter<2; ++$iter) { - - # Set up this iter's test object - if($iter == 0) { - $s = Data::Hopen::Util::NameSet->new(); - isa_ok($s, 'Data::Hopen::Util::NameSet'); - ok(!$s->contains('x'), "Empty nameset rejects 'x'"); - ok(!('x' ~~ $s), "Empty nameset rejects 'x'"); - $s->add('foo', 'bar', qr/bat/, [qr/qu+x/i, 'array', ['inner array']], - {key=>'value'}, 'русский', 'язык'); - - } elsif($iter == 1) { - $s = Data::Hopen::Util::NameSet->new( - 'foo', 'bar', qr/bat/, [qr/qu+x/i, 'array', ['inner array']], - {key=>'value'}, 'русский', 'язык'); - isa_ok($s, 'Data::Hopen::Util::NameSet'); - } - - # Accessors - is(ref($s->strings), 'ARRAY', 'strings is an arrayref'); - is(ref($s->regexps), 'ARRAY', 'regexps is an arrayref'); - - # Contains tests - ok(!$s->contains('x'), "Nameset rejects 'x'"); - ok(!('x' ~~ $s), "Nameset rejects 'x'"); - ok($s->contains($_), "Nameset accepts literal $_") - foreach (qw(foo bar array key), 'inner array'); - ok($_ ~~ $s, "Nameset accepts literal $_ ~~") - foreach qw(foo bar array key), 'inner array'; - ok($s->contains($_), "Nameset accepts $_") foreach qw(bat qux QUX QuUuUx); - ok($_ ~~ $s, "Nameset accepts $_ ~~") foreach qw(bat qux QUX QuUuUx); - - # UTF-8 words - ok $_ ~~ $s, "Nameset accepts UTF8 $_" foreach qw(русский язык); - - # Some kanji and hiragana - ok !($_ ~~ $s), "Nameset rejects UTF8 $_" foreach qw(日本語 ひらがな); - - # Partial words shouldn't succeed - ok(!($_ ~~ $s), "Nameset rejects $_") - foreach qw(foobar fooqux fooQUX other_inner_array foofoo batqux batarray); - -} #foreach test - -# Complex -$s = Data::Hopen::Util::NameSet->new(qw(foo bar), qr/./); -ok($s->complex, 'set with regexps is complex'); -$s = Data::Hopen::Util::NameSet->new(qw(foo bar)); -ok(!$s->complex, 'set without regexps is not complex'); - -# Complex -$s = Data::Hopen::Util::NameSet->new; -$s->add(qw(foo bar), qr/./); -ok($s->complex, 'set with regexps is complex'); -$s = Data::Hopen::Util::NameSet->new; -$s->add(qw(foo bar)); -ok(!$s->complex, 'set without regexps is not complex'); - -done_testing(); -# vi: set fenc=utf8: diff --git a/t/009-hopen-constants.t b/t/009-hopen-constants.t deleted file mode 100755 index 6778140..0000000 --- a/t/009-hopen-constants.t +++ /dev/null @@ -1,20 +0,0 @@ -#!perl -# 009-hopen-constants.t: test Data::Hopen constants -use rlib 'lib'; -use HopenTest; - -use Data::Hopen ':all'; - -ok $_ ~~ UNSPECIFIED, "UNSPECIFIED accepts $_" - foreach qw(a 0 - ab a0 0a a- -a русский язык 日本語 ひらがな); - -ok !($_ ~~ NOTHING), "NOTHING rejects $_" - foreach qw(a 0 - ab a0 0a a- -a русский язык 日本語 ひらがな); - -ok !("" ~~ UNSPECIFIED), "UNSPECIFIED rejects the empty string"; - # Because UNSPECIFIED doesn't mean missing -ok !("" ~~ NOTHING), "NOTHING rejects the empty string"; - # Because NOTHING really means nothing! - -done_testing(); -# vi: set fenc=utf8: diff --git a/t/010-scope-hash.t b/t/010-scope-hash.t deleted file mode 100755 index 7500ad1..0000000 --- a/t/010-scope-hash.t +++ /dev/null @@ -1,41 +0,0 @@ -#!perl -# t/010-scope.t: test Data::Hopen::Scope -use rlib 'lib'; -use HopenTest; - -sub makeset { - my $set = Set::Scalar->new; - $set->insert(@_); - return $set; -} - -use Data::Hopen::Scope::Hash; - -my $s = Data::Hopen::Scope::Hash->new(); -isa_ok($s, 'Data::Hopen::Scope::Hash'); - -$s->add(foo => 42); -cmp_ok($s->find('foo'), '==', 42, 'Retrieving works'); - -ok($s->names->is_equal(makeset('foo')), 'names works with a non-nested scope'); -ok($s->names(0)->is_equal(makeset('foo')), 'names(0) works with a non-nested scope'); - -my $t = Data::Hopen::Scope::Hash->new()->add(bar => 1337); -$t->outer($s); -ok($t->names->is_equal(makeset(qw(foo bar))), 'names works with a nested scope'); -ok($t->names(1)->is_equal(makeset(qw(foo bar))), 'names(1) works with a nested scope'); -ok($t->names(0)->is_equal(makeset(qw(bar))), 'names(0) works with a nested scope'); - -cmp_ok($s->find('foo'), '==', 42, 'Retrieving from a parent (outer) scope works'); - -my $u = Data::Hopen::Scope::Hash->new()->add(quux => 128); -$u->outer($t); -ok($u->names->is_equal(makeset(qw(foo bar quux))), 'names works with a doubly-nested scope'); -ok($u->names(2)->is_equal(makeset(qw(foo bar quux))), 'names(2) works with a doubly-nested scope'); -ok($u->names(1)->is_equal(makeset(qw(bar quux))), 'names(1) works with a doubly-nested scope'); -ok($u->names(0)->is_equal(makeset(qw(quux))), 'names(0) works with a doubly-nested scope'); - -cmp_ok($s->find('foo'), '==', 42, 'Retrieving from a grandparent scope works'); - -done_testing(); -# vi: set fenc=utf8: diff --git a/t/011-scope-env.t b/t/011-scope-env.t deleted file mode 100755 index 2418253..0000000 --- a/t/011-scope-env.t +++ /dev/null @@ -1,51 +0,0 @@ -#!perl -# t/011-scope-env.t: test Data::Hopen::Scope::Environment -use rlib 'lib'; -use HopenTest; -use Data::Hopen::Scope::Hash; - -$Data::Hopen::VERBOSE=@ARGV; - # say `perl -Ilib t/011-scope-env.t -- foo` to turn on verbose output - -use Data::Hopen::Scope::Environment; - -my $s = Data::Hopen::Scope::Environment->new(); -isa_ok($s, 'Data::Hopen::Scope::Environment'); -ok($s->DOES('Data::Hopen::Scope'), 'Scope::Environment DOES Scope'); - -$s->add(foo_hopen => 42); -cmp_ok($ENV{foo_hopen}, '==', 42, 'add() updates %ENV'); -cmp_ok($s->find('foo_hopen'), '==', 42, 'Retrieving previously-set variable works'); - -foreach my $varname (qw(SHELL COMSPEC PATH)) { - is($s->find($varname), $ENV{$varname}, "Finds existing env var $varname") - if exists $ENV{$varname}; -} - -# Some constants for variable names -our ($varname_inner, $varname_outer, $varname_env); -local *varname_inner = \'+;!@#$%^&*() Some crazy variable name that is not a valid env var name'; -local *varname_outer = \'+;!@#$%^&*() Another crazy variable name that is not a valid env var name'; -local *varname_env = \'__ENV_VAR_FOR_TESTING_HOPEN_'; - # On Win32, ENV variable names are all uppercase. - -my $inner = Data::Hopen::Scope::Hash->new()->add($varname_inner => 42); -my $outer = Data::Hopen::Scope::Hash->new()->add($varname_outer => 1337); - -$inner->outer($s); -$s->outer($outer); - -cmp_ok($inner->find($varname_outer), '==', 1337, 'find() through intervening Scope::Environment works'); -cmp_ok($s->find($varname_outer), '==', 1337, 'find() from Scope::Environment to outer works'); - -$ENV{$varname_env} = 'C=128'; -#diag "New environment var $varname_env is $ENV{$varname_env} (should be 'C=128')"; - -ok(!$outer->names->has($varname_env),'$ENV{}-set var is not in scope in outer'); - -ok($s->names->has($varname_env), '$ENV{}-set var is in scope'); -ok($inner->names->has($varname_env), '$ENV{}-set var is in scope starting from inner'); -is($inner->find($varname_env), 'C=128', 'find() from inner up to Scope::Environment works'); - -done_testing(); -# vi: set fenc=utf8: diff --git a/t/012-scope-nested.t b/t/012-scope-nested.t deleted file mode 100755 index b963a19..0000000 --- a/t/012-scope-nested.t +++ /dev/null @@ -1,95 +0,0 @@ -#!perl -# t/012-scope-nested.t: test nested Data::Hopen::Scope instances -use rlib 'lib'; -use HopenTest; -use Set::Scalar; - -use Data::Hopen::Scope::Hash; -use Data::Hopen::Scope::Environment; - -sub makeset { - my $set = Set::Scalar->new; - $set->insert(@_); - return $set; -} - -# Make scopes - -my $innermost = Data::Hopen::Scope::Hash->new(); -isa_ok($innermost, 'Data::Hopen::Scope::Hash'); -my $middle = Data::Hopen::Scope::Hash->new(); -isa_ok($middle, 'Data::Hopen::Scope::Hash'); -my $outermost_env = Data::Hopen::Scope::Environment->new(); -isa_ok($outermost_env, 'Data::Hopen::Scope::Environment'); - -$middle->outer($outermost_env); -$innermost->outer($middle); - -# Test find() - -use constant CRAZY_NAME => "==|> something wacky \x{00a2} <|=="; - # equals signs and lowercase => not a valid Windows env var name - # pipe/gt/lt => not a POSIX env var name you would create without - # serious effort - # U+00A2: not in the POSIX Portable Character Set (references at - # https://stackoverflow.com/a/2821183/2877364) - -$innermost->add(CRAZY_NAME, 42); -cmp_ok($innermost->find(CRAZY_NAME), '==', 42, 'Retrieving from hash works'); - -$middle->add(bar => 1337); -cmp_ok($middle->find('bar'), '==', 1337, 'Retrieving from hash works'); -cmp_ok($innermost->find('bar'), '==', 1337, 'Retrieving from hash through outer works'); -ok(!defined($middle->find(CRAZY_NAME)), "Inner doesn't leak into outer"); - -my $env_var_name; -foreach my $varname (qw(SHELL COMSPEC PATH)) { - next unless exists $ENV{$varname}; - $env_var_name = $varname; - - is($innermost->find($varname), $ENV{$varname}, "Finds env var $varname through double chain"); - is($middle->find($varname), $ENV{$varname}, "Finds env var $varname through single chain"); - is($outermost_env->find($varname), $ENV{$varname}, "Finds env var $varname directly"); -} - -# Test names() with -levels -ok($innermost->names(-levels=>0)->is_equal(makeset(CRAZY_NAME)), 'names, levels=0'); -ok($innermost->names(-levels=>1)->is_equal(makeset(CRAZY_NAME, 'bar')), 'names, levels=1'); -ok($innermost->names(-levels=>2)->is_equal(makeset(CRAZY_NAME, 'bar', keys %ENV)), 'names, levels=2'); -ok($innermost->names(-levels=>1337)->is_equal(makeset(CRAZY_NAME, 'bar', keys %ENV)), 'names, levels=1337'); - -# Test find() with -levels -cmp_ok($innermost->find(CRAZY_NAME, -levels=>0), '==', 42, 'find, levels=0'); -ok(!defined $innermost->find('bar', -levels=>0), 'find, levels=0, does not go up'); - -cmp_ok($innermost->find(CRAZY_NAME, -levels=>1), '==', 42, 'find at 0, levels=1'); -cmp_ok($innermost->find('bar', -levels=>1), '==', 1337, 'find at 1, levels=1'); -ok(!defined $innermost->find($env_var_name, -levels=>1), 'find, levels=1, does not go up') - if $env_var_name; - -cmp_ok($innermost->find(CRAZY_NAME, -levels=>2), '==', 42, 'find at 0, levels=2'); -cmp_ok($innermost->find('bar', -levels=>2), '==', 1337, 'find at 1, levels=2'); - -# Test names() with local -$innermost->local(true); -ok($innermost->names(-levels=>'local')->is_equal(makeset(CRAZY_NAME)), 'names, levels=local, innermost local'); -$innermost->local(false); - -$middle->local(true); -ok($innermost->names(-levels=>'local')->is_equal(makeset(CRAZY_NAME, 'bar')), 'names, levels=local, middle local'); -$middle->local(false); - -# Test find() with local -$innermost->local(true); -cmp_ok($innermost->find(CRAZY_NAME, -levels=>'local'), '==', 42, 'find at 0, levels=local, innermost local'); -ok(!defined $innermost->find('bar', -levels=>'local'), 'find at 1 does not leak, levels=local, innermost local'); -ok(!defined $innermost->find($env_var_name, -levels=>'local'), 'find at 2 does not leak, levels=local, innermost local') if $env_var_name; -$innermost->local(false); - -$middle->local(true); -cmp_ok($innermost->find(CRAZY_NAME, -levels=>'local'), '==', 42, 'names, levels=local, middle local'); -ok(!defined $innermost->find($env_var_name, -levels=>'local'), 'find at 2 does not leak, levels=local, middle local') if $env_var_name; -$middle->local(false); - -done_testing(); -# vi: set fenc=utf8: diff --git a/t/021-dag-single-goal.t b/t/021-dag-single-goal.t deleted file mode 100755 index fe2f647..0000000 --- a/t/021-dag-single-goal.t +++ /dev/null @@ -1,47 +0,0 @@ -#!perl -# t/021-dag-single-goal.t: basic tests of Data::Hopen::G::DAG with one goal -use rlib 'lib'; -use HopenTest; -use Test::Deep; - -use Data::Hopen; -use Data::Hopen::Scope::Hash; -use Data::Hopen::Scope::Environment; -use Data::Hopen::G::Link; - -$Data::Hopen::VERBOSE = @ARGV; - -sub run { - my $outermost_scope = Data::Hopen::Scope::Hash->new()->add(foo => 42); - - my $dag = hnew DAG => 'dag'; - - # Add a goal - my $goal = $dag->goal('all'); - is($goal->name, 'all', 'DAG::goal() sets goal name'); - ok($dag->_graph->has_edge($goal, $dag->_final), 'DAG::goal() adds goal->final edge'); - - # Add an op - my $link = hnew Link => 'link1', greedy => 1; - my $op = hnew CollectOp => 'op1', levels => 3; - # levels = 0 => just the op's overrides - # levels = 1 => also the op's inputs (DAG $node_inputs) - # levels = 2 => also the DAG's overrides ($dag->scope) - # levels = 3 => also the DAG's inputs (inputs to $dag->run) - # TODO make a helper function for determining these? - isa_ok($op,'Data::Hopen::G::CollectOp'); - $dag->connect($op, $link, $goal); - ok($dag->_graph->has_edge($op, $goal), 'DAG::connect() adds edge'); - - # Run it - #print Dumper($outermost_scope); - my $dag_out = $dag->run($outermost_scope); - #print Dumper($dag_out); - #print Dumper($op->outputs); - - cmp_deeply($dag_out, {all => { foo=>42 } }, "DAG passes everything through, tagged with the goal's name"); -} - -run(); - -done_testing(); diff --git a/t/030-util-basedpath.t b/t/030-util-basedpath.t index 2da1e60..f40f410 100644 --- a/t/030-util-basedpath.t +++ b/t/030-util-basedpath.t @@ -4,13 +4,25 @@ use rlib 'lib'; use HopenTest 'App::hopen::Util::BasedPath'; use Path::Class; -my $e2 = DUT->new(path=>dir(), base=>dir()); +my $e2; + +$e2 = $DUT->new(path=>dir(), base=>dir()); isa_ok($e2, $DUT); +is($e2->path, dir(), "path is set correctly"); +is($e2->base, dir(), "base is set correctly"); +ok($e2->orig_cwd->is_absolute, "orig_cwd is stored in absolute form"); +is($e2->orig_cwd, dir()->absolute, "orig_cwd is set correctly"); $e2 = based_path(path=>dir(), base=>dir()); isa_ok($e2, $DUT); -eval { $e2 = DUT->new(path=>dir(), base=>""); }; +my $d = dir('','foo'); +ok($d->is_absolute, 'Sanity check (absolute dir)'); +eval { $e2 = $DUT->new(path=>dir('','foo'), base=>dir()); }; +ok($@, 'Constructor rejects absolute path=>(something absolute)'); + + +eval { $e2 = $DUT->new(path=>dir(), base=>""); }; ok($@, 'Constructor rejects base=>""'); $e2 = based_path(path=>dir(), base=>dir('')); diff --git a/t/040-ah-g-assetop.t b/t/040-ah-g-assetop.t new file mode 100755 index 0000000..033fee0 --- /dev/null +++ b/t/040-ah-g-assetop.t @@ -0,0 +1,13 @@ +#!perl +# t/040-ah-g-assetop: tests of App::hopen::G::AssetOp +use rlib 'lib'; +use HopenTest; +use Test::Exception; + +use App::hopen::G::AssetOp; + +dies_ok { App::hopen::G::AssetOp->new(asset=>$_) } + "Rejects asset " . ($_ // 'undef') + foreach (undef, 'hello', 42); + +done_testing(); diff --git a/t/100-h.t b/t/100-h.t new file mode 100644 index 0000000..8d4c58b --- /dev/null +++ b/t/100-h.t @@ -0,0 +1,48 @@ +#!perl +# 100-h: test App::hopen::H +use rlib 'lib'; +use HopenTest 'App::hopen::H'; +use Path::Class; + +use App::hopen::BuildSystemGlobals; +use Data::Hopen qw(:default :v); +use Data::Hopen::G::DAG; + +package FakeGenerator { + # Since AhG::FilesCmd requires a visitor be present + use parent 'Data::Hopen::Visitor'; + use Class::Tiny; + sub asset { } + sub visit_node { } + sub visit_goal { } +} + +$VERBOSE = @ARGV; + +# H requires $ProjDir to be initialized +$ProjDir = dir(); +$DestDir = dir('nonexistent'); + +# Make the DAG +my $dag = hnew DAG => 'dag'; +isa_ok($dag, 'Data::Hopen::G::DAG'); + +# Make the node +my $builder = $dag->App::hopen::H::files('foo.c'); +isa_ok($builder, 'Data::Hopen::G::GraphBuilder'); +isa_ok($builder->node, 'App::hopen::G::FilesCmd'); +my $node = $builder->node; + +# Run the DAG +$builder->default_goal; +my $dag_out = $dag->run(-phase=>'foo', -visitor => FakeGenerator->new); + +# Check the results +ok($node->outputs, 'Node has outputs'); +is(ref $node->outputs->{made}, 'ARRAY', 'Node outputs made arrayref'); +cmp_ok(@{$node->outputs->{made}}, '==', 1, 'One input->one output'); +my $made = $node->outputs->{made}->[0]; +isa_ok($made, 'App::hopen::Asset'); +is($made->target->orig, dir()->file('foo.c'), 'Filename carries through'); + +done_testing(); diff --git a/t/lib/HopenTest.pm b/t/lib/HopenTest.pm index cd2d1c2..0b6e665 100755 --- a/t/lib/HopenTest.pm +++ b/t/lib/HopenTest.pm @@ -22,6 +22,8 @@ use Test::More; use Data::Hopen::Base; +BEGIN { $Data::Dumper::Indent = 1; } # For easier-to-read dumps + # Definitions from this file use constant { true => !!1, @@ -36,6 +38,10 @@ sub import { #my $pkg = shift; # Don't need our package name + # Keep output lines in order + STDOUT->autoflush(true); + STDERR->autoflush(true); + # --- Basic exports/re-exports ------------------------------------ # Export all symbols listed in @EXPORT @@ -50,8 +56,7 @@ sub import { # --- Process argument list ---------------------------------------- - # First argument: if a non-reference, the name of the package to load - # and alias to DUT. + # First argument: if a non-reference, the name of the package to load. if(@_ && $_[0] && !ref($_[0])) { my $dut = shift; @@ -59,12 +64,18 @@ sub import { eval "require $dut;"; die "Could not locate DUT $dut\n$@\n" if $@; - Package::Alias->import::into($target, DUT => $dut); # Load it + $dut->import::into($target); # load it + + #Package::Alias->import::into($target, DUT => $dut); # Load it + # NOTE: Class::Tiny subclasses won't construct properly if called via + # a package alias (e.g., DUT->new). Therefore, don't do the alias. { # Export the name of the DUT package as the caller's $DUT no strict 'refs'; - *{ $target . '::DUT' } = \$dut; + *{ $target . '::DUT' } = eval qq(\\"$dut"); # eval => constant } + + diag "DUT is $dut"; } } #import()