changeset 693:aeab4866ee36

defined separate_code_and_data_gear_after_parse test
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Fri, 21 Aug 2020 17:07:01 +0900
parents 3d959f470c8b
children 89abde9fb7ce
files src/parallel_execution/generate_stub.pl src/parallel_execution/lib/Gears/Interface.pm src/parallel_execution/lib/Gears/Util.pm src/parallel_execution/perlTests/Interface.t src/parallel_execution/tools/trans_impl.pl
diffstat 5 files changed, 146 insertions(+), 104 deletions(-) [+]
line wrap: on
line diff
--- a/src/parallel_execution/generate_stub.pl	Fri Aug 21 15:57:24 2020 +0900
+++ b/src/parallel_execution/generate_stub.pl	Fri Aug 21 17:07:01 2020 +0900
@@ -11,6 +11,7 @@
 use FindBin;
 use lib "$FindBin::Bin/lib";
 
+use Gears::Interface;
 use Gears::Util;
 
 
@@ -197,11 +198,11 @@
                     }
                   }
                   unless ($typeName){
-                    print "[ERROR] $.: $_\n";
-                    die "[ERROR] not found $instance type\n";
+                    die "[ERROR] not found $instance type $.: $_\n";
                   }
                 }
 
+                my $res = findExistsOutputDataGear($typeName, $method);
                 print "[INFO] found instance $instance, typeName $typeName, cuurentCodeGear: $currentCodeGear, method: $method\n";
 
             } elsif (/^}$/) {
@@ -445,6 +446,37 @@
     return 1;
 }
 
+
+
+sub findExistsOutputDataGear {
+    my ($interfaceName, $method) = @_;
+                use DDP {deparse => 1};
+
+    my $interfacePATH = $interfaceNameToHeaderPath->{$interfaceName};
+    unless ($interfacePATH) {
+      return undef;
+    }
+
+    my $parsedInterface = Gears::Interface->separate_code_and_data_gear_after_parse($interfacePATH);
+
+    unless ($parsedInterface) {
+      return undef;
+    }
+
+    unless (exists $parsedInterface->{hasOutputArgs}->{$method}) {
+      return undef;
+    }
+
+    my $vname2types = $parsedInterface->{hasOutputArgs}->{$method};
+
+    use Data::Dumper;
+    print Dumper $parsedInterface;
+    p $parsedInterface;
+    my @outputArgs = keys %$vname2types;
+    return \@outputArgs;
+}
+
+
 sub generateDataGear {
     my ($filename) = @_;
     open my $in,"<",$filename or die("can't open $filename $!");
--- a/src/parallel_execution/lib/Gears/Interface.pm	Fri Aug 21 15:57:24 2020 +0900
+++ b/src/parallel_execution/lib/Gears/Interface.pm	Fri Aug 21 17:07:01 2020 +0900
@@ -106,5 +106,49 @@
   return $ir;
 }
 
+sub separate_code_and_data_gear_after_parse {
+  my ($class, $file)  = @_;
+  my $ir = Gears::Interface->parse($file);
+
+  unless ($ir) {
+    return undef;
+  }
+
+  $ir->{hasOutputArgs} = {};
+
+  my @data_gears;
+  my @code_gears;
+  map { push (@data_gears, $_) unless ($_ =~ /enum Code/);} @{$ir->{content}};
+  map { push (@code_gears, $1) if ($_ =~ /enum Code (\w+);/);} @{$ir->{content}};
+
+  open my $fh , '<', $file;
+  my $i = 0;
+  my @have_output_data;
+  while (($i < scalar @code_gears) && (my $line = <$fh>)) {
+      my $codeGearName = $code_gears[$i];
+      if ($line =~ m|__code $codeGearName\(([()\.\*\s\w,_]+)\)|) {
+        my $arg = $1;
+        $code_gears[$i] = {
+          name => $codeGearName,
+          args => $arg,
+        };
+        # args   "Impl* stack, __code next(Type* data, Type* data1, ...)",
+        if ($arg =~ /__code \w+\((.+),\s*\.\.\.\s*\)/) {
+          my $outputArgs = $1;
+          while ($outputArgs =~ /([\w*]+)\s(\w+),?/g) {
+            my $ttype = $1;
+            my $tname = $2;
+            $ir->{hasOutputArgs}->{$codeGearName}->{$tname} = $ttype;
+          }
+        }
+        $i++;
+      }
+  }
+
+  $ir->{codes} = \@code_gears;
+  $ir->{data}  = \@data_gears;
+  return $ir;
+}
+
 
 1;
