Added AS for parameters. You can now have one name for a parameter as seen

by the user, and another name for the vaiable in your code.

This will be particularly useful for avoiding conflicts when sharing parameters
from other implementations.

Syntax:

[uses|extends] <type> <name> ["<description>"] AS <newname>

Tom


git-svn-id: http://svn.cactuscode.org/flesh/trunk@2832 17b73243-c579-4c4c-a9d2-2d5706c11dac

5 files changed, 96 insertions, 84 deletions

diff --git a/lib/sbin/CreateParameterBindings.pl b/lib/sbin/CreateParameterBindings.pl
index dc1b0d02..dc9049be 100644
--- a/lib/sbin/CreateParameterBindings.pl
+++ b/lib/sbin/CreateParameterBindings.pl
@@ -225,19 +225,21 @@ sub CreateParameterBindings
 
       foreach $parameter (split(' ',$rhparameter_db->{"\U$thorn SHARES $friend\E variables"}))
       {
-        $type = $rhparameter_db->{"\U$friend_thorn $parameter\E type"};
+        my $realname = $rhparameter_db->{"\U$thorn $parameter\E realname"};
+
+        $type = $rhparameter_db->{"\U$friend_thorn $realname\E type"};
+        $array = $rhparameter_db->{"\U$friend_thorn $realname\E array_size"};
         $type_string = &get_c_type_string($type);
 
-        # See if we are sharing it AS something
-        my $name = $rhparameter_db->{"\U$thorn $parameter\E alias"};
+        my $varprefix = '';
 
-        if(! $name)
+        if($array_size)
         {
-          $name = "$parameter";
+          $varprefix = '*';
         }
 
-        push(@data, "  const $type_string$name = RESTRICTED_\U$friend\E_STRUCT.$parameter; \\");
-        push(@use, "  (void) ($name + 0); \\");
+        push(@data, "  const $type_string $varprefix$parameter = RESTRICTED_\U$friend\E_STRUCT.$realname; \\");
+        push(@use, "  (void) ($parameter + 0); \\");
       }
     }
 
@@ -499,6 +501,8 @@ sub CreateParameterRegistrationStuff
       &CST_error(0,$message,'',__LINE__,__FILE__);
     }
 
+    my $realname = $rhparameter_db->{"\U$thorn $parameter\E realname"};
+
     my $array_size = $rhparameter_db->{"\U$thorn $parameter\E array_size"};
 
     my $dereference = '';
@@ -534,7 +538,7 @@ sub CreateParameterRegistrationStuff
           "                        $steerable_type,\n" .
           "                        " . $rhparameter_db->{"\U$thorn $parameter\E description"} . ",\n" .
           "                        \"" . $quoted_default . "\",\n" .
-          "                        $dereference($structure.$parameter),\n" .
+          "                        $dereference($structure.$realname),\n" .
           "                        $array_size,\n" .
           "                        $accumulator_expression,\n" .
 #          "                        $accumulator_base,\n" .
@@ -629,7 +633,7 @@ sub CreateParameterAccumulationStuff
     if($accumulator_base)
     {
 
-      print "accumulator_base = $accumulator_base\n";
+#      print "accumulator_base = $accumulator_base\n";
 
       $accumulator_base =~ m/([^:]+)::(.+)/;
 
diff --git a/lib/sbin/ImpParamConsistency.pl b/lib/sbin/ImpParamConsistency.pl
index 8a322019..aa511368 100644
--- a/lib/sbin/ImpParamConsistency.pl
+++ b/lib/sbin/ImpParamConsistency.pl
@@ -48,11 +48,13 @@ sub CheckImpParamConsistency
       {
 #       print "Parameter is $parameter\n";
 
+        my $realname = $parameter_database{"\U$thorn $parameter\E realname"};
+
         # Check if the parameter exists in the other thorn
-        if($parameter_database{"\U$other_thorn $parameter\E type"})
+        if($parameter_database{"\U$other_thorn $realname\E type"})
         {
           # Check that the parameter is in the restricted block.
-          if($parameter_database{"\U$other_thorn RESTRICTED\E variables"} =~ m:\b$parameter\b:i)
+          if($parameter_database{"\U$other_thorn RESTRICTED\E variables"} =~ m:\b$realname\b:i)
           {
 
 #   This lot is done by C now, and SHOULD NOT BE DONE by the perl
@@ -73,13 +75,13 @@ sub CheckImpParamConsistency
           }
           else
           {
-              $message = "Thorn $thorn attempted to EXTEND or USE non-restricted parameter $parameter from $friend";
+              $message = "Thorn $thorn attempted to EXTEND or USE non-restricted parameter $realname from $friend";
               &CST_error(0,$message,"",__LINE__,__FILE__);
           }
         }
         else
         {
-          $message = "Thorn $thorn attempted to EXTEND or USE non-existent parameter $parameter from $friend";
+          $message = "Thorn $thorn attempted to EXTEND or USE non-existent parameter $realname from $friend";
           &CST_error(0,$message,"",__LINE__,__FILE__);
         }
       }
diff --git a/lib/sbin/create_c_stuff.pl b/lib/sbin/create_c_stuff.pl
index 99bb78c3..b7d15826 100644
--- a/lib/sbin/create_c_stuff.pl
+++ b/lib/sbin/create_c_stuff.pl
@@ -40,6 +40,8 @@ sub CreateParameterBindingFile
     my $type = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E type"};
     my $type_string = &get_c_type_string($type);
 
+    my $realname = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E realname"};
+
     my $array_size = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E array_size"};
 
     my $suffix = '';
@@ -49,7 +51,7 @@ sub CreateParameterBindingFile
       $suffix = "[$array_size]";
     }
 
