changeset 757:21698f275162

warning
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Tue, 05 Jan 2021 20:46:46 +0900
parents bdb423c4531d
children 73e300d2a868
files src/parallel_execution/generate_stub.pl src/parallel_execution/lib/Gears/Interface.pm
diffstat 2 files changed, 54 insertions(+), 4 deletions(-) [+]
line wrap: on
line diff
--- a/src/parallel_execution/generate_stub.pl	Mon Jan 04 20:43:26 2021 +0900
+++ b/src/parallel_execution/generate_stub.pl	Tue Jan 05 20:46:46 2021 +0900
@@ -786,6 +786,28 @@
                 # Put interface argument
                 my $prot = $code{$ntype}->{$method};
                 my $i = 1;
+                my $nextType = $currentCodeGearInfo->{localVar}->{$next}  // $currentCodeGearInfo->{arg}->{$next};
+                #  use DDP {deparse => 1};
+                #  p $currentCodeGearInfo;
+                my $nextTypePath = $headerNameToInfo->{$nextType}->{path};
+                my $parsedNextTypePath = Gears::Interface->detailed_parse($nextTypePath);
+                #p $parsedNextTypePath;
+                #print "method\n";
+                #p $method;
+                unless (exists $parsedNextTypePath->{codeName}->{$method}) {
+                  die "[ERROR] not found $next definition at $_ in $fn\n";
+                }
+                my $nextMethodInfo = $parsedNextTypePath->{codeName}->{$method};
+                my $nextMethodWantArgc = $nextMethodInfo->{argc};
+
+                if ($nextMethodWantArgc != scalar(@args)) {
+                  #use DDP {deparse => 1};
+                  #  p $nextMethodWantArgc;
+                  #  p $nextMethodInfo;
+                  #  p @args;
+                  #die "[EROR] invalid arg $_  you shoud impl $nextMethodInfo->{args}\n";
+                }
+
                 for my $arg (@args) {
                     my $pType;
                     my $pName;
--- a/src/parallel_execution/lib/Gears/Interface.pm	Mon Jan 04 20:43:26 2021 +0900
+++ b/src/parallel_execution/lib/Gears/Interface.pm	Tue Jan 05 20:46:46 2021 +0900
@@ -144,10 +144,38 @@
 
       if ($line =~ m|__code $codeGearName\(([()\.\*\s\w,_]+)\)|) {
         my $arg = $1;
-        push(@output_code_gears, {
-          name => $codeGearName,
-          args => $arg,
-        });
+
+        # check individual argument
+        # eg. (Impl* self, Int a, char* b, struct hoge* h, __code next(out* o, out* o2, ...))
+        # indivisual argument is  self, a, b, h, next  ( $argc == 5)
+        my @comma_split_arg =  split /,/, $arg;
+        my $inParen = undef;
+        my $argc = 0;
+        for my $tmpArg (@comma_split_arg) {
+          #ignore inner code gear (eg next)
+          if ($tmpArg =~ /\(/ ) {
+            $inParen = 1;
+          }
+
+          # want to __code next(...) <- right paren
+          if ($tmpArg =~ /\)/) {
+            $inParen = undef;
+          }
+
+          next if ($inParen);
+          $argc++;
+        }
+        #ignore self
+        # ex upper case, before $argc == 5, after $argc == 4
+        if (@comma_split_arg) {
+          $argc-- if ($comma_split_arg[0] =~ /Impl/);
+        }
+        my $element = { name => $codeGearName, args => $arg, argc => $argc };
+        push(@output_code_gears, $element);
+
+        #code gear name to hash
+        $ir->{codeName}->{$codeGearName} = $element;
+
         # args  eq "Impl* stack, __code next(Type* data, Type* data1, ...)",
         if ($arg =~ /__code \w+\((.+),\s*\.\.\.\s*\)/) {
           my $outputArgs = $1;