summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/sbin/config_parser.pl20
-rw-r--r--lib/sbin/interface_parser.pl275
-rw-r--r--lib/sbin/parameter_parser.pl2
3 files changed, 277 insertions, 20 deletions
diff --git a/lib/sbin/config_parser.pl b/lib/sbin/config_parser.pl
index d51b5233..73e9d95b 100644
--- a/lib/sbin/config_parser.pl
+++ b/lib/sbin/config_parser.pl
@@ -42,13 +42,13 @@ require "lib/sbin/create_fortran_stuff.pl";
%thorns = &create_thorn_list;
-%interface_database = create_interface_database(%thorns);
+%interface_database = &create_interface_database(%thorns);
-%parameter_database = create_parameter_database(%thorns);
+%parameter_database = &create_parameter_database(%thorns);
#&print_parameter_database(%parameter_database);
-#&print_interface_database(%interface_database);
+&print_interface_database(%interface_database);
@implementations = (keys %thorns);
@@ -68,13 +68,16 @@ require "lib/sbin/create_fortran_stuff.pl";
@c_structures = &create_c_parameter_structures(scalar(@implementations),@implementations,%parameter_database);
-foreach $line (@c_structures)
-{
- print "$line\n";
-}
+#foreach $line (@c_structures)
+#{
+# print "$line\n";
+#}
@subroutine = &create_c_param_init_subroutine("test2", %parameter_database);
+
+
+
foreach $line (@subroutine)
{
print "$line\n";
@@ -85,7 +88,8 @@ sub create_thorn_list
{
return ("flesh", "toolkits/test/flesh",
"test1", "toolkits/test/test1",
- "test2", "toolkits/test/test2");
+ "test2", "toolkits/test/test2",
+ "test3", "toolkits/test/test3");
}
diff --git a/lib/sbin/interface_parser.pl b/lib/sbin/interface_parser.pl
index 22f4627e..9611563c 100644
--- a/lib/sbin/interface_parser.pl
+++ b/lib/sbin/interface_parser.pl
@@ -34,7 +34,7 @@ sub create_interface_database
foreach $thorn (keys %thorns)
{
# Read the data
- @indata = read_file("$thorns{$thorn}/interface.ccl");
+ @indata = &read_file("$thorns{$thorn}/interface.ccl");
# Get the interface data from it
@new_interface_data = &parse_interface_ccl($thorn, @indata);
@@ -43,11 +43,264 @@ sub create_interface_database
push (@interface_data, @new_interface_data);
}
+
+ @interface_data = &cross_index_interface_data(scalar(keys %thorns), (keys %thorns), @interface_data);
+
return @interface_data;
}
+
+sub cross_index_interface_data
+{
+ local($n_thorns, @indata) = @_;
+ local(@thorns);
+ local(%interface_data);
+ local(%implementations);
+ local($implementation);
+
+ @thorns = @indata[0..$n_thorns-1];
+ %interface_data = @indata[$n_thorns..$#indata];
+
+ foreach $thorn (@thorns)
+ {
+ $implementation = $interface_data{"\U$thorn\E IMPLEMENTS"};
+ if($implementation =~ m:^\s*$:)
+ {
+ die "Thorn $thorn doesn't specify an implementation.\n";
+ }
+
+ $interface_data{"IMPLEMENTATION \U$implementation\E THORNS"} .= " $thorn";
+
+ $implementations{"\U$implementation\E"} = "$implementation";
+ }
+
+ $interface_data{"THORNS"} = join(" ", @thorns);
+
+ foreach $implementation (keys %implementations)
+ {
+ $interface_data{"IMPLEMENTATIONS"} .= $implementations{"\U$implementation\E"} . " ";
+
+ &check_interface_consistency($implementation, %interface_data);
+ }
+
+
+}
+
+
+sub check_interface_consistency
+{
+ local($implementation, %interface_data) = @_;
+ local(@thorns);
+ local($thorn);
+ local($thing);
+ local(%inherits);
+ local(%friend);
+ local(%public_groups);
+ local(%private_groups);
+ local(%variables);
+ local($n_errors);
+ local($group);
+ local(%attributes);
+
+ # Find out which thorns provide this implementation.
+ @thorns = split(" ", $interface_data{"IMPLEMENTATION \U$implementation\E THORNS"});
+
+ if(scalar(@thorns) > 1)
+ {
+ foreach $thorn (@thorns)
+ {
+ # Record the inheritance
+ foreach $thing (split(" ", $interface_data{"\U$thorn\E INHERITS"}))
+ {
+ if($thing =~ m:\w:)
+ {
+ $inherits{"\U$thing\E"} .= "$thorn ";
+ }
+ }
+
+ # Record the friends
+ foreach $thing (split(" ", $interface_data{"\U$thorn\E FRIEND"}))
+ {
+ if($thing =~ m:\w:)
+ {
+ $friend{"\U$thing\E"} .= "$thorn ";
+ }
+ }
+
+ # Record the piblic groups
+ foreach $thing (split(" ", $interface_data{"\U$thorn\E PUBLIC GROUPS"}))
+ {
+ if($thing =~ m:\w:)
+ {
+ $public_groups{"\U$thing\E"} .= "$thorn ";
+ }
+ }
+
+ # Record the protected groups
+ foreach $thing (split(" ", $interface_data{"\U$thorn\E PROTECTED GROUPS"}))
+ {
+ if($thing =~ m:\w:)
+ {
+ $protected_groups{"\U$thing\E"} .= "$thorn ";
+ }
+ }
+ }
+
+ $n_thorns = @thorns;
+
+ # Check the consistency of the inheritance
+ foreach $thing (keys %inherits)
+ {
+ if(split(" ", $inherits{$thing}) != $n_thorns)
+ {
+ if(!$n_errors)
+ {
+ print STDERR "Inconsistent implementations of $implementation\n";
+ print STDERR " Implemented by thorns " . join(" ", @thorns) . "\n";
+ }
+ print STDERR " Not all inherit: $thing\n";
+ $n_errors++;
+ }
+ }
+
+ # Check the consistency of the friendships
+ foreach $thing (keys %friend)
+ {
+ if(split(" ", $friend{$thing}) != $n_thorns)
+ {
+ if(!$n_errors)
+ {
+ print STDERR "Inconsistent implementations of $implementation\n";
+ print STDERR " Implemented by thorns " . join(" ", @thorns) . "\n";
+ }
+ print STDERR " Not all are friends of : $thing\n";
+ $n_errors++;
+ }
+ }
+
+ # Check the consistency of the public groups
+ foreach $thing (keys %public_groups)
+ {
+ if(split(" ", $public_groups{$thing}) != $n_thorns)
+ {
+ if(!$n_errors)
+ {
+ print STDERR "Inconsistent implementations of $implementation\n";
+ print STDERR " Implemented by thorns " . join(" ", @thorns) . "\n";
+ }
+ print STDERR " Not all declare public group: $thing\n";
+ $n_errors++;
+ }
+ }
+
+ # Check the consistency of the protected groups
+ foreach $thing (keys %protected_groups)
+ {
+ if(split(" ", $protected_groups{$thing}) != $n_thorns)
+ {
+ if(!$n_errors)
+ {
+ print STDERR "Inconsistent implementations of $implementation\n";
+ print STDERR " Implemented by thorns " . join(" ", @thorns) . "\n";
+ }
+ print STDERR " Not all declare potected group: $thing\n";
+ $n_errors++;
+ }
+ }
+
+ # Stop if any errors discovered so far.
+ if($n_errors)
+ {
+ print STDERR "$n_errors Errors found, please fix before continuing.\n";
+ exit;
+ }
+
+ # Check consistancy of group definitions
+ foreach $group ((keys %public_groups), (keys %protected_groups))
+ {
+ %variables = ();
+ %attributes = ();
+
+ foreach $thorn (@thorns)
+ {
+ # Remember which variables are defined in this group.
+ foreach $thing (split(" ",$interface_data{"\U$thorn GROUP $group\E"}))
+ {
+ $variables{"\U$thing\E"} .= "$thorn ";
+ }
+
+ # Check variable type definition.
+ if($attributes{"VTYPE"})
+ {
+ if($attributes{"VTYPE"} ne $interface_data{"\U$thorn GROUP $group\E VTYPE"})
+ {
+ if(!$n_errors)
+ {
+ print STDERR "Inconsistent implementations of $implementation\n";
+ print STDERR " Implemented by thorns " . join(" ", @thorns) . "\n";
+ }
+ print STDERR " Group $group has inconsistent variable type.\n";
+ $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"})
+ {
+ if(!$n_errors)
+ {
+ print STDERR "Inconsistent implementations of $implementation\n";
+ print STDERR " Implemented by thorns " . join(" ", @thorns) . "\n";
+ }
+ print STDERR " Group $group has inconsistent group type.\n";
+ $n_errors++;
+ }
+ }
+ else
+ {
+ $attributes{"GTYPE"} = $interface_data{"\U$thorn GROUP $group\E GTYPE"};
+ }
+
+ # Check the dimensions are consistant
+ if($attributes{"DIM"} && $attributes{"GTYPE"} ne "SCALAR")
+ {
+ if($attributes{"DIM"} ne $interface_data{"\U$thorn GROUP $group\E DIM"})
+ {
+ if(!$n_errors)
+ {
+ print STDERR "Inconsistent implementations of $implementation\n";
+ print STDERR " Implemented by thorns " . join(" ", @thorns) . "\n";
+ }
+ print STDERR " Group $group has inconsistent dimension.\n";
+ $n_errors++;
+ }
+ }
+ else
+ {
+ $attributes{"DIM"} = $interface_data{"\U$thorn GROUP $group\E DIM"};
+ }
+ }
+ }
+ }
+ else
+ {
+ # No need to do a consistency check if only one thorn
+ # provides this implementation.
+
+ }
+
+}
+
+
+
#/*@@
# @routine parse_interface_ccl
# @date Wed Sep 16 15:07:11 1998
@@ -109,10 +362,10 @@ sub parse_interface_ccl
{
$current_group = "$2";
- if($know_groups{"\U$current_group\E"})
+ if($known_groups{"\U$current_group\E"})
{
print STDERR "Duplicate group $2 in thorn $thorn.\n";
- if($data[linenum+1] =~ m:\}:)
+ if($data[linenum+1] =~ m:\{:)
{
print STDERR "...Skipping block ....\n";
$linenum++ until ($data[$linenum] =~ m:\}:);
@@ -121,10 +374,10 @@ sub parse_interface_ccl
}
else
{
- $know_groups{"\U$current_group\E"} = 1;
+ $known_groups{"\U$current_group\E"} = 1;
}
- $interface_db{"\U$thorn $block GROUPS \E"} .= " $2";
+ $interface_db{"\U$thorn $block GROUPS\E"} .= " $2";
$interface_db{"\U$thorn GROUP $current_group\E VTYPE"} = "\U$1\E";
%options = split(/\s+|\s*=\s*/, $3);
@@ -157,12 +410,12 @@ sub parse_interface_ccl
}
# Check that it is a know group type
- if($interface_db{"\U$thorn GROUP $current_group\E GTYPE"} !~ m:SCALAR|GF|ARRAY:g)
+ if($interface_db{"\U$thorn GROUP $current_group\E GTYPE"} !~ m:SCALAR|GF|ARRAY:)
{
print STDERR "Unknown GROUP TYPE " .
$interface_db{"\U$thorn GROUP $current_group\E GTYPE"} .
" for group $current_group of thorn $thorn.\n";
- if($data[linenum+1] =~ m:\}:)
+ if($data[linenum+1] =~ m:\{:)
{
print STDERR "...Skipping block ....\n";
$linenum++ until ($data[$linenum] =~ m:\}:);
@@ -184,9 +437,9 @@ sub parse_interface_ccl
if($function =~ m:[^\s]+:)
{
- if(! $known_functions{"\U$function\E"})
+ if(! $known_variables{"\U$function\E"})
{
- $known_functions{"\U$function\E"} = 1;
+ $known_variables{"\U$function\E"} = 1;
$interface_db{"\U$thorn GROUP $current_group\E"} .= " $function";
}
@@ -203,9 +456,9 @@ sub parse_interface_ccl
{
# If no block, create a variable with the same name as group.
$function = $current_group;
- if(! $known_functions{"\U$function\E"})
+ if(! $known_variables{"\U$function\E"})
{
- $known_functions{"\U$function\E"} = 1;
+ $known_variables{"\U$function\E"} = 1;
$interface_db{"\U$thorn GROUP $current_group\E"} .= " $function";
}
diff --git a/lib/sbin/parameter_parser.pl b/lib/sbin/parameter_parser.pl
index adb6dc5d..d2881648 100644
--- a/lib/sbin/parameter_parser.pl
+++ b/lib/sbin/parameter_parser.pl
@@ -31,7 +31,7 @@ sub create_parameter_database
foreach $imp (keys %implementations)
{
# Read the data
- @indata = read_file("$implementations{$imp}/param.ccl");
+ @indata = &read_file("$implementations{$imp}/param.ccl");
# Get the parameters from it
@new_parameter_data = &parse_param_ccl($imp, @indata);
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-22 18:16:02 +0000