-    push(@data, "  $type_string$parameter$suffix;");
+    push(@data, "  $type_string$realname$suffix;");
   }
 
   # Some compilers don't like an empty structure.
@@ -186,24 +188,19 @@ sub CreateCStructureParameterHeader
     my $array_size = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E array_size"};
 
     my $suffix = '';
-    my $prefix = '';
+    my $varprefix = '';
 
     if($array_size)
     {
-      $prefix = '*';
+      $varprefix = '*';
       $suffix = "[$array_size]";
     }
 
-    my $name = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E alias"};
-
-    if(! $name)
-    {
-      $name = "$parameter";
-    }
+    my $realname = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E realname"};
 
-    push(@data, "  $type_string $parameter$suffix;");
-    push(@definition, "  const $type_string $prefix$name = $structure.$parameter; \\");
-    push(@use, "  (void) ($name + 0); \\");
+    push(@data, "  $type_string $realname$suffix;");
+    push(@definition, "  const $type_string $varprefix$parameter = $structure.$realname; \\");
+    push(@use, "  (void) ($parameter + 0); \\");
   }
 
   # Some compilers don't like an empty structure.
diff --git a/lib/sbin/create_fortran_stuff.pl b/lib/sbin/create_fortran_stuff.pl
index 1bd517a4..4f2283f0 100644
--- a/lib/sbin/create_fortran_stuff.pl
+++ b/lib/sbin/create_fortran_stuff.pl
@@ -4,8 +4,9 @@
 #  @date      Tue Jan 12 09:52:35 1999
 #  @author    Tom Goodale
 #  @desc
-#
+#  Create the Fortran parameter stuff
 #  @enddesc
+#version $Header$
 #@@*/
 
 sub CreateFortranThornParameterBindings
@@ -69,8 +70,11 @@ sub CreateFortranThornParameterBindings
   # thorns, especially if the variable isn't being used !
   $num_aliases = 0;
 
+#  print "DEBUG ********************************************\n";
+#  print "DEBUG thorn is $thorn\n";
   foreach $friend (split(' ',$rhparameter_db->{"\U$thorn\E SHARES implementations"}))
   {
+#    print "DEBUG friend is $friend\n";
 
     # Determine which thorn provides this friend implementation
     $rhinterface_db->{"IMPLEMENTATION \U$friend\E THORNS"} =~ m:([^ ]*):;
@@ -83,25 +87,30 @@ sub CreateFortranThornParameterBindings
 
     foreach $parameter (sort(keys %these_parameters))
     {
-      # Alias the parameter unless it is one we want.
-      if(($rhparameter_db->{"\U$thorn SHARES $friend\E variables"} =~ m:( )*$parameter( )*:) && 
-         (length($1) > 0)||length($2)>0||$1 eq $rhparameter_db->{"\U$thorn SHARES $friend\E variables"})
-      {
-        # See if we are sharing it AS something
-        my $name = $rhparameter_db->{"\U$thorn $parameter\E alias"};
+#      print "DEBUG parameter is $parameter\n";
+      my $foundit = 0;
+      my $thornparam;
+      my $name = "";
 
-        if(! $name)
+      foreach $thornparam (split(/\s+/,$rhparameter_db->{"\U$thorn SHARES $friend\E variables"}))
+      {
+#        print "DEBUG thorn parameter is $thornparam\n";
+#        print "DEBUG       realname is " . $rhparameter_db->{"\U$thorn $thornparam\E realname"} ."\n";
+          
+        if($rhparameter_db->{"\U$thorn $thornparam\E realname"} =~ m/^$parameter$/i)
         {
-          $name = "$parameter";
+#          print "DEBUG ... " . $rhparameter_db->{"\U$thorn $thornparam\E realname"} . "\n";
+          $name = $thornparam; #$rhparameter_db->{"\U$thorn $thornparam\E realname"};
+          last;
         }
-
-        $alias_names{$parameter} = $name;
       }
-      else
+
+      if($name eq "")
       {
-        $alias_names{$parameter} = "CCTKH$num_aliases";
+        $name = "CCTKH$num_aliases";
         $num_aliases++;
       }
+      $alias_names{$parameter} = "$name";
     }
 
     @data = &CreateFortranCommonDeclaration("${friend}rest", \%these_parameters, $rhparameter_db, \%alias_names);
@@ -158,23 +167,19 @@ sub CreateFortranCommonDeclaration
       $suffix = "($array_size)";
     }
 
-    if($aliases == 0)
-    {
-      my $name = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E alias"};
+    my $name;
 
-      if(! $name)
-      {
-        $name = "$parameter";
-      }
-      
-      $line = "$type_string $name$suffix";
-      $definition .= "$sepchar$name";
+    if($aliases)
+    {
+      $name = $rhaliases->{$parameter};
     }
     else
     {
-      $line = "$type_string $rhaliases->{$parameter}$suffix";
-      $definition .= "$sepchar$rhaliases->{$parameter}";
+      $name = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E realname"};
     }
+      
+    $line = "$type_string $name$suffix";
+    $definition .= "$sepchar$name";
 
     push(@data, $line);
 
diff --git a/lib/sbin/parameter_parser.pl b/lib/sbin/parameter_parser.pl
index 0af8bed7..d164a544 100644
--- a/lib/sbin/parameter_parser.pl
+++ b/lib/sbin/parameter_parser.pl
@@ -1,4 +1,13 @@
 #! /usr/bin/perl
+#/*@@
+#  @file      parameter_parser.pl
+#  @date      Mon 25 May 08:07:40 1998
+#  @author    Tom Goodale
+#  @desc 
+#  Parser for param.ccl files
+#  @enddesc 
+#  @version $Header$
+#@@*/
 
 #%implementations = ("flesh", "flesh", "test1", "test1", "test2", "test2");
  
@@ -180,6 +189,32 @@ sub parse_param_ccl
         }
       }
 
