diff options
| -rw-r--r-- | lib/sbin/BuildHeaders.pl | 109 | ||||
| -rw-r--r-- | lib/sbin/CSTUtils.pl | 50 | ||||
| -rw-r--r-- | lib/sbin/ConfigurationParser.pl | 50 | ||||
| -rw-r--r-- | lib/sbin/CreateFunctionBindings.pl | 291 | ||||
| -rw-r--r-- | lib/sbin/CreateScheduleBindings.pl | 166 | ||||
| -rw-r--r-- | lib/sbin/ImpParamConsistency.pl | 73 | ||||
| -rw-r--r-- | lib/sbin/Runtest.pl | 6 | ||||
| -rw-r--r-- | lib/sbin/ScheduleParser.pl | 120 | ||||
| -rw-r--r-- | lib/sbin/create_c_stuff.pl | 8 | ||||
| -rw-r--r-- | lib/sbin/create_fortran_stuff.pl | 12 | ||||
| -rw-r--r-- | lib/sbin/interface_parser.pl | 888 | ||||
| -rw-r--r-- | lib/sbin/parameter_parser.pl | 334 |
12 files changed, 1051 insertions, 1056 deletions
diff --git a/lib/sbin/BuildHeaders.pl b/lib/sbin/BuildHeaders.pl index 91507980..c4462fc1 100644 --- a/lib/sbin/BuildHeaders.pl +++ b/lib/sbin/BuildHeaders.pl @@ -48,27 +48,27 @@ sub BuildHeaders { if ($inc_file1 !~ /^\s*$/) { - $inc_file1 =~ s/ //g; - $inc_file2 = $interface_database{"\U$thorn ADD HEADER $inc_file1 TO"}; - - # Write information to the global include file - $data{"$inc_file2"} .= "/* Including header file $inc_file1 from $thorn */\n"; - - # Now have to find the include file and copy it - if (-e "$cctk_home/arrangements/$arrangement/$thorn/src/$inc_file1") - { - $data{"$inc_file2"} .= "#include \"$arrangement/$thorn/src/$inc_file1\"\n\n"; - } - elsif (-e "$cctk_home/arrangements/$arrangement/$thorn/src/include/$inc_file1") - { - $data{"$inc_file2"} .= "#include \"$arrangement/$thorn/src/include/$inc_file1\"\n\n"; - } - else - { - $message = "Include file $inc_file1 not found in $arrangement/$thorn\n"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } - $data{"$inc_file2"} .= "/* End of include header file $inc_file1 from $thorn */\n"; + $inc_file1 =~ s/ //g; + $inc_file2 = $interface_database{"\U$thorn ADD HEADER $inc_file1 TO"}; + + # Write information to the global include file + $data{"$inc_file2"} .= "/* Including header file $inc_file1 from $thorn */\n"; + + # Now have to find the include file and copy it + if (-e "$cctk_home/arrangements/$arrangement/$thorn/src/$inc_file1") + { + $data{"$inc_file2"} .= "#include \"$arrangement/$thorn/src/$inc_file1\"\n\n"; + } + elsif (-e "$cctk_home/arrangements/$arrangement/$thorn/src/include/$inc_file1") + { + $data{"$inc_file2"} .= "#include \"$arrangement/$thorn/src/include/$inc_file1\"\n\n"; + } + else + { + $message = "Include file $inc_file1 not found in $arrangement/$thorn\n"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } + $data{"$inc_file2"} .= "/* End of include header file $inc_file1 from $thorn */\n"; } } @@ -76,40 +76,40 @@ sub BuildHeaders { if ($inc_file1 !~ /^\s*$/) { - $inc_file1 =~ s/ //g; - $inc_file2 = $interface_database{"\U$thorn ADD SOURCE $inc_file1 TO"}; - - # Write information to the global include file - $data{"$inc_file2"} .= "/* Including source file $inc_file1 from $thorn */\n"; - - # Now have to find the include file and copy it - if (-e "$cctk_home/arrangements/$arrangement/$thorn/src/$inc_file1") - { - $tmpline = "#include \"$arrangement/$thorn/src/$inc_file1\"\n"; - } - elsif (-e "$cctk_home/arrangements/$arrangement/$thorn/src/include/$inc_file1") - { - $tmpline = "#include \"$arrangement/$thorn/src/include/$inc_file1\"\n}\n"; - } - else - { - $message = "Include file $inc_file1 not found in $arrangement/$thorn\n"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } + $inc_file1 =~ s/ //g; + $inc_file2 = $interface_database{"\U$thorn ADD SOURCE $inc_file1 TO"}; + + # Write information to the global include file + $data{"$inc_file2"} .= "/* Including source file $inc_file1 from $thorn */\n"; + + # Now have to find the include file and copy it + if (-e "$cctk_home/arrangements/$arrangement/$thorn/src/$inc_file1") + { + $tmpline = "#include \"$arrangement/$thorn/src/$inc_file1\"\n"; + } + elsif (-e "$cctk_home/arrangements/$arrangement/$thorn/src/include/$inc_file1") + { + $tmpline = "#include \"$arrangement/$thorn/src/include/$inc_file1\"\n}\n"; + } + else + { + $message = "Include file $inc_file1 not found in $arrangement/$thorn\n"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } - $data{"$inc_file2"} .= "#ifdef FCODE\n"; - $data{"$inc_file2"} .= " if (CCTK_IsThornActive(\"$thorn\").eq.1) then\n"; - $data{"$inc_file2"} .= "#else\n"; - $data{"$inc_file2"} .= "if (CCTK_IsThornActive(\"$thorn\")){\n"; - $data{"$inc_file2"} .= "#endif\n"; - $data{"$inc_file2"} .= "$tmpline\n"; - $data{"$inc_file2"} .= "#ifdef FCODE\n"; - $data{"$inc_file2"} .= " end if\n"; - $data{"$inc_file2"} .= "#else\n"; - $data{"$inc_file2"} .= "\n}\n"; - $data{"$inc_file2"} .= "#endif\n"; - - $data{"$inc_file2"} .= "/* End of include source file $inc_file1 from $thorn */\n"; + $data{"$inc_file2"} .= "#ifdef FCODE\n"; + $data{"$inc_file2"} .= " if (CCTK_IsThornActive(\"$thorn\").eq.1) then\n"; + $data{"$inc_file2"} .= "#else\n"; + $data{"$inc_file2"} .= "if (CCTK_IsThornActive(\"$thorn\")){\n"; + $data{"$inc_file2"} .= "#endif\n"; + $data{"$inc_file2"} .= "$tmpline\n"; + $data{"$inc_file2"} .= "#ifdef FCODE\n"; + $data{"$inc_file2"} .= " end if\n"; + $data{"$inc_file2"} .= "#else\n"; + $data{"$inc_file2"} .= "\n}\n"; + $data{"$inc_file2"} .= "#endif\n"; + + $data{"$inc_file2"} .= "/* End of include source file $inc_file1 from $thorn */\n"; } } @@ -133,4 +133,3 @@ sub BuildHeaders } 1; - diff --git a/lib/sbin/CSTUtils.pl b/lib/sbin/CSTUtils.pl index c54880a7..4a1dc2be 100644 --- a/lib/sbin/CSTUtils.pl +++ b/lib/sbin/CSTUtils.pl @@ -1,4 +1,3 @@ - #/*@@ # @routine CST_error # @date 4 July 1999 @@ -21,35 +20,35 @@ sub CST_error if ($full_warnings) { - if ($level == 0) - { - $CST_errors++; + if ($level == 0) + { + $CST_errors++; $error = "\nCST error in $file (at $line)\n -> $mess\n"; - print STDERR "$error\n"; - $error_string .= "$error$help\n"; - } - else - { + print STDERR "$error\n"; + $error_string .= "$error$help\n"; + } + else + { $error = "\nCST warning in $file (at $line)\n -> $mess\n"; - print STDERR "$error\n"; - $error_string .= "$error$help\n"; - } + print STDERR "$error\n"; + $error_string .= "$error$help\n"; + } } else { - if ($level == 0) - { - $CST_errors++; + if ($level == 0) + { + $CST_errors++; $error = "\nCST error $CST_errors:\n -> $mess\n"; - print STDERR "$error\n"; - $error_string .= "$error$help\n"; - } - else - { + print STDERR "$error\n"; + $error_string .= "$error$help\n"; + } + else + { $error = "\nCST warning:\n -> $mess\n"; - print STDERR "$error\n"; - $error_string .= "$error$help\n"; - } + print STDERR "$error\n"; + $error_string .= "$error$help\n"; + } } return; @@ -154,11 +153,11 @@ sub chompme $lastchar = chop($in); if ($lastchar eq "\n") { - return $_; + return $_; } else { - return $in; + return $in; } } @@ -248,4 +247,3 @@ sub TestName } 1; - diff --git a/lib/sbin/ConfigurationParser.pl b/lib/sbin/ConfigurationParser.pl index 0aefc1cf..5bb2a68b 100644 --- a/lib/sbin/ConfigurationParser.pl +++ b/lib/sbin/ConfigurationParser.pl @@ -169,24 +169,24 @@ sub ParseProvidesBlock $line_number++; if($ra_data->[$line_number] =~ m/^\s*SCRIPT\s*(.*)$/i) { - $script = $1; - next; + $script = $1; + next; } elsif($ra_data->[$line_number] =~ m/^\s*LANG[^\s]*\s*(.*)$/i) { - $lang = $1; - next; + $lang = $1; + next; } elsif($ra_data->[$line_number] =~ m:\s*\}\s*:) { - # do nothing. + # do nothing. } else { - print STDERR "Error parsing provides block line '$ra_data->[$line_number]'\n"; - print STDERR "Unrecognised statement\n"; - $CST_errors++; - } + print STDERR "Error parsing provides block line '$ra_data->[$line_number]'\n"; + print STDERR "Unrecognised statement\n"; + $CST_errors++; + } } } @@ -235,28 +235,28 @@ sub ParseOptionalBlock $line_number++; if($ra_data->[$line_number] =~ m/^\s*DEFINE\s*(.*)$/i) { - if($define eq "") - { - $define = $1; - next; - } - else - { - print STDERR "Error parsing optional block line '$ra_data->[$line_number]'\n"; - print STDERR "Only one define allowed\n"; - $CST_errors++; - } + if($define eq "") + { + $define = $1; + next; + } + else + { + print STDERR "Error parsing optional block line '$ra_data->[$line_number]'\n"; + print STDERR "Only one define allowed\n"; + $CST_errors++; + } } elsif($ra_data->[$line_number] =~ m:\s*\}\s*:) { - # do nothing. + # do nothing. } else { - print STDERR "Error parsing provides block line '$ra_data->[$line_number]'\n"; - print STDERR "Unrecognised statement\n"; - $CST_errors++; - } + print STDERR "Error parsing provides block line '$ra_data->[$line_number]'\n"; + print STDERR "Unrecognised statement\n"; + $CST_errors++; + } } } diff --git a/lib/sbin/CreateFunctionBindings.pl b/lib/sbin/CreateFunctionBindings.pl index cbb28b93..24f3b825 100644 --- a/lib/sbin/CreateFunctionBindings.pl +++ b/lib/sbin/CreateFunctionBindings.pl @@ -592,8 +592,8 @@ sub ThornIncludes { if ($function !~ m:^\s*$:) { - $line = "extern $function_db->{\"$function RET\"} (*$function)($function_db->{\"$function CARGS\"});\n"; - push(@data, $line); + $line = "extern $function_db->{\"$function RET\"} (*$function)($function_db->{\"$function CARGS\"});\n"; + push(@data, $line); } } @@ -742,44 +742,44 @@ sub DummyThornFunctions { if ($function !~ m:^\s*$:) { - $ret = $function_db->{"$function RET"}; - - $line = "$ret CCTKBindings_Dummy$function($function_db->{\"$function CARGS\"});\n"; - push(@data, $line); - $line = "$ret CCTKBindings_Dummy$function($function_db->{\"$function CARGS\"})\n"; - push(@data, $line); - $line = "{\n"; - push(@data, $line); - - # Make sure we use all arguments to avoid warnings - $line = " const void *cctk_dummy_pointer;\n"; - push(@data, $line); - $line = " cctk_dummy_pointer = cctk_dummy_pointer;\n"; - push(@data, $line); - foreach $arg (split(",",$function_db->{"$function CARGS"})) - { - $arg =~ m:(.*\s+\**)([^\s*\*]+)\s*:; -# $type=$1; - $name=$2; - $line = " cctk_dummy_pointer = \&$name;\n"; - push(@data, $line); - } - $line = " CCTK_Warn(1,__LINE__,__FILE__,\"Bindings\",\n"; - push(@data, $line); - $line = " \"CCTKBindings_Dummy$function: Calling thorn function $function which has not been overloaded\");\n"; - push(@data, $line); - if ($ret =~ m:INT:i) - { - $line = "return -1;"; - push(@data, $line); - } - elsif ($ret =~ m:REAL:i) - { - $line = "return 0;"; - push(@data, $line); - } - $line = "}\n\n"; - push(@data, $line); + $ret = $function_db->{"$function RET"}; + + $line = "$ret CCTKBindings_Dummy$function($function_db->{\"$function CARGS\"});\n"; + push(@data, $line); + $line = "$ret CCTKBindings_Dummy$function($function_db->{\"$function CARGS\"})\n"; + push(@data, $line); + $line = "{\n"; + push(@data, $line); + + # Make sure we use all arguments to avoid warnings + $line = " const void *cctk_dummy_pointer;\n"; + push(@data, $line); + $line = " cctk_dummy_pointer = cctk_dummy_pointer;\n"; + push(@data, $line); + foreach $arg (split(",",$function_db->{"$function CARGS"})) + { + $arg =~ m:(.*\s+\**)([^\s*\*]+)\s*:; +# $type=$1; + $name=$2; + $line = " cctk_dummy_pointer = \&$name;\n"; + push(@data, $line); + } + $line = " CCTK_Warn(1,__LINE__,__FILE__,\"Bindings\",\n"; + push(@data, $line); + $line = " \"CCTKBindings_Dummy$function: Calling thorn function $function which has not been overloaded\");\n"; + push(@data, $line); + if ($ret =~ m:INT:i) + { + $line = "return -1;"; + push(@data, $line); + } + elsif ($ret =~ m:REAL:i) + { + $line = "return 0;"; + push(@data, $line); + } + $line = "}\n\n"; + push(@data, $line); } } @@ -866,10 +866,10 @@ sub RegisterThornFunctions { if ($function !~ m:^\s*$:) { - $line = " ierr = CCTKBindings_Overload$function($rhinterface_db->{\"\U$thorn PROVIDES FUNCTION\E $function WITH\"});\n"; - push(@data, $line); - $line = " retval = (ierr == 0) ? retval-- : retval;\n"; - push(@data, $line); + $line = " ierr = CCTKBindings_Overload$function($rhinterface_db->{\"\U$thorn PROVIDES FUNCTION\E $function WITH\"});\n"; + push(@data, $line); + $line = " retval = (ierr == 0) ? retval-- : retval;\n"; + push(@data, $line); } } @@ -935,8 +935,8 @@ sub FortranThornFunctions { if ($function !~ m:^\s*$:) { - $line = "extern $function_db->{\"$function RET\"} (*$function)($function_db->{\"$function CARGS\"});\n"; - push(@data, $line); + $line = "extern $function_db->{\"$function RET\"} (*$function)($function_db->{\"$function CARGS\"});\n"; + push(@data, $line); } } $line = "\n\n"; @@ -951,15 +951,15 @@ sub FortranThornFunctions $line .= "($function_db->{\"$function WARGS\"}"; if ($function_db->{"$function STRINGS"} == 1) { - $line .= ", ONE_FORTSTRING_ARG"; + $line .= ", ONE_FORTSTRING_ARG"; } elsif ($function_db->{"$function STRINGS"} == 2) { - $line .= ", TWO_FORTSTRINGS_ARGS"; + $line .= ", TWO_FORTSTRINGS_ARGS"; } elsif ($function_db->{"$function STRINGS"} == 3) { - $line .= ", THREE_FORTSTRINGS_ARGS"; + $line .= ", THREE_FORTSTRINGS_ARGS"; } $line .= ")"; @@ -973,30 +973,30 @@ sub FortranThornFunctions if ($function_db->{"$function TYPE"} =~ "FUNC") { - $line = " $function_db->{\"$function RET\"} cctki_retval;\n"; - push(@data, $line); + $line = " $function_db->{\"$function RET\"} cctki_retval;\n"; + push(@data, $line); } if ($function_db->{"$function STRINGS"} == 1) { - $line = "ONE_FORTSTRING_CREATE(cctki_string1)\n"; - push(@data, $line); + $line = "ONE_FORTSTRING_CREATE(cctki_string1)\n"; + push(@data, $line); } elsif ($function_db->{"$function STRINGS"} == 2) { - $line = "TWO_FORTSTRINGS_CREATE(cctki_string1,cctki_string2)\n"; - push(@data, $line); + $line = "TWO_FORTSTRINGS_CREATE(cctki_string1,cctki_string2)\n"; + push(@data, $line); } elsif ($function_db->{"$function STRINGS"} == 3) { - $line = "THREE_FORTSTRINGS_CREATE(cctki_string1,cctki_string2,cctki_string3)\n"; - push(@data, $line); + $line = "THREE_FORTSTRINGS_CREATE(cctki_string1,cctki_string2,cctki_string3)\n"; + push(@data, $line); } if ($function_db->{"$function TYPE"} =~ "FUNC") { - $line = " cctki_retval = \n"; - push(@data, $line); + $line = " cctki_retval = \n"; + push(@data, $line); } $line = " $function($function_db->{\"$function WCALL\"}"; @@ -1004,18 +1004,18 @@ sub FortranThornFunctions if ($function_db->{"$function STRINGS"} == 1) { - $line = ", cctki_string1"; - push(@data, $line); + $line = ", cctki_string1"; + push(@data, $line); } elsif ($function_db->{"$function STRINGS"} == 2) { - $line = ", cctki_string1, cctki_string2"; - push(@data, $line); + $line = ", cctki_string1, cctki_string2"; + push(@data, $line); } elsif ($function_db->{"$function STRINGS"} == 3) { - $line = ", cctki_string1, cctki_string2, cctki_string3"; - push(@data, $line); + $line = ", cctki_string1, cctki_string2, cctki_string3"; + push(@data, $line); } $line = ");\n"; @@ -1023,24 +1023,24 @@ sub FortranThornFunctions if ($function_db->{"$function STRINGS"} == 1) { - $line = " free(cctki_string1);\n"; - push(@data, $line); + $line = " free(cctki_string1);\n"; + push(@data, $line); } elsif ($function_db->{"$function STRINGS"} == 2) { - $line = " free(cctki_string1);\n free(cctki_string2);\n"; - push(@data, $line); + $line = " free(cctki_string1);\n free(cctki_string2);\n"; + push(@data, $line); } elsif ($function_db->{"$function STRINGS"} == 3) { - $line = " free(cctki_string1);\n free(cctki_string2);\n free(cctki_string3);\n"; - push(@data, $line); + $line = " free(cctki_string1);\n free(cctki_string2);\n free(cctki_string3);\n"; + push(@data, $line); } if ($function_db->{"$function TYPE"} =~ "FUNC") { - $line = " return cctki_retval; \n"; - push(@data, $line); + $line = " return cctki_retval; \n"; + push(@data, $line); } $line = "}\n"; @@ -1092,64 +1092,64 @@ sub FunctionDatabase if ($function_db->{"FUNCTIONS"} =~ / $function / && $function !~ /^\s*$/) { - if ($types ne $function_db->{"$function TYPES"}) - { - $message = "Argument types for aliased $function do not match"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } - if ($inret ne $function_db->{"$function RET"}) - { - $message = "Return types for aliased $function do not match"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } + if ($types ne $function_db->{"$function TYPES"}) + { + $message = "Argument types for aliased $function do not match"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } + if ($inret ne $function_db->{"$function RET"}) + { + $message = "Return types for aliased $function do not match"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } } else { - if ($inret =~ m:^\s*void\s*$:) - { - $function_db->{"$function CARGS"} = "SUB"; - } - else - { - $function_db->{"$function CARGS"} = "FUNC"; - } - - if ($c) - { - if ($fortran) - { - $function_db->{"$function LANG"} = "FC"; - } - else - { - $function_db->{"$function LANG"} = "C"; - $message = "Fortran wrapper not created for alias $function"; - &CST_error(1,$message,"",__LINE__,__FILE__); - } - } - else - { - $function_db->{"$function LANG"} = ""; - $message = "Can't create alias for $function"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } - - if ($rhinterface_db->{"\U$thorn FUNCTION\E $function RET"} eq "void") - { - $function_db->{"$function TYPE"} = "SUB"; - } - else - { - $function_db->{"$function TYPE"} = "FUNC"; - } - - $function_db->{"FUNCTIONS"} .= "$function "; - $function_db->{"$function STRINGS"} = $nstrings; - $function_db->{"$function CARGS"} = $cargs; - $function_db->{"$function TYPES"} = $types; - $function_db->{"$function WARGS"} = $wrapperargs; - $function_db->{"$function WCALL"} = $wrappercall; - $function_db->{"$function RET"} = $rhinterface_db->{"\U$thorn FUNCTION\E $function RET"}; + if ($inret =~ m:^\s*void\s*$:) + { + $function_db->{"$function CARGS"} = "SUB"; + } + else + { + $function_db->{"$function CARGS"} = "FUNC"; + } + + if ($c) + { + if ($fortran) + { + $function_db->{"$function LANG"} = "FC"; + } + else + { + $function_db->{"$function LANG"} = "C"; + $message = "Fortran wrapper not created for alias $function"; + &CST_error(1,$message,"",__LINE__,__FILE__); + } + } + else + { + $function_db->{"$function LANG"} = ""; + $message = "Can't create alias for $function"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } + + if ($rhinterface_db->{"\U$thorn FUNCTION\E $function RET"} eq "void") + { + $function_db->{"$function TYPE"} = "SUB"; + } + else + { + $function_db->{"$function TYPE"} = "FUNC"; + } + + $function_db->{"FUNCTIONS"} .= "$function "; + $function_db->{"$function STRINGS"} = $nstrings; + $function_db->{"$function CARGS"} = $cargs; + $function_db->{"$function TYPES"} = $types; + $function_db->{"$function WARGS"} = $wrapperargs; + $function_db->{"$function WCALL"} = $wrappercall; + $function_db->{"$function RET"} = $rhinterface_db->{"\U$thorn FUNCTION\E $function RET"}; } } } @@ -1166,16 +1166,16 @@ sub FunctionDatabase if ($function_db->{"FUNCTIONS"} =~ / $function / && $function !~ /^\s*$/) { - if ($types ne $function_db->{"$function TYPES"}) - { - $message = "Argument types for aliased $function do not match"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } - if ($inret ne $function_db->{"$function RET"}) - { - $message = "Return types for aliased $function do not match"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } + if ($types ne $function_db->{"$function TYPES"}) + { + $message = "Argument types for aliased $function do not match"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } + if ($inret ne $function_db->{"$function RET"}) + { + $message = "Return types for aliased $function do not match"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } } $function_db->{"PROVIDED FUNCTIONS"} .= "$function "; } @@ -1262,20 +1262,20 @@ sub ParseArguments { if ($number_strings) { - $fortran = 0; + $fortran = 0; } # look for an array if ($type =~ m/^\s*(CCTK_INT??|CCTK_REAL??):ARRAY\s*$/) { - $ccallargs .= "$1 *$name, "; - $fwrapperargs .= "$1 *$name, "; - $fwrappercallargs .= "$name, "; + $ccallargs .= "$1 *$name, "; + $fwrapperargs .= "$1 *$name, "; + $fwrappercallargs .= "$name, "; } else { - $ccallargs .= "$type $name, "; - $fwrapperargs .= "$type *$name, "; - $fwrappercallargs .= "*$name, "; + $ccallargs .= "$type $name, "; + $fwrapperargs .= "$type *$name, "; + $fwrappercallargs .= "*$name, "; } } else @@ -1302,4 +1302,3 @@ sub ParseArguments } 1; - diff --git a/lib/sbin/CreateScheduleBindings.pl b/lib/sbin/CreateScheduleBindings.pl index 860ddedb..21956a8f 100644 --- a/lib/sbin/CreateScheduleBindings.pl +++ b/lib/sbin/CreateScheduleBindings.pl @@ -128,7 +128,7 @@ sub ScheduleCreateFile if ($rhschedule_db->{"\U$thorn\E BLOCK_$block WHERE"} !~ /RECOVER_PARAMETERS/) { ($block_buffer, $block_prototype) = &ScheduleBlock($thorn, $implementation, $block, - $rhinterface_db, $rhschedule_db); + $rhinterface_db, $rhschedule_db); $buffer =~ s:\@BLOCK\@$block:$block_buffer:; $prototypes .= "$block_prototype"; } @@ -142,7 +142,7 @@ sub ScheduleCreateFile for($statement = 0 ; $statement < $rhschedule_db->{"\U$thorn\E N_STATEMENTS"}; $statement++) { ($statement_buffer, $statement_prototype) = &ScheduleStatement($thorn, $implementation, $statement, - $rhinterface_db, $rhschedule_db); + $rhinterface_db, $rhschedule_db); $buffer =~ s:\@STATEMENT\@$statement:$statement_buffer:; $prototypes .= "$statement_prototype"; } @@ -231,14 +231,14 @@ sub ParameterRecoveryCreateFile { if ($rhschedule_db->{"\U$thorn\E BLOCK_$block WHERE"} =~ /RECOVER_PARAMETERS/) { - if($rhschedule_db->{"\U$thorn\E BLOCK_$block LANG"} =~ m:^\s*C\s*$:i ) - { - $block_buffer = $rhschedule_db->{"\U$thorn\E BLOCK_$block NAME"}; - } - elsif($rhschedule_db->{"\U$thorn\E BLOCK_$block LANG"} =~ m:^\s*(F|F77|FORTRAN|F90)\s*$:i ) + if($rhschedule_db->{"\U$thorn\E BLOCK_$block LANG"} =~ m:^\s*C\s*$:i ) { - $block_buffer = "CCTK_FNAME(".$rhschedule_db->{"\U$thorn\E BLOCK_$block NAME"} .")"; - } + $block_buffer = $rhschedule_db->{"\U$thorn\E BLOCK_$block NAME"}; + } + elsif($rhschedule_db->{"\U$thorn\E BLOCK_$block LANG"} =~ m:^\s*(F|F77|FORTRAN|F90)\s*$:i ) + { + $block_buffer = "CCTK_FNAME(".$rhschedule_db->{"\U$thorn\E BLOCK_$block NAME"} .")"; + } $buffer =~ s:\@BLOCK\@$block:result = $block_buffer();:; $prototypes .= "extern int $block_buffer(void);\n"; @@ -470,13 +470,13 @@ sub ScheduleBlock # Extract group and routine information from the databases @mem_groups = &ScheduleSelectGroups($thorn, $implementation, - $rhschedule_db->{"\U$thorn\E BLOCK_$block STOR"}, - $rhinterface_db); + $rhschedule_db->{"\U$thorn\E BLOCK_$block STOR"}, + $rhinterface_db); @unused_comm_groups = &ScheduleSelectGroups($thorn, $implementation, - $rhschedule_db->{"\U$thorn\E BLOCK_$block COMM"}, - $rhinterface_db); + $rhschedule_db->{"\U$thorn\E BLOCK_$block COMM"}, + $rhinterface_db); if (@unused_comm_groups) { print "No need to switch on Communication in $thorn\n"; @@ -486,26 +486,26 @@ sub ScheduleBlock @comm_groups = @mem_groups; # Switch on storage for groups with comm @trigger_groups = &ScheduleSelectGroups($thorn, $implementation, - $rhschedule_db->{"\U$thorn\E BLOCK_$block TRIG"}, - $rhinterface_db); - + $rhschedule_db->{"\U$thorn\E BLOCK_$block TRIG"}, + $rhinterface_db); + @sync_groups = &ScheduleSelectGroups($thorn, $implementation, - $rhschedule_db->{"\U$thorn\E BLOCK_$block SYNC"}, - $rhinterface_db); + $rhschedule_db->{"\U$thorn\E BLOCK_$block SYNC"}, + $rhinterface_db); @options = split(/,/, $rhschedule_db->{"\U$thorn\E BLOCK_$block OPTIONS"}); @before_list = &ScheduleSelectRoutines($thorn, $implementation, - $rhschedule_db->{"\U$thorn\E BLOCK_$block BEFORE"}, - $rhschedule_db); + $rhschedule_db->{"\U$thorn\E BLOCK_$block BEFORE"}, + $rhschedule_db); @after_list = &ScheduleSelectRoutines($thorn, $implementation, - $rhschedule_db->{"\U$thorn\E BLOCK_$block AFTER"}, - $rhschedule_db); + $rhschedule_db->{"\U$thorn\E BLOCK_$block AFTER"}, + $rhschedule_db); @while_list = &ScheduleSelectVars($thorn, $implementation, - $rhschedule_db->{"\U$thorn\E BLOCK_$block WHILE"}, - $rhinterface_db); + $rhschedule_db->{"\U$thorn\E BLOCK_$block WHILE"}, + $rhinterface_db); # Start writing out the data @@ -566,7 +566,7 @@ sub ScheduleBlock $buffer .= $indent . scalar(@while_list) . " /* Number of WHILE variables */"; foreach $item (@mem_groups, @comm_groups, @trigger_groups, @sync_groups, - @options, @before_list, @after_list, @while_list) + @options, @before_list, @after_list, @while_list) { $buffer .= ",\n" . $indent . "\"" . $item . "\"" ; } @@ -600,8 +600,8 @@ sub ScheduleStatement # Extract the groups. @groups = &ScheduleSelectGroups($thorn, $implementation, - $rhschedule_db->{"\U$thorn\E STATEMENT_$statement GROUPS"}, - $rhinterface_db); + $rhschedule_db->{"\U$thorn\E STATEMENT_$statement GROUPS"}, + $rhinterface_db); if($rhschedule_db->{"\U$thorn\E STATEMENT_$statement TYPE"} eq "STOR") { @@ -675,38 +675,38 @@ sub ScheduleSelectGroups if(($1 !~ m:^\s*$thorn\s*$:i) && ($1 !~ m:^\s*$implementation\s*$:i)) { - # The name has been given completely specified but it isn't this thorn. + # The name has been given completely specified but it isn't this thorn. - if($rhinterface_db->{"IMPLEMENTATION \U$implementation\E ANCESTORS"} =~ m:\b$other_imp\b:i) - { - $block = "PUBLIC"; - } - elsif($rhinterface_db->{"IMPLEMENTATION \U$implementation\E FRIENDS"} =~ m:\b$other_imp\b:i) - { - $block = "PROTECTED"; - } - else - { - $mess = "Schedule error: Thorn $thorn - group $other_imp\:\:$group doesn't exist."; - $help = "Check thorn $thorn inherits from implementation $other_imp"; - &CST_error(0,$mess,$help,__LINE__,__FILE__); - next; - } - - $rhinterface_db->{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):; - $other_thorn = $1; + if($rhinterface_db->{"IMPLEMENTATION \U$implementation\E ANCESTORS"} =~ m:\b$other_imp\b:i) + { + $block = "PUBLIC"; + } + elsif($rhinterface_db->{"IMPLEMENTATION \U$implementation\E FRIENDS"} =~ m:\b$other_imp\b:i) + { + $block = "PROTECTED"; + } + else + { + $mess = "Schedule error: Thorn $thorn - group $other_imp\:\:$group doesn't exist."; + $help = "Check thorn $thorn inherits from implementation $other_imp"; + &CST_error(0,$mess,$help,__LINE__,__FILE__); + next; + } + + $rhinterface_db->{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):; + $other_thorn = $1; - if($rhinterface_db->{"\U$other_thorn\E $block GROUPS"} =~ m:\b$group\b:i) - { - push(@groups, "$other_imp\::$group"); - next; - } - else - { - $mess = "Schedule error: Thorn $thorn - group $other_imp\:\:$group doesn't exist.\n"; - &CST_error(0,$mess,"",__LINE__,__FILE__); - next; - } + if($rhinterface_db->{"\U$other_thorn\E $block GROUPS"} =~ m:\b$group\b:i) + { + push(@groups, "$other_imp\::$group"); + next; + } + else + { + $mess = "Schedule error: Thorn $thorn - group $other_imp\:\:$group doesn't exist.\n"; + &CST_error(0,$mess,"",__LINE__,__FILE__); + next; + } } } @@ -728,39 +728,39 @@ sub ScheduleSelectGroups # Check ancestors and friends foreach $other_imp (split(" ", $rhinterface_db->{"IMPLEMENTATION \U$implementation\E ANCESTORS"})) { - $rhinterface_db->{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):; - $other_thorn = $1; - - if($rhinterface_db->{"\U$other_thorn\E PUBLIC GROUPS"} =~ m:\b$group\b:i) - { - push(@groups, "$other_imp\::$group"); - $foundit = 1; - last; - } + $rhinterface_db->{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):; + $other_thorn = $1; + + if($rhinterface_db->{"\U$other_thorn\E PUBLIC GROUPS"} =~ m:\b$group\b:i) + { + push(@groups, "$other_imp\::$group"); + $foundit = 1; + last; + } } if(! $foundit) { - foreach $other_imp (split(" ", $rhinterface_db->{"IMPLEMENTATION \U$implementation\E FRIENDS"})) - { - $rhinterface_db->{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):; - $other_thorn = $1; - - if($rhinterface_db->{"\U$other_thorn\E PROTECTED GROUPS"} =~ m:\b$group\b:i) - { - push(@groups, "$other_imp\::$group"); - $foundit = 1; - last; - } - } + foreach $other_imp (split(" ", $rhinterface_db->{"IMPLEMENTATION \U$implementation\E FRIENDS"})) + { + $rhinterface_db->{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):; + $other_thorn = $1; + + if($rhinterface_db->{"\U$other_thorn\E PROTECTED GROUPS"} =~ m:\b$group\b:i) + { + push(@groups, "$other_imp\::$group"); + $foundit = 1; + last; + } + } } if(! $foundit) { - $mess = "Schedule error: Thorn $thorn - group $group doesn't exist."; - $help = "Check $group really is in thorn $thorn. Groups from other thorns "; + $mess = "Schedule error: Thorn $thorn - group $group doesn't exist."; + $help = "Check $group really is in thorn $thorn. Groups from other thorns "; $help .= "need to be specified using \$implementation\:\:\$group and "; - $help .= "$implementation must be inheritied by your thorn."; - &CST_error(0,$mess,$help,__LINE__,__FILE__); - + $help .= "$implementation must be inheritied by your thorn."; + &CST_error(0,$mess,$help,__LINE__,__FILE__); + } } else diff --git a/lib/sbin/ImpParamConsistency.pl b/lib/sbin/ImpParamConsistency.pl index 288ac90a..78fbe5be 100644 --- a/lib/sbin/ImpParamConsistency.pl +++ b/lib/sbin/ImpParamConsistency.pl @@ -35,53 +35,53 @@ sub CheckImpParamConsistency # Check the other implementation exists. if($other_thorn =~ m:^\s*$:) { - print "$thorn SHARES from implementation $friend - no such implementation\n"; - - $CST_errors++; - - next; + print "$thorn SHARES from implementation $friend - no such implementation\n"; + + $CST_errors++; + + next; } # print "Other thorn is $other_thorn\n"; foreach $parameter (split(" ", $parameter_database{"\U$thorn SHARES $friend\E variables"})) { -# print "Parameter is $parameter\n"; +# print "Parameter is $parameter\n"; - # Check if the parameter exists in the other thorn - if($parameter_database{"\U$other_thorn $parameter\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) - { + # Check if the parameter exists in the other thorn + if($parameter_database{"\U$other_thorn $parameter\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) + { # This lot is done by C now, and SHOULD NOT BE DONE by the perl -# # Loop through all the added ranges. -# for($range=1; -# $range <= $parameter_database{"\U$thorn $parameter\E ranges"}; -# $range++) -# { -# # Increment the number of ranges for the extended parameter -# $parameter_database{"\U$other_thorn $parameter\E ranges"}++; +# # Loop through all the added ranges. +# for($range=1; +# $range <= $parameter_database{"\U$thorn $parameter\E ranges"}; +# $range++) +# { +# # Increment the number of ranges for the extended parameter +# $parameter_database{"\U$other_thorn $parameter\E ranges"}++; - # Add in the range -# $parameter_database{"\U$other_thorn $parameter\E range $parameter_database{\"\U$other_thorn $parameter\E ranges\"} range"} = $parameter_database{"\U$thorn $parameter\E range $range range"}; + # Add in the range +# $parameter_database{"\U$other_thorn $parameter\E range $parameter_database{\"\U$other_thorn $parameter\E ranges\"} range"} = $parameter_database{"\U$thorn $parameter\E range $range range"}; - # Add in the range description -# $parameter_database{"\U$other_thorn $parameter\E range $parameter_database{\"\U$other_thorn $parameter\E ranges\"} description"} = $parameter_database{"\U$thorn $parameter\E range $range description"}; -# } - } - else - { - $message = "Thorn $thorn attempted to EXTEND or USE non-restricted parameter $parameter from $friend"; - &CST_error(0,$message,__LINE__,__FILE__); - } - } - else - { - $message = "Thorn $thorn attempted to EXTEND or USE non-existant parameter $parameter from $friend"; - &CST_error(0,$message,__LINE__,__FILE__); - } + # Add in the range description +# $parameter_database{"\U$other_thorn $parameter\E range $parameter_database{\"\U$other_thorn $parameter\E ranges\"} description"} = $parameter_database{"\U$thorn $parameter\E range $range description"}; +# } + } + else + { + $message = "Thorn $thorn attempted to EXTEND or USE non-restricted parameter $parameter from $friend"; + &CST_error(0,$message,__LINE__,__FILE__); + } + } + else + { + $message = "Thorn $thorn attempted to EXTEND or USE non-existant parameter $parameter from $friend"; + &CST_error(0,$message,__LINE__,__FILE__); + } } } } @@ -90,4 +90,3 @@ sub CheckImpParamConsistency } 1; - diff --git a/lib/sbin/Runtest.pl b/lib/sbin/Runtest.pl index 283b5c1d..3d6aad5d 100644 --- a/lib/sbin/Runtest.pl +++ b/lib/sbin/Runtest.pl @@ -499,8 +499,8 @@ sub runtest if ( -e $newfile) { - #print STDERR "*************** -e :${newfile}:!\n"; - #if (-e $file) {print "************** file exists\n";} + #print STDERR "*************** -e :${newfile}:!\n"; + #if (-e $file) {print "************** file exists\n";} open (INORIG, "<$file"); open (INNEW, "<$newfile"); @@ -516,7 +516,7 @@ sub runtest { # Check against nans - #print STDERR "*************** Looking for nans...........\n\a\a\a"; + #print STDERR "*************** Looking for nans...........\n\a\a\a"; if ($nline =~ /nan/i) { print "****CAUGHT NAN in $newfile****\n"; diff --git a/lib/sbin/ScheduleParser.pl b/lib/sbin/ScheduleParser.pl index dd204546..6e74e0a9 100644 --- a/lib/sbin/ScheduleParser.pl +++ b/lib/sbin/ScheduleParser.pl @@ -206,19 +206,19 @@ sub ParseScheduleBlock $field+=2; if($where ne "") { - print STDERR "Error parsing schedule block line '$data[$line_number]'\n"; - print STDERR "Attempt to schedule same block at/in two places.\n"; + print STDERR "Error parsing schedule block line '$data[$line_number]'\n"; + print STDERR "Attempt to schedule same block at/in two places.\n"; } else { - if($fields[$field] =~ m:CCTK_:) - { - $where = "\U$fields[$field]\E"; - } - else - { - $where = "CCTK_\U$fields[$field]\E"; - } + if($fields[$field] =~ m:CCTK_:) + { + $where = "\U$fields[$field]\E"; + } + else + { + $where = "CCTK_\U$fields[$field]\E"; + } } $field+=2; } @@ -227,12 +227,12 @@ sub ParseScheduleBlock $field+=2; if($where ne "") { - print STDERR "Error parsing schedule block line '$data[$line_number]'\n"; - print STDERR "Attempt to schedule same block at/in two places.\n"; + print STDERR "Error parsing schedule block line '$data[$line_number]'\n"; + print STDERR "Attempt to schedule same block at/in two places.\n"; } else { - $where = "$fields[$field]"; + $where = "$fields[$field]"; } $field+=2; } @@ -241,12 +241,12 @@ sub ParseScheduleBlock $field+=2; if($as ne "") { - print STDERR "Error parsing schedule block line '$data[$line_number]'\n"; - print STDERR "Attempt to schedule same block with two names.\n"; + print STDERR "Error parsing schedule block line '$data[$line_number]'\n"; + print STDERR "Attempt to schedule same block with two names.\n"; } else { - $as = "$fields[$field]"; + $as = "$fields[$field]"; } $field+=2; } @@ -254,8 +254,8 @@ sub ParseScheduleBlock { if($keyword ne "") { - $message = "Error parsing schedule block line '$data[$line_number]'\n"; - &CST_error(0,$message,"",__LINE__,__FILE__); + $message = "Error parsing schedule block line '$data[$line_number]'\n"; + &CST_error(0,$message,"",__LINE__,__FILE__); } $keyword = "BEFORE"; $field++; @@ -264,8 +264,8 @@ sub ParseScheduleBlock { if($keyword ne "") { - $message="Error parsing schedule block line '$data[$line_number]'\n"; - &CST_error(0,$message,"",__LINE__,__FILE__); + $message="Error parsing schedule block line '$data[$line_number]'\n"; + &CST_error(0,$message,"",__LINE__,__FILE__); } $keyword = "AFTER"; $field++; @@ -274,8 +274,8 @@ sub ParseScheduleBlock { if($keyword ne "") { - $message="Error parsing schedule block line '$data[$line_number]'\n"; - &CST_error(0,$message,"",__LINE__,__FILE__); + $message="Error parsing schedule block line '$data[$line_number]'\n"; + &CST_error(0,$message,"",__LINE__,__FILE__); } $keyword = "WHILE"; $field++; @@ -289,29 +289,29 @@ sub ParseScheduleBlock while($fields[$field] !~ m:\s*\)\s*: && $field <= $#fields) { - if($fields[$field] =~ m:\s*,\s*:) - { - $field++; - next; - } - - push(@current_sched_list, $fields[$field]); - $field++; + if($fields[$field] =~ m:\s*,\s*:) + { + $field++; + next; + } + + push(@current_sched_list, $fields[$field]); + $field++; } $field++; if($keyword eq "BEFORE") { - push(@before_list, @current_sched_list); + push(@before_list, @current_sched_list); } elsif($keyword eq "AFTER") { - push(@after_list, @current_sched_list); + push(@after_list, @current_sched_list); } elsif($keyword eq "WHILE") { - push(@while_list, @current_sched_list); + push(@while_list, @current_sched_list); } # Reset keyword to empty for next time. @@ -321,15 +321,15 @@ sub ParseScheduleBlock { if($keyword eq "BEFORE") { - push(@before_list, $fields[$field]); + push(@before_list, $fields[$field]); } elsif($keyword eq "AFTER") { - push(@after_list, $fields[$field]); + push(@after_list, $fields[$field]); } elsif($keyword eq "WHILE") { - push(@while_list, $fields[$field]); + push(@while_list, $fields[$field]); } $field++; $keyword = ""; @@ -373,48 +373,48 @@ sub ParseScheduleBlock $line_number++; if($data[$line_number] =~ m/^\s*STOR[^:]*:\s*(.*)$/i) { - push(@mem_groups, split(/\s,/, $1)); + push(@mem_groups, split(/\s,/, $1)); } elsif($data[$line_number] =~ m/^\s*COMM[^:]*:\s*(.*)$/i) { - push(@comm_groups, split(/\s,/, $1)); + push(@comm_groups, split(/\s,/, $1)); } elsif($data[$line_number] =~ m/^\s*TRIG[^:]*:\s*(.*)$/i) { - push(@trigger_groups, split(/\s,/, $1)); + push(@trigger_groups, split(/\s,/, $1)); } elsif($data[$line_number] =~ m/^\s*SYNC[^:]*:\s*(.*)$/i) { - push(@sync_groups, split(/\s,/, $1)); + push(@sync_groups, split(/\s,/, $1)); } elsif($data[$line_number] =~ m/^\s*OPTI[^:]*:\s*(.*)$/i) { - push(@options, split(/\s,/, $1)); + push(@options, split(/\s,/, $1)); } elsif($data[$line_number] =~ m/^\s*LANG[^:]*:\s*(.*)$/i) { - if($language ne "") - { - $thisline = $data[$line_number]; - $thisline =~ s/^\s*([^\s])\s$/$1/; - $message = "Error parsing schedule block in $thorn\n"; - $message .= "Attempt to specify language more than once\n"; - $message .= "Line: $thisline"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } - else - { - $language= $1; - } + if($language ne "") + { + $thisline = $data[$line_number]; + $thisline =~ s/^\s*([^\s])\s$/$1/; + $message = "Error parsing schedule block in $thorn\n"; + $message .= "Attempt to specify language more than once\n"; + $message .= "Line: $thisline"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } + else + { + $language= $1; + } } elsif($data[$line_number] =~ m:\s*\}\s*:) { - # do nothing. + # do nothing. } else { - $message = "Error parsing schedule block line '$data[$line_number]'\nUnrecognised statement"; - &CST_error(0,$message,"",__LINE__,__FILE__); + $message = "Error parsing schedule block line '$data[$line_number]'\nUnrecognised statement"; + &CST_error(0,$message,"",__LINE__,__FILE__); } } } @@ -440,9 +440,9 @@ sub ParseScheduleBlock return ($line_number, - $name, $as, $type, $description, $where, $language, - $mem_groups, $comm_groups, $trigger_groups, $sync_groups, - $options,$before_list, $after_list, $while_list); + $name, $as, $type, $description, $where, $language, + $mem_groups, $comm_groups, $trigger_groups, $sync_groups, + $options,$before_list, $after_list, $while_list); } diff --git a/lib/sbin/create_c_stuff.pl b/lib/sbin/create_c_stuff.pl index e7b55566..0b0370c1 100644 --- a/lib/sbin/create_c_stuff.pl +++ b/lib/sbin/create_c_stuff.pl @@ -46,7 +46,7 @@ sub CreateParameterBindingFile $line = "\#include \"CParameterStructNames.h\""; push(@data, $line); $line = "\#include \"cctk_Misc.h\""; - push(@data, $line); + push(@data, $line); $line = "\#include \"ParameterBindings.h\""; push(@data, $line); push(@data, ""); @@ -253,7 +253,7 @@ sub order_params push(@string_params, $parameter); } elsif($type eq "BOOLEAN" || - $type eq "INT") + $type eq "INT") { push(@int_params, $parameter); } @@ -263,8 +263,8 @@ sub order_params } else { - $message = "Unknown parameter type '$type'"; - &CST_error(0,$message,__LINE__,__FILE__); + $message = "Unknown parameter type '$type'"; + &CST_error(0,$message,__LINE__,__FILE__); } } diff --git a/lib/sbin/create_fortran_stuff.pl b/lib/sbin/create_fortran_stuff.pl index c207574b..502fee90 100644 --- a/lib/sbin/create_fortran_stuff.pl +++ b/lib/sbin/create_fortran_stuff.pl @@ -86,12 +86,12 @@ sub CreateFortranThornParameterBindings # 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"}) { - $alias_names{$parameter} = "$parameter"; + $alias_names{$parameter} = "$parameter"; } else { - $alias_names{$parameter} = "CCTKH".$num_aliases; - $num_aliases++; + $alias_names{$parameter} = "CCTKH".$num_aliases; + $num_aliases++; } } @@ -183,7 +183,7 @@ sub get_fortran_type_string $type_string = "CCTK_STRING "; } elsif($type eq "BOOLEAN" || - $type eq "INT") + $type eq "INT") { $type_string = "CCTK_INT"; } @@ -193,8 +193,8 @@ sub get_fortran_type_string } else { - $message = "Unknown parameter type '$type'"; - &CST_error(0,$message,"",__LINE__,__FILE__); + $message = "Unknown parameter type '$type'"; + &CST_error(0,$message,"",__LINE__,__FILE__); } return $type_string; diff --git a/lib/sbin/interface_parser.pl b/lib/sbin/interface_parser.pl index c5aa39f4..10b71f62 100644 --- a/lib/sbin/interface_parser.pl +++ b/lib/sbin/interface_parser.pl @@ -169,7 +169,7 @@ sub get_friends_of_me { if($friend =~ m:$implementation:i) { - $friends .= "$other_implementation "; + $friends .= "$other_implementation "; } } } @@ -205,16 +205,16 @@ sub get_implementation_friends # Recurse foreach $friend (split(" ", $interface_data{"\U$thorn\E FRIEND"}), - split(" ", $interface_data{"IMPLEMENTATION \U$implementation\E FRIENDS"})) + split(" ", $interface_data{"IMPLEMENTATION \U$implementation\E FRIENDS"})) { if(! $friends{"\U$friend\E"}) { $friends{"\U$friend\E"} = 1; if(! $interface_data{"IMPLEMENTATION \U$friend\E THORNS"}) { - $message = "$implementation is friends with $friend - non-existent implementation"; - &CST_error(0,$message,"",__LINE__,__FILE__); - next; + $message = "$implementation is friends with $friend - non-existent implementation"; + &CST_error(0,$message,"",__LINE__,__FILE__); + next; } %friends = &get_implementation_friends($friend, scalar(keys %friends), %friends,%interface_data); } @@ -257,34 +257,34 @@ sub get_implementation_ancestors $ancestors{"\U$ancestor\E"} = 1; if(! $interface_data{"IMPLEMENTATION \U$ancestor\E THORNS"}) { - # Implementation not found give extensive information - %info = &buildthorns("$cctk_home/arrangements","thorns"); - $suggest_thorns = ""; - foreach $thorninfo (keys %info) - { - $info{"$thorninfo"} =~ /^([^\s]+)/; - $testimp = $1; - if ($testimp =~ m:^$ancestor$:i) - { - $suggest_thorns .= "\n $thorninfo"; - } - } - $message = "$implementation (thorn $thorn) inherits from $ancestor\n"; - $message .= " No thorn in your current ThornList implements $ancestor\n"; - $message .= " Either remove $thorn, or add a thorn to your\n"; - $message .= " ThornList implementing $ancestor\n"; - if ($suggest_thorns !~ m:^$:) - { - $message .= " Available thorns in arrangements directory implementing $ancestor:"; + # Implementation not found give extensive information + %info = &buildthorns("$cctk_home/arrangements","thorns"); + $suggest_thorns = ""; + foreach $thorninfo (keys %info) + { + $info{"$thorninfo"} =~ /^([^\s]+)/; + $testimp = $1; + if ($testimp =~ m:^$ancestor$:i) + { + $suggest_thorns .= "\n $thorninfo"; + } + } + $message = "$implementation (thorn $thorn) inherits from $ancestor\n"; + $message .= " No thorn in your current ThornList implements $ancestor\n"; + $message .= " Either remove $thorn, or add a thorn to your\n"; + $message .= " ThornList implementing $ancestor\n"; + if ($suggest_thorns !~ m:^$:) + { + $message .= " Available thorns in arrangements directory implementing $ancestor:"; $message .= "$suggest_thorns"; - } - else - { - $message .= " No thorns in arrangements directory implement $ancestor"; - } - &CST_error(0,$message,"",__LINE__,__FILE__); - - next; + } + else + { + $message .= " No thorns in arrangements directory implement $ancestor"; + } + &CST_error(0,$message,"",__LINE__,__FILE__); + + next; } %ancestors = &get_implementation_ancestors($ancestor, scalar(keys %ancestors), scalar(keys %system_database), %ancestors,%system_database, %interface_data); @@ -319,69 +319,69 @@ sub check_implementation_consistency # Record the inheritance foreach $thing (split(" ", $interface_data{"\U$thorn\E INHERITS"})) { - if($thing =~ m:\w:) - { - # Put if statement around this to prevent perl -w from complaining. - if($inherits{"\U$thing\E"}) - { - $inherits{"\U$thing\E"} .= "$thorn "; - } - else - { - $inherits{"\U$thing\E"} = "$thorn "; - } - } + if($thing =~ m:\w:) + { + # Put if statement around this to prevent perl -w from complaining. + if($inherits{"\U$thing\E"}) + { + $inherits{"\U$thing\E"} .= "$thorn "; + } + else + { + $inherits{"\U$thing\E"} = "$thorn "; + } + } } # Record the friends foreach $thing (split(" ", $interface_data{"\U$thorn\E FRIEND"})) { - if($thing =~ m:\w:) - { - # Put if statement around this to prevent perl -w from complaining. - if($friend{"\U$thing\E"}) - { - $friend{"\U$thing\E"} .= "$thorn "; - } - else - { - $friend{"\U$thing\E"} = "$thorn "; - } - } + if($thing =~ m:\w:) + { + # Put if statement around this to prevent perl -w from complaining. + if($friend{"\U$thing\E"}) + { + $friend{"\U$thing\E"} .= "$thorn "; + } + else + { + $friend{"\U$thing\E"} = "$thorn "; + } + } } # Record the public groups foreach $thing (split(" ", $interface_data{"\U$thorn\E PUBLIC GROUPS"})) { - if($thing =~ m:\w:) - { - # Put if statement around this to prevent perl -w from complaining. - if($public_groups{"\U$thing\E"}) - { - $public_groups{"\U$thing\E"} .= "$thorn "; - } - else - { - $public_groups{"\U$thing\E"} = "$thorn "; - } - } + if($thing =~ m:\w:) + { + # Put if statement around this to prevent perl -w from complaining. + if($public_groups{"\U$thing\E"}) + { + $public_groups{"\U$thing\E"} .= "$thorn "; + } + else + { + $public_groups{"\U$thing\E"} = "$thorn "; + } + } } # Record the protected groups foreach $thing (split(" ", $interface_data{"\U$thorn\E PROTECTED GROUPS"})) { - if($thing =~ m:\w:) - { - # Put if statement around this to prevent perl -w from complaining. - if($protected_groups{"\U$thing\E"}) - { - $protected_groups{"\U$thing\E"} .= "$thorn "; - } - else - { - $protected_groups{"\U$thing\E"} = "$thorn "; - } - } + if($thing =~ m:\w:) + { + # Put if statement around this to prevent perl -w from complaining. + if($protected_groups{"\U$thing\E"}) + { + $protected_groups{"\U$thing\E"} .= "$thorn "; + } + else + { + $protected_groups{"\U$thing\E"} = "$thorn "; + } + } } } @@ -392,11 +392,11 @@ sub check_implementation_consistency { if(split(" ", $inherits{$thing}) != $n_thorns) { - $message = "Inconsistent implementations of $implementation. "; - $message .= "Implemented by thorns " . join(" ", @thorns); - $message .= "Not all inherit: $thing"; - &CST_error(0,$message,"",__LINE__,__FILE__); - $n_errors++; + $message = "Inconsistent implementations of $implementation. "; + $message .= "Implemented by thorns " . join(" ", @thorns); + $message .= "Not all inherit: $thing"; + &CST_error(0,$message,"",__LINE__,__FILE__); + $n_errors++; } } @@ -405,11 +405,11 @@ sub check_implementation_consistency { if(split(" ", $friend{$thing}) != $n_thorns) { - $message = "Inconsistent implementations of $implementation\n"; - $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; - $message .= "Not all are friends of: $thing"; - &CST_error(0,$message,"",__LINE__,__FILE__); - $n_errors++; + $message = "Inconsistent implementations of $implementation\n"; + $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; + $message .= "Not all are friends of: $thing"; + &CST_error(0,$message,"",__LINE__,__FILE__); + $n_errors++; } } @@ -418,11 +418,11 @@ sub check_implementation_consistency { if(split(" ", $public_groups{$thing}) != $n_thorns) { - $message = "Inconsistent implementations of $implementation\n"; - $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; - $message .= "Not all declare public group: $thing"; - &CST_error(0,$message,"",__LINE__,__FILE__); - $n_errors++; + $message = "Inconsistent implementations of $implementation\n"; + $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; + $message .= "Not all declare public group: $thing"; + &CST_error(0,$message,"",__LINE__,__FILE__); + $n_errors++; } } @@ -431,11 +431,11 @@ sub check_implementation_consistency { if(split(" ", $protected_groups{$thing}) != $n_thorns) { - $message = "Inconsistent implementations of $implementation\n"; - $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; - $message .= "Not all declare protected group: $thing"; - &CST_error(0,$message,"",__LINE__,__FILE__); - $n_errors++; + $message = "Inconsistent implementations of $implementation\n"; + $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; + $message .= "Not all declare protected group: $thing"; + &CST_error(0,$message,"",__LINE__,__FILE__); + $n_errors++; } } @@ -447,157 +447,157 @@ sub check_implementation_consistency foreach $thorn (@thorns) { - # Remember which variables are defined in this group. - foreach $thing (split(" ",$interface_data{"\U$thorn GROUP $group\E"})) - { - # Put if statement around this to prevent perl -w from complaining. - if($variables{"\U$thing\E"}) - { - $variables{"\U$thing\E"} .= "$thorn "; - } - else - { - $variables{"\U$thing\E"} = "$thorn "; - } - } - - # Check variable type definition. - if($attributes{"VTYPE"}) - { - if($attributes{"VTYPE"} ne $interface_data{"\U$thorn GROUP $group\E VTYPE"}) - { - $message = "Inconsistent implementations of $implementation"; - $message .= " in thorns " . join(" ", @thorns) . ". "; - $message .= "Group $group has inconsistent variable type ($attributes{\"VTYPE\"} and $interface_data{\"\\U$thorn GROUP $group\\E VTYPE\"}). "; - $hint = "All public and protected groups implementing $implementation must have groups with consistent properties"; - &CST_error(0,$message,$hint,__LINE__,__FILE__); - $n_errors++; - } - } - else - { - $attributes{"VTYPE"} = $interface_data{"\U$thorn GROUP $group\E VTYPE"}; - } - - # Check group type definition. - if($attributes{"GTYPE"}) - { - if($attributes{"GTYPE"} ne $interface_data{"\U$thorn GROUP $group\E GTYPE"}) - { - $message = "Inconsistent implementations of $implementation"; - $message .= " in thorns " . join(" ", @thorns) . ". "; - $message .= "Group $group has inconsistent group type ($attributes{\"GTYPE\"} and $interface_data{\"\U$thorn GROUP $group\E GTYPE\"}). "; - $hint = "All public and protected groups implementing $implementation must have groups with consistent properties"; - &CST_error(0,$message,$hint,__LINE__,__FILE__); - $n_errors++; - } - } - else - { - $attributes{"GTYPE"} = $interface_data{"\U$thorn GROUP $group\E GTYPE"}; - } - - # Check the number of time levels is consistent. - if($attributes{"TIMELEVELS"}) - { - if($attributes{"TIMELEVELS"} ne $interface_data{"\U$thorn GROUP $group\E TIMELEVELS"}) - { - $message = "Inconsistent implementations of $implementation\n"; - $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; - $message .= "Group $group has inconsistent time levels"; - &CST_error(0,$message,"",__LINE__,__FILE__); - $n_errors++; - } - } - else - { - $attributes{"TIMELEVELS"} = $interface_data{"\U$thorn GROUP $group\E TIMELEVELS"}; - } - - # Check the size array sizes are consistent. - if($attributes{"SIZE"}) - { - if($attributes{"SIZE"} ne $interface_data{"\U$thorn GROUP $group\E SIZE"}) - { - $message = "Inconsistent implementations of $implementation\n"; - $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; - $message .= "Group $group has inconsistent size"; - &CST_error(0,$message,"",__LINE__,__FILE__); - $n_errors++; - } - } - else - { - $attributes{"SIZE"} = $interface_data{"\U$thorn GROUP $group\E SIZE"}; - } - - # Check the ghostsize array sizes are consistent. - if($attributes{"GHOSTSIZE"}) - { - if($attributes{"GHOSTSIZE"} ne $interface_data{"\U$thorn GROUP $group\E GHOSTSIZE"}) - { - $message = "Inconsistent implementations of $implementation\n"; - $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; - $message .= "Group $group has inconsistent ghostsize"; - &CST_error(0,$message,"",__LINE__,__FILE__); - $n_errors++; - } - } - else - { - $attributes{"GHOSTSIZE"} = $interface_data{"\U$thorn GROUP $group\E GHOSTSIZE"}; - } - - # Check the distribution of arrays are consistent. - if($attributes{"DISTRIB"}) - { - if($attributes{"DISTRIB"} ne $interface_data{"\U$thorn GROUP $group\E DISTRIB"}) - { - $message = "Inconsistent implementations of $implementation\n"; - $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; - $message .= " Group $group has inconsistent distribution"; - &CST_error(0,$message,"",__LINE__,__FILE__); - $n_errors++; - } - } - else - { - $attributes{"GHOSTSIZE"} = $interface_data{"\U$thorn GROUP $group\E GHOSTSIZE"}; - } - - # Check the dimensions are consistant - if($attributes{"DIM"} && $attributes{"GTYPE"} ne "SCALAR") - { - if($attributes{"DIM"} ne $interface_data{"\U$thorn GROUP $group\E DIM"}) - { - $message = "Inconsistent implementations of $implementation\n"; - $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; - $message .= "Group $group has inconsistent dimension"; - &CST_error(0,$message,"",__LINE__,__FILE__); - $n_errors++; - } - } - else - { - $attributes{"DIM"} = $interface_data{"\U$thorn GROUP $group\E DIM"}; - } - - # Check the staggering are consistant - if($attributes{"STYPE"}) - { - if($attributes{"STYPE"} ne $interface_data{"\U$thorn GROUP $group\E STYPE"}) - { - $message = "Inconsistent implementations of $implementation\n"; - $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; - $message .= "Group $group has inconsistent staggering type"; - &CST_error(0,$message,"",__LINE__,__FILE__); - $n_errors++; - } - } - else - { - $attributes{"STYPE"} = $interface_data{"\U$thorn GROUP $group\E STYPE"}; - } + # Remember which variables are defined in this group. + foreach $thing (split(" ",$interface_data{"\U$thorn GROUP $group\E"})) + { + # Put if statement around this to prevent perl -w from complaining. + if($variables{"\U$thing\E"}) + { + $variables{"\U$thing\E"} .= "$thorn "; + } + else + { + $variables{"\U$thing\E"} = "$thorn "; + } + } + + # Check variable type definition. + if($attributes{"VTYPE"}) + { + if($attributes{"VTYPE"} ne $interface_data{"\U$thorn GROUP $group\E VTYPE"}) + { + $message = "Inconsistent implementations of $implementation"; + $message .= " in thorns " . join(" ", @thorns) . ". "; + $message .= "Group $group has inconsistent variable type ($attributes{\"VTYPE\"} and $interface_data{\"\\U$thorn GROUP $group\\E VTYPE\"}). "; + $hint = "All public and protected groups implementing $implementation must have groups with consistent properties"; + &CST_error(0,$message,$hint,__LINE__,__FILE__); + $n_errors++; + } + } + else + { + $attributes{"VTYPE"} = $interface_data{"\U$thorn GROUP $group\E VTYPE"}; + } + + # Check group type definition. + if($attributes{"GTYPE"}) + { + if($attributes{"GTYPE"} ne $interface_data{"\U$thorn GROUP $group\E GTYPE"}) + { + $message = "Inconsistent implementations of $implementation"; + $message .= " in thorns " . join(" ", @thorns) . ". "; + $message .= "Group $group has inconsistent group type ($attributes{\"GTYPE\"} and $interface_data{\"\U$thorn GROUP $group\E GTYPE\"}). "; + $hint = "All public and protected groups implementing $implementation must have groups with consistent properties"; + &CST_error(0,$message,$hint,__LINE__,__FILE__); + $n_errors++; + } + } + else + { + $attributes{"GTYPE"} = $interface_data{"\U$thorn GROUP $group\E GTYPE"}; + } + + # Check the number of time levels is consistent. + if($attributes{"TIMELEVELS"}) + { + if($attributes{"TIMELEVELS"} ne $interface_data{"\U$thorn GROUP $group\E TIMELEVELS"}) + { + $message = "Inconsistent implementations of $implementation\n"; + $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; + $message .= "Group $group has inconsistent time levels"; + &CST_error(0,$message,"",__LINE__,__FILE__); + $n_errors++; + } + } + else + { + $attributes{"TIMELEVELS"} = $interface_data{"\U$thorn GROUP $group\E TIMELEVELS"}; + } + + # Check the size array sizes are consistent. + if($attributes{"SIZE"}) + { + if($attributes{"SIZE"} ne $interface_data{"\U$thorn GROUP $group\E SIZE"}) + { + $message = "Inconsistent implementations of $implementation\n"; + $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; + $message .= "Group $group has inconsistent size"; + &CST_error(0,$message,"",__LINE__,__FILE__); + $n_errors++; + } + } + else + { + $attributes{"SIZE"} = $interface_data{"\U$thorn GROUP $group\E SIZE"}; + } + + # Check the ghostsize array sizes are consistent. + if($attributes{"GHOSTSIZE"}) + { + if($attributes{"GHOSTSIZE"} ne $interface_data{"\U$thorn GROUP $group\E GHOSTSIZE"}) + { + $message = "Inconsistent implementations of $implementation\n"; + $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; + $message .= "Group $group has inconsistent ghostsize"; + &CST_error(0,$message,"",__LINE__,__FILE__); + $n_errors++; + } + } + else + { + $attributes{"GHOSTSIZE"} = $interface_data{"\U$thorn GROUP $group\E GHOSTSIZE"}; + } + + # Check the distribution of arrays are consistent. + if($attributes{"DISTRIB"}) + { + if($attributes{"DISTRIB"} ne $interface_data{"\U$thorn GROUP $group\E DISTRIB"}) + { + $message = "Inconsistent implementations of $implementation\n"; + $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; + $message .= " Group $group has inconsistent distribution"; + &CST_error(0,$message,"",__LINE__,__FILE__); + $n_errors++; + } + } + else + { + $attributes{"GHOSTSIZE"} = $interface_data{"\U$thorn GROUP $group\E GHOSTSIZE"}; + } + + # Check the dimensions are consistant + if($attributes{"DIM"} && $attributes{"GTYPE"} ne "SCALAR") + { + if($attributes{"DIM"} ne $interface_data{"\U$thorn GROUP $group\E DIM"}) + { + $message = "Inconsistent implementations of $implementation\n"; + $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; + $message .= "Group $group has inconsistent dimension"; + &CST_error(0,$message,"",__LINE__,__FILE__); + $n_errors++; + } + } + else + { + $attributes{"DIM"} = $interface_data{"\U$thorn GROUP $group\E DIM"}; + } + + # Check the staggering are consistant + if($attributes{"STYPE"}) + { + if($attributes{"STYPE"} ne $interface_data{"\U$thorn GROUP $group\E STYPE"}) + { + $message = "Inconsistent implementations of $implementation\n"; + $message .= "Implemented by thorns " . join(" ", @thorns) . "\n"; + $message .= "Group $group has inconsistent staggering type"; + &CST_error(0,$message,"",__LINE__,__FILE__); + $n_errors++; + } + } + else + { + $attributes{"STYPE"} = $interface_data{"\U$thorn GROUP $group\E STYPE"}; + } } } } @@ -649,8 +649,8 @@ sub check_interface_consistency { if ($interface_data{"\U$ancestor_thorn\E PUBLIC GROUPS"} =~ $private_group) { - $message = "Private group $private_group in thorn $thorn has same name as \n public group in ancestor implementation $ancestor_imp (e.g. thorn $ancestor_thorn)"; - &CST_error(0,$message,"",__LINE__,__FILE__); + $message = "Private group $private_group in thorn $thorn has same name as \n public group in ancestor implementation $ancestor_imp (e.g. thorn $ancestor_thorn)"; + &CST_error(0,$message,"",__LINE__,__FILE__); } } } @@ -713,23 +713,23 @@ sub parse_interface_ccl { if ($line =~ m/^\s*IMPLEMENTS\s*:\s*([a-z]+[a-z_0-9]*)\s*$/i) { - if(!$implementation) + if(!$implementation) + { + $implementation = $1; + $interface_db{"\U$thorn\E IMPLEMENTS"} = $implementation; + } + else { - $implementation = $1; - $interface_db{"\U$thorn\E IMPLEMENTS"} = $implementation; - } - else - { - $message = "Multiple implementations specified in $thorn"; - $hint = "A thorn can only specify one implementation in it's interface.ccl file, with the format implements:<implementation>"; - &CST_error(0,$message,$hint,__LINE__,__FILE__); - } + $message = "Multiple implementations specified in $thorn"; + $hint = "A thorn can only specify one implementation in it's interface.ccl file, with the format implements:<implementation>"; + &CST_error(0,$message,$hint,__LINE__,__FILE__); + } } else { - $message = "Implementation line has wrong format in $thorn"; - $hint = "A thorn must specify one implementation in it's interface.ccl file with the format IMPLEMENTS: <implementation>"; - &CST_error(0,$message,$hint,__LINE__,__FILE__); + $message = "Implementation line has wrong format in $thorn"; + $hint = "A thorn must specify one implementation in it's interface.ccl file with the format IMPLEMENTS: <implementation>"; + &CST_error(0,$message,$hint,__LINE__,__FILE__); } } # implementation names can be sepeated by ,\s, where , are stripped out below @@ -749,12 +749,12 @@ sub parse_interface_ccl if($provided_by =~ m/(.*)\s*LANGUAGE\s*(.+)/i) { - $provided_by = $1; - $provided_by_language = $2; + $provided_by = $1; + $provided_by_language = $2; } else { - $provided_by_language = "Fortran"; + $provided_by_language = "Fortran"; } $interface_db{"\U$thorn PROVIDES FUNCTION\E"} .= "$funcname "; @@ -774,23 +774,23 @@ sub parse_interface_ccl $rest = $3; if($rest =~ m/(.*)\s*PROVIDED-BY\s*(.+)/i) { - $funcargs = $1; - $provided_by = $2; - - if($provided_by =~ m/(.*)\s*LANGUAGE\s*(.+)/i) - { - $provided_by = $1; - $provided_by_language = $2; - } - else - { - $provided_by_language = "Fortran"; - } + $funcargs = $1; + $provided_by = $2; + + if($provided_by =~ m/(.*)\s*LANGUAGE\s*(.+)/i) + { + $provided_by = $1; + $provided_by_language = $2; + } + else + { + $provided_by_language = "Fortran"; + } } else { - $funcargs = $rest; - $provided_by = ""; + $funcargs = $rest; + $provided_by = ""; } $interface_db{"\U$thorn FUNCTIONS\E"} .= "$funcname "; @@ -799,9 +799,9 @@ sub parse_interface_ccl if($provided_by ne "") { - $interface_db{"\U$thorn PROVIDES FUNCTION\E"} .= "$funcname"; - $interface_db{"\U$thorn PROVIDES FUNCTION\E $funcname WITH"} .= "$provided_by"; - $interface_db{"\U$thorn PROVIDES FUNCTION\E $funcname LANG"} .= "$provided_by_language"; + $interface_db{"\U$thorn PROVIDES FUNCTION\E"} .= "$funcname"; + $interface_db{"\U$thorn PROVIDES FUNCTION\E $funcname WITH"} .= "$provided_by"; + $interface_db{"\U$thorn PROVIDES FUNCTION\E $funcname LANG"} .= "$provided_by_language"; } } elsif ($line =~ m/^\s*(CCTK_)?(CHAR|BYTE|INT|INT2|INT4|INT8|REAL|REAL4|REAL8|REAL16|COMPLEX|COMPLEX8|COMPLEX16|COMPLEX32)\s*(([a-zA-Z]+[a-zA-Z_0-9]*)(\[([a-zA-Z1-9][a-zA-Z_0-9]*)(::[a-zA-Z]+[a-zA-Z_0-9]*)?\])?)\s*(.*)\s*$/i) @@ -809,7 +809,7 @@ sub parse_interface_ccl # for($i = 1; $i < 10; $i++) # { -# print "$i is ${$i}\n"; +# print "$i is ${$i}\n"; # } my $vtype = $2; @@ -820,22 +820,22 @@ sub parse_interface_ccl if($known_groups{"\U$current_group\E"}) { - $message = "Duplicate group $current_group in thorn $thorn"; - &CST_error(0,$message,"",__LINE__,__FILE__); - if($data[$line_number+1] =~ m:\{:) - { - $message = "Skipping interface block"; - &CST_error(1,$message,"",__LINE__,__FILE__); - $line_number++ until ($data[$line_number] =~ m:\}:); - } - next; + $message = "Duplicate group $current_group in thorn $thorn"; + &CST_error(0,$message,"",__LINE__,__FILE__); + if($data[$line_number+1] =~ m:\{:) + { + $message = "Skipping interface block"; + &CST_error(1,$message,"",__LINE__,__FILE__); + $line_number++ until ($data[$line_number] =~ m:\}:); + } + next; } else { - $known_groups{"\U$current_group\E"} = 1; + $known_groups{"\U$current_group\E"} = 1; - # Initialise some stuff to prevent perl -w from complaining. - $interface_db{"\U$thorn GROUP $current_group\E"} = ""; + # Initialise some stuff to prevent perl -w from complaining. + $interface_db{"\U$thorn GROUP $current_group\E"} = ""; } $interface_db{"\U$thorn $block GROUPS\E"} .= " $current_group"; @@ -846,194 +846,194 @@ sub parse_interface_ccl # Parse the options foreach $option (keys %options) { - if($option =~ m:DIM|DIMENSION:i) - { - $interface_db{"\U$thorn GROUP $current_group\E DIM"} = $options{$option}; - } - elsif($option =~ m:STAGGER:i) - { - $interface_db{"\U$thorn GROUP $current_group\E STYPE"} = "\U$options{$option}\E"; - } - elsif($option =~ m:TYPE:i) - { - $interface_db{"\U$thorn GROUP $current_group\E GTYPE"} = "\U$options{$option}\E"; - } - elsif($option =~ m:TIMELEVELS:i) - { - $interface_db{"\U$thorn GROUP $current_group\E TIMELEVELS"} = "\U$options{$option}\E"; - } - elsif($option =~ m:GHOSTSIZE:i) - { - $interface_db{"\U$thorn GROUP $current_group\E GHOSTSIZE"} = "\U$options{$option}\E"; - } - elsif($option =~ m:DISTRIB:i) - { - $interface_db{"\U$thorn GROUP $current_group\E DISTRIB"} = "\U$options{$option}\E"; - } - elsif($option =~ m:SIZE:i) - { - $interface_db{"\U$thorn GROUP $current_group\E SIZE"} = "\U$options{$option}\E"; - } - else - { - $message = "Unknown option $option in group $current_group of thorn $thorn"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } + if($option =~ m:DIM|DIMENSION:i) + { + $interface_db{"\U$thorn GROUP $current_group\E DIM"} = $options{$option}; + } + elsif($option =~ m:STAGGER:i) + { + $interface_db{"\U$thorn GROUP $current_group\E STYPE"} = "\U$options{$option}\E"; + } + elsif($option =~ m:TYPE:i) + { + $interface_db{"\U$thorn GROUP $current_group\E GTYPE"} = "\U$options{$option}\E"; + } + elsif($option =~ m:TIMELEVELS:i) + { + $interface_db{"\U$thorn GROUP $current_group\E TIMELEVELS"} = "\U$options{$option}\E"; + } + elsif($option =~ m:GHOSTSIZE:i) + { + $interface_db{"\U$thorn GROUP $current_group\E GHOSTSIZE"} = "\U$options{$option}\E"; + } + elsif($option =~ m:DISTRIB:i) + { + $interface_db{"\U$thorn GROUP $current_group\E DISTRIB"} = "\U$options{$option}\E"; + } + elsif($option =~ m:SIZE:i) + { + $interface_db{"\U$thorn GROUP $current_group\E SIZE"} = "\U$options{$option}\E"; + } + else + { + $message = "Unknown option $option in group $current_group of thorn $thorn"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } } # Put in defaults if(! $interface_db{"\U$thorn GROUP $current_group\E GTYPE"}) { - $interface_db{"\U$thorn GROUP $current_group\E GTYPE"} = "SCALAR"; + $interface_db{"\U$thorn GROUP $current_group\E GTYPE"} = "SCALAR"; } if($interface_db{"\U$thorn GROUP $current_group\E GTYPE"} eq "SCALAR") { - $interface_db{"\U$thorn GROUP $current_group\E DIM"} = 1; + $interface_db{"\U$thorn GROUP $current_group\E DIM"} = 1; } if(! $interface_db{"\U$thorn GROUP $current_group\E DIM"}) { - $interface_db{"\U$thorn GROUP $current_group\E DIM"} = 3; + $interface_db{"\U$thorn GROUP $current_group\E DIM"} = 3; } if(! $interface_db{"\U$thorn GROUP $current_group\E TIMELEVELS"}) { - $interface_db{"\U$thorn GROUP $current_group\E TIMELEVELS"} = 1; + $interface_db{"\U$thorn GROUP $current_group\E TIMELEVELS"} = 1; } if(! $interface_db{"\U$thorn GROUP $current_group\E STYPE"}) { - $interface_db{"\U$thorn GROUP $current_group\E STYPE"} = "NONE"; + $interface_db{"\U$thorn GROUP $current_group\E STYPE"} = "NONE"; } if(! $interface_db{"\U$thorn GROUP $current_group\E DISTRIB"}) { - $interface_db{"\U$thorn GROUP $current_group\E DISTRIB"} = "DEFAULT"; + $interface_db{"\U$thorn GROUP $current_group\E DISTRIB"} = "DEFAULT"; } if(! $interface_db{"\U$thorn GROUP $current_group\E COMPACT"}) { - $interface_db{"\U$thorn GROUP $current_group\E COMPACT"} = 0; + $interface_db{"\U$thorn GROUP $current_group\E COMPACT"} = 0; } # Check that it is a known group type if($interface_db{"\U$thorn GROUP $current_group\E GTYPE"} !~ m:^\s*(SCALAR|GF|ARRAY)\s*$:) { - $message = "Unknown GROUP TYPE " . - $interface_db{"\U$thorn GROUP $current_group\E GTYPE"} . - " for group $current_group of thorn $thorn"; - $hint = "Allowed group types are SCALAR, GF or ARRAY"; - &CST_error(0,$message,$hint,__LINE__,__FILE__); - if($data[$line_number+1] =~ m:\{:) - { - $message = "Skipping interface block in $thorn"; - &CST_error(1,$message,"",__LINE__,__FILE__); - $line_number++ until ($data[$line_number] =~ m:\}:); - } - next; - } + $message = "Unknown GROUP TYPE " . + $interface_db{"\U$thorn GROUP $current_group\E GTYPE"} . + " for group $current_group of thorn $thorn"; + $hint = "Allowed group types are SCALAR, GF or ARRAY"; + &CST_error(0,$message,$hint,__LINE__,__FILE__); + if($data[$line_number+1] =~ m:\{:) + { + $message = "Skipping interface block in $thorn"; + &CST_error(1,$message,"",__LINE__,__FILE__); + $line_number++ until ($data[$line_number] =~ m:\}:); + } + next; + } # Check that it is a known distribution type if($interface_db{"\U$thorn GROUP $current_group\E DISTRIB"} !~ m:DEFAULT|CONSTANT:) { - $message = "Unknown DISTRIB TYPE " . - $interface_db{"\U$thorn GROUP $current_group\E DISTRIB"} . - " for group $current_group of thorn $thorn"; - $hint = "Allowed distribution types are DEFAULT or CONSTANT"; - &CST_error(0,$message,"",__LINE__,__FILE__); - if($data[$line_number+1] =~ m:\{:) - { - $message = "Skipping interface block in $thorn"; - &CST_error(1,$message,"",__LINE__,__FILE__); - $line_number++ until ($data[$line_number] =~ m:\}:); - } - next; - } + $message = "Unknown DISTRIB TYPE " . + $interface_db{"\U$thorn GROUP $current_group\E DISTRIB"} . + " for group $current_group of thorn $thorn"; + $hint = "Allowed distribution types are DEFAULT or CONSTANT"; + &CST_error(0,$message,"",__LINE__,__FILE__); + if($data[$line_number+1] =~ m:\{:) + { + $message = "Skipping interface block in $thorn"; + &CST_error(1,$message,"",__LINE__,__FILE__); + $line_number++ until ($data[$line_number] =~ m:\}:); + } + next; + } # Is it is a vararray ? if($isgrouparray) { - # Create a variable with the same name as the group - $function = $current_group; - - if(! $known_variables{"\U$function\E"}) - { - $known_variables{"\U$function\E"} = 1; - - $interface_db{"\U$thorn GROUP $current_group\E"} .= " $function"; - } - else - { - $message = "Duplicate variable $function in thorn $thorn"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } + # Create a variable with the same name as the group + $function = $current_group; + + if(! $known_variables{"\U$function\E"}) + { + $known_variables{"\U$function\E"} = 1; + + $interface_db{"\U$thorn GROUP $current_group\E"} .= " $function"; + } + else + { + $message = "Duplicate variable $function in thorn $thorn"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } # get its size and, if a parameter, get fullname - if($grouparray_size !~ m/::/) - { - $grouparray_size = "$thorn\::$grouparray_size"; - } - $interface_db{"\U$thorn GROUP $current_group\E VARARRAY_SIZE"} = $grouparray_size; - - if($data[$line_number+1] =~ m/^\s*\{\s*$/) - { - &CST_error(1,"Can't give explicit list of array names with an array group - ignoring list","",__LINE__,__FILE__); - $line_number++ until ($data[$line_number] =~ m:\}:); - } + if($grouparray_size !~ m/::/) + { + $grouparray_size = "$thorn\::$grouparray_size"; + } + $interface_db{"\U$thorn GROUP $current_group\E VARARRAY_SIZE"} = $grouparray_size; + + if($data[$line_number+1] =~ m/^\s*\{\s*$/) + { + &CST_error(1,"Can't give explicit list of array names with an array group - ignoring list","",__LINE__,__FILE__); + $line_number++ until ($data[$line_number] =~ m:\}:); + } } else { - # Fill in data for the scalars/arrays/functions - $line_number++; - if($data[$line_number] =~ m/^\s*\{\s*$/) - { - $line_number++; - while($data[$line_number] !~ m:\}:i) - { - @functions = split(/[^a-zA-Z_0-9]+/, $data[$line_number]); - foreach $function (@functions) - { - $function =~ s:\s*::g; - - if($function =~ m:[^\s]+:) - { - if(! $known_variables{"\U$function\E"}) - { - $known_variables{"\U$function\E"} = 1; - - $interface_db{"\U$thorn GROUP $current_group\E"} .= " $function"; - } - else - { - $message = "Duplicate variable $function in thorn $thorn"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } - } - } - $line_number++; - } - } - else - { - # If no block, create a variable with the same name as group. - $function = $current_group; - if(! $known_variables{"\U$function\E"}) - { - $known_variables{"\U$function\E"} = 1; - - $interface_db{"\U$thorn GROUP $current_group\E"} .= " $function"; - } - else - { - $message = "Duplicate variable $function in thorn $thorn"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } - - # Decrement the line number, since the line is the first line of the next CCL statement. - $line_number--; - } + # Fill in data for the scalars/arrays/functions + $line_number++; + if($data[$line_number] =~ m/^\s*\{\s*$/) + { + $line_number++; + while($data[$line_number] !~ m:\}:i) + { + @functions = split(/[^a-zA-Z_0-9]+/, $data[$line_number]); + foreach $function (@functions) + { + $function =~ s:\s*::g; + + if($function =~ m:[^\s]+:) + { + if(! $known_variables{"\U$function\E"}) + { + $known_variables{"\U$function\E"} = 1; + + $interface_db{"\U$thorn GROUP $current_group\E"} .= " $function"; + } + else + { + $message = "Duplicate variable $function in thorn $thorn"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } + } + } + $line_number++; + } + } + else + { + # If no block, create a variable with the same name as group. + $function = $current_group; + if(! $known_variables{"\U$function\E"}) + { + $known_variables{"\U$function\E"} = 1; + + $interface_db{"\U$thorn GROUP $current_group\E"} .= " $function"; + } + else + { + $message = "Duplicate variable $function in thorn $thorn"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } + + # Decrement the line number, since the line is the first line of the next CCL statement. + $line_number--; + } } } elsif ($line =~ m/^\s*(USES\s*INCLUDE)S?\s*(SOURCE)S?\s*:\s*(.*)\s*$/i) @@ -1064,15 +1064,15 @@ sub parse_interface_ccl { if($line =~ m:\{:) { - $message = "...Skipping interface block with missing keyword...."; - &CST_error(0,$message,"",__LINE__,__FILE__); + $message = "...Skipping interface block with missing keyword...."; + &CST_error(0,$message,"",__LINE__,__FILE__); - $line_number++ until ($data[$line_number] =~ m:\}:); + $line_number++ until ($data[$line_number] =~ m:\}:); } else { - $message = "Unknown line in thorn $arrangement/$thorn\n$line"; - &CST_error(0,$message,"",__LINE__,__FILE__); + $message = "Unknown line in thorn $arrangement/$thorn\n$line"; + &CST_error(0,$message,"",__LINE__,__FILE__); } } } diff --git a/lib/sbin/parameter_parser.pl b/lib/sbin/parameter_parser.pl index 34e23e02..e8160d48 100644 --- a/lib/sbin/parameter_parser.pl +++ b/lib/sbin/parameter_parser.pl @@ -70,14 +70,14 @@ sub cross_index_parameters { if($public_parameters{"\U$parameter\E"}) { - $message = "Duplicate public parameter $parameter, defined in $imp and ".$public_parameters{"\Uparameter\E"}; - &CST_error(0,$message,"",__LINE__,__FILE__); + $message = "Duplicate public parameter $parameter, defined in $imp and ".$public_parameters{"\Uparameter\E"}; + &CST_error(0,$message,"",__LINE__,__FILE__); } else { - $public_parameters{"\Uparameter\E"} = "$thorn"; - - $parameter_database{"GLOBAL PARAMETERS"} .= "$thorn\::$parameter "; + $public_parameters{"\Uparameter\E"} = "$thorn"; + + $parameter_database{"GLOBAL PARAMETERS"} .= "$thorn\::$parameter "; } } } @@ -130,19 +130,19 @@ sub parse_param_ccl if($block eq "SHARES") { - $current_friend = $2; - $current_friend =~ s:\s::; - - # It's a friend block. - $block .= " \U$current_friend\E"; - # Remember this friend, but make the memory unique. - $friends{"\U$current_friend\E"} = 1; + $current_friend = $2; + $current_friend =~ s:\s::; + + # It's a friend block. + $block .= " \U$current_friend\E"; + # Remember this friend, but make the memory unique. + $friends{"\U$current_friend\E"} = 1; } # Do some initialisation to prevent perl -w from complaining. if(!$parameter_db{"\U$thorn $block\E variables"}) { - $parameter_db{"\U$thorn $block\E variables"} = ""; + $parameter_db{"\U$thorn $block\E variables"} = ""; } } elsif($line =~ m:(EXTENDS |USES )?\s*(?\:CCTK_)?(INT|REAL|BOOLEAN|KEYWORD|STRING)\s+([a-zA-Z]+[a-zA-Z0-9_]*)\s+(\"[^\"]*\")?\s*(.*)$:i) @@ -158,191 +158,191 @@ sub parse_param_ccl if($use_or_extend =~ m:USES:i) { - $use_clause = 1; + $use_clause = 1; } else { - $use_clause = 0; + $use_clause = 0; } if($description !~ m:\":) { - if($use_or_extend) - { - $description = ""; - } - else - { - $message = "Missing description for $variable in thorn $thorn."; - &CST_error(0,$message,"",__LINE__,__FILE__); - } + if($use_or_extend) + { + $description = ""; + } + else + { + $message = "Missing description for $variable in thorn $thorn."; + &CST_error(0,$message,"",__LINE__,__FILE__); + } } if($defined_parameters{"\U$variable\E"}) { - $message = "Duplicate parameter $variable in thorn $thorn. Ignoring second definition"; - &CST_error(1,$message,"",__LINE__,__FILE__); + $message = "Duplicate parameter $variable in thorn $thorn. Ignoring second definition"; + &CST_error(1,$message,"",__LINE__,__FILE__); - $line_number++ until ($data[$line_number] =~ m:\}:); + $line_number++ until ($data[$line_number] =~ m:\}:); } elsif($use_or_extend && $use_or_extend =~ m:(EXTENDS|USES):i && $block !~ m:SHARES\s*\S:) { - # Can only extend a friend variable. - $message = "Parse error in $thorn/param.ccl"; - &CST_error(0,$message,"",__LINE__,__FILE__); - $line_number++ until ($data[$line_number] =~ m:\}:); + # Can only extend a friend variable. + $message = "Parse error in $thorn/param.ccl"; + &CST_error(0,$message,"",__LINE__,__FILE__); + $line_number++ until ($data[$line_number] =~ m:\}:); } elsif($data[$line_number+1] !~ m:^\s*\{\s*$: && $use_clause == 0) { - # Since the data should have no blank lines, the next - # line should have { on it. - $message = "Parse error in $thorn/param.ccl - missing \"{\" in definition of parameter \"$variable\""; - &CST_error(0,$message,"",__LINE__,__FILE__); - # Move past the end of this block. - $line_number++ until ($data[$line_number] =~ m:\}:); + # Since the data should have no blank lines, the next + # line should have { on it. + $message = "Parse error in $thorn/param.ccl - missing \"{\" in definition of parameter \"$variable\""; + &CST_error(0,$message,"",__LINE__,__FILE__); + # Move past the end of this block. + $line_number++ until ($data[$line_number] =~ m:\}:); } else { - $skip_range_block = 0; - # Move past { - if($data[$line_number+1] !~ m:\s*\{\s*:) - { - if ($use_clause) - { - $skip_range_block = 1; - } - else - { + $skip_range_block = 0; + # Move past { + if($data[$line_number+1] !~ m:\s*\{\s*:) + { + if ($use_clause) + { + $skip_range_block = 1; + } + else + { # This message is already given above. -# message = "Missing { at start of range block for parameter $variable pf thorn $thorn"; -# &CST_error(0,$message,"",__LINE__,__FILE__); - die "Internal error in parser: this line should never be reached." - } - } - else - { - $skip_range_block = 0; - $line_number++; - $line_number++; - } - - # Parse the options - %options = split(/\s*=\s*|\s+/, $options); +# message = "Missing { at start of range block for parameter $variable pf thorn $thorn"; +# &CST_error(0,$message,"",__LINE__,__FILE__); + die "Internal error in parser: this line should never be reached." + } + } + else + { + $skip_range_block = 0; + $line_number++; + $line_number++; + } + + # Parse the options + %options = split(/\s*=\s*|\s+/, $options); - foreach $option (keys %options) - { - if($option =~ m:STEERABLE:i) - { - $parameter_db{"\U$thorn $variable\E steerable"} = $options{$option}; - } - else - { - $message = "Unknown option $option for parameter $variable of thorn $thorn"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } - } - - # Store data about this variable. - $defined_parameters{"\U$variable\E"} = 1; - - $parameter_db{"\U$thorn $block\E variables"} .= $variable." "; - $parameter_db{"\U$thorn $variable\E type"} = $type; - $parameter_db{"\U$thorn $variable\E description"} = $description; - $parameter_db{"\U$thorn $variable\E ranges"} = 0; - - if(! $skip_range_block) - { - # Parse the allowed values and their descriptions. - # The (optional) description is seperated by :: - while($data[$line_number] !~ m:^\s*\}:) - { - if($data[$line_number] =~ m/::/) - { - ($new_ranges, $delim, $new_desc) = $data[$line_number] =~ m/(.*)(::)(.*)/; - } - else - { - ($new_ranges, $delim, $new_desc) = ($data[$line_number],"",""); - } - # Increment the number of ranges found (ranges) - $parameter_db{"\U$thorn $variable\E ranges"}++; - # Strip out any spaces in the range for a numeric parameter. - if($type =~ m:INT|REAL:) - { - $new_ranges =~ s/\s//g; - } - - $parameter_db{"\U$thorn $variable\E range $parameter_db{\"\U$thorn $variable\E ranges\"} range"} = $new_ranges; - - # Check description - if($delim eq "" || ($delim =~ /::/ && $new_desc =~ /^\s*$/)) - { - $message = "Missing description of range '$new_ranges' for parameter $thorn\::$variable"; - &CST_error(1,$message,"",__LINE__,__FILE__); - } - elsif ($new_desc =~ /^\s*\".*[^\s\"]\s*$|^\s*[^\s\"].*\"\s*$/) - { - $message = "Description of range for $thorn\::$variable has misplaced quotes ($new_desc)"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } - $parameter_db{"\U$thorn $variable\E range $parameter_db{\"\U$thorn $variable\E ranges\"} description"} = $new_desc; - $line_number++; - } - } + foreach $option (keys %options) + { + if($option =~ m:STEERABLE:i) + { + $parameter_db{"\U$thorn $variable\E steerable"} = $options{$option}; + } + else + { + $message = "Unknown option $option for parameter $variable of thorn $thorn"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } + } + + # Store data about this variable. + $defined_parameters{"\U$variable\E"} = 1; + + $parameter_db{"\U$thorn $block\E variables"} .= $variable." "; + $parameter_db{"\U$thorn $variable\E type"} = $type; + $parameter_db{"\U$thorn $variable\E description"} = $description; + $parameter_db{"\U$thorn $variable\E ranges"} = 0; + + if(! $skip_range_block) + { + # Parse the allowed values and their descriptions. + # The (optional) description is seperated by :: + while($data[$line_number] !~ m:^\s*\}:) + { + if($data[$line_number] =~ m/::/) + { + ($new_ranges, $delim, $new_desc) = $data[$line_number] =~ m/(.*)(::)(.*)/; + } + else + { + ($new_ranges, $delim, $new_desc) = ($data[$line_number],"",""); + } + # Increment the number of ranges found (ranges) + $parameter_db{"\U$thorn $variable\E ranges"}++; + # Strip out any spaces in the range for a numeric parameter. + if($type =~ m:INT|REAL:) + { + $new_ranges =~ s/\s//g; + } + + $parameter_db{"\U$thorn $variable\E range $parameter_db{\"\U$thorn $variable\E ranges\"} range"} = $new_ranges; + + # Check description + if($delim eq "" || ($delim =~ /::/ && $new_desc =~ /^\s*$/)) + { + $message = "Missing description of range '$new_ranges' for parameter $thorn\::$variable"; + &CST_error(1,$message,"",__LINE__,__FILE__); + } + elsif ($new_desc =~ /^\s*\".*[^\s\"]\s*$|^\s*[^\s\"].*\"\s*$/) + { + $message = "Description of range for $thorn\::$variable has misplaced quotes ($new_desc)"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } + $parameter_db{"\U$thorn $variable\E range $parameter_db{\"\U$thorn $variable\E ranges\"} description"} = $new_desc; + $line_number++; + } + } # Give a warning if no range was given and it was needed if (($use_clause == 0) && ($parameter_db{"\U$thorn $variable\E ranges"}==0 && $type =~ m:INT|REAL:)) { - $message = "No range given for $variable in $thorn"; - &CST_error(0,$message,"",__LINE__,__FILE__); + $message = "No range given for $variable in $thorn"; + &CST_error(0,$message,"",__LINE__,__FILE__); } - if($block !~ m:SHARES:) - { - if($data[$line_number] =~ m:\s*\}\s*(.+):) - { - $default = $1; - if ($type =~ m:INT|REAL: && $default =~ m:":) - { - $message = "String default given for $type $variable in $thorn"; + if($block !~ m:SHARES:) + { + if($data[$line_number] =~ m:\s*\}\s*(.+):) + { + $default = $1; + if ($type =~ m:INT|REAL: && $default =~ m:":) + { + $message = "String default given for $type $variable in $thorn"; &CST_error(0,$message,"",__LINE__,__FILE__); - } + } elsif ($type =~ m:STRING|KEYWORD: && $default !~ m:".*":) { - $message = "Default given for $type $variable in $thorn is not a string"; + $message = "Default given for $type $variable in $thorn is not a string"; &CST_error(0,$message,"",__LINE__,__FILE__); - } + } elsif ($type =~ m:BOOLEAN: && $default =~ m:": && $default !~ m:".*":) - { - $message = "Default given for $type $variable in $thorn is missing a quote"; + { + $message = "Default given for $type $variable in $thorn is missing a quote"; &CST_error(0,$message,"",__LINE__,__FILE__); - } - - $default = $1 if ($default =~ m:\"(((\\\")|[^\"])*)\":); - - &CheckParameterDefault($thorn,$variable,$default,%parameter_db); - - $parameter_db{"\U$thorn $variable\E default"} = $default; - } - else - { - $message = "Unable to find default for $variable"; - &CST_error(0,$message,"",__LINE__,__FILE__); - } - } + } + + $default = $1 if ($default =~ m:\"(((\\\")|[^\"])*)\":); + + &CheckParameterDefault($thorn,$variable,$default,%parameter_db); + + $parameter_db{"\U$thorn $variable\E default"} = $default; + } + else + { + $message = "Unable to find default for $variable"; + &CST_error(0,$message,"",__LINE__,__FILE__); + } + } } } else { if($line =~ m:\{:) { - $message = "Skipping parameter block in $thorn with missing keyword"; + $message = "Skipping parameter block in $thorn with missing keyword"; &CST_error(1,$message,"",__LINE__,__FILE__); - $line_number++ until ($data[$line_number] =~ m:\}:); + $line_number++ until ($data[$line_number] =~ m:\}:); } else { - $message = "Unknown line \"$line\" in $thorn/param.ccl"; + $message = "Unknown line \"$line\" in $thorn/param.ccl"; &CST_error(0,$message,"",__LINE__,__FILE__); } } @@ -436,8 +436,8 @@ sub CheckParameterDefault { if ($default !~ m:^yes|no|1|0$:i) { - $message = "Default ($default) for boolean incorrect for $variable in $thorn"; - &CST_error(0,$message,"",__LINE__,__FILE__); + $message = "Default ($default) for boolean incorrect for $variable in $thorn"; + &CST_error(0,$message,"",__LINE__,__FILE__); } } @@ -456,7 +456,7 @@ sub CheckParameterDefault $range = quotemeta $range; if ($default =~ m:$range:i) { - $foundit = 1; + $foundit = 1; } } if ($foundit == 0) @@ -480,7 +480,7 @@ sub CheckParameterDefault if ($default =~ m:$range:i) { - $foundit = 1; + $foundit = 1; } } if ($foundit == 0) @@ -507,23 +507,23 @@ sub CheckParameterDefault $max = $2; if ($min =~ /^\s*[\*\s]*\s*$/) { - $minok=1; + $minok=1; } elsif ($default >= $min) { - $minok=1; + $minok=1; } if ($max =~ /^\s*[\*\s]*\s*$/) { - $maxok=1; + $maxok=1; } elsif ($default <= $max) { - $maxok=1; + $maxok=1; } if ($minok == 1 && $maxok == 1) { - $foundit = 1; + $foundit = 1; } } if ($foundit == 0) @@ -550,23 +550,23 @@ sub CheckParameterDefault $max = $2; if ($min =~ /^\s*[\*\s]*\s*$/) { - $minok=1; + $minok=1; } elsif ($default >= $min) { - $minok=1; + $minok=1; } if ($max =~ /^\s*[\*\s]*\s*$/) { - $maxok=1; + $maxok=1; } elsif ($default <= $max) { - $maxok=1; + $maxok=1; } if ($minok == 1 && $maxok == 1) { - $foundit = 1; + $foundit = 1; } } if ($foundit == 0) |