WebSVN – gelsvn – Diff – /trunk/MPC/modules/WorkspaceCreator.pm

 use strict;
 use FileHandle;
 use File::Path;
 use File::Compare;
-use File::Basename;
 use Creator;
 use Options;
 use vars qw(@ISA);
           else {
             $name =~ s/^\(\s*//;
             $name =~ s/\s*\)$//;
             ## Replace any *'s with the default name
-            if ($name =~ /\*/) {
+            if (index($name, '*') >= 0) {
               $name = $self->fill_type_name(
                                     $name,
                                     $self->get_default_workspace_name());
+            }
+          }
+        }
         $self->{$self->{'type_check'}} = 1;
+      }
+    }
-    elsif ($values[0] eq 'assignment') {
+    elsif ($values[0] eq '=') {
       if (defined $validNames{$values[1]}) {
         $self->process_assignment($values[1], $values[2]);
+      }
       else {
         $error = "Invalid assignment name: $values[1]";
         $status = 0;
+      }
+    }
-    elsif ($values[0] eq 'assign_add') {
+    elsif ($values[0] eq '+=') {
       if (defined $validNames{$values[1]}) {
         $self->process_assignment_add($values[1], $values[2]);
+      }
       else {
         $error = "Invalid addition name: $values[1]";
         $status = 0;
+      }
+    }
-    elsif ($values[0] eq 'assign_sub') {
+    elsif ($values[0] eq '-=') {
       if (defined $validNames{$values[1]}) {
         $self->process_assignment_sub($values[1], $values[2]);
+      }
       else {
         $error = "Invalid subtraction name: $values[1]";
       $error = "Unrecognized line: $line";
       $status = 0;
+    }
+  }
   elsif ($status == -1) {
+    foreach my $expfile ($line =~ /[\?\*\[\]]/ ? $self->mpc_glob($line) :
+                                                 $line) {
-    if ($line =~ /\.$wsext$/) {
+      if ($expfile =~ /\.$wsext$/) {
-      ($status, $error) = $self->aggregated_workspace($line);
+        ($status, $error) = $self->aggregated_workspace($expfile);
+        last if (!$status);
-    }
+      }
-    else {
+      else {
-      push(@{$self->{'project_files'}}, $line);
+        push(@{$self->{'project_files'}}, $expfile);
-      $status = 1;
+        $status = 1;
+      }
+    }
+  }
   return $status, $error;
+}
       ## Was the line recognized?
       if ($status) {
         if (defined $values[0]) {
           if ($values[0] eq $self->{'grammar_type'}) {
             if (defined $values[2]) {
-              my($name) = basename($file);
+              my($name) = $self->mpc_basename($file);
               $name =~ s/\.[^\.]+$//;
               $status = 0;
               $error  = 'Aggregated workspace (' . $name .
                         ') can not inherit from another workspace';
+            }
   my(%types)   = ();
   @types{split(/\s*,\s*/, $typestr)} = ();
   ## If there is a negation at all, add our
   ## current type, it may be removed below
-  if ($typestr =~ /!/) {
+  if (index($typestr, '!') >= 0) {
     $negated = 1;
     $types{$self->{wctype}} = 1;
     ## Process negated exclusions
     foreach my $key (keys %types) {
           $errorString = undef;
+        }
         last;
+      }
       else {
+        if ($line =~ /^"([^"]+)"$/) {
+          $line = $1;
+        }
         if (defined $self->{'scoped_basedir'}) {
           $line = $self->{'scoped_basedir'} . '/' . $line;
+        }
+        if ($line =~ /[\?\*\[\]]/) {
+          push(@exclude, $self->mpc_glob($line));
+        }
+        else {
-        push(@exclude, $line);
+          push(@exclude, $line);
+        }
+      }
+    }
     foreach my $type (keys %types) {
       if (!defined $self->{'exclude'}->{$type}) {
 sub excluded {
   my($self) = shift;
   my($file) = shift;
   foreach my $excluded (@{$self->{'exclude'}->{$self->{'wctype'}}}) {
-    if ($excluded eq $file || $file =~ /^$excluded\//) {
+    if ($excluded eq $file || index($file, "$excluded/") == 0) {
       return 1;
+    }
+  }
   return 0;
+        }
+      }
+    }
+  }
   else {
+    foreach my $expfile ($line =~ /[\?\*\[\]]/ ? $self->mpc_glob($line) :
+                                                 $line) {
-    if ($line =~ /\.$wsext$/) {
+      if ($expfile =~ /\.$wsext$/) {
-      ## An aggregated workspace within an aggregated workspace.
+        ## An aggregated workspace within an aggregated workspace.
-      ($status, $error) = $self->aggregated_workspace($line);
+        ($status, $error) = $self->aggregated_workspace($expfile);
+        last if (!$status);
-    }
+      }
-    else {
+      else {
-      if (!$self->excluded($line)) {
+        if (!$self->excluded($expfile)) {
-        if (defined $dupchk && exists $$dupchk{$line}) {
+          if (defined $dupchk && exists $$dupchk{$expfile}) {
-          $self->warning("Duplicate mpc file ($line) added by an " .
+            $self->warning("Duplicate mpc file ($expfile) added by an " .
-                         'aggregate workspace.  It will be ignored.');
+                           'aggregate workspace.  It will be ignored.');
-        }
+          }
-        else {
+          else {
-          $self->{'scoped_assign'}->{$line} = $flags;
+            $self->{'scoped_assign'}->{$expfile} = $flags;
-          push(@{$self->{'project_files'}}, $line);
+            push(@{$self->{'project_files'}}, $expfile);
+          }
+        }
+      }
+    }
+  }
   $self->{'handled_scopes'}->{$type} = 1;
   return $status, $error;
+}
 sub search_for_files {
-  my($self)  = shift;
+  my($self)     = shift;
-  my($files) = shift;
+  my($files)    = shift;
-  my($array) = shift;
+  my($array)    = shift;
-  my($impl)  = shift;
+  my($impl)     = shift;
+  my($excluded) = 0;
   foreach my $file (@$files) {
     if (-d $file) {
       my(@f) = $self->generate_default_file_list(
                          $file,
-                         $self->{'exclude'}->{$self->{'wctype'}});
+                         $self->{'exclude'}->{$self->{'wctype'}},
+                         \$excluded);
       $self->search_for_files(\@f, $array, $impl);
       if ($impl) {
         $file =~ s/^\.\///;
         unshift(@$array, $file);
+      }
         $file =~ s/^\.\///;
         unshift(@$array, $file);
+      }
+    }
+  }
+  return $excluded;
+}
 sub remove_duplicate_projects {
   my($self)  = shift;
   my($count) = scalar(@$list);
   for(my $i = 0; $i < $count; ++$i) {
     my($file) = $$list[$i];
     foreach my $inner (@$list) {
+      if ($file ne $inner &&
-      if ($file ne $inner && $file eq $self->mpc_dirname($inner) && ! -d $inner) {
+          $file eq $self->mpc_dirname($inner) && ! -d $inner) {
         splice(@$list, $i, 1);
         --$count;
         --$i;
         last;
+      }
+  }
+}
 sub generate_default_components {
-  my($self)  = shift;
+  my($self)     = shift;
-  my($files) = shift;
+  my($files)    = shift;
-  my($impl)  = shift;
+  my($impl)     = shift;
+  my($excluded) = shift;
-  my($pjf)   = $self->{'project_files'};
+  my($pjf)      = $self->{'project_files'};
   if (defined $$pjf[0]) {
     ## If we have files, then process directories
     my(@built) = ();
     foreach my $file (@$pjf) {
     $self->{'project_files'} = \@built;
+  }
   else {
     ## Add all of the wanted files in this directory
     ## and in the subdirectories.
-    $self->search_for_files($files, $pjf, $impl);
+    $excluded |= $self->search_for_files($files, $pjf, $impl);
     ## If the workspace is set to implicit
     if ($impl) {
       ## Remove duplicates from this list
       $self->remove_duplicate_projects($pjf);
+    }
     ## If no files were found, then we push the empty
     ## string, so the Project Creator will generate
     ## the default project file.
-    if (!defined $$pjf[0]) {
+    if (!defined $$pjf[0] && !$excluded) {
       push(@$pjf, '');
+    }
+  }
+}
   ## Generate default workspace name
   if (!defined $self->{'workspace_name'}) {
     $self->{'workspace_name'} = $self->get_default_workspace_name();
+  }
+  ## Modify the exclude list if we have changed directory from the original
+  ## starting directory.  Just take off the difference from the front.
+  my(@original) = ();
+  my($top)      = $self->getcwd() . '/';
+  my($start)    = $self->getstartdir() . '/';
+  if ($start ne $top && $top =~ s/^$start//) {
+    foreach my $exclude (@{$self->{'exclude'}->{$self->{'wctype'}}}) {
+      push(@original, $exclude);
+      $exclude =~ s/^$top//;
+    }
+  }
+  my($excluded) = 0;
   my(@files) = $self->generate_default_file_list(
                         '.',
-                        $self->{'exclude'}->{$self->{'wctype'}});
+                        $self->{'exclude'}->{$self->{'wctype'}},
+                        \$excluded);
   ## Generate default components
   $self->generate_default_components(\@files,
-                                     $self->get_assignment('implicit'));
+                                     $self->get_assignment('implicit'),
+                                     $excluded);
+  ## Return the actual exclude list of we modified it
+  if (defined $original[0]) {
+    $self->{'exclude'}->{$self->{'wctype'}} = \@original;
+  }
+}
 sub get_workspace_name {
   my($self) = shift;
       foreach my $project (@{$self->{'projects'}}) {
         my($name) = lc($self->{'project_info'}->{$project}->[0]);
         if (defined $names{$name}) {
           ++$duplicates;
           $self->error("Duplicate case-insensitive project '$name'. " .
-                       "Look in " . $self->mpc_dirname($project) . " and " .
+                       "Look in " . $self->mpc_dirname($project) .
-                       $self->mpc_dirname($names{$name}) .
+                       " and " . $self->mpc_dirname($names{$name}) .
                        " for project name conflicts.");
+        }
         else {
           $names{$name} = $project;
+        }
           $gen_proj_info = $allprinfo{$prkey};
           $gen_lib_locs  = $allliblocs{$prkey};
           $status = 1;
+        }
         else {
-          $status = $creator->generate(basename($file));
+          $status = $creator->generate($self->mpc_basename($file));
           ## If any one project file fails, then stop
           ## processing altogether.
           if (!$status) {
             ## We don't restore the state before we leave,
   my($self)   = shift;
   my($dir)    = shift;
   my($ccheck) = shift;
   my($cfile)  = shift;
-  if ($self->{'project_info'}->{$ccheck}->[1] =~ /$cfile/) {
+  if (index($self->{'project_info'}->{$ccheck}->[1], $cfile) >= 0) {
     return 1;
+  }
   else {
     my($deps) = $self->create_array(
                          $self->{'project_info'}->{$ccheck}->[1]);
             $bidir{$key} = [$ikey];
+          }
           my($append) = $creator->translate_value('after', $key);
           my($file)   = $self->{'project_file_list'}->{$ikey}->[0];
           my($dir)    = $self->{'project_file_list'}->{$ikey}->[1];
-          my($cfile)  = $self->escape_regex_special(
-                              $creator->translate_value('after', $ikey));
+          my($cfile)  = $creator->translate_value('after', $ikey);
           ## Remove our starting directory from the projects directory
           ## to get the right part of the directory to prepend.
           $dir =~ s/^$cwd[\/\\]*//;
           ## Turn the append value into a key for 'project_info' and
       $movepjs = [];
+    }
     $previ = $i;
     $deps = $self->get_validated_ordering($$list[$i]);
-    if ($deps ne '') {
+    if (defined $$deps[0]) {
-      my($baseproj) = basename($$list[$i]);
+      my($baseproj) = $self->mpc_basename($$list[$i]);
-      my($darr) = $self->create_array($deps);
       my($moved) = 0;
-      foreach my $dep (@$darr) {
+      foreach my $dep (@$deps) {
         if ($baseproj ne $dep) {
           ## See if the dependency is listed after this project
           for(my $j = $i + 1; $j <= $end; ++$j) {
-            if (basename($$list[$j]) eq $dep) {
+            if ($self->mpc_basename($$list[$j]) eq $dep) {
               $movepjs = [$i, $j];
               ## If so, move it in front of the current project.
               ## The original code, which had splices, didn't always
               ## work correctly (especially on AIX for some reason).
               my($save) = $$list[$j];
+    }
+  }
+}
+sub build_dependency_chain {
+  my($self)   = shift;
+  my($name)   = shift;
+  my($len)    = shift;
+  my($list)   = shift;
+  my($ni)     = shift;
+  my($glen)   = shift;
+  my($groups) = shift;
+  my($map)    = shift;
+  my($gdeps)  = shift;
+  my($deps)   = $self->get_validated_ordering($name);
+  if (defined $$deps[0]) {
+    foreach my $dep (@$deps) {
+      ## Find the item in the list that matches our current dependency
+      my($mapped) = $$map{$dep};
+      for(my $i = 0; $i < $len; $i++) {
+        if ($$list[$i] eq $mapped) {
+          ## Locate the group number to which the dependency belongs
+          for(my $j = 0; $j < $glen; $j++) {
+            if ($i >= $$groups[$j]->[0] && $i <= $$groups[$j]->[1]) {
+              if ($j != $ni) {
+                ## Add every project in the group to the dependency chain
+                for(my $k = $$groups[$j]->[0]; $k <= $$groups[$j]->[1]; $k++) {
+                  my($ldep) = $self->mpc_basename($$list[$k]);
+                  if (!exists $$gdeps{$ldep}) {
+                    $$gdeps{$ldep} = 1;
+                    $self->build_dependency_chain($$list[$k],
+                                                  $len, $list, $j,
+                                                  $glen, $groups,
+                                                  $map, $gdeps);
+                  }
+                }
+              }
+              last;
+            }
+          }
+          last;
+        }
+      }
+      $$gdeps{$dep} = 1;
+    }
+  }
+}
 sub sort_by_groups {
   my($self)    = shift;
   my($list)    = shift;
   my($grindex) = shift;
   my(@groups)  = @$grindex;
-  my($ccount)  = 0;
-  my($cmax)    = $#groups;
+  my($llen)    = scalar(@$list);
-  my($prevgi)  = -1;
-  my($prevgrs) = [];
-  my($movegrs) = [];
-  for(my $gi = 0; $gi <= $#groups; ++$gi) {
-    ## If our moved group equals our previously moved group then
+  ## Check for duplicates first before we attempt to sort the groups.
-    ## we count this as a possible circular dependency.
+  ## If there is a duplicate, we quietly return immediately.  The
-    if (defined $$movegrs[0] && defined $$prevgrs[0] &&
-        $$movegrs[0] == $$prevgrs[0] && $$movegrs[1] == $$prevgrs[1]) {
+  ## duplicates will be flagged as an error when creating the main
-      ++$ccount;
+  ## workspace.
-    }
+  my(%dupcheck) = ();
-    else {
+  foreach my $proj (@$list) {
+    my($base) = $self->mpc_basename($proj);
+    if (defined $dupcheck{$base}) {
-      $ccount = 0;
+      return;
+    }
+    $dupcheck{$base} = $proj;
+  }
+  my(%circular_checked) = ();
+  for(my $gi = 0; $gi <= $#groups; ++$gi) {
     ## Detect circular dependencies
-    if ($ccount > $cmax) {
+    if (!$circular_checked{$gi}) {
+      $circular_checked{$gi} = 1;
+      for(my $i = $groups[$gi]->[0]; $i <= $groups[$gi]->[1]; ++$i) {
+        my(%gdeps) = ();
+        $self->build_dependency_chain($$list[$i], $llen, $list, $gi,
+                                      $#groups + 1, \@groups,
+                                      \%dupcheck, \%gdeps);
+        if (exists $gdeps{$self->mpc_basename($$list[$i])}) {
+          ## There was a cirular dependency, get all of the directories
+          ## involved.
-      my(@dirs) = ();
+          my(%dirs) = ();
-      foreach my $mvgr (@$movegrs) {
+          foreach my $gdep (keys %gdeps) {
+            $dirs{$self->mpc_dirname($dupcheck{$gdep})} = 1;
+          }
+          ## If the current directory was involved, translate that into
+          ## a directory relative to the start directory.
+          if (defined $dirs{'.'}) {
+            my($cwd) = $self->getcwd();
-        push(@dirs, $$list[$groups[$mvgr]->[0]]);
+            my($start) = $self->getstartdir();
+            if ($cwd ne $start) {
+              my($startre) = $self->escape_regex_special($start);
+              delete $dirs{'.'};
-        $dirs[$#dirs] =~ s/[\/\\].*//;
+              $cwd =~ s/^$startre[\\\/]//;
+              $dirs{$cwd} = 1;
+            }
+          }
+          ## Display a warining to the user
+          my(@keys) = sort keys %dirs;
+          $self->warning('Circular directory dependency detected in the ' .
+                         ($self->{'current_input'} eq '' ?
+                           'default' : $self->{'current_input'}) .
+                         ' workspace. ' .
+                         'The following director' .
+                         ($#keys == 0 ? 'y is' : 'ies are') .
+                         ' involved: ' . join(', ', @keys));
+          return;
+        }
+      }
-      $self->warning('Circular dependency detected while processing the ' .
-                     ($self->{'current_input'} eq '' ?
-                       'default' : $self->{'current_input'}) .
-                     ' workspace. ' .
-                     'The following directories or projects are involved: ' .
-                     join(' and ', @dirs));
-      return;
+    }
     ## Build up the group dependencies
     my(%gdeps) = ();
     for(my $i = $groups[$gi]->[0]; $i <= $groups[$gi]->[1]; ++$i) {
       my($deps) = $self->get_validated_ordering($$list[$i]);
-      if ($deps ne '') {
+      if (defined $$deps[0]) {
-        my($darr) = $self->create_array($deps);
-        foreach my $dep (@$darr) {
-          $gdeps{$dep} = 1;
+        @gdeps{@$deps} = ();
-        }
+      }
+    }
-    ## Keep track of the previous group movement
-    $prevgrs = $movegrs;
-    if ($prevgi < $gi) {
-      $movegrs = [];
-    }
-    $prevgi = $gi;
     ## Search the rest of the groups for any of the group dependencies
-    my($moved) = 0;
     for(my $gj = $gi + 1; $gj <= $#groups; ++$gj) {
       for(my $i = $groups[$gj]->[0]; $i <= $groups[$gj]->[1]; ++$i) {
-        if (defined $gdeps{basename($$list[$i])}) {
+        if (exists $gdeps{$self->mpc_basename($$list[$i])}) {
           ## Move this group ($gj) in front of the current group ($gi)
-          $movegrs = [$gj, $gi];
           my(@save) = ();
           for(my $j = $groups[$gi]->[1] + 1; $j <= $groups[$gj]->[1]; ++$j) {
             push(@save, $$list[$j]);
+          }
           my($offset) = $groups[$gj]->[1] - $groups[$gi]->[1];
           for(my $j = $gi; $j < $gj; ++$j) {
             $groups[$j] = $groups[$j + 1];
+          }
           $groups[$gj] = \@grsave;
-          ## Signify that we have moved a group
+          ## Start over from the first group
-          $moved = 1;
+          $gi = -1;
+          ## Exit from the outter ($gj) loop
+          $gj = $#groups;
           last;
+        }
+      }
-      if ($moved) {
-        ## Start over from the first group
-        $gi = -1;
-        last;
-      }
+    }
+  }
+}
 sub sort_dependencies {
   my($self)     = shift;
   my($projects) = shift;
+  my($groups)   = shift;
   my(@list)     = sort { return $self->sort_projects_by_directory($a, $b) + 0;
                        } @$projects;
+  ## The list above is sorted by directory in order to keep projects
+  ## within the same directory together.  Otherwise, when groups are
+  ## created we may get multiple groups for the same directory.
   ## Put the projects in the order specified
   ## by the project dpendencies.  We only need to do
   ## this if there is more than one element in the array.
   if ($#list > 0) {
+    ## If the parameter wasn't passed in or it was passed in
+    ## and was true, sort with directory groups in mind
+    if (!defined $groups || $groups) {
-    ## First determine the individual groups
+      ## First determine the individual groups
-    my(@grindex)  = ();
+      my(@grindex)  = ();
-    my($previous) = [0, undef];
+      my($previous) = [0, undef];
-    for(my $li = 0; $li <= $#list; ++$li) {
+      for(my $li = 0; $li <= $#list; ++$li) {
-      my($dir) = $self->get_first_level_directory($list[$li]);
+        my($dir) = $self->get_first_level_directory($list[$li]);
-      if (!defined $previous->[1]) {
+        if (!defined $previous->[1]) {
-        $previous = [$li, $dir];
+          $previous = [$li, $dir];
-      }
+        }
-      elsif ($previous->[1] ne $dir) {
+        elsif ($previous->[1] ne $dir) {
-        push(@grindex, [$previous->[0], $li - 1]);
+          push(@grindex, [$previous->[0], $li - 1]);
-        $previous = [$li, $dir];
+          $previous = [$li, $dir];
+        }
+      }
+      push(@grindex, [$previous->[0], $#list]);
+      ## Next, sort the individual groups
+      foreach my $gr (@grindex) {
+        if ($$gr[0] != $$gr[1]) {
+          $self->sort_within_group(\@list, @$gr);
+        }
+      }
-    }
-    push(@grindex, [$previous->[0], $#list]);
-    ## Next, sort the individual groups
+      ## Now sort the groups as single entities
-    foreach my $gr (@grindex) {
-      if ($$gr[0] != $$gr[1]) {
+      if ($#grindex > 0) {
-        $self->sort_within_group(\@list, @$gr);
+        $self->sort_by_groups(\@list, \@grindex);
+      }
+    }
-    ## Now sort the groups as single entities
-    if ($#grindex > 0) {
+    else {
-      $self->sort_by_groups(\@list, \@grindex);
+      $self->sort_within_group(\@list, 0, $#list);
+    }
+  }
   return @list;
+}
 sub number_target_deps {
   my($self)     = shift;
   my($projects) = shift;
   my($pjs)      = shift;
   my($targets)  = shift;
+  my($groups)   = shift;
-  my(@list)     = $self->sort_dependencies($projects);
+  my(@list)     = $self->sort_dependencies($projects, $groups);
   ## This block of code must be done after the list of dependencies
   ## has been sorted in order to get the correct project numbers.
   for(my $i = 0; $i <= $#list; ++$i) {
     my($project) = $list[$i];
     if (defined $$pjs{$project}) {
       my($name, $deps) = @{$$pjs{$project}};
       if (defined $deps && $deps ne '') {
-        my(%targetnumbers) = ();
+        my(@numbers) = ();
+        my(%dhash)   = ();
-        my($darr) = $self->create_array($deps);
+        @dhash{@{$self->create_array($deps)}} = ();
         ## For each dependency, search in the sorted list
         ## up to the point of this project for the projects
         ## that this one depends on.  When the project is
-        ## found, we put the target number in a hash map (to avoid
+        ## found, we put the target number in the numbers array.
-        ## duplicates).
-        foreach my $dep (@$darr) {
-          for(my $j = 0; $j < $i; ++$j) {
+        for(my $j = 0; $j < $i; ++$j) {
-            if (basename($list[$j]) eq $dep) {
+          if (exists $dhash{$self->mpc_basename($list[$j])}) {
-              $targetnumbers{$j} = 1;
+            push(@numbers, $j);
-            }
+          }
+        }
-        ## Get the keys of the hash map and store the
-        ## array in the hash keyed on the project file.
+        ## Store the array in the hash keyed on the project file.
-        my(@numbers) = sort { $a <=> $b } keys %targetnumbers;
         if (defined $numbers[0]) {
           $$targets{$project} = \@numbers;
+        }
+      }
+    }
         $self->optionError('-noreldefs is ignored');
+      }
       if (defined $options->{'coexistence'}) {
         $self->optionError('-make_coexistence is ignored');
+      }
-      if (defined $options->{'genins'}) {
-        $self->optionError('-genins is ignored');
-      }
       if (defined $options->{'into'}) {
         $self->optionError('-into is ignored');
+      }
-      if (defined $options->{'language'}) {
-        $self->optionError('-language is ignored');
-      }
       if (defined $options->{'input'}->[0]) {
         $self->optionError('Command line files ' .
                            'specified in a workspace are ignored');
+      }
       ## Determine if it's ok to use the cache
       my(@cacheInvalidating) = ('global', 'include', 'baseprojs',
-                                'template', 'ti', 'relative',
+                                'template', 'ti', 'relative', 'language',
                                 'addtemp', 'addproj', 'feature_file',
                                 'features', 'use_env', 'expand_vars');
       foreach my $key (@cacheInvalidating) {
         if ($self->is_set($key, $options)) {
           $self->{'cacheok'} = 0;
                    $parameters{'hierarchy'},
                    $self->{'exclude'}->{$self->{'wctype'}},
                    $self->make_coexistence(),
                    $parameters{'name_modifier'},
                    $parameters{'apply_project'},
-                   $self->{'generate_ins'},
+                   $self->{'generate_ins'} || $parameters{'genins'},
                    $parameters{'into'},
-                   $self->get_language(),
+                   $parameters{'language'},
                    $parameters{'use_env'},
                    $parameters{'expand_vars'});
+}
   if (defined $self->{'ordering_cache'}->{$project}) {
     $deps = $self->{'ordering_cache'}->{$project};
+  }
   else {
-    $deps = '';
+    $deps = [];
     if (defined $self->{'project_info'}->{$project}) {
-      my($name) = undef;
-      ($name, $deps) = @{$self->{'project_info'}->{$project}};
+      my($name, $dstr) = @{$self->{'project_info'}->{$project}};
-      if (defined $deps && $deps ne '') {
+      if (defined $dstr && $dstr ne '') {
-        my($darr) = $self->create_array($deps);
+        $deps = $self->create_array($dstr);
+        my($dlen) = scalar(@$deps);
-        foreach my $dep (@$darr) {
+        for(my $i = 0; $i < $dlen; $i++) {
+          my($dep)   = $$deps[$i];
           my($found) = 0;
           ## Avoid circular dependencies
-          if ($dep ne $name && $dep ne basename($project)) {
+          if ($dep ne $name && $dep ne $self->mpc_basename($project)) {
             foreach my $p (@{$self->{'projects'}}) {
               if ($dep eq $self->{'project_info'}->{$p}->[0] ||
-                  $dep eq basename($p)) {
+                  $dep eq $self->mpc_basename($p)) {
                 $found = 1;
                 last;
+              }
+            }
             if (!$found) {
               if (defined $ENV{MPC_VERBOSE_ORDERING}) {
                 $self->warning("'$name' references '$dep' which has " .
                                "not been processed.");
+              }
-              my($reg) = $self->escape_regex_special($dep);
+              splice(@$deps, $i, 1);
-              $deps =~ s/\s*"$reg"\s*/ /g;
+              --$dlen;
+              --$i;
+            }
+          }
+          else {
+            ## If a project references itself, we must remove it
+            ## from the list of dependencies.
+            splice(@$deps, $i, 1);
+            --$dlen;
+            --$i;
+          }
+        }
-        $deps =~ s/^\s+//;
-        $deps =~ s/\s+$//;
+      }
       $self->{'ordering_cache'}->{$project} = $deps;
+    }
+  }
 sub source_listing_callback {
   my($self)         = shift;
   my($project_file) = shift;
   my($project_name) = shift;
-  my(@files)        = @_;
   my($cwd)          = $self->getcwd();
   $self->{'project_file_list'}->{$project_name} = [ $project_file,
-                                                    $cwd, \@files ];
+                                                    $cwd, \@_ ];
+}
 sub sort_projects_by_directory {
   my($self)  = shift;
   my($left)  = shift;
   my($right) = shift;
-  my($sa)    = ($left =~ /\//);
+  my($sa)    = index($left, '/');
-  my($sb)    = ($right =~ /\//);
+  my($sb)    = index($right, '/');
-  if ($sa && !$sb) {
+  if ($sa >= 0 && $sb == -1) {
     return 1;
+  }
-  elsif ($sb && !$sa) {
+  elsif ($sb >= 0 && $sa == -1) {
     return -1;
+  }
   return $left cmp $right;
+}

Subversion Repositories gelsvn

(root)/trunk/MPC/modules/WorkspaceCreator.pm @ 258 – Rev 198 → 217