Mercurial > hg > Gears > Gears

changeset 688:317ff12ab253

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
add Gears::Interface module
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Fri, 21 Aug 2020 15:33:24 +0900
parents 90a35ebecac5
children 39f856a85565
files src/parallel_execution/lib/Gears/Context.pm src/parallel_execution/lib/Gears/Interface.pm src/parallel_execution/lib/Gears/Util.pm src/parallel_execution/perlTests/util.t
diffstat 4 files changed, 125 insertions(+), 146 deletions(-) [+]
line wrap: on
line diff
--- a/src/parallel_execution/lib/Gears/Context.pm	Fri Aug 21 14:54:27 2020 +0900
+++ b/src/parallel_execution/lib/Gears/Context.pm	Fri Aug 21 15:33:24 2020 +0900
@@ -4,6 +4,7 @@
 use warnings;
 
 use Gears::Util;
+use Gears::Interface;
 
 use Module::Load qw/load/;
 
@@ -166,10 +167,10 @@
   #print Dumper $dg2path;
   #print Dumper  $self;
 
-  map {  my $ir = Gears::Util->parse_interface($inters->{$_});   $dg_str{$_}->{elem} = $ir if $ir} keys %$inters;
+  map {  my $ir = Gears::Interface->parse($inters->{$_});   $dg_str{$_}->{elem} = $ir if $ir} keys %$inters;
 
   map {
-    my $res = Gears::Util->parse($impls->{$_});
+    my $res = Gears::Interface->parse($impls->{$_});
     if ($res) {
       if ($res->{isa}) {
           $dg_str{$res->{isa}}->{impl}->{$_} = $res;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/parallel_execution/lib/Gears/Interface.pm	Fri Aug 21 15:33:24 2020 +0900
@@ -0,0 +1,110 @@
+package Gears::Interface;
+use strict;
+use warnings;
+use Carp qw/croak carp/;
+
+
+use Gears::Util;
+
+sub parse {
+
+    # create this data structure
+
+  my ($class, $file) = @_;
+  my $ir  = {};
+  $ir->{file_name} = $file;
+
+  Gears::Util->file_checking($file);
+  open my $fh, '<', $file;
+  my $line = <$fh>;
+  my $static_data_gear_write_mode = 0;
+
+  my $directory_containing_file = "";
+
+  if ($file  =~ m<([\.\w/]+)/\w+\.(?:cbc|h|c)>) {
+     $directory_containing_file = $1;
+  }
+
+
+  while ($line =~ /#include\s+"([\w\/\.]+)"/) {
+    my $header_file = $1;
+    if ($header_file =~ m|\./context\.h|) {
+      next;
+     }
+    push(@{$ir->{cbc_context_include_headers}}, "$directory_containing_file/$header_file");
+    $line = <$fh>;
+  }
+
+  # skip space
+
+  while ($line =~ /^\s*$/) {
+    $line = <$fh>;
+  }
+
+  if ($line =~ /typedef struct (\w+)\s?<.*>([\s\w{]+)/) {
+    my $vname = $1;
+    unless ($vname) {
+      carp "[WARN] invalied struct name from $file";
+      return undef;
+    }
+    $ir->{name} = $vname;
+    my $annotation = $2;
+
+    if ($annotation =~ m|\s*impl\s*([\w+]+)\s*{|) {
+      $ir->{isa} = $1;
+    }
+  }
+
+  unless ($ir->{name}) {
+    return undef;
+  }
+
+  my @data_gears;
+  while ($line = <$fh>) {
+    chomp $line;
+    if ($line =~ m|\s*/\*|) {
+      while ( $line !~ m|\*/|) {
+        $line = <$fh>;
+        next;
+      }
+      next;
+    }
+    next if ($line =~ /^\s+$/);
+    next if ($line =~ m[^\s*//]);
+    next if ($line =~ m[^\}\s*$ir->{name};]);
+
+    if ($line =~ m|__code (\w+)|) {
+
+      push(@data_gears,"enum Code $1;"); #this case insert __code name (__code hoge -> enum Code hoge;)
+
+      #In the case of writing field variables one line at a time, cancel the following
+      next if $static_data_gear_write_mode;
+
+      my $args = $';
+      #$args eq  (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...));
+      while ($args =~ /\s*(struct|union|const|enum)?\s*([\w*\[\]_]+)\s*(\w+)?,?/g) {
+        my $const_type = $1;
+        my $type = $2;
+        my $vname = $3;
+        next if ($type eq '__code');
+        next unless $vname; # __code hoge(int ret, __code next(ret, ...); this is second "ret" case
+        $type =~ s/^(?:Impl|Type|Isa)\s*(\*)?/union Data$1/;
+
+        my $val = "$type $vname;";
+        push(@data_gears, $const_type ?  "$const_type $val" : $val);
+      }
+      next;
+    }
+
+    #this is a case of writing field variables one line at a time
+    $line =~ s/^\s+//;
+    push(@data_gears,$line);
+    $static_data_gear_write_mode = 1;
+  }
+
+  push(@{$ir->{content}}, Gears::Util->uniq(@data_gears));
+  return $ir;
+}
+
+
+1;
--- a/src/parallel_execution/lib/Gears/Util.pm	Fri Aug 21 14:54:27 2020 +0900
+++ b/src/parallel_execution/lib/Gears/Util.pm	Fri Aug 21 15:33:24 2020 +0900
@@ -5,149 +5,9 @@
 use File::Find;
 
 
-sub parse_interface {
-  my ($class, $file_name) = @_;
-  my $ir = Gears::Util->parse($file_name);
 
-  unless ($ir->{name}) {
-    carp "[WARN] invalid interface name at $file_name";
-    return undef;
-  }
-  return $ir;
-}
-
-
-sub parse {
-
-    # create this data structure
-    #  \ {
-    #    content     [
-    #        [0]  "union Data* stack;
-    #",
-    #        [1]  "union Data* data;
-    #",
-    #        [2]  "union Data* data1;
-    #",
-    #        [3]  "enum Code whenEmpty;
-    #",
-    #        [4]  "enum Code clear;
-    #",
-    #        [5]  "enum Code push;
-    #",
-    #        [6]  "enum Code pop;
-    #",
-    #        [7]  "enum Code pop2;
-    #",
-    #        [8]  "enum Code isEmpty;
-    #",
-    #        [9]  "enum Code get;
-    #",
-    #        [10] "enum Code get2;
-    #",
-    #        [11] "enum Code next;
-    #"
-    #    ],
-    #    file_name   "/Users/anatofuz/src/firefly/hg/Gears/Gears/src/parallel_execution/tools/../Stack.h",
-    #    name        "Stack"
-    #}
-
-  my ($class, $file) = @_;
-  my $ir  = {};
-  $ir->{file_name} = $file;
-
-  Gears::Util->file_checking($file);
-  open my $fh, '<', $file;
-  my $line = <$fh>;
-  my $static_data_gear_write_mode = 0;
-
-  my $directory_containing_file = "";
-
-  if ($file  =~ m<([\.\w/]+)/\w+\.(?:cbc|h|c)>) {
-     $directory_containing_file = $1;
-  }
-
-
-  while ($line =~ /#include\s+"([\w\/\.]+)"/) {
-    my $header_file = $1;
-    if ($header_file =~ m|\./context\.h|) {
-      next;
-     }
-    push(@{$ir->{cbc_context_include_headers}}, "$directory_containing_file/$header_file");
-    $line = <$fh>;
-  }
-
-  # skip space
-
-  while ($line =~ /^\s*$/) {
-    $line = <$fh>;
-  }
-
-  if ($line =~ /typedef struct (\w+)\s?<.*>([\s\w{]+)/) {
-    my $vname = $1;
-    unless ($vname) {
-      carp "[WARN] invalied struct name from $file";
-      return undef;
-    }
-    $ir->{name} = $vname;
-    my $annotation = $2;
-
-    if ($annotation =~ m|\s*impl\s*([\w+]+)\s*{|) {
-      $ir->{isa} = $1;
-    }
-  }
-
-  unless ($ir->{name}) {
-    return undef;
-  }
-
-  my @data_gears;
-  while ($line = <$fh>) {
-    chomp $line;
-    if ($line =~ m|\s*/\*|) {
-      while ( $line !~ m|\*/|) {
-        $line = <$fh>;
-        next;
-      }
-      next;
-    }
-    next if ($line =~ /^\s+$/);
-    next if ($line =~ m[^\s*//]);
-    next if ($line =~ m[^\}\s*$ir->{name};]);
-
-    if ($line =~ m|__code (\w+)|) {
-
-      push(@data_gears,"enum Code $1;"); #this case insert __code name (__code hoge -> enum Code hoge;)
-
-      #In the case of writing field variables one line at a time, cancel the following
-      next if $static_data_gear_write_mode;
-
-      my $args = $';
-      #$args eq  (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...));
-      while ($args =~ /\s*(struct|union|const|enum)?\s*([\w*\[\]_]+)\s*(\w+)?,?/g) {
-        my $const_type = $1;
-        my $type = $2;
-        my $vname = $3;
-        next if ($type eq '__code');
-        next unless $vname; # __code hoge(int ret, __code next(ret, ...); this is second "ret" case
-        $type =~ s/^(?:Impl|Type|Isa)\s*(\*)?/union Data$1/;
-
-        my $val = "$type $vname;";
-        push(@data_gears, $const_type ?  "$const_type $val" : $val);
-      }
-      next;
-    }
-
-    #this is a case of writing field variables one line at a time
-    $line =~ s/^\s+//;
-    push(@data_gears,$line);
-    $static_data_gear_write_mode = 1;
-  }
-
-  push(@{$ir->{content}}, _uniq(@data_gears));
-  return $ir;
-}
-
-sub _uniq {
+sub uniq {
+  my $class = shift;
   my %seen;
   return grep { !$seen{$_}++ } @_;
 }
@@ -213,7 +73,7 @@
 #
 
   my ($class, $file)  = @_;
-  my $ir = Gears::Util->parse($file);
+  my $ir = Gears::Interface->parse($file);
 
   $ir->{hasOutputArgs} = {};
 
--- a/src/parallel_execution/perlTests/util.t	Fri Aug 21 14:54:27 2020 +0900
+++ b/src/parallel_execution/perlTests/util.t	Fri Aug 21 15:33:24 2020 +0900
@@ -22,7 +22,16 @@
 };
 
 subtest 'parse' => sub {
+  subtest 'file_checking' => sub {
+    plan tests => 2;
+
+    eval { Gears::Util->parse("nonexistent_file.c") };
+    ok $@;
+    like( $@, qr/invalid filepath/ );
+  };
+
   subtest 'parsing_stack' => sub {
+    plan tests => 1;
 
     my $stack_header = "$FindBin::Bin/../Stack.h";
     my $expand = {
@@ -47,7 +56,6 @@
      my $res = Gears::Util->parse($stack_header);
 
      is_deeply ($res, $expand, "parsing stack.h");
-
   };
 };