--- a/src/parallel_execution/lib/Gears/Util.pm	Fri Aug 21 15:57:24 2020 +0900
+++ b/src/parallel_execution/lib/Gears/Util.pm	Fri Aug 21 17:07:01 2020 +0900
@@ -10,105 +10,6 @@
   return grep { !$seen{$_}++ } @_;
 }
 
-sub separate_code_and_data_gear_after_parse {
-# create this data structure
-#\ {
-#    codes       [
-#        [0] {
-#            args   "Impl* stackTest, struct Stack* stack, __code next(...)",
-#            name   "insertTest1"
-#        },
-#        [1] {
-#            args   "Impl* stackTest, struct Stack* stack, __code next(...)",
-#            name   "insertTest2"
-#        },
-#        [2] {
-#            args   "Impl* stackTest, struct Stack* stack, __code next(...)",
-#            name   "pop2Test"
-#        },
-#        [3] {
-#            args   "Impl* stackTest, union Data* data, union Data* data1, struct Stack* stack, __code next(...)",
-#            name   "pop2Test1"
-#        },
-#        [4] {
-#            args   "...",
-#            name   "next"
-#        }
-#    ],
-#    content     [
-#        [0] "enum Code insertTest1;
-#",
-#        [1] "union Data* stackTest;
-#",
-#        [2] "struct Stack* stack;
-#",
-#        [3] "enum Code insertTest2;
-#",
-#        [4] "enum Code pop2Test;
-#",
-#        [5] "enum Code pop2Test1;
-#",
-#        [6] "union Data* data;
-#",
-#        [7] "union Data* data1;
-#",
-#        [8] "enum Code next;
-#"
-#    ],
-#    data        [
-#        [0] "union Data* stackTest;
-#",
-#        [1] "struct Stack* stack;
-#",
-#        [2] "union Data* data;
-#",
-#        [3] "union Data* data1;
-#"
-#    ],
-#    file_name   "/Users/anatofuz/src/firefly/hg/Gears/Gears/src/parallel_execution/tools/../examples/pop_and_push/StackTest.h",
-#    name        "StackTest"
-#}
-#
-
-  my ($class, $file)  = @_;
-  my $ir = Gears::Interface->parse($file);
-
-  $ir->{hasOutputArgs} = {};
-
-  my @data_gears;
-  my @code_gears;
-  map { push (@data_gears, $_) unless ($_ =~ /enum Code/);} @{$ir->{content}};
-  map { push (@code_gears, $1) if ($_ =~ /enum Code (\w+);/);} @{$ir->{content}};
-
-  open my $fh , '<', $file;
-  my $i = 0;
-  my @have_output_data;
-  while (($i < scalar @code_gears) && (my $line = <$fh>)) {
-      my $codeGearName = $code_gears[$i];
-      if ($line =~ m|__code $codeGearName\(([()\.\*\s\w,_]+)\)|) {
-        my $arg = $1;
-        $code_gears[$i] = {
-          name => $codeGearName,
-          args => $arg,
-        };
-        # args   "Impl* stack, __code next(Type* data, Type* data1, ...)",
-        if ($arg =~ /__code \w+\((.+),\s*\.\.\.\s*\)/) {
-          my $outputArgs = $1;
-          while ($outputArgs =~ /([\w*]+)\s(\w+),?/g) {
-            my $ttype = $1;
-            my $tname = $2;
-            $ir->{hasOutputArgs}->{$codeGearName}->{$tname} = $ttype;
-          }
-        }
-        $i++;
-      }
-  }
-
-  $ir->{codes} = \@code_gears;
-  $ir->{data}  = \@data_gears;
-  return $ir;
-}
-
 sub file_checking {
   my ($class, $file_name) = @_;
   unless (-f $file_name) {
--- a/src/parallel_execution/perlTests/Interface.t	Fri Aug 21 15:57:24 2020 +0900
+++ b/src/parallel_execution/perlTests/Interface.t	Fri Aug 21 17:07:01 2020 +0900
@@ -3,7 +3,7 @@
 use warnings;
 use FindBin;
 
-use Test::More  tests => 2; #subtests
+use Test::More  tests => 3; #subtests
 
 use_ok "Gears::Interface"; #use test
 
@@ -45,3 +45,67 @@
   };
 };
 
