Mercurial > hg > GearsTemplate
view src/parallel_execution/update_context.pl @ 575:3e3158198cb5
bug fix...
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 25 Nov 2019 17:03:33 +0900 |
parents | 7d66643d837d |
children |
line wrap: on
line source
#!/usr/bin/env perl use strict; use warnings; use Getopt::Std; use FindBin; use lib "$FindBin::Bin/lib"; use Gears::Util; my %opt; getopts("wc" => \%opt); my $interface_file = shift or die "require itnerface file"; my $h2context = Gears::Util->parse_interface($interface_file); my $context = Gears::Util->h2context_str($h2context); if ($opt{c}) { print "$context"; exit 0; } my ($first,$last) = slup_context_h($h2context->{name}); if ($opt{w}) { context_write(@{$first},$context,@{$last}); } else { context_dump(@{$first},$context,@{$last}); } sub slup_context_h { open my $fh, '<', 'context.h'; my $data_gear_name = shift; my @first_context_headers = (); my @last_context_headers = (); while (my $line = <$fh>) { if ( $line =~ /union Data end/) { push(@last_context_headers, $line); push(@last_context_headers, <$fh>); last; } if ( $line =~ /struct $data_gear_name/) { print "WARN! $data_gear_name struct already exists\n"; exit 1; } push(@first_context_headers, $line); } close $fh; #print "@first_context_headers\n"; #print "@last_context_headers\n"; return (\@first_context_headers,\@last_context_headers); } sub context_dump { for my $line (@_) { print "$line"; } } sub context_write { open my $fh, '>', "context.h"; for my $line (@_) { print $fh "$line"; } close $fh; }