+      my $realname = $variable;
+
+      # First deal with an alias
+
+      if($options =~ m/\bAS\s+([^\s]+)\s*/i)
+      {
+        my $alias = $1;
+        
+        if($alias !~ m/[a-zA-Z]+[a-zA-Z0-9_]*/)
+        {
+          $message = "Invalid alias name '$alias' for  $variable of thorn $thorn";
+          &CST_error(0,$message,"",__LINE__,__FILE__);
+        }
+        elsif($defined_parameters{"\U$alias\E"})
+        {
+          $message = "Invalid alias name '$alias' for $variable of thorn $thorn - parameter of that name already exists";
+          &CST_error(0,$message,"",__LINE__,__FILE__);
+        }
+              
+        $options =~ s/\bAS\s+([^\s])+\s*//i;
+
+        # Rename the variable for internal use
+        $variable = $alias
+      }
+      
+      
       if($defined_parameters{"\U$variable\E"})
       {
 
@@ -228,33 +263,9 @@ sub parse_param_ccl
           $line_number++;
           $line_number++;
         }
-
+        
         # Parse the options
 
-        # First deal with an alias
-#         if($options =~ m/\bAS\s+([^\s]+)\s*/i)
-#         {
-#           my $alias = $1;
-
-#           if($alias !~ m/[a-zA-Z]+[a-zA-Z0-9_]*/)
-#           {
-#             $message = "Invalid alias name '$alias' for  $variable of thorn $thorn";
-#             &CST_error(0,$message,"",__LINE__,__FILE__);
-#           }
-#           elsif($defined_parameters{"\U$alias\E"})
-#           {
-#             $message = "Invalid alias name '$alias' for $variable of thorn $thorn - parameter of that name already exists";
-#             &CST_error(0,$message,"",__LINE__,__FILE__);
-#           }
-#           else
-#           {
-#             $parameter_db{"\U$thorn $variable\E alias"} = $alias;
-#           }
-
-#           $options =~ s/\bAS\s+([^\s])+\s*//i;
-#         }
-
-        # Now parse options of the form option = value
         %options = split(/\s*=\s*|\s+/, $options);
       
         foreach $option (keys %options)
@@ -346,15 +357,8 @@ sub parse_param_ccl
 
         # Store data about this variable.
 
-        if($alias)
-        {
-          $defined_parameters{"\U$alias\E"} = 1;
-        }
-        else
-        {
-          $defined_parameters{"\U$variable\E"} = 1;
-        }
-
+        $defined_parameters{"\U$variable\E"} = 1;
+        $parameter_db{"\U$thorn $variable\E realname"} = $realname;
         $parameter_db{"\U$thorn $block\E variables"} .= $variable." ";
         $parameter_db{"\U$thorn $variable\E type"} = $type;
         $parameter_db{"\U$thorn $variable\E description"} = $description;