+
+subtest 'separate_code_and_data_gear_after_parse' => sub {
+  subtest 'Queue' => sub {
+    plan tests => 1;
+
+    my $queue_header = "$FindBin::Bin/../Queue.h";
+
+    my $expand = {
+            'data' => [
+                        'union Data* queue;',
+                        'union Data* data;'
+                      ],
+            'content' => [
+                           'enum Code whenEmpty;',
+                           'enum Code clear;',
+                           'union Data* queue;',
+                           'enum Code put;',
+                           'union Data* data;',
+                           'enum Code take;',
+                           'enum Code isEmpty;',
+                           'enum Code next;'
+                         ],
+            'file_name' => $queue_header,
+            'name' => 'Queue',
+            'codes' => [
+                         {
+                           'args' => '...',
+                           'name' => 'whenEmpty'
+                         },
+                         {
+                           'args' => 'Impl* queue, __code next(...)',
+                           'name' => 'clear'
+                         },
+                         {
+                           'name' => 'put',
+                           'args' => 'Impl* queue, union Data* data, __code next(...)'
+                         },
+                         {
+                           'args' => 'Impl* queue, __code next(union Data* data, ...)',
+                           'name' => 'take'
+                         },
+                         {
+                           'name' => 'isEmpty',
+                           'args' => 'Impl* queue, __code next(...), __code whenEmpty(...)'
+                         },
+                         {
+                           'name' => 'next',
+                           'args' => '...'
+                         }
+                       ],
+            'hasOutputArgs' => {
+                                 'take' => {
+                                             'Data' => 'union',
+                                             'data' => '*'
+                                           }
+                               }
+          };
+
+          my $res = Gears::Interface->separate_code_and_data_gear_after_parse($queue_header);
+
+          is_deeply ($res, $expand, "parsing Queue.h");
+      };
+
+};
--- a/src/parallel_execution/tools/trans_impl.pl	Fri Aug 21 15:57:24 2020 +0900
+++ b/src/parallel_execution/tools/trans_impl.pl	Fri Aug 21 17:07:01 2020 +0900
@@ -4,6 +4,7 @@
 
 use FindBin;
 use lib "$FindBin::Bin/../lib";
+use Gears::Interface;
 use Gears::Util;
 
 use Getopt::Std;
@@ -18,10 +19,10 @@
     die "require header file";
 }
 
-my $impl_ir         = Gears::Util->separate_code_and_data_gear_after_parse(File::Spec->rel2abs($impl_file));
+my $impl_ir         = Gears::Interface->separate_code_and_data_gear_after_parse(File::Spec->rel2abs($impl_file));
 my $interface_file  = find_using_interface_header($impl_ir->{isa},"$FindBin::Bin/..");
 
-my $inter_ir        = Gears::Util->separate_code_and_data_gear_after_parse($interface_file);
+my $inter_ir        = Gears::Interface->separate_code_and_data_gear_after_parse($interface_file);
 
 my $interface_var_name = shift @{$inter_ir->{data}};