Mercurial > hg > Gears > Gears
view src/parallel_execution/lib/Gears/Util.pm @ 709:ed7183a46dca
create a stub when the output is a different interface
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 24 Aug 2020 21:20:34 +0900 |
parents | cf82fc3512dd |
children | a7f52fd3d546 |
line wrap: on
line source
package Gears::Util; use strict; use warnings; use Carp qw/croak/; use File::Find qw/find/; my $cbc_files; my $header_files; my $cbc_files_analyzed_code_gear; sub uniq { my $class = shift; my %seen; return grep { !$seen{$_}++ } @_; } sub file_checking { my ($class, $file_name) = @_; unless (-f $file_name) { croak "[ERROR] invalid filepath :$file_name\n"; } return $file_name; } sub slup { my ($class,$file) = @_; open my $fh, '<', $file; local $/; my $f = <$fh>; return $f; } sub find_cbc_sources_from_path { my ($class, $find_path) = @_; $find_path //= "."; return $cbc_files if $cbc_files; my @files; find( { wanted => sub { push @files, $_ if /\.cbc/ }, no_chdir => 1 }, $find_path); $cbc_files = \@files; return $cbc_files; } sub find_headers_from_path { my ($class, $find_path) = @_; $find_path //= "."; return $header_files if $header_files; my @files; find( { wanted => sub { push @files, $_ if /\.(?:h|dg)/ }, no_chdir => 1 }, $find_path); $header_files = \@files; return $header_files; } sub collect_codegears_from_all_cbc_sources { my ($class, $find_path) = @_; $find_path //= "."; if ($cbc_files_analyzed_code_gear) { return $cbc_files_analyzed_code_gear; } Gears::Util->find_cbc_sources_from_path($find_path) unless ($cbc_files); my $codes; for my $file (@$cbc_files) { open my $fh, '<', $file; while (my $line = <$fh>) { if ($line =~ /^__code\s+(\w+)\((.*)\)\s*\{/) { my $codeGear = $1; my $arg = $2; $codes->{$file}->{$codeGear} = $arg; } } close $fh; } $cbc_files_analyzed_code_gear = $codes; return $cbc_files_analyzed_code_gear; } sub searchFileContainsCodeGear { my ($class, $codeGearName) = @_; unless ($cbc_files_analyzed_code_gear) { Gears::Util-> collect_codegears_from_all_cbc_sources(); } my @res = grep { exists $cbc_files_analyzed_code_gear->{$_}->{$codeGearName} } keys %$cbc_files_analyzed_code_gear; unless (@res) { return undef; } return \@res; } sub parseCodeGearDeclarationArg { my ($clas, $args) = @_; my %tname2type; while ($args =~ /\s*(struct|union|const|enum)?\s*([\w\[\]_]+)\*?\s*(\w+),?/g) { #$args eq (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...)); my $const_type = $1; my $ttype = $2; my $tname = $3; $ttype =~ s/(Impl|Isa|Type)/Data/; if ($const_type && ($const_type =~ /(const|enum)/)) { $ttype = "$1 $ttype"; } $tname2type{$tname} = $ttype; } return \%tname2type; } 1;