1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
#/*@@
# @file ImpParamConsistency.pl
# @date Tue Mar 9 12:34:54 1999
# @author Tom Goodale
# @desc
# Consistency checking for interface and parameter databases.
# @enddesc
#@@*/
sub CheckImpParamConsistency
{
my($n_interface_data, @indata) = @_;
my(%interface_database);
my(%parameter_database);
my(@thorns);
my($thorn, $friend, $implementation, $other_thorn);
my($range);
# Extract the arguments
%interface_database = @indata[0..2*$n_interface_data-1];
%parameter_database = @indata[2*$n_interface_data..$#indata];
@thorns = split(" ", $interface_database{"THORNS"});
foreach $thorn (@thorns)
{
# print "Processing thorn $thorn\n";
foreach $friend (split(" ", $parameter_database{"\U$thorn\E SHARES implementations"}))
{
# print "Friend is $friend\n";
# Find a thorn providing this implementation
($other_thorn) = split(" ", $interface_database{"IMPLEMENTATION \U$friend\E THORNS"});
# Check the other implementation exists.
if($other_thorn =~ m:^\s*$:)
{
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";
my $realname = $parameter_database{"\U$thorn $parameter\E realname"};
# Check if the parameter exists in the other thorn
if($parameter_database{"\U$other_thorn $realname\E type"})
{
# Check that the parameter is in the restricted block.
if($parameter_database{"\U$other_thorn RESTRICTED\E variables"} =~ m:\b$realname\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"}++;
# 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 \"$realname\" from implementation \"$friend\"";
&CST_error(0,$message,"",__LINE__,__FILE__);
}
}
else
{
$message = "Thorn \"$thorn\" attempted to EXTEND or USE non-existent parameter \"$realname\" from implementation \"$friend\"";
&CST_error(0,$message,"",__LINE__,__FILE__);
}
}
}
}
return %parameter_database;
}
1;
|