line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
## no critic qw(ProhibitExcessMainComplexity) # SYSTEM SPECIAL 4: allow complex code outside subroutines, must be on line 1 |
2
|
|
|
|
|
|
|
# [[[ PREPROCESSOR ]]] |
3
|
|
|
|
|
|
|
# <<< TYPE_CHECKING: OFF >>> |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
# [[[ HEADER ]]] |
6
|
|
|
|
|
|
|
package RPerl::Compiler; |
7
|
3
|
|
|
3
|
|
17
|
use strict; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
67
|
|
8
|
3
|
|
|
3
|
|
15
|
use warnings; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
63
|
|
9
|
3
|
|
|
3
|
|
14
|
use RPerl::AfterSubclass; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
371
|
|
10
|
|
|
|
|
|
|
our $VERSION = 0.029_000; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# [[[ OO INHERITANCE ]]] |
13
|
3
|
|
|
3
|
|
21
|
use parent qw(RPerl::CompileUnit::Module::Class); |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
16
|
|
14
|
3
|
|
|
3
|
|
161
|
use RPerl::CompileUnit::Module::Class; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
50
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# [[[ CRITICS ]]] |
17
|
|
|
|
|
|
|
## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls) # USER DEFAULT 1: allow numeric values & print operator |
18
|
|
|
|
|
|
|
## no critic qw(RequireInterpolationOfMetachars) # USER DEFAULT 2: allow single-quoted control characters & sigils |
19
|
|
|
|
|
|
|
## no critic qw(ProhibitStringyEval) # SYSTEM DEFAULT 1: allow eval() |
20
|
|
|
|
|
|
|
## no critic qw(RequireBriefOpen) # SYSTEM SPECIAL 10: allow complex processing with open filehandle |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# [[[ INCLUDES ]]] |
23
|
3
|
|
|
3
|
|
16
|
use RPerl::Parser; |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
56
|
|
24
|
3
|
|
|
3
|
|
12
|
use RPerl::Generator; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
65
|
|
25
|
3
|
|
|
3
|
|
16
|
use File::Temp qw(tempfile); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
135
|
|
26
|
3
|
|
|
3
|
|
17
|
use File::Basename; |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
152
|
|
27
|
3
|
|
|
3
|
|
16
|
use English qw(-no_match_vars); # for $OSNAME; why isn't this included from 'require RPerl::Config', which is included from 'use RPerl' above? |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
23
|
|
28
|
3
|
|
|
3
|
|
870
|
use IPC::Cmd qw(can_run); # to check for `perltidy` and `astyle` |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
125
|
|
29
|
3
|
|
|
3
|
|
14
|
use List::MoreUtils qw(uniq); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
36
|
|
30
|
3
|
|
|
3
|
|
2016
|
use File::Spec; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
55
|
|
31
|
3
|
|
|
3
|
|
13
|
use Config; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
107
|
|
32
|
3
|
|
|
3
|
|
17
|
use Config qw(config_re); |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
90
|
|
33
|
|
|
|
|
|
|
#use IPC::Open3; ## 93r |
34
|
|
|
|
|
|
|
#use IO::Select; ## 93r |
35
|
3
|
|
|
3
|
|
1029
|
use IPC::Run3 qw(run3); |
|
3
|
|
|
|
|
7678
|
|
|
3
|
|
|
|
|
154
|
|
36
|
3
|
|
|
3
|
|
22
|
use Cwd; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
140
|
|
37
|
3
|
|
|
3
|
|
17
|
use File::Copy; # for move() |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
113
|
|
38
|
3
|
|
|
3
|
|
709
|
use Alien::astyle; |
|
3
|
|
|
|
|
605
|
|
|
3
|
|
|
|
|
29
|
|
39
|
3
|
|
|
3
|
|
19813
|
use Env qw(@PATH); |
|
3
|
|
|
|
|
5588
|
|
|
3
|
|
|
|
|
19
|
|
40
|
|
|
|
|
|
|
unshift @PATH, Alien::astyle->bin_dir(); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
#our string_arrayref_hashref_hashref $filename_suffixes_supported = { |
43
|
|
|
|
|
|
|
our hashref_hashref $filename_suffixes_supported = { |
44
|
|
|
|
|
|
|
INPUT_SOURCE => { PL => ['.pl'], PM => ['.pm'] }, |
45
|
|
|
|
|
|
|
OUTPUT_SOURCE => { CPP => ['.cpp'], H => ['.h'], PMC => ['.pmc'], OPENMP_CPP => ['.openmp.cpp'] }, |
46
|
|
|
|
|
|
|
OUTPUT_BINARY => { O => ['.o'], A => ['.a'], SO => ['.so'], EXE => [ q{}, '.exe' ], OPENMP_EXE => [ '.openmp', '.openmp.exe' ] } |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# NEED ANSWER: what are the correct Windows file extensions? |
49
|
|
|
|
|
|
|
# OUTPUT_BINARY => { O => ['.o', '.lib'], A => ['.a', '.lib'], SO => ['.so', '.dll'], EXE => [q{}, '.exe'], OPENMP_EXE => ['.openmp', '.openmp.exe']} |
50
|
|
|
|
|
|
|
}; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# [[[ SUBROUTINES ]]] |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub find_parents { |
55
|
1374
|
|
|
1374
|
|
3127
|
{ my string_arrayref $RETURN_TYPE }; |
|
1374
|
|
|
|
|
2759
|
|
56
|
1374
|
|
|
|
|
4333
|
( my string $file_name, my boolean $find_grandparents_recurse, my string_hashref $modes ) = @ARG; |
57
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_parents(), received $file_name = ' . $file_name . "\n" ); |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# trim unnecessary (and possibly problematic) absolute or current-directory paths from input file name |
60
|
1374
|
|
|
|
|
28459
|
$file_name = post_processor__absolute_path_delete($file_name); |
61
|
1374
|
|
|
|
|
29232
|
$file_name = post_processor__current_directory_path_delete($file_name); |
62
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_parents(), have possibly-trimmed $file_name = ' . $file_name . "\n" ); |
63
|
|
|
|
|
|
|
|
64
|
1374
|
|
|
|
|
3541
|
my string_arrayref $parents = []; |
65
|
|
|
|
|
|
|
|
66
|
1374
|
50
|
|
|
|
31042
|
if ( not -f $file_name ) { |
67
|
0
|
|
|
|
|
0
|
die 'ERROR ECOCOPA00, COMPILER, FIND PARENTS: File not found, ' . q{'} . $file_name . q{'} . ', dying' . "\n"; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
1374
|
50
|
|
|
|
56073
|
open my filehandleref $FILE_HANDLE, '<', $file_name |
71
|
|
|
|
|
|
|
or die 'ERROR ECOCOPA01, COMPILER, FIND PARENTS: Cannot open file ' . q{'} . $file_name . q{'} . ' for reading, ' . $OS_ERROR . ', dying' . "\n"; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# read in input file, match on 'use' includes for parents |
74
|
1374
|
|
|
|
|
3500
|
my string $file_line; |
75
|
1374
|
|
|
|
|
2955
|
my string $top_level_package_name = undef; |
76
|
1374
|
|
|
|
|
3553
|
my boolean $use_rperl = 0; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# NEED FIX: do not make recursive calls until after closing file, to avoid |
79
|
|
|
|
|
|
|
# ERROR ECOCOPA01, COMPILER, FIND PARENTS: Cannot open file Foo/Bar.pm for reading, Too many open files, dying |
80
|
1374
|
|
|
|
|
53320
|
while ( $file_line = <$FILE_HANDLE> ) { |
81
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_parents(), top of while loop, have $file_line = ' . $file_line . "\n"); |
82
|
|
|
|
|
|
|
|
83
|
31850
|
100
|
|
|
|
52955
|
if ( $file_line =~ /^\s*package\s+[\w:]+\s*;\s*$/xms ) { |
84
|
414
|
100
|
|
|
|
1469
|
if ( not defined $top_level_package_name ) { |
85
|
410
|
|
|
|
|
1016
|
$top_level_package_name = $file_line; |
86
|
410
|
|
|
|
|
2673
|
$top_level_package_name =~ s/^\s*package\s+([\w:]+)\s*;\s*$/$1/gxms; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
# DEV NOTE: for monolithic modules (more than one package), we only find parents of the first package, to avoid incorrect parent lists & infinite recursion |
89
|
|
|
|
|
|
|
else { |
90
|
4
|
|
|
|
|
11
|
last; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
31846
|
100
|
|
|
|
75561
|
if ( $file_line =~ /^\s*use\s+[\w:]+/xms ) { |
95
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_parents(), found use line, have $file_line = ' . $file_line . "\n"); |
96
|
4660
|
100
|
100
|
|
|
24220
|
if (( $file_line =~ /use\s+RPerl\s*;/ ) or |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
97
|
|
|
|
|
|
|
( $file_line =~ /use\s+RPerl::AfterSubclass\s*;/ )) { |
98
|
1376
|
|
|
|
|
2237
|
$use_rperl = 1; |
99
|
1376
|
|
|
|
|
4709
|
next; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
elsif ( $file_line =~ /use\s+lib/ ) { |
102
|
0
|
|
|
|
|
0
|
die |
103
|
|
|
|
|
|
|
q{ERROR ECOCOPA02, COMPILER, FIND PARENTS: 'use lib...' not currently supported, please set @INC using the PERL5LIB environment variable, file } |
104
|
|
|
|
|
|
|
. q{'} |
105
|
|
|
|
|
|
|
. $file_name . q{'} |
106
|
|
|
|
|
|
|
. ', dying' . "\n"; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
elsif ( $file_line !~ /use\s+parent/ ) |
109
|
|
|
|
|
|
|
{ |
110
|
|
|
|
|
|
|
# safely ignore these not-parent uses |
111
|
3140
|
|
|
|
|
7734
|
next; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# 'use RPerl;' must appear before any other 'use Foo;' statements, or else this is not a valid RPerl input file and we return empty deps |
115
|
144
|
50
|
|
|
|
370
|
if (not $use_rperl) { |
116
|
0
|
|
|
|
|
0
|
last; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
144
|
|
|
|
|
243
|
my string $package_file_name_included; |
120
|
144
|
|
|
|
|
329
|
my string $package_name = $file_line; |
121
|
|
|
|
|
|
|
# remove everything except the package name |
122
|
144
|
|
|
|
|
696
|
$package_name =~ s/^(\s*)//gxms; # strip leading whitespace |
123
|
144
|
|
|
|
|
363
|
substr $package_name, 0, 14, q{}; # strip leading 'use parent qw(' |
124
|
144
|
|
|
|
|
731
|
$package_name =~ s/([\w:]+)(.*)$/$1/gxms; # strip trailing everything |
125
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_parents(), have $package_name = ' . $package_name . "\n\n"); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# safely skip base class for no parent inheritance |
128
|
144
|
100
|
|
|
|
531
|
if ($package_name eq 'RPerl::CompileUnit::Module::Class') { |
129
|
100
|
|
|
|
|
325
|
next; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
44
|
|
|
|
|
117
|
my string $package_file_name = $package_name; |
133
|
44
|
|
|
|
|
224
|
$package_file_name =~ s/::/\//gxms; # replace double-colon :: scope delineator with forward-slash / directory delineator |
134
|
44
|
|
|
|
|
133
|
$package_file_name .= '.pm'; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# find specific included dependency file in @INC |
137
|
44
|
|
|
|
|
203
|
foreach my string $INC_directory (@INC) { |
138
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_parents(), top of @INC foreach loop, have $INC_directory = ' . $INC_directory . "\n" ); |
139
|
132
|
|
|
|
|
326
|
$package_file_name_included = $INC_directory . '/' . $package_file_name; |
140
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_parents(), inside @INC foreach loop, have $package_file_name_included = ' . $package_file_name_included . "\n" ); |
141
|
132
|
100
|
|
|
|
1235
|
if (-e $package_file_name_included) { |
142
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_parents(), inside @INC foreach loop, have EXISTING $package_file_name_included = ' . $package_file_name_included . "\n" ); |
143
|
44
|
|
|
|
|
99
|
last; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
else { |
146
|
88
|
|
|
|
|
286
|
$package_file_name_included = q{}; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
} |
149
|
44
|
50
|
|
|
|
159
|
if ($package_file_name_included eq q{}) { |
150
|
0
|
|
|
|
|
0
|
die 'ERROR ECOCOPA04, COMPILER, FIND PARENTS: Failed to find package file ', q{'}, $package_file_name, q{'}, |
151
|
|
|
|
|
|
|
' in @INC, included from file ', q{'}, $file_name, q{'}, ', dying', "\n"; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_parents(), have $package_file_name_included = ' . $package_file_name_included . "\n" ); |
155
|
|
|
|
|
|
|
|
156
|
44
|
|
|
|
|
1098
|
my string $package_file_name_included_relative = post_processor__absolute_path_delete( $package_file_name_included ); |
157
|
44
|
|
|
|
|
893
|
$package_file_name_included_relative = post_processor__current_directory_path_delete( $package_file_name_included_relative ); |
158
|
44
|
|
|
|
|
89
|
push @{$parents}, $package_file_name_included_relative; |
|
44
|
|
|
|
|
140
|
|
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_parents(), have PRE-SUBDEPS $parents = ' . Dumper($parents) . "\n" ); |
161
|
|
|
|
|
|
|
|
162
|
44
|
50
|
|
|
|
138
|
if ($find_grandparents_recurse) { |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# recursively find grandparents |
165
|
44
|
|
|
|
|
969
|
my string_arrayref $grandparents = find_parents( $package_file_name_included, $find_grandparents_recurse, $modes ); |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
# discard duplicate parents that now appear in grandparents |
168
|
44
|
|
|
|
|
97
|
$parents = [ uniq @{$grandparents}, @{$parents} ]; |
|
44
|
|
|
|
|
141
|
|
|
44
|
|
|
|
|
522
|
|
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_parents(), have POST-SUBDEPS $parents = ' . Dumper($parents) . "\n" ); |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
1374
|
50
|
|
|
|
12336
|
close $FILE_HANDLE |
176
|
|
|
|
|
|
|
or die 'ERROR ECOCOPA05, COMPILER, FIND PARENTS: Cannot close file ' . q{'} |
177
|
|
|
|
|
|
|
. $file_name . q{'} |
178
|
|
|
|
|
|
|
. ' after reading, ' |
179
|
|
|
|
|
|
|
. $OS_ERROR |
180
|
|
|
|
|
|
|
. ', dying' . "\n"; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_parents(), returning $parents = ' . Dumper($parents) . "\n" ); |
183
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_parents(), about to return, have $modes->{_enable_sse} = ' . Dumper($modes->{_enable_sse}) . "\n"); |
184
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_parents(), about to return, have $modes->{_enable_gmp} = ' . Dumper($modes->{_enable_gmp}) . "\n"); |
185
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_parents(), about to return, have $modes->{_enable_gsl} = ' . Dumper($modes->{_enable_gsl}) . "\n"); |
186
|
1374
|
|
|
|
|
9170
|
return $parents; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub find_dependencies { |
190
|
0
|
|
|
0
|
|
0
|
{ my string_arrayref $RETURN_TYPE }; |
|
0
|
|
|
|
|
0
|
|
191
|
0
|
|
|
|
|
0
|
( my string $file_name, my boolean $find_subdependencies_recurse, my string_hashref $modes ) = @ARG; |
192
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_dependencies(), received $file_name = ' . $file_name . "\n" ); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# trim unnecessary (and possibly problematic) absolute and current-directory paths from input file name |
195
|
0
|
|
|
|
|
0
|
$file_name = post_processor__absolute_path_delete($file_name); |
196
|
0
|
|
|
|
|
0
|
$file_name = post_processor__current_directory_path_delete($file_name); |
197
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_dependencies(), have possibly-trimmed $file_name = ' . $file_name . "\n" ); |
198
|
|
|
|
|
|
|
|
199
|
0
|
|
|
|
|
0
|
my string_arrayref $dependencies = []; |
200
|
|
|
|
|
|
|
# my string_arrayref $pmc_disable_paths = []; # DISABLE_DYNAMIC_DEPS_ANALYSIS |
201
|
|
|
|
|
|
|
|
202
|
0
|
0
|
|
|
|
0
|
if ( not -f $file_name ) { |
203
|
0
|
|
|
|
|
0
|
die 'ERROR ECOCODE00, COMPILER, FIND DEPENDENCIES: File not found, ' . q{'} . $file_name . q{'} . ', dying' . "\n"; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
0
|
0
|
|
|
|
0
|
open my filehandleref $FILE_HANDLE, '<', $file_name |
207
|
|
|
|
|
|
|
or die 'ERROR ECOCODE01, COMPILER, FIND DEPENDENCIES: Cannot open file ' . q{'} . $file_name . q{'} . ' for reading, ' . $OS_ERROR . ', dying' . "\n"; |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# read in input file, match on 'use' includes for dependencies |
210
|
0
|
|
|
|
|
0
|
my string $file_line; |
211
|
0
|
|
|
|
|
0
|
my string $top_level_package_name = undef; |
212
|
0
|
|
|
|
|
0
|
my boolean $use_rperl = 0; |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
# NEED FIX: do not make recursive calls until after closing file, to avoid |
215
|
|
|
|
|
|
|
# ERROR ECOCODE01, COMPILER, FIND DEPENDENCIES: Cannot open file Foo/Bar.pm for reading, Too many open files, dying |
216
|
0
|
|
|
|
|
0
|
while ( $file_line = <$FILE_HANDLE> ) { |
217
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_dependencies(), top of while loop, have $file_line = ' . $file_line . "\n"); |
218
|
|
|
|
|
|
|
|
219
|
0
|
0
|
0
|
|
|
0
|
if ( ( $file_line =~ /^\s*package\s+[\w:]+\s*;\s*$/xms ) and ( not defined $top_level_package_name ) ) { |
220
|
|
|
|
|
|
|
# disable top-level PMC file before finding subdependencies |
221
|
0
|
|
|
|
|
0
|
$top_level_package_name = $file_line; |
222
|
0
|
|
|
|
|
0
|
$top_level_package_name =~ s/^\s*package\s+([\w:]+)\s*;\s*$/$1/gxms; |
223
|
|
|
|
|
|
|
=DISABLE_DYNAMIC_DEPS_ANALYSIS |
224
|
|
|
|
|
|
|
my string $pmc_disable_path = pmc_disable($top_level_package_name); |
225
|
|
|
|
|
|
|
if ($pmc_disable_path eq q{}) { |
226
|
|
|
|
|
|
|
# my integer $eval_retval = eval_use_dependencies($top_level_package_name); # NEED ANSWER: do we need to care about $eval_retval? |
227
|
|
|
|
|
|
|
eval_use_dependencies($top_level_package_name); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
else { |
230
|
|
|
|
|
|
|
push @{$pmc_disable_paths}, $pmc_disable_path; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
=cut |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
# DEV NOTE, CORRELATION #rp050: hard-coded list of RPerl files/packages/namespaces |
236
|
|
|
|
|
|
|
# these instances of the 'use' keyword are NOT subdependencies of the current file, do not try to compile them |
237
|
0
|
0
|
|
|
|
0
|
if ( $file_line =~ /^\s*use\s+[\w:]+/xms ) { |
238
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_dependencies(), found use line, have $file_line = ' . $file_line . "\n"); |
239
|
0
|
0
|
0
|
|
|
0
|
if (( $file_line =~ /use\s+RPerl\s*;/ ) or |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
240
|
|
|
|
|
|
|
( $file_line =~ /use\s+RPerl::AfterSubclass\s*;/ )) { |
241
|
0
|
|
|
|
|
0
|
$use_rperl = 1; |
242
|
0
|
|
|
|
|
0
|
next; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
elsif ( ( $file_line =~ /use\s+strict\s*;/ ) |
245
|
|
|
|
|
|
|
or ( $file_line =~ /use\s+warnings\s*;/ ) |
246
|
|
|
|
|
|
|
or ( $file_line =~ /use\s+RPerl::CompileUnit::Module::Class\s*;/ ) |
247
|
|
|
|
|
|
|
or ( $file_line =~ /use\s+RPerl::Class\s*;/ ) |
248
|
|
|
|
|
|
|
or ( $file_line =~ /use\s+RPerl::Config\s*;/ ) |
249
|
|
|
|
|
|
|
or ( $file_line =~ /use\s+RPerl::Exporter.*;/ ) |
250
|
|
|
|
|
|
|
or ( $file_line =~ /use\s+\w+Perl::Config\s*;/ ) # DEV NOTE, CORRELATION #rp027: MathPerl::Config, PhysicsPerl::Config, etc |
251
|
|
|
|
|
|
|
or ( $file_line =~ /use\s+perlapinames_generated/ ) |
252
|
|
|
|
|
|
|
or ( $file_line =~ /use\s+parent/ ) |
253
|
|
|
|
|
|
|
or ( $file_line =~ /use\s+constant/ ) |
254
|
|
|
|
|
|
|
or ( $file_line =~ /use\s+overload/ ) |
255
|
|
|
|
|
|
|
or ( $file_line =~ /use\s+integer/ ) |
256
|
|
|
|
|
|
|
or ( $file_line =~ /use\s+[0-9]/ ) |
257
|
|
|
|
|
|
|
) |
258
|
|
|
|
|
|
|
{ |
259
|
|
|
|
|
|
|
# safely ignore these possibly-valid but not-subdependency uses |
260
|
0
|
|
|
|
|
0
|
next; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
elsif ((defined $top_level_package_name) and ( $file_line =~ /use\s+$top_level_package_name\s*;/ )) { |
263
|
|
|
|
|
|
|
# DEV NOTE, CORRELATION #rp042: do not recursively load the same .pm file from within itself |
264
|
0
|
|
|
|
|
0
|
next; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
elsif ( $file_line =~ /use\s+rperlsse\s*;/ ) { |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_dependencies(), found rperlsse line, have $modes->{_enable_sse} = ' . Dumper($modes->{_enable_sse}) . "\n"); |
269
|
0
|
0
|
|
|
|
0
|
if ( ( substr $Config{archname}, 0, 3 ) eq 'arm' ) { |
270
|
0
|
|
|
|
|
0
|
die q{ERROR ECOCODE06, COMPILER, FIND DEPENDENCIES: 'use rperlsse;' command found but SSE not supported on ARM architecture, file } |
271
|
|
|
|
|
|
|
. q{'} |
272
|
|
|
|
|
|
|
. $file_name . q{'} |
273
|
|
|
|
|
|
|
. ', dying' . "\n"; |
274
|
|
|
|
|
|
|
} |
275
|
0
|
0
|
0
|
|
|
0
|
if ( ( not exists $modes->{_enable_sse} ) or ( not defined $modes->{_enable_sse} ) ) { |
276
|
0
|
|
|
|
|
0
|
$modes->{_enable_sse} = {}; |
277
|
|
|
|
|
|
|
} |
278
|
0
|
|
|
|
|
0
|
$modes->{_enable_sse}->{$file_name} = 1; |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_dependencies(), after finding rperlsse line, have $modes->{_enable_sse} = ' . Dumper($modes->{_enable_sse}) . "\n"); |
281
|
0
|
|
|
|
|
0
|
next; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
elsif ( $file_line =~ /use\s+rperlgmp\s*;/ ) { |
284
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_dependencies(), found rperlgmp line, have $modes->{_enable_gmp} = ' . Dumper($modes->{_enable_gmp}) . "\n"); |
285
|
0
|
0
|
0
|
|
|
0
|
if ( ( not exists $modes->{_enable_gmp} ) or ( not defined $modes->{_enable_gmp} ) ) { |
286
|
0
|
|
|
|
|
0
|
$modes->{_enable_gmp} = {}; |
287
|
|
|
|
|
|
|
} |
288
|
0
|
|
|
|
|
0
|
$modes->{_enable_gmp}->{$file_name} = 1; |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_dependencies(), after finding rperlgmp line, have $modes->{_enable_gmp} = ' . Dumper($modes->{_enable_gmp}) . "\n"); |
291
|
0
|
|
|
|
|
0
|
next; |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
elsif ( $file_line =~ /use\s+rperlgsl\s*;/ ) { |
294
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_dependencies(), found rperlgsl line, have $modes->{_enable_gsl} = ' . Dumper($modes->{_enable_gsl}) . "\n"); |
295
|
0
|
0
|
0
|
|
|
0
|
if ( ( not exists $modes->{_enable_gsl} ) or ( not defined $modes->{_enable_gsl} ) ) { |
296
|
0
|
|
|
|
|
0
|
$modes->{_enable_gsl} = {}; |
297
|
|
|
|
|
|
|
} |
298
|
0
|
|
|
|
|
0
|
$modes->{_enable_gsl}->{$file_name} = 1; |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_dependencies(), after finding rperlgsl line, have $modes->{_enable_gsl} = ' . Dumper($modes->{_enable_gsl}) . "\n"); |
301
|
0
|
|
|
|
|
0
|
next; |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
elsif ( $file_line =~ /use\s+lib/ ) { |
304
|
0
|
|
|
|
|
0
|
die |
305
|
|
|
|
|
|
|
q{ERROR ECOCODE02, COMPILER, FIND DEPENDENCIES: 'use lib...' not currently supported, please set @INC using the PERL5LIB environment variable, file } |
306
|
|
|
|
|
|
|
. q{'} |
307
|
|
|
|
|
|
|
. $file_name . q{'} |
308
|
|
|
|
|
|
|
. ', dying' . "\n"; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
# 'use RPerl;' or 'use RPerl::AfterSubclass;' must appear before any other 'use Foo;' statements, or else this is not a valid RPerl input file and we return empty deps |
312
|
0
|
0
|
|
|
|
0
|
if (not $use_rperl) { |
313
|
0
|
|
|
|
|
0
|
last; |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
0
|
|
|
|
|
0
|
my string $package_file_name_included; |
317
|
0
|
|
|
|
|
0
|
my string $package_name = $file_line; |
318
|
0
|
|
|
|
|
0
|
$package_name =~ s/^\s*use\s+([\w:]+)\s*.*\s*;\s*$/$1/gxms; # remove everything except the package name |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# disable PMC file before finding subdependencies |
321
|
|
|
|
|
|
|
# my string $pmc_disable_path = pmc_disable($package_name); # DISABLE_DYNAMIC_DEPS_ANALYSIS |
322
|
|
|
|
|
|
|
|
323
|
0
|
|
|
|
|
0
|
my string $package_file_name = $package_name; |
324
|
0
|
|
|
|
|
0
|
$package_file_name =~ s/::/\//gxms; # replace double-colon :: scope delineator with forward-slash / directory delineator |
325
|
0
|
|
|
|
|
0
|
$package_file_name .= '.pm'; |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
# find specific included dependency file in either %INC or @INC |
328
|
|
|
|
|
|
|
=DISABLE_DYNAMIC_DEPS_ANALYSIS |
329
|
|
|
|
|
|
|
if ($pmc_disable_path eq q{}) { |
330
|
|
|
|
|
|
|
eval_use_dependencies($package_name); |
331
|
|
|
|
|
|
|
if ( not exists $INC{$package_file_name} ) { |
332
|
|
|
|
|
|
|
die 'ERROR ECOCODE03, COMPILER, FIND DEPENDENCIES: Failed to find package file ', q{'}, $package_file_name, q{'}, |
333
|
|
|
|
|
|
|
' in %INC, included from file ', q{'}, $file_name, q{'}, ', dying', "\n"; |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
$package_file_name_included = $INC{$package_file_name}; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
else { |
338
|
|
|
|
|
|
|
=cut |
339
|
0
|
|
|
|
|
0
|
foreach my string $INC_directory (@INC) { |
340
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_dependencies(), top of @INC foreach loop, have $INC_directory = ' . $INC_directory . "\n" ); |
341
|
0
|
|
|
|
|
0
|
$package_file_name_included = $INC_directory . '/' . $package_file_name; |
342
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_dependencies(), inside @INC foreach loop, have $package_file_name_included = ' . $package_file_name_included . "\n" ); |
343
|
0
|
0
|
|
|
|
0
|
if (-e $package_file_name_included) { |
344
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_dependencies(), inside @INC foreach loop, have EXISTING $package_file_name_included = ' . $package_file_name_included . "\n" ); |
345
|
0
|
|
|
|
|
0
|
last; |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
else { |
348
|
0
|
|
|
|
|
0
|
$package_file_name_included = q{}; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
} |
351
|
0
|
0
|
|
|
|
0
|
if ($package_file_name_included eq q{}) { |
352
|
0
|
|
|
|
|
0
|
die 'ERROR ECOCODE04, COMPILER, FIND DEPENDENCIES: Failed to find package file ', q{'}, $package_file_name, q{'}, |
353
|
|
|
|
|
|
|
' in @INC, included from file ', q{'}, $file_name, q{'}, ', dying', "\n"; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
=DISABLE_DYNAMIC_DEPS_ANALYSIS |
356
|
|
|
|
|
|
|
push @{$pmc_disable_paths}, $pmc_disable_path; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
=cut |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_dependencies(), have $package_file_name_included = ' . $package_file_name_included . "\n" ); |
361
|
|
|
|
|
|
|
|
362
|
0
|
|
|
|
|
0
|
my string $package_file_name_included_relative = post_processor__absolute_path_delete( $package_file_name_included ); |
363
|
0
|
|
|
|
|
0
|
$package_file_name_included_relative = post_processor__current_directory_path_delete( $package_file_name_included_relative ); |
364
|
0
|
|
|
|
|
0
|
push @{$dependencies}, $package_file_name_included_relative; |
|
0
|
|
|
|
|
0
|
|
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_dependencies(), have PRE-SUBDEPS $dependencies = ' . Dumper($dependencies) . "\n" ); |
367
|
|
|
|
|
|
|
|
368
|
0
|
0
|
|
|
|
0
|
if ($find_subdependencies_recurse) { |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
# recursively find subdependencies |
371
|
0
|
|
|
|
|
0
|
my string_arrayref $subdependencies = find_dependencies( $package_file_name_included, $find_subdependencies_recurse, $modes ); |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
# discard duplicate dependencies that now appear in subdependencies |
374
|
0
|
|
|
|
|
0
|
$dependencies = [ uniq @{$subdependencies}, @{$dependencies} ]; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_dependencies(), have POST-SUBDEPS $dependencies = ' . Dumper($dependencies) . "\n" ); |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
0
|
0
|
|
|
|
0
|
close $FILE_HANDLE |
382
|
|
|
|
|
|
|
or die 'ERROR ECOCODE05, COMPILER, FIND DEPENDENCIES: Cannot close file ' . q{'} |
383
|
|
|
|
|
|
|
. $file_name . q{'} |
384
|
|
|
|
|
|
|
. ' after reading, ' |
385
|
|
|
|
|
|
|
. $OS_ERROR |
386
|
|
|
|
|
|
|
. ', dying' . "\n"; |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=DISABLE_DYNAMIC_DEPS_ANALYSIS |
389
|
|
|
|
|
|
|
# re-enable all PMC files after finding dependencies |
390
|
|
|
|
|
|
|
while (scalar @{$pmc_disable_paths}) { |
391
|
|
|
|
|
|
|
pmc_reenable(pop @{$pmc_disable_paths}); |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
=cut |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::find_dependencies(), returning $dependencies = ' . Dumper($dependencies) . "\n" ); |
396
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_dependencies(), about to return, have $modes->{_enable_sse} = ' . Dumper($modes->{_enable_sse}) . "\n"); |
397
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_dependencies(), about to return, have $modes->{_enable_gmp} = ' . Dumper($modes->{_enable_gmp}) . "\n"); |
398
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_dependencies(), about to return, have $modes->{_enable_gsl} = ' . Dumper($modes->{_enable_gsl}) . "\n"); |
399
|
0
|
|
|
|
|
0
|
return $dependencies; |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
=DISABLE_DYNAMIC_DEPS_ANALYSIS |
403
|
|
|
|
|
|
|
# temporarily disable a package's PMC file, if it exists |
404
|
|
|
|
|
|
|
sub pmc_disable { |
405
|
|
|
|
|
|
|
{ my string $RETURN_TYPE }; |
406
|
|
|
|
|
|
|
( my string $package_name ) = @ARG; |
407
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::pmc_disable(), received $package_name = ' . $package_name . "\n" ); |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
my string $pmc_file_path_absolute; |
410
|
|
|
|
|
|
|
my string $pmc_file_path_absolute_disabled = q{}; |
411
|
|
|
|
|
|
|
my string $pmc_file_path_relative = $package_name; |
412
|
|
|
|
|
|
|
$pmc_file_path_relative =~ s/::/\//gxms; # replace double-colon :: scope delineator with forward-slash / directory delineator |
413
|
|
|
|
|
|
|
$pmc_file_path_relative .= '.pmc'; |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
foreach my string $INC_directory (@INC) { |
416
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::pmc_disable(), top of foreach loop, have $INC_directory = ' . $INC_directory . "\n" ); |
417
|
|
|
|
|
|
|
$pmc_file_path_absolute = $INC_directory . '/' . $pmc_file_path_relative; |
418
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::pmc_disable(), inside foreach loop, have $pmc_file_path_absolute = ' . $pmc_file_path_absolute . "\n" ); |
419
|
|
|
|
|
|
|
if (-e $pmc_file_path_absolute) { |
420
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::pmc_disable(), inside foreach loop, have EXISTING $pmc_file_path_absolute = ' . $pmc_file_path_absolute . "\n" ); |
421
|
|
|
|
|
|
|
$pmc_file_path_absolute_disabled = $pmc_file_path_absolute . '.PMC_DISABLED'; |
422
|
|
|
|
|
|
|
my boolean $move_success = move($pmc_file_path_absolute, $pmc_file_path_absolute_disabled); |
423
|
|
|
|
|
|
|
if (not $move_success) { |
424
|
|
|
|
|
|
|
die 'ERROR ECOCODE07, COMPILER, PMC DISABLE: Failed to temporarily disable package file ', q{'}, $pmc_file_path_absolute, q{'; }, |
425
|
|
|
|
|
|
|
$OS_ERROR, ', dying', "\n"; |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::pmc_disable(), DISABLED $pmc_file_path_absolute = ' . $pmc_file_path_absolute . "\n" ); |
428
|
|
|
|
|
|
|
last; |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
return $pmc_file_path_absolute_disabled; |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
# re-enable a package's temporarily-disabled PMC file, if it exists |
435
|
|
|
|
|
|
|
sub pmc_reenable { |
436
|
|
|
|
|
|
|
{ my boolean $RETURN_TYPE }; |
437
|
|
|
|
|
|
|
( my string $file_name ) = @ARG; |
438
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::pmc_reenable(), received $file_name = ' . $file_name . "\n" ); |
439
|
|
|
|
|
|
|
if ((defined $file_name) and ($file_name ne q{})) { |
440
|
|
|
|
|
|
|
if ((substr $file_name, -13, 13) ne '.PMC_DISABLED') { |
441
|
|
|
|
|
|
|
die 'ERROR ECOCODE08, COMPILER, PMC RE-ENABLE: Temporarily-disabled package file name ', q{'}, $file_name, q{'}, |
442
|
|
|
|
|
|
|
' does not with .PMC_DISABLED, dying', "\n"; |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
if (-e $file_name) { |
445
|
|
|
|
|
|
|
my string $file_name_original = $file_name; |
446
|
|
|
|
|
|
|
substr $file_name_original, -13, 13, q{}; # strip trailing .PMC_DISABLED |
447
|
|
|
|
|
|
|
my boolean $move_success = move($file_name, $file_name_original); |
448
|
|
|
|
|
|
|
if (not $move_success) { |
449
|
|
|
|
|
|
|
die 'ERROR ECOCODE09, COMPILER, PMC RE-ENABLE: Failed to re-enable temporarily-disabled package file ', q{'}, $file_name, q{'; }, |
450
|
|
|
|
|
|
|
$OS_ERROR, ', dying', "\n"; |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::pmc_disable(), RE-ENABLED $file_name = ' . $file_name . "\n" ); |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
else { |
455
|
|
|
|
|
|
|
die 'ERROR ECOCODE10, COMPILER, PMC RE-ENABLE: Failed to re-enable temporarily-disabled package file ', q{'}, $file_name, q{'; }, |
456
|
|
|
|
|
|
|
' file does not exist, dying', "\n"; |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
return 1; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
else { |
461
|
|
|
|
|
|
|
return 0; |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# call RPerl::eval_use() to perform a runtime use on a package, with dependencies-specific warning message |
466
|
|
|
|
|
|
|
sub eval_use_dependencies { |
467
|
|
|
|
|
|
|
{ my integer $RETURN_TYPE }; |
468
|
|
|
|
|
|
|
( my string $package_name ) = @ARG; |
469
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::eval_use(), received $package_name = ' . $package_name . "\n" ); |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
my integer $eval_retval = RPerl::eval_use($package_name, 0); |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::find_dependencies(), have POST-EVAL NON-DEP %INC = ' . Dumper(\%INC) . "\n"); |
474
|
|
|
|
|
|
|
# warn instead of dying on eval error here and below, in order to preserve proper parser errors instead of weird eval errors |
475
|
|
|
|
|
|
|
# in RPerl/Test/*/*Bad*.pm and RPerl/Test/*/*bad*.pl |
476
|
|
|
|
|
|
|
if ( ( not defined $eval_retval ) or ( $EVAL_ERROR ne q{} ) ) { |
477
|
|
|
|
|
|
|
RPerl::warning( 'WARNING WCOCODE00, COMPILER, FIND DEPENDENCIES: Failed to eval-use package ' . q{'} |
478
|
|
|
|
|
|
|
. $package_name . q{'} . ', fatal error trapped and delayed' . "\n" ); |
479
|
|
|
|
|
|
|
RPerl::diag( ' Trapped the following error message...' . "\n\n" . $EVAL_ERROR . "\n" ); |
480
|
|
|
|
|
|
|
RPerl::warning("\n"); |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::pmc_disable(), EVAL USED $package_name = ' . $package_name . "\n" ); |
483
|
|
|
|
|
|
|
return $eval_retval; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
=cut |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
# [[[ COMPILE RPERL TO RPERL, TEST MODE ]]] |
488
|
|
|
|
|
|
|
# [[[ COMPILE RPERL TO RPERL, TEST MODE ]]] |
489
|
|
|
|
|
|
|
# [[[ COMPILE RPERL TO RPERL, TEST MODE ]]] |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
sub rperl_to_rperl__parse_generate { |
492
|
0
|
|
|
0
|
|
0
|
{ my string_hashref $RETURN_TYPE }; |
|
0
|
|
|
|
|
0
|
|
493
|
0
|
|
|
|
|
0
|
( my string $rperl_input_file_name, my string_hashref $rperl_output_file_name_group, my string_hashref $rperl_source_group, my string_hashref $modes ) = @ARG; |
494
|
0
|
|
|
|
|
0
|
my object $rperl_ast; |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler->rperl_to_rperl__parse_generate(), received $rperl_input_file_name = ' . $rperl_input_file_name . "\n" ); |
497
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler->rperl_to_rperl__parse_generate(), received $rperl_output_file_name_group = ' . "\n" . Dumper($rperl_output_file_name_group) . "\n" ); |
498
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler->rperl_to_rperl__parse_generate(), received $rperl_source_group = ' . "\n" . Dumper($rperl_source_group) . "\n" ); |
499
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler->rperl_to_rperl__parse_generate(), received $modes = ' . "\n" . Dumper($modes) . "\n" ); |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
# [[[ PARSE RPERL TO AST ]]] |
502
|
|
|
|
|
|
|
|
503
|
0
|
0
|
0
|
|
|
0
|
if ( ( $modes->{compile} eq 'PARSE' ) |
|
|
|
0
|
|
|
|
|
504
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'GENERATE' ) |
505
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SAVE' ) ) |
506
|
|
|
|
|
|
|
{ |
507
|
0
|
|
|
|
|
0
|
$rperl_ast = RPerl::Parser::rperl_to_ast__parse($rperl_input_file_name); |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
# [[[ GENERATE AST TO RPERL ]]] |
511
|
|
|
|
|
|
|
|
512
|
0
|
0
|
0
|
|
|
0
|
if ( ( $modes->{compile} eq 'GENERATE' ) |
513
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SAVE' ) ) |
514
|
|
|
|
|
|
|
{ |
515
|
0
|
|
|
|
|
0
|
$rperl_source_group = RPerl::Generator::ast_to_rperl__generate( $rperl_ast, $modes ); |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
# [[[ SAVE RPERL TO DISK ]]] |
519
|
|
|
|
|
|
|
|
520
|
0
|
0
|
0
|
|
|
0
|
if ( ( $modes->{compile} eq 'SAVE' ) |
521
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SAVE_DEFERRED' ) ) |
522
|
|
|
|
|
|
|
{ |
523
|
0
|
|
|
|
|
0
|
save_source_files( $rperl_source_group, $rperl_output_file_name_group, $modes ); |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
# always return $rperl_source_group to maintain consistent return type, |
527
|
|
|
|
|
|
|
# only utilized for GENERATE compile mode during dependencies |
528
|
0
|
|
|
|
|
0
|
return $rperl_source_group; |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
# [[[ COMPILE RPERL TO XS & BINARY ]]] |
532
|
|
|
|
|
|
|
# [[[ COMPILE RPERL TO XS & BINARY ]]] |
533
|
|
|
|
|
|
|
# [[[ COMPILE RPERL TO XS & BINARY ]]] |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
sub rperl_to_xsbinary__parse_generate_compile { |
536
|
1518
|
|
|
1518
|
|
4260
|
{ my string_hashref $RETURN_TYPE }; |
|
1518
|
|
|
|
|
3123
|
|
537
|
1518
|
|
|
|
|
5008
|
( my string $rperl_input_file_name, my string_hashref $cpp_output_file_name_group, my string_hashref $cpp_source_group, my string_hashref $modes ) = @ARG; |
538
|
1518
|
|
|
|
|
4290
|
my object $rperl_ast; |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler->rperl_to_xsbinary__parse_generate_compile(), received $modes->{_symbol_table} = ' . "\n" . Dumper($modes->{_symbol_table}) . "\n" ); |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
# [[[ PARSE RPERL TO AST ]]] |
543
|
|
|
|
|
|
|
|
544
|
1518
|
0
|
33
|
|
|
8586
|
if ( ( $modes->{compile} eq 'PARSE' ) |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
545
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'GENERATE' ) |
546
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SAVE' ) |
547
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SUBCOMPILE' ) ) |
548
|
|
|
|
|
|
|
{ |
549
|
1518
|
|
|
|
|
34934
|
$rperl_ast = RPerl::Parser::rperl_to_ast__parse($rperl_input_file_name); |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
# [[[ GENERATE AST TO C++ ]]] |
553
|
|
|
|
|
|
|
|
554
|
622
|
50
|
33
|
|
|
9276
|
if ( ( $modes->{compile} eq 'GENERATE' ) |
|
|
|
33
|
|
|
|
|
555
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SAVE' ) |
556
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SUBCOMPILE' ) ) |
557
|
|
|
|
|
|
|
{ |
558
|
0
|
|
|
|
|
0
|
$cpp_source_group = RPerl::Generator::ast_to_cpp__generate( $rperl_ast, $modes ); |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
# [[[ SAVE C++ TO DISK ]]] |
562
|
|
|
|
|
|
|
|
563
|
622
|
50
|
33
|
|
|
6760
|
if ( ( $modes->{compile} eq 'SAVE' ) |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
564
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SAVE_DEFERRED' ) |
565
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SUBCOMPILE' ) |
566
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SUBCOMPILE_DEFERRED' ) ) |
567
|
|
|
|
|
|
|
{ |
568
|
0
|
|
|
|
|
0
|
save_source_files( $cpp_source_group, $cpp_output_file_name_group, $modes ); |
569
|
|
|
|
|
|
|
} |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
# [[[ AUTO-PARALLELIZE C++ VIA PLUTO & OPENMP ]]] |
572
|
|
|
|
|
|
|
|
573
|
622
|
50
|
|
|
|
2971
|
if ( $modes->{parallel} eq 'OPENMP' ) { |
574
|
0
|
|
|
|
|
0
|
cpp_to_openmp_cpp( $cpp_output_file_name_group, $modes ); |
575
|
|
|
|
|
|
|
} |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
# [[[ SUBCOMPILE C++ TO XS & BINARY ]]] |
578
|
|
|
|
|
|
|
|
579
|
622
|
50
|
33
|
|
|
3786
|
if ( ( $modes->{compile} eq 'SUBCOMPILE' ) |
580
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SUBCOMPILE_DEFERRED' ) ) |
581
|
|
|
|
|
|
|
{ |
582
|
0
|
|
|
|
|
0
|
cpp_to_xsbinary__subcompile( $cpp_output_file_name_group, $modes ); |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
# always return $cpp_source_group to maintain consistent return type, |
586
|
|
|
|
|
|
|
# only utilized for GENERATE compile mode during dependencies |
587
|
622
|
|
|
|
|
42426
|
return $cpp_source_group; |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
# generate output file name group(s) based on input file name(s) |
591
|
|
|
|
|
|
|
sub generate_output_file_names { |
592
|
1330
|
|
|
1330
|
|
2236
|
{ my hashref_arrayref $RETURN_TYPE }; |
|
1330
|
|
|
|
|
2127
|
|
593
|
1330
|
|
|
|
|
4146
|
( my string_arrayref $input_file_names, my string_arrayref $output_file_name_prefixes, my integer $input_files_count, my string_hashref $modes ) = @ARG; |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::generate_output_file_names(), received $input_file_names = ' . "\n" . Dumper($input_file_names) . "\n"); |
596
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::generate_output_file_names(), received $output_file_name_prefixes = ' . "\n" . Dumper($output_file_name_prefixes) . "\n"); |
597
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::generate_output_file_names(), received $input_files_count = ' . $input_files_count . "\n"); |
598
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::generate_output_file_names(), received $modes = ' . "\n" . Dumper($modes) . "\n" ); |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
# NEED FIX: add string_hashref_arrayref type |
601
|
|
|
|
|
|
|
# my string_hashref_arrayref $output_file_name_groups = []; |
602
|
1330
|
|
|
|
|
2419
|
my hashref_arrayref $output_file_name_groups = []; |
603
|
1330
|
|
|
|
|
4867
|
my string $input_file_name; |
604
|
|
|
|
|
|
|
my string $input_file_name_path; |
605
|
1330
|
|
|
|
|
0
|
my string $input_file_name_prefix; |
606
|
1330
|
|
|
|
|
0
|
my string $input_file_name_suffix; |
607
|
|
|
|
|
|
|
|
608
|
1330
|
|
|
|
|
4867
|
for my $i ( 0 .. ( $input_files_count - 1 ) ) { |
609
|
1330
|
|
|
|
|
2766
|
$input_file_name = $input_file_names->[$i]; |
610
|
|
|
|
|
|
|
|
611
|
1330
|
|
|
|
|
3651
|
$output_file_name_groups->[$i] = {}; |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
# if output file prefix(es) provided, then use to generate output file name(s) |
614
|
1330
|
50
|
|
|
|
4124
|
if ( defined $output_file_name_prefixes->[$i] ) { |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
# explicitly provided option should already be only prefix, but fileparse() to make sure |
617
|
0
|
|
|
|
|
0
|
( $input_file_name_prefix, $input_file_name_path, $input_file_name_suffix ) = fileparse( $output_file_name_prefixes->[$i], qr/[.][^.]*/xms ); |
618
|
0
|
0
|
|
|
|
0
|
if ( $input_file_name_prefix eq q{} ) { |
619
|
0
|
|
|
|
|
0
|
die "ERROR EAR17: Invalid RPerl source code output file command-line argument specified, dying\n"; |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
} |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
# if output file prefix(es) not provided, then generate output file name(s) from input file name(s) |
624
|
|
|
|
|
|
|
else { |
625
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::generate_output_file_names(), have $input_file_name = ' . $input_file_name . "\n"); |
626
|
|
|
|
|
|
|
# should not already be only prefix, fileparse() to isolate prefix |
627
|
1330
|
|
|
|
|
53880
|
( $input_file_name_prefix, $input_file_name_path, $input_file_name_suffix ) = fileparse( $input_file_name, qr/[.][^.]*/xms ); |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
|
630
|
1330
|
|
|
|
|
6654
|
my string $output_file_name_path_prefix = $input_file_name_path . $input_file_name_prefix; |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
# *.pl input files may generate *.o, *.a, *.so, *.exe, and/or non-suffix output files |
633
|
1330
|
100
|
|
|
|
5901
|
if ( $input_file_name =~ /[.]pl$/xms ) { |
634
|
964
|
50
|
33
|
|
|
9632
|
if ( $modes->{subcompile} eq 'ASSEMBLE' ) { |
|
|
50
|
0
|
|
|
|
|
|
|
50
|
0
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
# NEED ANSWER: does Micro$oft Windows use *.lib file extension (suffix) for both *.o and *.a assembled object files? |
637
|
|
|
|
|
|
|
# but does that only apply when using the M$ VC++ compiler? so does it apply here? |
638
|
|
|
|
|
|
|
# apply answer to ARCHIVE mode elsif block immediately below; and also for ASSEMBLE & ARCHIVE blocks in *.pm else block below that; |
639
|
|
|
|
|
|
|
# ask similar question for *.so in *NIX vs *.dll in M$, apply to .so elsif blocks below and $filename_suffixes_supported in script/rperl |
640
|
|
|
|
|
|
|
# if ( $OSNAME eq 'MSWin32' ) { |
641
|
|
|
|
|
|
|
# $output_file_name_groups->[$i]->{LIB} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_BINARY}->{O}->[1]; |
642
|
|
|
|
|
|
|
# } |
643
|
|
|
|
|
|
|
# *NIX uses *.o file extension (suffix) for assembled object files |
644
|
|
|
|
|
|
|
# else { |
645
|
0
|
|
|
|
|
0
|
$output_file_name_groups->[$i]->{O} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_BINARY}->{O}->[0]; |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
# } |
648
|
|
|
|
|
|
|
} |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
elsif ( $modes->{subcompile} eq 'ARCHIVE' ) { |
651
|
0
|
|
|
|
|
0
|
$output_file_name_groups->[$i]->{O} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_BINARY}->{O}->[0]; |
652
|
0
|
|
|
|
|
0
|
$output_file_name_groups->[$i]->{_O_label} = ' (temporary)'; |
653
|
0
|
|
|
|
|
0
|
$output_file_name_groups->[$i]->{A} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_BINARY}->{A}->[0]; |
654
|
|
|
|
|
|
|
} |
655
|
|
|
|
|
|
|
elsif ( $modes->{subcompile} eq 'SHARED' ) { |
656
|
0
|
|
|
|
|
0
|
$output_file_name_groups->[$i]->{SO} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_BINARY}->{SO}->[0]; |
657
|
|
|
|
|
|
|
} |
658
|
|
|
|
|
|
|
elsif ( |
659
|
|
|
|
|
|
|
( $modes->{subcompile} eq 'STATIC' ) |
660
|
|
|
|
|
|
|
or ( $modes->{subcompile} eq 'DYNAMIC' ) |
661
|
|
|
|
|
|
|
or (( $modes->{subcompile} eq 'OFF' ) |
662
|
|
|
|
|
|
|
and ( ( $modes->{compile} eq 'PARSE' ) |
663
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'GENERATE' ) |
664
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SAVE' ) |
665
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SUBCOMPILE' ) ) |
666
|
|
|
|
|
|
|
) |
667
|
|
|
|
|
|
|
) |
668
|
|
|
|
|
|
|
{ |
669
|
|
|
|
|
|
|
# Micro$oft Windows uses *.exe file extension (suffix) for compiled executables |
670
|
964
|
50
|
|
|
|
2839
|
if ( $OSNAME eq 'MSWin32' ) { |
671
|
0
|
0
|
|
|
|
0
|
if ( $modes->{parallel} eq 'OFF' ) { |
|
|
0
|
|
|
|
|
|
672
|
0
|
|
|
|
|
0
|
$output_file_name_groups->[$i]->{EXE} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_BINARY}->{EXE}->[1]; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
elsif ( $modes->{parallel} eq 'OPENMP' ) { |
675
|
|
|
|
|
|
|
$output_file_name_groups->[$i]->{OPENMP_EXE} |
676
|
0
|
|
|
|
|
0
|
= $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_BINARY}->{OPENMP_EXE}->[1]; |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
} |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
# traditionally, *NIX has no file extension (suffix) for compiled executables, non-suffix |
681
|
|
|
|
|
|
|
else { |
682
|
964
|
50
|
|
|
|
2561
|
if ( $modes->{parallel} eq 'OFF' ) { |
|
|
0
|
|
|
|
|
|
683
|
964
|
|
|
|
|
5396
|
$output_file_name_groups->[$i]->{EXE} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_BINARY}->{EXE}->[0]; |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
elsif ( $modes->{parallel} eq 'OPENMP' ) { |
686
|
|
|
|
|
|
|
$output_file_name_groups->[$i]->{OPENMP_EXE} |
687
|
0
|
|
|
|
|
0
|
= $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_BINARY}->{OPENMP_EXE}->[0]; |
688
|
|
|
|
|
|
|
} |
689
|
|
|
|
|
|
|
} |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
# NEED ANSWER: allow this subroutine to be called even when we return empty results? |
693
|
|
|
|
|
|
|
else { |
694
|
|
|
|
|
|
|
die "ERROR EAR18: Invalid compile mode '" |
695
|
|
|
|
|
|
|
. $modes->{compile} |
696
|
|
|
|
|
|
|
. "' and/or subcompile mode '" |
697
|
|
|
|
|
|
|
. $modes->{subcompile} |
698
|
0
|
|
|
|
|
0
|
. "' command-line arguments specified, dying\n"; |
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
} |
701
|
|
|
|
|
|
|
else { # *.pm input files may generate *.o, *.a, *.so, and/or *.pmc output files |
702
|
366
|
50
|
0
|
|
|
3815
|
if ( $modes->{subcompile} eq 'ASSEMBLE' ) { |
|
|
50
|
0
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
703
|
0
|
|
|
|
|
0
|
$output_file_name_groups->[$i]->{O} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_BINARY}->{O}->[0]; |
704
|
|
|
|
|
|
|
} |
705
|
|
|
|
|
|
|
elsif ( $modes->{subcompile} eq 'ARCHIVE' ) { |
706
|
0
|
|
|
|
|
0
|
$output_file_name_groups->[$i]->{O} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_BINARY}->{O}->[0]; |
707
|
0
|
|
|
|
|
0
|
$output_file_name_groups->[$i]->{_O_label} = ' (temporary)'; |
708
|
0
|
|
|
|
|
0
|
$output_file_name_groups->[$i]->{A} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_BINARY}->{A}->[0]; |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
elsif ( $modes->{subcompile} eq 'SHARED' ) { |
711
|
0
|
|
|
|
|
0
|
$output_file_name_groups->[$i]->{SO} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_BINARY}->{SO}->[0]; |
712
|
|
|
|
|
|
|
} |
713
|
|
|
|
|
|
|
elsif ( $modes->{subcompile} eq 'STATIC' ) { |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
# DEV NOTE: correlates to errors EAR* in script/rperl |
716
|
0
|
|
|
|
|
0
|
die 'ERROR EAR15: Incompatible command-line arguments provided, both --static subcompile mode flag and *.pm Perl module input file, dying' |
717
|
|
|
|
|
|
|
. "\n"; |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
elsif ( |
720
|
|
|
|
|
|
|
( $modes->{subcompile} eq 'DYNAMIC' ) |
721
|
|
|
|
|
|
|
or (( $modes->{subcompile} eq 'OFF' ) |
722
|
|
|
|
|
|
|
and ( ( $modes->{compile} eq 'PARSE' ) |
723
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'GENERATE' ) |
724
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SAVE' ) |
725
|
|
|
|
|
|
|
or ( $modes->{compile} eq 'SUBCOMPILE' ) ) |
726
|
|
|
|
|
|
|
) |
727
|
|
|
|
|
|
|
) |
728
|
|
|
|
|
|
|
{ |
729
|
366
|
|
|
|
|
2672
|
$output_file_name_groups->[$i]->{PMC} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_SOURCE}->{PMC}->[0]; |
730
|
|
|
|
|
|
|
} |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
# NEED ANSWER: allow this subroutine to be called even when we return empty results? |
733
|
|
|
|
|
|
|
else { |
734
|
|
|
|
|
|
|
die "ERROR EAR18: Invalid compile mode '" |
735
|
|
|
|
|
|
|
. $modes->{compile} |
736
|
|
|
|
|
|
|
. "' and/or subcompile mode '" |
737
|
|
|
|
|
|
|
. $modes->{subcompile} |
738
|
0
|
|
|
|
|
0
|
. "' command-line arguments specified, dying\n"; |
739
|
|
|
|
|
|
|
} |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
# all CPP ops modes require CPP output files; H output files may optionally be generated as needed |
743
|
1330
|
100
|
|
|
|
4965
|
if ( $modes->{ops} eq 'CPP' ) { |
744
|
665
|
|
|
|
|
1676
|
$output_file_name_groups->[$i]->{CPP} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_SOURCE}->{CPP}->[0]; |
745
|
665
|
|
|
|
|
1495
|
$output_file_name_groups->[$i]->{H} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_SOURCE}->{H}->[0]; |
746
|
665
|
|
|
|
|
1048
|
$output_file_name_groups->[$i]->{_H_label} = ' (if needed)'; |
747
|
665
|
50
|
|
|
|
1826
|
if ( $modes->{parallel} eq 'OPENMP' ) { |
748
|
0
|
|
|
|
|
0
|
$output_file_name_groups->[$i]->{OPENMP_CPP} = $output_file_name_path_prefix . $filename_suffixes_supported->{OUTPUT_SOURCE}->{OPENMP_CPP}->[0]; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::generate_output_file_names(), bottom of loop ' . $i . ' of ' . ($input_files_count - 1) . ", have \$output_file_name_groups->[$i] = \n" . Dumper( $output_file_name_groups->[$i] ) . "\n"); |
753
|
|
|
|
|
|
|
} |
754
|
1330
|
|
|
|
|
4777
|
return $output_file_name_groups; |
755
|
|
|
|
|
|
|
} |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
# Write Source Code Files To File System |
758
|
|
|
|
|
|
|
sub save_source_files { |
759
|
0
|
|
|
0
|
|
0
|
{ my void $RETURN_TYPE }; |
|
0
|
|
|
|
|
0
|
|
760
|
0
|
|
|
|
|
0
|
( my string_hashref $source_group, my string_hashref $file_name_group, my string_hashref $modes ) = @ARG; |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::save_source_files(), received $source_group =} . "\n" . Dumper($source_group) . "\n" ); |
763
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::save_source_files(), received $file_name_group =} . "\n" . Dumper($file_name_group) . "\n" ); |
764
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), received $modes =' . "\n" . Dumper($modes) . "\n" ); |
765
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), received $modes->{_symbol_table} =' . "\n" . Dumper($modes->{_symbol_table}) . "\n" ); |
766
|
|
|
|
|
|
|
# RPerl::diag( "\n" . 'in Compiler::save_source_files(), received $modes->{subcompile} =' . "\n" . Dumper($modes->{subcompile}) . "\n" ); |
767
|
|
|
|
|
|
|
|
768
|
0
|
|
|
|
|
0
|
foreach my string $suffix_key ( sort keys %{$source_group} ) { |
|
0
|
|
|
|
|
0
|
|
769
|
0
|
0
|
|
|
|
0
|
if ( ( substr $suffix_key, 0, 1 ) eq '_' ) { next; } |
|
0
|
|
|
|
|
0
|
|
770
|
0
|
0
|
0
|
|
|
0
|
if ( ( not exists $file_name_group->{$suffix_key} ) |
|
|
|
0
|
|
|
|
|
771
|
|
|
|
|
|
|
or ( not defined $file_name_group->{$suffix_key} ) |
772
|
|
|
|
|
|
|
or ( $file_name_group->{$suffix_key} eq q{} ) ) |
773
|
|
|
|
|
|
|
{ |
774
|
0
|
|
|
|
|
0
|
croak("\nERROR ECOCOFI00, COMPILER, SAVE OUTPUT FILES: Expecting file name for suffix '$suffix_key', but received empty or no value, croaking"); |
775
|
|
|
|
|
|
|
} |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
# CPPOPS POST-PROCESSING: set H paths in CPP files & finally create PMC file, as needed |
779
|
0
|
0
|
|
|
|
0
|
if ( $modes->{ops} eq 'CPP' ) { |
780
|
0
|
|
|
|
|
0
|
RPerl::verbose('SAVE PHASE 0: Final file modifications... '); |
781
|
|
|
|
|
|
|
|
782
|
0
|
|
|
|
|
0
|
$source_group->{CPP} = post_processor_cpp__header_unneeded( $source_group ); |
783
|
0
|
|
|
|
|
0
|
$source_group->{CPP} = post_processor_cpp__header_or_cpp_path( $source_group->{CPP}, $file_name_group->{H} ); |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
# MODULE POST-PROCESSING |
786
|
0
|
0
|
|
|
|
0
|
if ( $modes->{_input_file_name} =~ /[.]pm$/xms ) { |
787
|
0
|
|
|
|
|
0
|
$source_group = post_processor_cpp__types_change( $source_group, $modes ); |
788
|
0
|
|
|
|
|
0
|
post_processor_cpp__pmc_generate( $source_group, $file_name_group, $modes ); |
789
|
|
|
|
|
|
|
} |
790
|
0
|
|
|
|
|
0
|
RPerl::verbose( ' done.' . "\n" ); |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
|
793
|
0
|
|
|
|
|
0
|
RPerl::verbose('SAVE PHASE 1: Format & write files to disk...'); |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), have [sort keys %{$source_group}] = ' . Dumper([sort keys %{$source_group}]) . "\n" ); |
796
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), have $source_group->{H} = ' . Dumper($source_group->{H}) . "\n" ); |
797
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), have $source_group = ' . Dumper($source_group) . "\n" ); |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
# foreach my string $suffix_key ( sort keys %{$file_name_group} ) { ## no critic qw(ProhibitPostfixControls) # SYSTEM SPECIAL 6: PERL CRITIC FILED ISSUE #639, not postfix foreach or if |
800
|
0
|
|
|
|
|
0
|
foreach my string $suffix_key ( sort keys %{$source_group} ) { ## no critic qw(ProhibitPostfixControls) # SYSTEM SPECIAL 6: PERL CRITIC FILED ISSUE #639, not postfix foreach or if |
|
0
|
|
|
|
|
0
|
|
801
|
0
|
0
|
|
|
|
0
|
if ( ( substr $suffix_key, 0, 1 ) eq '_' ) { next; } |
|
0
|
|
|
|
|
0
|
|
802
|
0
|
0
|
0
|
|
|
0
|
if ( ( not exists $source_group->{$suffix_key} ) |
|
|
|
0
|
|
|
|
|
803
|
|
|
|
|
|
|
or ( not defined $source_group->{$suffix_key} ) |
804
|
|
|
|
|
|
|
or ( $source_group->{$suffix_key} eq q{} ) ) |
805
|
|
|
|
|
|
|
{ |
806
|
0
|
|
|
|
|
0
|
croak("\nERROR ECOCOFI05, COMPILER, SAVE OUTPUT FILES: Expecting source code for suffix '$suffix_key', but received empty or no value, croaking"); |
807
|
|
|
|
|
|
|
} |
808
|
0
|
|
|
|
|
0
|
my filehandleref $SOURCE_FILE_HANDLE; |
809
|
0
|
|
|
|
|
0
|
my string $file_name = $file_name_group->{$suffix_key}; |
810
|
0
|
|
|
|
|
0
|
my string $source = $source_group->{$suffix_key}; |
811
|
|
|
|
|
|
|
|
812
|
0
|
0
|
|
|
|
0
|
if ( $file_name eq '_TEMPFILE' ) { |
813
|
0
|
|
|
|
|
0
|
( $SOURCE_FILE_HANDLE, $file_name ) |
814
|
|
|
|
|
|
|
= tempfile( 'tempfileXXXX', SUFFIX => ( lc $suffix_key ), UNLINK => 1, TMPDIR => 1 ); |
815
|
|
|
|
|
|
|
|
816
|
0
|
0
|
|
|
|
0
|
print {$SOURCE_FILE_HANDLE} $source |
|
0
|
|
|
|
|
0
|
|
817
|
|
|
|
|
|
|
or croak("\nERROR ECOCOFI06, COMPILER, FILE SYSTEM: Attempting to save new file '$file_name', cannot write to file,\ncroaking: $OS_ERROR"); |
818
|
|
|
|
|
|
|
|
819
|
0
|
0
|
|
|
|
0
|
close $SOURCE_FILE_HANDLE |
820
|
|
|
|
|
|
|
or croak("\nERROR ECOCOFI09, COMPILER, FILE SYSTEM: Attempting to save new file '$file_name', cannot close file,\ncroaking: $OS_ERROR"); |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
else { |
823
|
|
|
|
|
|
|
# overwrite existing file |
824
|
0
|
0
|
|
|
|
0
|
if ( -f $file_name ) { |
825
|
0
|
0
|
|
|
|
0
|
unlink $file_name |
826
|
|
|
|
|
|
|
or croak( |
827
|
|
|
|
|
|
|
"\nERROR ECOCOFI07, COMPILER, FILE SYSTEM: Attempting to save new file '$file_name', cannot delete existing file,\ncroaking: $OS_ERROR"); |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
|
830
|
0
|
0
|
|
|
|
0
|
open $SOURCE_FILE_HANDLE, '>', $file_name |
831
|
|
|
|
|
|
|
or |
832
|
|
|
|
|
|
|
croak("\nERROR ECOCOFI08, COMPILER, FILE SYSTEM: Attempting to save new file '$file_name', cannot open file for writing,\ncroaking: $OS_ERROR"); |
833
|
|
|
|
|
|
|
|
834
|
0
|
0
|
|
|
|
0
|
print {$SOURCE_FILE_HANDLE} $source |
|
0
|
|
|
|
|
0
|
|
835
|
|
|
|
|
|
|
or croak("\nERROR ECOCOFI06, COMPILER, FILE SYSTEM: Attempting to save new file '$file_name', cannot write to file,\ncroaking: $OS_ERROR"); |
836
|
|
|
|
|
|
|
|
837
|
0
|
0
|
|
|
|
0
|
close $SOURCE_FILE_HANDLE |
838
|
|
|
|
|
|
|
or croak("\nERROR ECOCOFI09, COMPILER, FILE SYSTEM: Attempting to save new file '$file_name', cannot close file,\ncroaking: $OS_ERROR"); |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
# format output code |
842
|
0
|
0
|
0
|
|
|
0
|
if ( ( $suffix_key eq 'PMC' ) or ( $suffix_key eq 'EXE' ) ) { |
|
|
0
|
0
|
|
|
|
|
843
|
0
|
|
|
|
|
0
|
my string $perltidy_path = undef; |
844
|
0
|
|
|
|
|
0
|
$perltidy_path = can_run('perltidy'); # DEV NOTE: comment this line to disable perltidy |
845
|
0
|
0
|
|
|
|
0
|
if ( defined $perltidy_path ) { |
846
|
|
|
|
|
|
|
# system $perltidy_path, '-pbp', '--ignore-side-comment-lengths', '--converge', '-l=160', '-b', '-nst', q{-bext='/'}, '-q', $file_name; |
847
|
0
|
|
|
|
|
0
|
system $perltidy_path, '-pbp', '--ignore-side-comment-lengths', '--converge', '-l=' . RPerl::Generator::PERLTIDY_LINE_WIDTH(), '-b', '-nst', q{-bext='/'}, '-q', $file_name; |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
else { |
850
|
0
|
|
|
|
|
0
|
RPerl::warning( |
851
|
|
|
|
|
|
|
"\n" . 'WARNING WCOCOFO00, COMPILER, PERL CODE FORMATTING: Perltidy command `perltidy` not found, abandoning formatting' . "\n" ); |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
} |
854
|
|
|
|
|
|
|
elsif ( ( $suffix_key eq 'H' ) or ( $suffix_key eq 'CPP' ) ) { |
855
|
0
|
|
|
|
|
0
|
my string $astyle_path = can_run('astyle'); |
856
|
0
|
0
|
|
|
|
0
|
if ( defined $astyle_path ) { |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
# system $astyle_path, '-q', $file_name; |
859
|
|
|
|
|
|
|
# don't insert extra newlines, which causes accessors, mutators, and ops_types reporting subroutines to be broken into multiple lines |
860
|
0
|
|
|
|
|
0
|
system $astyle_path, '-q', '--keep-one-line-blocks', '--keep-one-line-statements', $file_name; |
861
|
0
|
0
|
|
|
|
0
|
if ( -f $file_name . '.orig' ) { |
862
|
0
|
0
|
|
|
|
0
|
unlink( $file_name . '.orig' ) |
863
|
|
|
|
|
|
|
or croak( "\n" |
864
|
|
|
|
|
|
|
. 'ERROR ECOCOFI10, COMPILER, FILE SYSTEM: Cannot delete Artistic Style original file ' . q{'} |
865
|
|
|
|
|
|
|
. $file_name . '.orig' . q{'} . ',' . "\n" |
866
|
|
|
|
|
|
|
. 'croaking:' |
867
|
|
|
|
|
|
|
. $OS_ERROR ); |
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
} |
870
|
|
|
|
|
|
|
else { |
871
|
0
|
|
|
|
|
0
|
RPerl::warning( 'WARNING WCOCOFO01, COMPILER, C++ CODE FORMATTING: Artistic Style command `astyle` not found, abandoning formatting' . "\n" ); |
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
} |
874
|
|
|
|
|
|
|
} |
875
|
|
|
|
|
|
|
|
876
|
0
|
|
|
|
|
0
|
RPerl::verbose( ' done.' . "\n" ); |
877
|
0
|
|
|
|
|
0
|
return; |
878
|
|
|
|
|
|
|
} |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
# remove unneeded __NEED_HEADER_PATH line |
881
|
|
|
|
|
|
|
sub post_processor_cpp__header_unneeded { |
882
|
16
|
|
|
16
|
|
38
|
{ my string $RETURN_TYPE }; |
|
16
|
|
|
|
|
36
|
|
883
|
16
|
|
|
|
|
81
|
( my string $source_group ) = @ARG; |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
# DEV NOTE, CORRELATION #rp033: defer setting header include path until files are saved in Compiler |
886
|
16
|
50
|
33
|
|
|
95
|
if ((not exists $source_group->{H}) or (not defined $source_group->{H})) { |
887
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::post_processor_cpp__header_unneeded(), removing unneeded __NEED_HEADER_PATH line' . "\n" ); |
888
|
16
|
|
|
|
|
42
|
my string $source_group_CPP_no_header = q{}; |
889
|
16
|
|
|
|
|
173
|
foreach my string $source_group_CPP_line (split /\n/, $source_group->{CPP}) { |
890
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::post_processor_cpp__header_unneeded(), have $source_group_CPP_line = ' . "\n" . $source_group_CPP_line . "\n" ); |
891
|
300
|
100
|
|
|
|
519
|
if ($source_group_CPP_line =~ m/__NEED_HEADER_PATH/) { next; } |
|
16
|
|
|
|
|
39
|
|
892
|
284
|
|
|
|
|
434
|
$source_group_CPP_no_header .= $source_group_CPP_line . "\n"; |
893
|
|
|
|
|
|
|
} |
894
|
16
|
|
|
|
|
109
|
return $source_group_CPP_no_header; |
895
|
|
|
|
|
|
|
} |
896
|
|
|
|
|
|
|
else { |
897
|
0
|
|
|
|
|
0
|
return $source_group->{CPP}; |
898
|
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
} |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
# replace __NEED_HEADER_PATH or __NEED_CPP_PATH with proper C++ header path |
902
|
|
|
|
|
|
|
sub post_processor_cpp__header_or_cpp_path { |
903
|
48
|
|
|
48
|
|
179
|
{ my string $RETURN_TYPE }; |
|
48
|
|
|
|
|
117
|
|
904
|
48
|
|
|
|
|
270
|
( my string $source_CPP, my string $file_path ) = @ARG; |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
# remove leading '.\' or './' if present |
907
|
48
|
50
|
|
|
|
416
|
if ( $OSNAME eq 'MSWin32' ) { |
908
|
0
|
0
|
|
|
|
0
|
if ( ( substr $file_path, 0, 2 ) eq q{.\\} ) { |
909
|
0
|
|
|
|
|
0
|
substr $file_path, 0, 2, q{}; |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
else { |
913
|
48
|
50
|
|
|
|
305
|
if ( ( substr $file_path, 0, 2 ) eq './' ) { |
914
|
0
|
|
|
|
|
0
|
substr $file_path, 0, 2, q{}; |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
} |
917
|
|
|
|
|
|
|
|
918
|
48
|
|
|
|
|
1171
|
$file_path = post_processor_cpp__lib_path_delete($file_path); |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
# DEV NOTE, CORRELATION #rp033: deferred, finally set path to H module header file in CPP module file |
921
|
48
|
|
|
|
|
195
|
$source_CPP =~ s/__NEED_HEADER_PATH/$file_path/gxms; |
922
|
48
|
|
|
|
|
252
|
$source_CPP =~ s/__NEED_CPP_PATH/$file_path/gxms; |
923
|
48
|
|
|
|
|
205
|
return $source_CPP; |
924
|
|
|
|
|
|
|
} |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
# remove leading library path if present, because it should already be enabled in RPerl/Inline.pm via -Ifoo subcompiler argument |
927
|
|
|
|
|
|
|
sub post_processor_cpp__lib_path_delete { |
928
|
48
|
|
|
48
|
|
130
|
{ my string $RETURN_TYPE }; |
|
48
|
|
|
|
|
115
|
|
929
|
48
|
|
|
|
|
147
|
( my string $path ) = @ARG; |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
# DEV NOTE: sometimes MS Windows OS has forward slashes in the 'blib/lib/' part of the path, so we do not differentiate by OS |
932
|
48
|
50
|
|
|
|
1010
|
if ( ( substr $path, 0, 4 ) eq 'lib\\' ) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
933
|
0
|
|
|
|
|
0
|
substr $path, 0, 4, q{}; |
934
|
|
|
|
|
|
|
} |
935
|
|
|
|
|
|
|
# elsif ( ( substr $path, 0, 5 ) eq '\\lib\\' ) { # NEED ANSWER: same question as below |
936
|
|
|
|
|
|
|
# substr $path, 0, 5, q{}; |
937
|
|
|
|
|
|
|
# } |
938
|
|
|
|
|
|
|
elsif ( ( substr $path, 0, 6 ) eq '.\\lib\\' ) { |
939
|
0
|
|
|
|
|
0
|
substr $path, 0, 6, q{}; |
940
|
|
|
|
|
|
|
} |
941
|
|
|
|
|
|
|
elsif ( ( substr $path, 0, 9 ) eq 'blib\\lib\\' ) { |
942
|
0
|
|
|
|
|
0
|
substr $path, 0, 9, q{}; |
943
|
|
|
|
|
|
|
} |
944
|
|
|
|
|
|
|
# elsif ( ( substr $path, 0, 10 ) eq '\\blib\\lib\\' ) { # NEED ANSWER: same question as below |
945
|
|
|
|
|
|
|
# substr $path, 0, 10, q{}; |
946
|
|
|
|
|
|
|
# } |
947
|
|
|
|
|
|
|
elsif ( ( substr $path, 0, 11 ) eq '.\\blib\\lib\\' ) { |
948
|
0
|
|
|
|
|
0
|
substr $path, 0, 11, q{}; |
949
|
|
|
|
|
|
|
} |
950
|
|
|
|
|
|
|
elsif ( ( substr $path, 0, 4 ) eq 'lib/' ) { |
951
|
0
|
|
|
|
|
0
|
substr $path, 0, 4, q{}; |
952
|
|
|
|
|
|
|
} |
953
|
|
|
|
|
|
|
# elsif ( ( substr $path, 0, 5 ) eq '/lib/' ) { # NEED ANSWER: is there ever a case where '/lib/' would appear instead of 'lib/' or './lib/' ??? |
954
|
|
|
|
|
|
|
# substr $path, 0, 5, q{}; |
955
|
|
|
|
|
|
|
# } |
956
|
|
|
|
|
|
|
elsif ( ( substr $path, 0, 6 ) eq './lib/' ) { |
957
|
0
|
|
|
|
|
0
|
substr $path, 0, 6, q{}; |
958
|
|
|
|
|
|
|
} |
959
|
|
|
|
|
|
|
elsif ( ( substr $path, 0, 9 ) eq 'blib/lib/' ) { |
960
|
48
|
|
|
|
|
183
|
substr $path, 0, 9, q{}; |
961
|
|
|
|
|
|
|
} |
962
|
|
|
|
|
|
|
# elsif ( ( substr $path, 0, 10 ) eq '/blib/lib/' ) { # NEED ANSWER: same question as above |
963
|
|
|
|
|
|
|
# substr $path, 0, 10, q{}; |
964
|
|
|
|
|
|
|
# } |
965
|
|
|
|
|
|
|
elsif ( ( substr $path, 0, 11 ) eq './blib/lib/' ) { |
966
|
0
|
|
|
|
|
0
|
substr $path, 0, 11, q{}; |
967
|
|
|
|
|
|
|
} |
968
|
48
|
|
|
|
|
214
|
return $path; |
969
|
|
|
|
|
|
|
} |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
# replace hard-coded PERLOPS_PERLTYPES with CPPOPS_*TYPES |
972
|
|
|
|
|
|
|
sub post_processor_cpp__types_change { |
973
|
16
|
|
|
16
|
|
37
|
{ my string_hashref $RETURN_TYPE }; |
|
16
|
|
|
|
|
35
|
|
974
|
16
|
|
|
|
|
88
|
( my string_hashref $source_group, my string_hashref $modes ) = @ARG; |
975
|
16
|
|
|
|
|
129
|
my string $mode_tagline = $modes->{ops} . 'OPS_' . $modes->{types} . 'TYPES'; |
976
|
16
|
50
|
|
|
|
86
|
if ( exists $source_group->{H} ) { |
977
|
0
|
|
|
|
|
0
|
$source_group->{H} =~ s/PERLOPS_PERLTYPES/$mode_tagline/gxms; |
978
|
|
|
|
|
|
|
} |
979
|
16
|
50
|
|
|
|
81
|
if ( exists $source_group->{CPP} ) { |
980
|
16
|
|
|
|
|
72
|
$source_group->{CPP} =~ s/PERLOPS_PERLTYPES/$mode_tagline/gxms; |
981
|
|
|
|
|
|
|
} |
982
|
16
|
|
|
|
|
83
|
return $source_group; |
983
|
|
|
|
|
|
|
} |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
# remove Perl comments |
986
|
|
|
|
|
|
|
sub post_processor_perl__comments_whitespace_delete { |
987
|
1244
|
|
|
1244
|
|
2594
|
{ my string $RETURN_TYPE }; |
|
1244
|
|
|
|
|
2353
|
|
988
|
1244
|
|
|
|
|
4013
|
( my string $input_source_code ) = @ARG; |
989
|
|
|
|
|
|
|
|
990
|
1244
|
|
|
|
|
10120
|
my string_arrayref $input_source_code_split = [ ( split /\n/xms, $input_source_code ) ]; |
991
|
1244
|
|
|
|
|
4237
|
my string_arrayref $input_source_code_split_tmp = []; |
992
|
|
|
|
|
|
|
|
993
|
1244
|
|
|
|
|
2435
|
my boolean $inside_comment = 0; |
994
|
1244
|
|
|
|
|
2567
|
my boolean $inside_string = 0; |
995
|
1244
|
|
|
|
|
2254
|
my boolean $inside_heredoc = 0; |
996
|
1244
|
|
|
|
|
3874
|
my boolean $inside_indent; |
997
|
|
|
|
|
|
|
my string $open_quote_string; |
998
|
1244
|
|
|
|
|
0
|
my string $open_quote_heredoc; |
999
|
1244
|
|
|
|
|
2854
|
foreach my string $input_source_code_line ( @{$input_source_code_split} ) { |
|
1244
|
|
|
|
|
3349
|
|
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::post_processor_perl__comments_whitespace_delete(), have $input_source_code_line = ' . q{'} . $input_source_code_line . q{'} . "\n" ); |
1002
|
|
|
|
|
|
|
# RPerl::diag( 'in C::ppp__cwd(), $iscl = ' . q{'} . $input_source_code_line . q{'} . "\n" ); |
1003
|
21482
|
50
|
|
|
|
35501
|
if ($inside_comment) { |
1004
|
0
|
0
|
|
|
|
0
|
if ( $input_source_code_line =~ m/^=cut$/xms ) { $inside_comment = 0; next; } # delete end of multi-line POD =COMMENT |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1005
|
0
|
|
|
|
|
0
|
next; # delete middle of multi-line POD =COMMENT |
1006
|
|
|
|
|
|
|
} |
1007
|
21482
|
100
|
|
|
|
31526
|
if ($inside_heredoc) { |
1008
|
14
|
50
|
|
|
|
25
|
if ( $input_source_code_line eq $open_quote_heredoc ) { $inside_heredoc = 0; } |
|
0
|
|
|
|
|
0
|
|
1009
|
14
|
|
|
|
|
18
|
push @{$input_source_code_split_tmp}, $input_source_code_line; |
|
14
|
|
|
|
|
23
|
|
1010
|
14
|
|
|
|
|
20
|
next; |
1011
|
|
|
|
|
|
|
} |
1012
|
21468
|
100
|
|
|
|
45972
|
if ( $input_source_code_line =~ m/^\s*$/xms ) { next; } # delete blank or all-whitespace line |
|
1440
|
|
|
|
|
3139
|
|
1013
|
20028
|
100
|
|
|
|
43494
|
if ( $input_source_code_line =~ m/^\s*[#][^#!]/xms ) { next; } # delete whole-line # COMMENT |
|
3200
|
|
|
|
|
5557
|
|
1014
|
16828
|
50
|
|
|
|
31472
|
if ( $input_source_code_line =~ m/^=\w+/xms ) { $inside_comment = 1; next; } # delete beginning of multi-line POD =COMMENT |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1015
|
|
|
|
|
|
|
|
1016
|
16828
|
|
|
|
|
19756
|
$inside_indent = 1; |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
# delete partial-line & multi-line comments, properly handling strings which contain comment characters |
1019
|
16828
|
|
|
|
|
20904
|
my string $input_source_code_line_tmp = q{}; |
1020
|
16828
|
|
|
|
|
22576
|
my string $current_character; |
1021
|
|
|
|
|
|
|
my string $next_character; |
1022
|
16828
|
|
|
|
|
18940
|
my boolean $advance_one = 0; |
1023
|
16828
|
|
|
|
|
31934
|
for my integer $i ( 0 .. ( ( length $input_source_code_line ) - 1 ) ) { |
1024
|
525689
|
|
|
|
|
633441
|
$current_character = substr $input_source_code_line, $i, 1; |
1025
|
525689
|
100
|
100
|
|
|
809367
|
if ( ($inside_indent) and ( $current_character !~ m/[ \t]/xms ) ) { |
1026
|
16828
|
|
|
|
|
20805
|
$inside_indent = 0; |
1027
|
|
|
|
|
|
|
} |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
# advance one extra character for q{ OR #! OR ## |
1030
|
525689
|
100
|
|
|
|
688747
|
if ($advance_one) { |
1031
|
3204
|
|
|
|
|
4221
|
$advance_one--; |
1032
|
3204
|
|
|
|
|
4013
|
$input_source_code_line_tmp .= $current_character; |
1033
|
3204
|
|
|
|
|
5056
|
next; |
1034
|
|
|
|
|
|
|
} |
1035
|
522485
|
100
|
|
|
|
640593
|
if ( not $inside_string ) { |
1036
|
469341
|
100
|
100
|
|
|
1653444
|
if ( $current_character eq '#' ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1037
|
4274
|
|
|
|
|
8371
|
$next_character = substr $input_source_code_line, ( $i + 1 ), 1; |
1038
|
4274
|
100
|
100
|
|
|
15348
|
if ( ( $next_character eq '!' ) or ( $next_character eq '#' ) ) { $advance_one = 1; } # do not delete shebang #! or critics ## |
|
3028
|
|
|
|
|
6519
|
|
1039
|
1246
|
|
|
|
|
2265
|
else { last; } # delete partial-line # COMMENT |
1040
|
|
|
|
|
|
|
} |
1041
|
|
|
|
|
|
|
elsif ( $current_character eq q{'} ) { |
1042
|
2550
|
|
|
|
|
3042
|
$inside_string = 1; |
1043
|
2550
|
|
|
|
|
3935
|
$open_quote_string = q{'}; |
1044
|
|
|
|
|
|
|
} |
1045
|
|
|
|
|
|
|
elsif ( $current_character eq q{"} ) { |
1046
|
1854
|
|
|
|
|
2271
|
$inside_string = 1; |
1047
|
1854
|
|
|
|
|
2615
|
$open_quote_string = q{"}; |
1048
|
|
|
|
|
|
|
} |
1049
|
|
|
|
|
|
|
elsif ( $current_character eq 'q' ) { |
1050
|
4602
|
|
|
|
|
7044
|
$next_character = substr $input_source_code_line, ( $i + 1 ), 1; |
1051
|
4602
|
100
|
|
|
|
8095
|
if ( $next_character eq '{' ) { |
1052
|
176
|
|
|
|
|
258
|
$inside_string = 1; |
1053
|
176
|
|
|
|
|
262
|
$advance_one = 1; |
1054
|
176
|
|
|
|
|
268
|
$open_quote_string = 'q{'; |
1055
|
|
|
|
|
|
|
} |
1056
|
|
|
|
|
|
|
} |
1057
|
|
|
|
|
|
|
elsif ( $current_character eq '<' ) { |
1058
|
148
|
|
|
|
|
295
|
$next_character = substr $input_source_code_line, ( $i + 1 ), 1; |
1059
|
148
|
100
|
|
|
|
430
|
if ( $next_character eq '<' ) { |
1060
|
2
|
|
|
|
|
6
|
$inside_heredoc = 1; |
1061
|
2
|
|
|
|
|
8
|
$open_quote_heredoc = substr $input_source_code_line, ( $i + 2 ); |
1062
|
2
|
50
|
|
|
|
8
|
if ( ( substr $open_quote_heredoc, 0, 1 ) eq q{'} ) { substr $open_quote_heredoc, 0, 1, q{}; } |
|
0
|
|
|
|
|
0
|
|
1063
|
2
|
50
|
|
|
|
10
|
if ( ( substr $open_quote_heredoc, 0, 1 ) eq q{"} ) { substr $open_quote_heredoc, 0, 1, q{}; } |
|
0
|
|
|
|
|
0
|
|
1064
|
2
|
|
|
|
|
7
|
$open_quote_heredoc =~ s/\s+$//xms; # delete trailing whitespace after heredoc open quote and semicolon |
1065
|
2
|
50
|
|
|
|
10
|
if ( ( substr $open_quote_heredoc, -1, 1 ) eq q{;} ) { substr $open_quote_heredoc, -1, 1, q{}; } |
|
2
|
|
|
|
|
8
|
|
1066
|
2
|
|
|
|
|
9
|
$open_quote_heredoc =~ s/\s+$//xms; # delete whitespace between heredoc open quote and semicolon |
1067
|
2
|
50
|
|
|
|
9
|
if ( ( substr $open_quote_heredoc, -1, 1 ) eq q{'} ) { substr $open_quote_heredoc, -1, 1, q{}; } |
|
0
|
|
|
|
|
0
|
|
1068
|
2
|
50
|
|
|
|
8
|
if ( ( substr $open_quote_heredoc, -1, 1 ) eq q{"} ) { substr $open_quote_heredoc, -1, 1, q{}; } |
|
0
|
|
|
|
|
0
|
|
1069
|
|
|
|
|
|
|
} |
1070
|
|
|
|
|
|
|
} |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
# delete extra whitespace inserted by Perl::Tidy |
1073
|
|
|
|
|
|
|
elsif ( ( not $inside_indent ) and ( $current_character =~ m/[ \t]/xms ) ) { |
1074
|
51679
|
|
|
|
|
75555
|
$next_character = substr $input_source_code_line, ( $i + 1 ), 1; |
1075
|
51679
|
100
|
|
|
|
84749
|
if ( $next_character =~ m/[ \t]/xms ) { next; } # delete extra whitespace |
|
4501
|
|
|
|
|
7429
|
|
1076
|
|
|
|
|
|
|
} |
1077
|
|
|
|
|
|
|
} |
1078
|
|
|
|
|
|
|
else { # $inside_string |
1079
|
53144
|
100
|
100
|
|
|
153552
|
if ( ( $current_character eq q{'} ) and ( $open_quote_string eq q{'} ) ) { $inside_string = 0; } |
|
2546
|
100
|
100
|
|
|
3382
|
|
|
|
100
|
100
|
|
|
|
|
1080
|
1854
|
|
|
|
|
3143
|
elsif ( ( $current_character eq q{"} ) and ( $open_quote_string eq q{"} ) ) { $inside_string = 0; } |
1081
|
176
|
|
|
|
|
239
|
elsif ( ( $current_character eq '}' ) and ( $open_quote_string eq 'q{' ) ) { $inside_string = 0; } |
1082
|
|
|
|
|
|
|
} |
1083
|
516738
|
|
|
|
|
640391
|
$input_source_code_line_tmp .= $current_character; |
1084
|
|
|
|
|
|
|
} |
1085
|
16828
|
|
|
|
|
22394
|
$input_source_code_line = $input_source_code_line_tmp; |
1086
|
|
|
|
|
|
|
|
1087
|
16828
|
|
|
|
|
40983
|
$input_source_code_line =~ s/[ \t]+$//xms; # delete trailing whitespace, if present |
1088
|
|
|
|
|
|
|
|
1089
|
16828
|
|
|
|
|
20195
|
push @{$input_source_code_split_tmp}, $input_source_code_line; |
|
16828
|
|
|
|
|
41393
|
|
1090
|
|
|
|
|
|
|
} |
1091
|
1244
|
|
|
|
|
2047
|
return join "\n", @{$input_source_code_split_tmp}; |
|
1244
|
|
|
|
|
17350
|
|
1092
|
|
|
|
|
|
|
} |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
# remove C++ comments |
1095
|
|
|
|
|
|
|
# NEED TEST: create full tests for this subroutine |
1096
|
|
|
|
|
|
|
sub post_processor_cpp__comments_whitespace_delete { |
1097
|
32
|
|
|
32
|
|
75
|
{ my string $RETURN_TYPE }; |
|
32
|
|
|
|
|
58
|
|
1098
|
32
|
|
|
|
|
119
|
( my string $input_source_code ) = @ARG; |
1099
|
|
|
|
|
|
|
|
1100
|
32
|
|
|
|
|
1941
|
my string_arrayref $input_source_code_split = [ ( split /\n/xms, $input_source_code ) ]; |
1101
|
32
|
|
|
|
|
162
|
my string_arrayref $input_source_code_split_tmp = []; |
1102
|
|
|
|
|
|
|
|
1103
|
32
|
|
|
|
|
64
|
my boolean $inside_comment = 0; |
1104
|
32
|
|
|
|
|
55
|
my boolean $inside_string = 0; |
1105
|
32
|
|
|
|
|
57
|
my string $open_quote; |
1106
|
32
|
|
|
|
|
50
|
foreach my string $input_source_code_line ( @{$input_source_code_split} ) { |
|
32
|
|
|
|
|
103
|
|
1107
|
1226
|
50
|
|
|
|
1926
|
if ($inside_comment) { |
1108
|
0
|
0
|
|
|
|
0
|
if ( $input_source_code_line =~ m!\*/!xms ) { |
1109
|
0
|
|
|
|
|
0
|
$input_source_code_line =~ s!^(.*\*/)!!xms; # delete end of multi-line /* COMMENT */ |
1110
|
0
|
|
|
|
|
0
|
$inside_comment = 0; |
1111
|
|
|
|
|
|
|
} |
1112
|
0
|
|
|
|
|
0
|
else { next; } # delete middle of multi-line /* COMMENT */ |
1113
|
|
|
|
|
|
|
} |
1114
|
1226
|
100
|
|
|
|
2717
|
if ( $input_source_code_line =~ m/^\s*$/xms ) { next; } # delete blank or all-whitespace line |
|
597
|
|
|
|
|
904
|
|
1115
|
629
|
100
|
|
|
|
1358
|
if ( $input_source_code_line =~ m!^\s*//!xms ) { next; } # delete whole-line // COMMENT |
|
95
|
|
|
|
|
203
|
|
1116
|
534
|
50
|
|
|
|
970
|
if ( $input_source_code_line =~ m!^\s*/\*.*\*/\s*$!xms ) { next; } # delete whole-line /* COMMENT */ |
|
0
|
|
|
|
|
0
|
|
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
# delete partial-line & multi-line comments, properly handling strings which contain comment characters |
1119
|
534
|
|
|
|
|
735
|
my string $input_source_code_line_tmp = q{}; |
1120
|
534
|
|
|
|
|
740
|
my string $current_character; |
1121
|
|
|
|
|
|
|
my string $next_character; |
1122
|
534
|
|
|
|
|
626
|
my boolean $advance_one = 0; |
1123
|
534
|
|
|
|
|
1062
|
for my integer $i ( 0 .. ( ( length $input_source_code_line ) - 1 ) ) { |
1124
|
21774
|
|
|
|
|
26699
|
$current_character = substr $input_source_code_line, $i, 1; |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
# advance one extra character for \' or \" or /* or */ |
1127
|
21774
|
100
|
|
|
|
30366
|
if ($advance_one) { |
1128
|
4
|
|
|
|
|
14
|
$advance_one = 0; |
1129
|
4
|
|
|
|
|
11
|
$input_source_code_line_tmp .= $current_character; |
1130
|
4
|
|
|
|
|
15
|
next; |
1131
|
|
|
|
|
|
|
} |
1132
|
21770
|
100
|
|
|
|
27266
|
if ( not $inside_string ) { |
1133
|
19752
|
50
|
|
|
|
24527
|
if ($inside_comment) { |
1134
|
0
|
0
|
|
|
|
0
|
if ( $current_character eq '*' ) { |
1135
|
0
|
|
|
|
|
0
|
$next_character = substr $input_source_code_line, ( $i + 1 ), 1; |
1136
|
0
|
0
|
|
|
|
0
|
if ( $next_character eq '/' ) { |
1137
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
# delete end of partial-line /* COMMENT */ |
1139
|
0
|
|
|
|
|
0
|
$advance_one = 1; |
1140
|
0
|
|
|
|
|
0
|
$inside_comment = 0; |
1141
|
0
|
|
|
|
|
0
|
next; |
1142
|
|
|
|
|
|
|
} |
1143
|
|
|
|
|
|
|
} |
1144
|
0
|
|
|
|
|
0
|
else { next; } # delete middle of partial-line /* COMMENT */ |
1145
|
|
|
|
|
|
|
} |
1146
|
|
|
|
|
|
|
else { # not $inside_comment |
1147
|
19752
|
50
|
|
|
|
36955
|
if ( $current_character eq '/' ) { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1148
|
0
|
|
|
|
|
0
|
$next_character = substr $input_source_code_line, ( $i + 1 ), 1; |
1149
|
0
|
0
|
|
|
|
0
|
if ( $next_character eq '/' ) { last; } # delete partial-line // COMMENT |
|
0
|
0
|
|
|
|
0
|
|
1150
|
|
|
|
|
|
|
elsif ( $next_character eq '*' ) { |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
# delete beginning of partial-line or multi-line /* COMMENT */ |
1153
|
0
|
|
|
|
|
0
|
$advance_one = 1; |
1154
|
0
|
|
|
|
|
0
|
$inside_comment = 1; |
1155
|
0
|
|
|
|
|
0
|
next; |
1156
|
|
|
|
|
|
|
} |
1157
|
|
|
|
|
|
|
} |
1158
|
|
|
|
|
|
|
elsif ( $current_character eq q{'} ) { |
1159
|
0
|
|
|
|
|
0
|
$inside_string = 1; |
1160
|
0
|
|
|
|
|
0
|
$open_quote = q{'}; |
1161
|
|
|
|
|
|
|
} |
1162
|
|
|
|
|
|
|
elsif ( $current_character eq q{"} ) { |
1163
|
146
|
|
|
|
|
169
|
$inside_string = 1; |
1164
|
146
|
|
|
|
|
232
|
$open_quote = q{"}; |
1165
|
|
|
|
|
|
|
} |
1166
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
# NEED UPGRADE: can not delete extra whitespace characters here, because it destroys indentation |
1168
|
|
|
|
|
|
|
# elsif ( $current_character =~ m/[ \t]/ ) { |
1169
|
|
|
|
|
|
|
# $next_character = substr $input_source_code_line, ( $i + 1 ), 1; |
1170
|
|
|
|
|
|
|
# if ( $next_character =~ m/[ \t]/ ) { next; } # delete extra whitespace |
1171
|
|
|
|
|
|
|
# } |
1172
|
|
|
|
|
|
|
} |
1173
|
|
|
|
|
|
|
} |
1174
|
|
|
|
|
|
|
else { # $inside_string |
1175
|
2018
|
50
|
66
|
|
|
5144
|
if ( ( $current_character eq q{'} ) and ( $open_quote eq q{'} ) ) { $inside_string = 0; } |
|
0
|
100
|
66
|
|
|
0
|
|
|
|
100
|
|
|
|
|
|
1176
|
146
|
|
|
|
|
193
|
elsif ( ( $current_character eq q{"} ) and ( $open_quote eq q{"} ) ) { $inside_string = 0; } |
1177
|
|
|
|
|
|
|
elsif ( $current_character eq '\\' ) { |
1178
|
10
|
|
|
|
|
39
|
$next_character = substr $input_source_code_line, ( $i + 1 ), 1; |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
# backslash-escaped quotes do not close a string |
1181
|
10
|
50
|
33
|
|
|
58
|
if ( ( $next_character eq q{'} ) and ( $open_quote eq q{'} ) ) { $advance_one = 1; } |
|
0
|
|
|
|
|
0
|
|
1182
|
10
|
100
|
66
|
|
|
66
|
if ( ( $next_character eq q{"} ) and ( $open_quote eq q{"} ) ) { $advance_one = 1; } |
|
4
|
|
|
|
|
22
|
|
1183
|
|
|
|
|
|
|
} |
1184
|
|
|
|
|
|
|
} |
1185
|
21770
|
|
|
|
|
26452
|
$input_source_code_line_tmp .= $current_character; |
1186
|
|
|
|
|
|
|
} |
1187
|
534
|
|
|
|
|
844
|
$input_source_code_line = $input_source_code_line_tmp; |
1188
|
|
|
|
|
|
|
|
1189
|
534
|
|
|
|
|
1469
|
$input_source_code_line =~ s/[ \t]+$//xms; # delete trailing whitespace, if present |
1190
|
|
|
|
|
|
|
|
1191
|
534
|
|
|
|
|
636
|
push @{$input_source_code_split_tmp}, $input_source_code_line; |
|
534
|
|
|
|
|
1652
|
|
1192
|
|
|
|
|
|
|
} |
1193
|
32
|
|
|
|
|
56
|
return join "\n", @{$input_source_code_split_tmp}; |
|
32
|
|
|
|
|
760
|
|
1194
|
|
|
|
|
|
|
} |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
# remove unnecessary absolute paths |
1197
|
|
|
|
|
|
|
sub post_processor__absolute_path_delete { |
1198
|
7971
|
|
|
7971
|
|
10809
|
{ my string $RETURN_TYPE }; |
|
7971
|
|
|
|
|
9866
|
|
1199
|
7971
|
|
|
|
|
11544
|
( my string $input_path ) = @ARG; |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::post_processor__absolute_path_delete(), received $input_path = ' . $input_path . "\n" ); |
1202
|
|
|
|
|
|
|
|
1203
|
7971
|
50
|
|
|
|
19116
|
if ( $OSNAME eq 'MSWin32' ) { |
1204
|
0
|
|
|
|
|
0
|
$input_path =~ s/\\/\//gxms; |
1205
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::post_processor__absolute_path_delete(), Windows OS detected, have possibly-reformatted $input_path = ' . $input_path . "\n" ); |
1206
|
|
|
|
|
|
|
} |
1207
|
|
|
|
|
|
|
|
1208
|
7971
|
|
|
|
|
33187
|
my string $current_working_directory = getcwd; |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::post_processor__absolute_path_delete(), have $current_working_directory = ' . $current_working_directory . "\n" ); |
1211
|
|
|
|
|
|
|
|
1212
|
7971
|
100
|
|
|
|
19120
|
if ( ( substr $input_path, 0, ( length $current_working_directory ) ) eq $current_working_directory ) { |
1213
|
2572
|
|
|
|
|
5350
|
return substr $input_path, ( ( length $current_working_directory ) + 1 ); |
1214
|
|
|
|
|
|
|
} |
1215
|
5399
|
|
|
|
|
13447
|
return $input_path; # this comment is a test of find_replace_old_subroutine_headers.sh |
1216
|
|
|
|
|
|
|
} |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
# remove unnecessary current-directory paths |
1219
|
|
|
|
|
|
|
sub post_processor__current_directory_path_delete { |
1220
|
1418
|
|
|
1418
|
|
2333
|
{ my string $RETURN_TYPE }; |
|
1418
|
|
|
|
|
2453
|
|
1221
|
1418
|
|
|
|
|
3123
|
( my string $input_path ) = @ARG; |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::post_processor__current_directory_path_delete(), received $input_path = ' . $input_path . "\n" ); |
1224
|
|
|
|
|
|
|
|
1225
|
1418
|
50
|
|
|
|
4221
|
if ( $OSNAME eq 'MSWin32' ) { |
1226
|
0
|
|
|
|
|
0
|
$input_path =~ s/\\/\//gxms; |
1227
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::post_processor__current_directory_path_delete(), Windows OS detected, have possibly-reformatted $input_path = ' . $input_path . "\n" ); |
1228
|
|
|
|
|
|
|
} |
1229
|
|
|
|
|
|
|
|
1230
|
1418
|
50
|
|
|
|
5621
|
if ( ( substr $input_path, 0, 2 ) eq './' ) { |
1231
|
0
|
|
|
|
|
0
|
return substr $input_path, 2; |
1232
|
|
|
|
|
|
|
} |
1233
|
1418
|
|
|
|
|
3482
|
return $input_path; # this comment is a test of find_replace_old_subroutine_headers.sh |
1234
|
|
|
|
|
|
|
} |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
# generate PMC file |
1237
|
|
|
|
|
|
|
sub post_processor_cpp__pmc_generate { |
1238
|
0
|
|
|
0
|
|
|
{ my void $RETURN_TYPE }; |
|
0
|
|
|
|
|
|
|
1239
|
0
|
|
|
|
|
|
( my string_hashref $source_group, my string_hashref $file_name_group, my string_hashref $modes ) = @ARG; |
1240
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
# NEED FIX WIN32: handle back-slash for Win32 instead of forward-slash only for *NIX |
1242
|
0
|
|
|
|
|
|
my string $cpp_file_path = $file_name_group->{CPP}; |
1243
|
0
|
|
|
|
|
|
$cpp_file_path = post_processor_cpp__lib_path_delete($cpp_file_path); |
1244
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
# DEV NOTE: barely-documented Inline::CPP bug, must have leading './' if no other directories in path |
1246
|
0
|
0
|
|
|
|
|
if ( $cpp_file_path !~ /\// ) { |
1247
|
0
|
0
|
|
|
|
|
if ( $OSNAME eq 'MSWin32' ) { |
1248
|
0
|
|
|
|
|
|
$cpp_file_path .= q{.\\}; |
1249
|
|
|
|
|
|
|
} |
1250
|
|
|
|
|
|
|
else { |
1251
|
0
|
|
|
|
|
|
$cpp_file_path .= q{./}; |
1252
|
|
|
|
|
|
|
} |
1253
|
|
|
|
|
|
|
} |
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
# DEV NOTE: only generate PMC output file in dynamic (default) subcompile mode |
1256
|
0
|
0
|
|
|
|
|
if ( $modes->{subcompile} eq 'DYNAMIC' ) { |
1257
|
0
|
0
|
0
|
|
|
|
if ( ( exists $source_group->{PMC} ) and ( defined $source_group->{PMC} ) and ( $source_group->{PMC} ne q{} ) ) { |
|
|
|
0
|
|
|
|
|
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::save_source_files(), have $source_group = } . Dumper($source_group) . "\n" ); |
1260
|
0
|
|
|
|
|
|
die 'ERROR ECOCOFI01, COMPILER, SAVE OUTPUT FILES, MODULE TEMPLATE COPY: Received non-empty PMC source, dying' . "\n"; |
1261
|
|
|
|
|
|
|
} |
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::save_source_files(), have %INC = } . Dumper(\%INC) . "\n" ); |
1264
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::save_source_files(), have @INC = } . Dumper(\@INC) . "\n" ); |
1265
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::save_source_files(), have $source_group->{_package_names_underscores} = } . Dumper($source_group->{_package_names_underscores}) . "\n" ); |
1266
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::save_source_files(), have $source_group->{_package_names} = } . Dumper($source_group->{_package_names}) . "\n" ); |
1267
|
|
|
|
|
|
|
|
1268
|
0
|
|
|
|
|
|
my string_arrayref $module_names_split = [ ( split /\n/, $source_group->{_package_names} ) ]; |
1269
|
0
|
|
|
|
|
|
my string_arrayref $module_names_underscores_split = [ ( split /\n/, $source_group->{_package_names_underscores} ) ]; |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::save_source_files(), have $module_names_split = } . Dumper($module_names_split) . "\n" ); |
1272
|
|
|
|
|
|
|
|
1273
|
0
|
|
|
|
|
|
my integer $module_count = scalar @{$module_names_split}; |
|
0
|
|
|
|
|
|
|
1274
|
0
|
|
|
|
|
|
my string $module_name = shift @{$module_names_split}; |
|
0
|
|
|
|
|
|
|
1275
|
0
|
|
|
|
|
|
my string $module_name_underscores = shift @{$module_names_underscores_split}; |
|
0
|
|
|
|
|
|
|
1276
|
0
|
|
|
|
|
|
my integer $i = 0; |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
# deferred, finally insert constants shims |
1279
|
|
|
|
|
|
|
# RPerl::diag('in Compiler::save_source_files(), have $source_group->{_H_constants_shims}->{$module_name_underscores} = ' . $source_group->{_H_constants_shims}->{$module_name_underscores} . "\n"); |
1280
|
|
|
|
|
|
|
|
1281
|
0
|
|
|
|
|
|
while ( defined $module_name_underscores ) { |
1282
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::save_source_files(), have $cpp_file_path = } . $cpp_file_path . "\n" ); |
1284
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::save_source_files(), have $module_name_underscores = } . $module_name_underscores . "\n" ); |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
# utilize modified copies of Module PMC template file |
1287
|
0
|
|
|
|
|
|
my string $module_pmc_filename_manual; |
1288
|
0
|
0
|
|
|
|
|
if ( $module_count == 1 ) { |
1289
|
0
|
|
|
|
|
|
$module_pmc_filename_manual = $RPerl::INCLUDE_PATH . '/RPerl/CompileUnit/Module.pmc.CPPOPS_DUALTYPES_TEMPLATE'; |
1290
|
|
|
|
|
|
|
} |
1291
|
|
|
|
|
|
|
else { |
1292
|
0
|
0
|
|
|
|
|
if ( $i == ( $module_count - 1 ) ) { |
1293
|
0
|
|
|
|
|
|
$module_pmc_filename_manual = $RPerl::INCLUDE_PATH . '/RPerl/CompileUnit/Module.pmc.CPPOPS_DUALTYPES_TEMPLATE_MONOLITH'; |
1294
|
|
|
|
|
|
|
} |
1295
|
|
|
|
|
|
|
else { |
1296
|
0
|
|
|
|
|
|
$module_pmc_filename_manual = $RPerl::INCLUDE_PATH . '/RPerl/CompileUnit/Module.pmc.CPPOPS_DUALTYPES_TEMPLATE_MONOLITH_SECONDARY'; |
1297
|
|
|
|
|
|
|
} |
1298
|
|
|
|
|
|
|
} |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), have $module_pmc_filename_manual = ' . $module_pmc_filename_manual . "\n" ); |
1301
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), have $source_group->{_PMC_accessors_mutators_shims} = ' . Dumper($source_group->{_PMC_accessors_mutators_shims}) . "\n" ); |
1302
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), have $source_group->{_PMC_subroutines_shims} = ' . Dumper($source_group->{_PMC_subroutines_shims}) . "\n" ); |
1303
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), have $source_group->{_PMC_includes} = ' . Dumper($source_group->{_PMC_includes}) . "\n" ); |
1304
|
|
|
|
|
|
|
|
1305
|
0
|
0
|
|
|
|
|
if ( not -f $module_pmc_filename_manual ) { |
1306
|
0
|
|
|
|
|
|
die 'ERROR ECOCOFI02, COMPILER, SAVE OUTPUT FILES, MODULE TEMPLATE COPY: File not found, ' . q{'} |
1307
|
|
|
|
|
|
|
. $module_pmc_filename_manual . q{'} . "\n" |
1308
|
|
|
|
|
|
|
. ', dying' . "\n"; |
1309
|
|
|
|
|
|
|
} |
1310
|
|
|
|
|
|
|
|
1311
|
0
|
0
|
|
|
|
|
open my filehandleref $FILE_HANDLE, '<', $module_pmc_filename_manual |
1312
|
|
|
|
|
|
|
or die 'ERROR ECOCOFI03, COMPILER, SAVE OUTPUT FILES, MODULE TEMPLATE COPY: Cannot open file ' |
1313
|
|
|
|
|
|
|
. $module_pmc_filename_manual |
1314
|
|
|
|
|
|
|
. ' for reading, ' |
1315
|
|
|
|
|
|
|
. $OS_ERROR |
1316
|
|
|
|
|
|
|
. ', dying' . "\n"; |
1317
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
# deferred, finally read in Module PMC template file, replace package name and paths, add accessor/mutator shim methods |
1319
|
0
|
|
|
|
|
|
my string $file_line; |
1320
|
0
|
|
|
|
|
|
my string $file_string = q{}; |
1321
|
0
|
|
|
|
|
|
my string $pm_file_path = $file_name_group->{PMC}; |
1322
|
0
|
|
|
|
|
|
chop $pm_file_path; # remove the 'c' from 'pmc' file suffix |
1323
|
0
|
|
|
|
|
|
while ( $file_line = <$FILE_HANDLE> ) { |
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
# $file_line =~ s/lib\/RPerl\/CompileUnit\/Module\.cpp/$cpp_file_path/gxms; |
1326
|
0
|
|
|
|
|
|
$file_line =~ s/RPerl\/CompileUnit\/Module\.cpp/$cpp_file_path/gxms; |
1327
|
0
|
|
|
|
|
|
$file_line =~ s/RPerl::CompileUnit::Module/$module_name/gxms; |
1328
|
0
|
|
|
|
|
|
$file_line =~ s/RPerl__CompileUnit__Module/$module_name_underscores/gxms; |
1329
|
0
|
0
|
|
|
|
|
if ( $file_line eq |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
( '# <<< OO PROPERTIES, ACCESSORS & MUTATORS, SHIMS >>> # <<< CHANGE_ME: add real shims after this line or delete it >>>' . "\n" ) ) |
1331
|
|
|
|
|
|
|
{ |
1332
|
0
|
0
|
0
|
|
|
|
if ( ( exists $source_group->{_PMC_accessors_mutators_shims}->{$module_name_underscores} ) |
1333
|
|
|
|
|
|
|
and ( defined $source_group->{_PMC_accessors_mutators_shims}->{$module_name_underscores} ) ) |
1334
|
|
|
|
|
|
|
{ |
1335
|
|
|
|
|
|
|
$file_line |
1336
|
0
|
|
|
|
|
|
= ( substr $file_line, 0, 52 ) . "\n" . $source_group->{_PMC_accessors_mutators_shims}->{$module_name_underscores} . "\n\n"; |
1337
|
|
|
|
|
|
|
} |
1338
|
0
|
|
|
|
|
|
else { $file_line = undef; } |
1339
|
|
|
|
|
|
|
} |
1340
|
|
|
|
|
|
|
elsif ( |
1341
|
|
|
|
|
|
|
$file_line eq ( '# <<< OO PROPERTIES, SUBROUTINES, SHIMS >>> # <<< CHANGE_ME: add real shims after this line or delete it >>>' . "\n" ) ) |
1342
|
|
|
|
|
|
|
{ |
1343
|
0
|
0
|
0
|
|
|
|
if ( ( exists $source_group->{_PMC_subroutines_shims}->{$module_name_underscores} ) |
1344
|
|
|
|
|
|
|
and ( defined $source_group->{_PMC_subroutines_shims}->{$module_name_underscores} ) ) |
1345
|
|
|
|
|
|
|
{ |
1346
|
0
|
|
|
|
|
|
$file_line = ( substr $file_line, 0, 43 ) . "\n" . $source_group->{_PMC_subroutines_shims}->{$module_name_underscores} . "\n\n"; |
1347
|
|
|
|
|
|
|
} |
1348
|
0
|
|
|
|
|
|
else { $file_line = undef; } |
1349
|
|
|
|
|
|
|
} |
1350
|
|
|
|
|
|
|
elsif ( $file_line eq ( '# <<< CHANGE_ME: add distribution-specific config include here >>>' . "\n" ) ) { |
1351
|
0
|
|
|
|
|
|
my string $distribution_package = ( split /::/, $source_group->{_package_name} )[0]; |
1352
|
0
|
|
|
|
|
|
$file_line = 'use ' . $distribution_package . '::Config;' . "\n"; |
1353
|
|
|
|
|
|
|
} |
1354
|
|
|
|
|
|
|
elsif ( $file_line eq ( '# <<< CHANGE_ME: add user-defined includes here >>>' . "\n" ) ) { |
1355
|
0
|
0
|
0
|
|
|
|
if ( ( exists $source_group->{_PMC_includes}->{$module_name_underscores} ) |
1356
|
|
|
|
|
|
|
and ( defined $source_group->{_PMC_includes}->{$module_name_underscores} ) ) |
1357
|
|
|
|
|
|
|
{ |
1358
|
0
|
|
|
|
|
|
$file_line = $source_group->{_PMC_includes}->{$module_name_underscores} . "\n\n"; |
1359
|
|
|
|
|
|
|
} |
1360
|
0
|
|
|
|
|
|
else { $file_line = undef; } |
1361
|
|
|
|
|
|
|
} |
1362
|
|
|
|
|
|
|
elsif ( $file_line eq ( ' # <<< CHANGE_ME: enable optional SSE support here >>>' . "\n" ) ) { |
1363
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), have $modes->{_enable_sse} = ' . Dumper($modes->{_enable_sse}) . "\n" ); |
1365
|
0
|
0
|
0
|
|
|
|
if ( ( exists $modes->{_enable_sse} ) |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1366
|
|
|
|
|
|
|
and ( defined $modes->{_enable_sse} ) |
1367
|
|
|
|
|
|
|
and ( exists $modes->{_enable_sse}->{$pm_file_path} ) |
1368
|
|
|
|
|
|
|
and ( defined $modes->{_enable_sse}->{$pm_file_path} ) |
1369
|
|
|
|
|
|
|
and $modes->{_enable_sse}->{$pm_file_path} ) |
1370
|
|
|
|
|
|
|
{ |
1371
|
0
|
|
|
|
|
|
$file_line = q( $RPerl::Inline::ARGS{optimize} .= ' -mfpmath=sse -msse3'; # enable SSE support) . "\n"; |
1372
|
0
|
|
|
|
|
|
$file_line |
1373
|
|
|
|
|
|
|
.= q( $RPerl::Inline::ARGS{auto_include} = ['#include <immintrin.h>', @{$RPerl::Inline::ARGS{auto_include}}]; # enable SSE support) |
1374
|
|
|
|
|
|
|
. "\n"; |
1375
|
|
|
|
|
|
|
} |
1376
|
0
|
|
|
|
|
|
else { $file_line = undef; } |
1377
|
|
|
|
|
|
|
} |
1378
|
|
|
|
|
|
|
elsif ( $file_line eq ( ' # <<< CHANGE_ME: enable optional GMP support here >>>' . "\n" ) ) { |
1379
|
|
|
|
|
|
|
|
1380
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), have $modes->{_enable_gmp} = ' . Dumper($modes->{_enable_gmp}) . "\n" ); |
1381
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), have $pm_file_path = ' . $pm_file_path . "\n" ); |
1382
|
0
|
0
|
0
|
|
|
|
if ( ( exists $modes->{_enable_gmp} ) |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1383
|
|
|
|
|
|
|
and ( defined $modes->{_enable_gmp} ) |
1384
|
|
|
|
|
|
|
and ( exists $modes->{_enable_gmp}->{$pm_file_path} ) |
1385
|
|
|
|
|
|
|
and ( defined $modes->{_enable_gmp}->{$pm_file_path} ) |
1386
|
|
|
|
|
|
|
and $modes->{_enable_gmp}->{$pm_file_path} ) |
1387
|
|
|
|
|
|
|
{ |
1388
|
0
|
|
|
|
|
|
$file_line = q( $RPerl::Inline::ARGS{libs} = '-lgmpxx -lgmp'; # enable GMP support) . "\n"; |
1389
|
0
|
|
|
|
|
|
$file_line |
1390
|
|
|
|
|
|
|
.= q( $RPerl::Inline::ARGS{auto_include} = [ @{ $RPerl::Inline::ARGS{auto_include} }, '#include <gmpxx.h>', '#include <gmp.h>' ]; # enable GMP support) |
1391
|
|
|
|
|
|
|
. "\n"; |
1392
|
|
|
|
|
|
|
} |
1393
|
0
|
|
|
|
|
|
else { $file_line = undef; } |
1394
|
|
|
|
|
|
|
} |
1395
|
|
|
|
|
|
|
elsif ( $file_line eq ( ' # <<< CHANGE_ME: enable optional GSL support here >>>' . "\n" ) ) { |
1396
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), have $modes->{_enable_gsl} = ' . Dumper($modes->{_enable_gsl}) . "\n" ); |
1397
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), have $pm_file_path = ' . $pm_file_path . "\n" ); |
1398
|
0
|
|
|
|
|
|
$pm_file_path = post_processor__absolute_path_delete($pm_file_path); |
1399
|
0
|
|
|
|
|
|
$pm_file_path = post_processor__current_directory_path_delete($pm_file_path); |
1400
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::save_source_files(), have possibly-trimmed $pm_file_path = ' . $pm_file_path . "\n" ); |
1401
|
|
|
|
|
|
|
|
1402
|
0
|
0
|
0
|
|
|
|
if ( ( exists $modes->{_enable_gsl} ) |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1403
|
|
|
|
|
|
|
and ( defined $modes->{_enable_gsl} ) |
1404
|
|
|
|
|
|
|
and ( exists $modes->{_enable_gsl}->{$pm_file_path} ) |
1405
|
|
|
|
|
|
|
and ( defined $modes->{_enable_gsl}->{$pm_file_path} ) |
1406
|
|
|
|
|
|
|
and $modes->{_enable_gsl}->{$pm_file_path} ) |
1407
|
|
|
|
|
|
|
{ |
1408
|
|
|
|
|
|
|
# DEV NOTE: linking instructions https://www.gnu.org/software/gsl/doc/html/usage.html#linking-programs-with-the-library |
1409
|
0
|
|
|
|
|
|
$file_line = q( $RPerl::Inline::ARGS{libs} = '-lgsl -lgslcblas -lm'; # enable GSL support) . "\n"; |
1410
|
0
|
|
|
|
|
|
$file_line .= q( $RPerl::Inline::ARGS{inc} .= ' -I' . $RPerl::Inline::gsl_include_dir; # enable GSL support) . "\n"; |
1411
|
0
|
|
|
|
|
|
$file_line |
1412
|
|
|
|
|
|
|
.= q( $RPerl::Inline::ARGS{auto_include} = [ @{ $RPerl::Inline::ARGS{auto_include} }, '#include <gsl_matrix.h>', '#include <gsl_blas.h>' ]; # enable GSL support) |
1413
|
|
|
|
|
|
|
. "\n"; |
1414
|
|
|
|
|
|
|
} |
1415
|
0
|
|
|
|
|
|
else { $file_line = undef; } |
1416
|
|
|
|
|
|
|
} |
1417
|
|
|
|
|
|
|
|
1418
|
0
|
0
|
|
|
|
|
if ( defined $file_line ) { $source_group->{PMC} .= $file_line; } |
|
0
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
} |
1420
|
|
|
|
|
|
|
|
1421
|
0
|
0
|
|
|
|
|
close $FILE_HANDLE |
1422
|
|
|
|
|
|
|
or die 'ERROR ECOCOFI04, COMPILER, SAVE OUTPUT FILES, MODULE TEMPLATE COPY: Cannot close file ' |
1423
|
|
|
|
|
|
|
. $module_pmc_filename_manual |
1424
|
|
|
|
|
|
|
. ' after reading, ' |
1425
|
|
|
|
|
|
|
. $OS_ERROR |
1426
|
|
|
|
|
|
|
. ', dying' . "\n"; |
1427
|
|
|
|
|
|
|
|
1428
|
0
|
|
|
|
|
|
$module_name = shift @{$module_names_split}; |
|
0
|
|
|
|
|
|
|
1429
|
0
|
|
|
|
|
|
$module_name_underscores = shift @{$module_names_underscores_split}; |
|
0
|
|
|
|
|
|
|
1430
|
0
|
|
|
|
|
|
$i++; |
1431
|
|
|
|
|
|
|
} |
1432
|
|
|
|
|
|
|
} |
1433
|
0
|
|
|
|
|
|
return; |
1434
|
|
|
|
|
|
|
} |
1435
|
|
|
|
|
|
|
|
1436
|
|
|
|
|
|
|
# Auto-Parallelize from Serial C++ File to Parallel C++ File via Pluto PolyCC & OpenMP |
1437
|
|
|
|
|
|
|
sub cpp_to_openmp_cpp { |
1438
|
0
|
|
|
0
|
|
|
{ my void $RETURN_TYPE }; |
|
0
|
|
|
|
|
|
|
1439
|
0
|
|
|
|
|
|
( my string_hashref $cpp_output_file_name_group, my string_hashref $modes ) = @ARG; |
1440
|
|
|
|
|
|
|
|
1441
|
0
|
|
|
|
|
|
RPerl::diag( q{in Compiler::cpp_to_openmp_cpp(), received $cpp_output_file_name_group =} . "\n" . Dumper($cpp_output_file_name_group) . "\n" ); |
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::cpp_to_openmp_cpp(), received $modes =} . "\n" . Dumper($modes) . "\n" ); |
1444
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::cpp_to_openmp_cpp(), NOT DOING ANYTHING YET} . "\n" ); |
1446
|
|
|
|
|
|
|
# return; |
1447
|
|
|
|
|
|
|
# die 'TMP DEBUG'; |
1448
|
|
|
|
|
|
|
|
1449
|
|
|
|
|
|
|
# START HERE: modify pluto min/max macros & calls, modify final g++ command |
1450
|
|
|
|
|
|
|
# START HERE: modify pluto min/max macros & calls, modify final g++ command |
1451
|
|
|
|
|
|
|
# START HERE: modify pluto min/max macros & calls, modify final g++ command |
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
# THEN START HERE, NEED FIX PARALLEL: enable non-pluto min/max sub calls, re-enable prints |
1454
|
0
|
|
|
|
|
|
RPerl::verbose('PARALLELIZE: Generate OpenMP Code... '); |
1455
|
|
|
|
|
|
|
|
1456
|
0
|
|
|
|
|
|
my string $polycc_path = can_run('polycc'); |
1457
|
0
|
0
|
|
|
|
|
if ( not defined $polycc_path ) { |
1458
|
0
|
|
|
|
|
|
die 'ERROR Exxxxx, COMPILER, PARALLELIZATION: Pluto PolyCC command `polycc` not found, dying'; |
1459
|
|
|
|
|
|
|
} |
1460
|
|
|
|
|
|
|
my string $polycc_command |
1461
|
0
|
|
|
|
|
|
= $polycc_path . q{ } . $cpp_output_file_name_group->{CPP} . ' -o ' . $cpp_output_file_name_group->{OPENMP_CPP} . ' --parallel --tile'; |
1462
|
|
|
|
|
|
|
|
1463
|
0
|
|
|
|
|
|
RPerl::diag( 'in Compiler::cpp_to_openmp_cpp(), have $polycc_command =' . "\n\n" . $polycc_command . "\n" ); |
1464
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
# ACTUALLY RUN POLYCC COMMAND |
1466
|
|
|
|
|
|
|
# my $pid = open3( 0, \*POLYCC_STDOUT, \*POLYCC_STDERR, $polycc_command ); # disable STDIN w/ 0 |
1467
|
|
|
|
|
|
|
# |
1468
|
|
|
|
|
|
|
# my $stdout_select; |
1469
|
|
|
|
|
|
|
# my $stderr_select; |
1470
|
|
|
|
|
|
|
# if ( $OSNAME ne 'MSWin32' ) { |
1471
|
|
|
|
|
|
|
# $stdout_select = IO::Select->new(); |
1472
|
|
|
|
|
|
|
# $stderr_select = IO::Select->new(); |
1473
|
|
|
|
|
|
|
# $stdout_select->add( \*POLYCC_STDOUT ); |
1474
|
|
|
|
|
|
|
# $stderr_select->add( \*POLYCC_STDERR ); |
1475
|
|
|
|
|
|
|
# } |
1476
|
|
|
|
|
|
|
# |
1477
|
|
|
|
|
|
|
|
1478
|
0
|
|
|
|
|
|
my string $polycc_command_stdout = q{}; |
1479
|
0
|
|
|
|
|
|
my string $polycc_command_stderr = q{}; |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
#if ( $OSNAME eq 'MSWin32' || $stdout_select->can_read(0) ) { sysread POLYCC_STDOUT, $polycc_command_stdout, 4096; } |
1482
|
|
|
|
|
|
|
# if ( $OSNAME eq 'MSWin32' || $stderr_select->can_read(0) ) { sysread POLYCC_STDERR, $polycc_command_stderr, 4096; } |
1483
|
|
|
|
|
|
|
# waitpid $pid, 0; |
1484
|
|
|
|
|
|
|
# if ( $OSNAME eq 'MSWin32' || $stdout_select->can_read(0) ) { my $s; sysread POLYCC_STDOUT, $s, 4096; $polycc_command_stdout .= $s; } |
1485
|
|
|
|
|
|
|
# if ( $OSNAME eq 'MSWin32' || $stderr_select->can_read(0) ) { my $s; sysread POLYCC_STDERR, $s, 4096; $polycc_command_stderr .= $s; } |
1486
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
#my $pid = open3( 0, \*POLYCC_STDOUT, \*POLYCC_STDERR, $polycc_command ); # disable STDIN w/ 0 |
1488
|
0
|
|
|
|
|
|
run3( $polycc_command, \undef, \$polycc_command_stdout, \$polycc_command_stderr ); |
1489
|
|
|
|
|
|
|
|
1490
|
0
|
|
|
|
|
|
my $test_exit_status = $CHILD_ERROR >> 8; |
1491
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::cpp_to_openmp_cpp(), have $CHILD_ERROR = ' . $CHILD_ERROR . "\n" ); |
1493
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::cpp_to_openmp_cpp(), have $test_exit_status = ' . $test_exit_status . "\n" ); |
1494
|
|
|
|
|
|
|
|
1495
|
0
|
|
|
|
|
|
RPerl::verbose( ' done.' . "\n" ); |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
# if ($polycc_command_stdout) { RPerl::diag( "===STDOUT=BEGIN===\n" . $polycc_command_stdout . "===STDOUT=END===\n" ); } |
1498
|
|
|
|
|
|
|
# if ($polycc_command_stderr) { RPerl::diag( "===STDERR=BEGIN===\n" . $polycc_command_stderr . "===STDERR=END===\n" ); } |
1499
|
0
|
|
0
|
|
|
|
my boolean $polycc_command_stdout_content = ( ( defined $polycc_command_stdout ) and ( $polycc_command_stdout =~ m/[^\s]+/g ) ); |
1500
|
0
|
|
0
|
|
|
|
my boolean $polycc_command_stderr_content = ( ( defined $polycc_command_stderr ) and ( $polycc_command_stderr =~ m/[^\s]+/g ) ); |
1501
|
|
|
|
|
|
|
|
1502
|
0
|
0
|
0
|
|
|
|
if ( $polycc_command_stdout_content or $polycc_command_stderr_content ) { |
1503
|
0
|
|
|
|
|
|
RPerl::diag("\n"); |
1504
|
0
|
0
|
|
|
|
|
if ($polycc_command_stdout_content) { |
1505
|
0
|
|
|
|
|
|
RPerl::diag( '[[[ POLYCC STDOUT ]]]' . "\n\n" . $polycc_command_stdout . "\n" ); |
1506
|
|
|
|
|
|
|
} |
1507
|
0
|
0
|
|
|
|
|
if ($polycc_command_stderr_content) { |
1508
|
0
|
|
|
|
|
|
RPerl::diag( '[[[ POLYCC STDERR ]]]' . "\n\n" . $polycc_command_stderr . "\n" ); |
1509
|
|
|
|
|
|
|
} |
1510
|
|
|
|
|
|
|
# NEED FIX PARALLEL: actually test polycc output for failure or error messages, etc. |
1511
|
|
|
|
|
|
|
# if ( $test_exit_status == 0 ) { # UNIX process return code 0, success |
1512
|
|
|
|
|
|
|
# RPerl::warning( 'WARNING WCOCOSU00, COMPILER, POLYCC: Pluto PolyCC compiler returned success code but produced output which may indicate an error,' . "\n" . 'please run again with `rperl -D` command or RPERL_DEBUG=1 environmental variable for error messages or other output if none appear above' . "\n" ); |
1513
|
|
|
|
|
|
|
# } |
1514
|
|
|
|
|
|
|
} |
1515
|
|
|
|
|
|
|
|
1516
|
0
|
0
|
|
|
|
|
if ($test_exit_status) { # UNIX process return code not 0, error |
1517
|
0
|
0
|
0
|
|
|
|
if ( not( $polycc_command_stdout_content or $polycc_command_stderr_content ) ) { |
1518
|
0
|
|
|
|
|
|
RPerl::diag( "\n" . '[[[ POLYCC STDOUT & STDERR ARE BOTH EMPTY ]]]' . "\n\n" ); |
1519
|
|
|
|
|
|
|
} |
1520
|
0
|
|
|
|
|
|
croak 'ERROR Exxxxx, COMPILER, POLYCC: Pluto PolyCC compiler returned error code,' . "\n" |
1521
|
|
|
|
|
|
|
. 'please run again with `rperl -D` command or RPERL_DEBUG=1 environmental variable for error messages if none appear above,' . "\n" |
1522
|
|
|
|
|
|
|
. 'croaking'; |
1523
|
|
|
|
|
|
|
} |
1524
|
|
|
|
|
|
|
|
1525
|
|
|
|
|
|
|
# NEED FIX PARALLEL: temporarily disable all user-defined or non-pluto uses of string 'min' and 'max' within parallel loop |
1526
|
|
|
|
|
|
|
|
1527
|
0
|
0
|
0
|
|
|
|
if (( not -e $cpp_output_file_name_group->{OPENMP_CPP} ) or ( not -f $cpp_output_file_name_group->{OPENMP_CPP} ) or ( not -T $cpp_output_file_name_group->{OPENMP_CPP} )) { |
|
|
|
0
|
|
|
|
|
1528
|
0
|
|
|
|
|
|
die 'ERROR Exxxxx, COMPILER, PARALLELIZATION: Missing or invalid Pluto PolyCC output file, ' . q{'} . $cpp_output_file_name_group->{OPENMP_CPP} . q{'} . "\n" . ', dying' . "\n"; |
1529
|
|
|
|
|
|
|
} |
1530
|
|
|
|
|
|
|
|
1531
|
|
|
|
|
|
|
open my filehandleref $FILE_HANDLE_POLYCC, '<', $cpp_output_file_name_group->{OPENMP_CPP} |
1532
|
0
|
0
|
|
|
|
|
or die 'ERROR Exxxxx, COMPILER, PARALLELIZATION: Cannot open Pluto PolyCC output file ' . q{'} . $cpp_output_file_name_group->{OPENMP_CPP} . q{'} . ' for reading,' . $OS_ERROR . ', dying' . "\n"; |
1533
|
|
|
|
|
|
|
|
1534
|
|
|
|
|
|
|
# read in file, strip blank lines |
1535
|
0
|
|
|
|
|
|
my string $file_line_polycc; |
1536
|
0
|
|
|
|
|
|
my string $string_polycc = q{}; |
1537
|
0
|
|
|
|
|
|
while ( $file_line_polycc = <$FILE_HANDLE_POLYCC> ) { |
1538
|
0
|
|
|
|
|
|
$file_line_polycc =~ s/min/polyccmin/gxms; |
1539
|
0
|
|
|
|
|
|
$file_line_polycc =~ s/max/polyccmax/gxms; |
1540
|
0
|
|
|
|
|
|
$string_polycc .= $file_line_polycc; |
1541
|
|
|
|
|
|
|
} |
1542
|
|
|
|
|
|
|
|
1543
|
|
|
|
|
|
|
close $FILE_HANDLE_POLYCC |
1544
|
0
|
0
|
|
|
|
|
or die 'ERROR Exxxxx, COMPILER, PARALLELIZATION: Cannot close file ' . q{'} . $cpp_output_file_name_group->{OPENMP_CPP} . q{'} . ' after reading, ' . $OS_ERROR . ', dying' . "\n"; |
1545
|
|
|
|
|
|
|
|
1546
|
|
|
|
|
|
|
open $FILE_HANDLE_POLYCC, '>', $cpp_output_file_name_group->{OPENMP_CPP} |
1547
|
0
|
0
|
|
|
|
|
or die 'ERROR Exxxxx, COMPILER, PARALLELIZATION: Cannot open Pluto PolyCC output file ' . q{'} . $cpp_output_file_name_group->{OPENMP_CPP} . q{'} . ' for writing,' . $OS_ERROR . ', dying' . "\n"; |
1548
|
|
|
|
|
|
|
|
1549
|
0
|
|
|
|
|
|
print {$FILE_HANDLE_POLYCC} $string_polycc; |
|
0
|
|
|
|
|
|
|
1550
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
close $FILE_HANDLE_POLYCC |
1552
|
0
|
0
|
|
|
|
|
or die 'ERROR Exxxxx, COMPILER, PARALLELIZATION: Cannot close file ' . q{'} . $cpp_output_file_name_group->{OPENMP_CPP} . q{'} . ' after writing, ' . $OS_ERROR . ', dying' . "\n"; |
1553
|
0
|
|
|
|
|
|
return; |
1554
|
|
|
|
|
|
|
} |
1555
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
# Sub-Compile from C++-Parsable String to Perl-Linkable XS & Machine-Readable Binary |
1557
|
|
|
|
|
|
|
sub cpp_to_xsbinary__subcompile { |
1558
|
0
|
|
|
0
|
|
|
{ my void $RETURN_TYPE }; |
|
0
|
|
|
|
|
|
|
1559
|
0
|
|
|
|
|
|
( my string_hashref $cpp_output_file_name_group, my string_hashref $modes ) = @ARG; |
1560
|
|
|
|
|
|
|
|
1561
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::cpp_to_xsbinary__subcompile(), received $cpp_output_file_name_group =} . "\n" . Dumper($cpp_output_file_name_group) . "\n" ); |
1562
|
|
|
|
|
|
|
# RPerl::diag( q{in Compiler::cpp_to_xsbinary__subcompile(), received $modes =} . "\n" . Dumper($modes) . "\n" ); |
1563
|
|
|
|
|
|
|
|
1564
|
0
|
0
|
0
|
|
|
|
if ( ( $modes->{_input_file_name} =~ /[.]pl$/xms ) or ( $modes->{subcompile} ne 'DYNAMIC' ) ) { |
1565
|
0
|
|
|
|
|
|
RPerl::verbose('SUBCOMPILE: Generate binary... '); |
1566
|
|
|
|
|
|
|
|
1567
|
0
|
0
|
0
|
|
|
|
if ( $modes->{subcompile} eq 'OFF' ) { |
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1568
|
0
|
|
|
|
|
|
croak 'ERROR ECOCOSU00, COMPILER, SUBCOMPILE: Received incorrect subcompile mode OFF while inside subcompile subroutine, croaking'; |
1569
|
|
|
|
|
|
|
} |
1570
|
|
|
|
|
|
|
elsif ( ( $modes->{subcompile} ne 'ASSEMBLE' ) |
1571
|
|
|
|
|
|
|
and ( $modes->{subcompile} ne 'ARCHIVE' ) |
1572
|
|
|
|
|
|
|
and ( $modes->{subcompile} ne 'SHARED' ) |
1573
|
|
|
|
|
|
|
and ( $modes->{subcompile} ne 'STATIC' ) |
1574
|
|
|
|
|
|
|
and ( $modes->{subcompile} ne 'DYNAMIC' ) ) |
1575
|
|
|
|
|
|
|
{ |
1576
|
|
|
|
|
|
|
croak 'ERROR ECOCOSU01, COMPILER, SUBCOMPILE: Received invalid subcompile mode ' . q{'} |
1577
|
0
|
|
|
|
|
|
. $modes->{subcompile} . q{'} |
1578
|
|
|
|
|
|
|
. ' while inside subcompile subroutine, croaking'; |
1579
|
|
|
|
|
|
|
} |
1580
|
|
|
|
|
|
|
|
1581
|
0
|
|
|
|
|
|
my string $subcompile_command = $modes->{CXX}; |
1582
|
|
|
|
|
|
|
|
1583
|
0
|
0
|
0
|
|
|
|
if ( ( $modes->{subcompile} eq 'ASSEMBLE' ) |
|
|
0
|
0
|
|
|
|
|
1584
|
|
|
|
|
|
|
or ( $modes->{subcompile} eq 'ARCHIVE' ) ) |
1585
|
|
|
|
|
|
|
{ |
1586
|
|
|
|
|
|
|
# stop the subcompiler after the assemble phase, output .o file; not in original Inline::CPP subcompile command |
1587
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-c'; |
1588
|
|
|
|
|
|
|
} |
1589
|
|
|
|
|
|
|
elsif (( $modes->{subcompile} eq 'STATIC' ) |
1590
|
|
|
|
|
|
|
or ( $modes->{subcompile} eq 'DYNAMIC' ) ) |
1591
|
|
|
|
|
|
|
{ |
1592
|
|
|
|
|
|
|
# Perl requires pthreads, at least Perls compiled with thread support do; not in original Inline::CPP subcompile command |
1593
|
|
|
|
|
|
|
# NEED ANSWER: test for non-threaded Perl to avoid including pthread support? |
1594
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-pthread'; |
1595
|
|
|
|
|
|
|
} |
1596
|
|
|
|
|
|
|
|
1597
|
0
|
|
|
|
|
|
my string $ccflags = [ config_re('ccflags') ]->[0]; |
1598
|
0
|
|
|
|
|
|
substr $ccflags, 0, 9, q{}; # remove leading ccflags=' |
1599
|
0
|
|
|
|
|
|
substr $ccflags, -1, 1, q{}; # remove trailing ' |
1600
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . $ccflags; |
1601
|
|
|
|
|
|
|
|
1602
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-xc++'; # force C++ language mode |
1603
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
# using RPerl::BASE_PATH instead of substr $RPerl::INCLUDE_PATH |
1605
|
|
|
|
|
|
|
# if ( ( ( substr $RPerl::INCLUDE_PATH, -4, 4 ) eq '/lib' ) or ( ( substr $RPerl::INCLUDE_PATH, -4, 4 ) eq '\lib' ) ) { |
1606
|
|
|
|
|
|
|
# $subcompile_command .= q{ } . '-I"' . ( substr $RPerl::INCLUDE_PATH, 0, -4 ) . '"'; # remove trailing /lib or \lib |
1607
|
|
|
|
|
|
|
# } |
1608
|
|
|
|
|
|
|
|
1609
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-I"' . $RPerl::BASE_PATH . '"'; |
1610
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-I"' . $RPerl::INCLUDE_PATH . '"'; # different than original Inline::CPP subcompile command, double-quotes added to encapsulate user-name directories |
1611
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-Ilib'; |
1612
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-I"' . $RPerl::Inline::pcre2_include_dir . '"'; # for regex support |
1613
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-I"' . $RPerl::Inline::jpcre2_include_dir . '"'; # for regex support |
1614
|
|
|
|
|
|
|
|
1615
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . $RPerl::Inline::CCFLAGSEX; |
1616
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-D__' . $modes->{types} . '__TYPES'; # same as #define __PERL__TYPES or #define__CPP__TYPES; don't just use hard-coded $RPerl::TYPES_CCFLAG |
1617
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-D__TYPE__INTEGER__' . $modes->{type_integer}; |
1618
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-D__TYPE__NUMBER__' . $modes->{type_number}; |
1619
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . $RPerl::Inline::ARGS{optimize}; |
1620
|
|
|
|
|
|
|
|
1621
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-DVERSION=\"0.00\" -DXS_VERSION=\"0.00\"'; # NEED ANSWER: what does this do? |
1622
|
|
|
|
|
|
|
|
1623
|
0
|
|
|
|
|
|
my string $cccdlflags = [ config_re('cccdlflags') ]->[0]; |
1624
|
0
|
|
|
|
|
|
substr $cccdlflags, 0, 12, q{}; # remove leading cccdlflags=' |
1625
|
0
|
|
|
|
|
|
substr $cccdlflags, -1, 1, q{}; # remove trailing ' |
1626
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . $cccdlflags; |
1627
|
|
|
|
|
|
|
|
1628
|
0
|
0
|
|
|
|
|
if ( $RPerl::CORE_PATH eq q{} ) { |
1629
|
0
|
|
|
|
|
|
croak 'ERROR ECOCOSU02, COMPILER, SUBCOMPILE: Perl source code CORE directory or CORE/perl.h file not found in @INC path listing, croaking'; |
1630
|
|
|
|
|
|
|
} |
1631
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '"-I' . $RPerl::CORE_PATH . '"'; |
1632
|
|
|
|
|
|
|
|
1633
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
|
1635
|
|
|
|
|
|
|
|
1636
|
0
|
0
|
|
|
|
|
if ($modes->{parallel} eq 'OFF') { |
|
|
0
|
|
|
|
|
|
1637
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . $cpp_output_file_name_group->{CPP}; |
1638
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-o '; |
1639
|
|
|
|
|
|
|
|
1640
|
0
|
0
|
0
|
|
|
|
if ( ( $modes->{subcompile} eq 'ASSEMBLE' ) |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
or ( $modes->{subcompile} eq 'ARCHIVE' ) ) |
1642
|
|
|
|
|
|
|
{ |
1643
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . $cpp_output_file_name_group->{O}; |
1644
|
|
|
|
|
|
|
} |
1645
|
|
|
|
|
|
|
elsif ( $modes->{subcompile} eq 'SHARED' ) { |
1646
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . $cpp_output_file_name_group->{SO}; |
1647
|
|
|
|
|
|
|
} |
1648
|
|
|
|
|
|
|
elsif (( $modes->{subcompile} eq 'STATIC' ) |
1649
|
|
|
|
|
|
|
or ( $modes->{subcompile} eq 'DYNAMIC' ) ) |
1650
|
|
|
|
|
|
|
{ |
1651
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . $cpp_output_file_name_group->{EXE}; |
1652
|
|
|
|
|
|
|
} |
1653
|
|
|
|
|
|
|
} |
1654
|
|
|
|
|
|
|
elsif ($modes->{parallel} eq 'OPENMP') { |
1655
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-mtune=native -ftree-vectorize -DTIME -fopenmp'; |
1656
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . $cpp_output_file_name_group->{OPENMP_CPP}; |
1657
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-o '; |
1658
|
|
|
|
|
|
|
|
1659
|
|
|
|
|
|
|
# NEED FIX PARALLEL: handle other subcompile modes??? |
1660
|
0
|
0
|
0
|
|
|
|
if (( $modes->{subcompile} eq 'STATIC' ) |
1661
|
|
|
|
|
|
|
or ( $modes->{subcompile} eq 'DYNAMIC' ) ) |
1662
|
|
|
|
|
|
|
{ |
1663
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . $cpp_output_file_name_group->{OPENMP_EXE}; |
1664
|
|
|
|
|
|
|
} |
1665
|
|
|
|
|
|
|
} |
1666
|
|
|
|
|
|
|
|
1667
|
0
|
0
|
|
|
|
|
if ( $modes->{subcompile} eq 'SHARED' ) { |
|
|
0
|
|
|
|
|
|
1668
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-shared'; |
1669
|
|
|
|
|
|
|
} |
1670
|
|
|
|
|
|
|
elsif ( $modes->{subcompile} eq 'STATIC' ) { |
1671
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-static'; |
1672
|
|
|
|
|
|
|
} |
1673
|
|
|
|
|
|
|
|
1674
|
0
|
0
|
0
|
|
|
|
if ( ( $modes->{subcompile} eq 'STATIC' ) |
1675
|
|
|
|
|
|
|
or ( $modes->{subcompile} eq 'DYNAMIC' ) ) |
1676
|
|
|
|
|
|
|
{ |
1677
|
0
|
0
|
|
|
|
|
if ($modes->{parallel} eq 'OPENMP') { |
1678
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-lm'; # not in original Inline::CPP subcompile command |
1679
|
|
|
|
|
|
|
} |
1680
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-lperl'; # not in original Inline::CPP subcompile command |
1681
|
|
|
|
|
|
|
# DEV NOTE, CORRELATION #rp300: must link against all bit width libs to allow automatic selection |
1682
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-lpcre2-8 -lpcre2-16 -lpcre2-32'; # for regex support, not in original Inline::CPP subcompile command |
1683
|
|
|
|
|
|
|
} |
1684
|
|
|
|
|
|
|
|
1685
|
0
|
0
|
|
|
|
|
if ( $modes->{subcompile} eq 'STATIC' ) { |
1686
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . '-lcrypt'; # not in original Inline::CPP subcompile command |
1687
|
|
|
|
|
|
|
} |
1688
|
|
|
|
|
|
|
|
1689
|
0
|
0
|
|
|
|
|
if ( $modes->{subcompile} eq 'ARCHIVE' ) { |
1690
|
0
|
|
|
|
|
|
$subcompile_command .= q{ } . ' ; ar -cvq ' . $cpp_output_file_name_group->{A} . q{ } . $cpp_output_file_name_group->{O}; |
1691
|
|
|
|
|
|
|
|
1692
|
|
|
|
|
|
|
# NEED ANSWER: is this always the correct output redirect mechanism M$ Windows? I think it is correct for cmd.exe, but what about Cygwin, etc? |
1693
|
0
|
0
|
|
|
|
|
if ( $OSNAME eq 'MSWin32' ) { $subcompile_command .= q{ } . ' > nul'; } |
|
0
|
|
|
|
|
|
|
1694
|
0
|
|
|
|
|
|
else { $subcompile_command .= q{ } . ' > /dev/null'; } |
1695
|
|
|
|
|
|
|
} |
1696
|
|
|
|
|
|
|
# my $pid = open3( 0, \*SUBCOMPILE_STDOUT, \*SUBCOMPILE_STDERR, $subcompile_command ); # disable STDIN w/ 0 |
1697
|
|
|
|
|
|
|
# |
1698
|
|
|
|
|
|
|
# my $stdout_select; |
1699
|
|
|
|
|
|
|
# my $stderr_select; |
1700
|
|
|
|
|
|
|
# if ( $OSNAME ne 'MSWin32' ) { |
1701
|
|
|
|
|
|
|
# $stdout_select = IO::Select->new(); |
1702
|
|
|
|
|
|
|
# $stderr_select = IO::Select->new(); |
1703
|
|
|
|
|
|
|
# $stdout_select->add( \*SUBCOMPILE_STDOUT ); |
1704
|
|
|
|
|
|
|
# $stderr_select->add( \*SUBCOMPILE_STDERR ); |
1705
|
|
|
|
|
|
|
# } |
1706
|
|
|
|
|
|
|
# |
1707
|
|
|
|
|
|
|
|
1708
|
|
|
|
|
|
|
# RPerl::diag( "\n" . 'in Compiler::cpp_to_xsbinary__subcompile(), have $subcompile_command =' . "\n\n" . $subcompile_command . "\n\n" ); |
1709
|
0
|
|
|
|
|
|
RPerl::diag( "\n\n" . $subcompile_command . "\n\n" ); |
1710
|
0
|
0
|
0
|
|
|
|
if ( $ENV{RPERL_VERBOSE} or $RPerl::VERBOSE ) { RPerl::diag( q{SUBCOMPILE: Generate binary... } ); } |
|
0
|
|
|
|
|
|
|
1711
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
# if ( $OSNAME eq 'MSWin32' || $stdout_select->can_read(0) ) { sysread SUBCOMPILE_STDOUT, $subcompile_command_stdout, 4096; } |
1713
|
|
|
|
|
|
|
# if ( $OSNAME eq 'MSWin32' || $stderr_select->can_read(0) ) { sysread SUBCOMPILE_STDERR, $subcompile_command_stderr, 4096; } |
1714
|
|
|
|
|
|
|
# waitpid $pid, 0; |
1715
|
|
|
|
|
|
|
# if ( $OSNAME eq 'MSWin32' || $stdout_select->can_read(0) ) { my $s; sysread SUBCOMPILE_STDOUT, $s, 4096; $subcompile_command_stdout .= $s; } |
1716
|
|
|
|
|
|
|
# if ( $OSNAME eq 'MSWin32' || $stderr_select->can_read(0) ) { my $s; sysread SUBCOMPILE_STDERR, $s, 4096; $subcompile_command_stderr .= $s; } |
1717
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
# ACTUALLY RUN SUBCOMPILE COMMAND |
1719
|
0
|
|
|
|
|
|
my string $subcompile_command_stdout = q{}; |
1720
|
0
|
|
|
|
|
|
my string $subcompile_command_stderr = q{}; |
1721
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
#my $pid = open3( 0, \*SUBCOMPILE_STDOUT, \*SUBCOMPILE_STDERR, $subcompile_command ); # disable STDIN w/ 0 |
1723
|
0
|
|
|
|
|
|
run3( $subcompile_command, \undef, \$subcompile_command_stdout, \$subcompile_command_stderr ); |
1724
|
|
|
|
|
|
|
|
1725
|
0
|
|
|
|
|
|
my $test_exit_status = $CHILD_ERROR >> 8; |
1726
|
|
|
|
|
|
|
|
1727
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::cpp_to_xsbinary__subcompile(), have $CHILD_ERROR = ' . $CHILD_ERROR . "\n" ); |
1728
|
|
|
|
|
|
|
# RPerl::diag( 'in Compiler::cpp_to_xsbinary__subcompile(), have $test_exit_status = ' . $test_exit_status . "\n" ); |
1729
|
|
|
|
|
|
|
|
1730
|
0
|
|
|
|
|
|
RPerl::verbose( ' done.' . "\n" ); |
1731
|
|
|
|
|
|
|
|
1732
|
|
|
|
|
|
|
# delete temporary .o file |
1733
|
0
|
0
|
|
|
|
|
if ( $modes->{subcompile} eq 'ARCHIVE' ) { |
1734
|
0
|
0
|
|
|
|
|
if ( -f $cpp_output_file_name_group->{O} ) { |
1735
|
|
|
|
|
|
|
unlink( $cpp_output_file_name_group->{O} ) |
1736
|
|
|
|
|
|
|
or croak( "\n" |
1737
|
|
|
|
|
|
|
. 'ERROR ECOCOSU03, COMPILER, SUBCOMPILE: Cannot delete temporary object file ' . q{'} |
1738
|
0
|
0
|
|
|
|
|
. $cpp_output_file_name_group->{O} . q{'} . ',' . "\n" |
1739
|
|
|
|
|
|
|
. 'croaking:' |
1740
|
|
|
|
|
|
|
. $OS_ERROR ); |
1741
|
|
|
|
|
|
|
} |
1742
|
|
|
|
|
|
|
} |
1743
|
|
|
|
|
|
|
|
1744
|
|
|
|
|
|
|
# if ($subcompile_command_stdout) { RPerl::diag( "===STDOUT=BEGIN===\n" . $subcompile_command_stdout . "===STDOUT=END===\n" ); } |
1745
|
|
|
|
|
|
|
# if ($subcompile_command_stderr) { RPerl::diag( "===STDERR=BEGIN===\n" . $subcompile_command_stderr . "===STDERR=END===\n" ); } |
1746
|
0
|
|
0
|
|
|
|
my boolean $subcompile_command_stdout_content = ( ( defined $subcompile_command_stdout ) and ( $subcompile_command_stdout =~ m/[^\s]+/g ) ); |
1747
|
0
|
|
0
|
|
|
|
my boolean $subcompile_command_stderr_content = ( ( defined $subcompile_command_stderr ) and ( $subcompile_command_stderr =~ m/[^\s]+/g ) ); |
1748
|
|
|
|
|
|
|
|
1749
|
0
|
0
|
0
|
|
|
|
if ( $subcompile_command_stdout_content or $subcompile_command_stderr_content ) { |
1750
|
0
|
|
|
|
|
|
RPerl::diag("\n"); |
1751
|
0
|
0
|
|
|
|
|
if ($subcompile_command_stdout_content) { |
1752
|
0
|
|
|
|
|
|
RPerl::diag( '[[[ SUBCOMPILE STDOUT ]]]' . "\n\n" . $subcompile_command_stdout . "\n" ); |
1753
|
|
|
|
|
|
|
} |
1754
|
0
|
0
|
|
|
|
|
if ($subcompile_command_stderr_content) { |
1755
|
0
|
|
|
|
|
|
RPerl::diag( '[[[ SUBCOMPILE STDERR ]]]' . "\n\n" . $subcompile_command_stderr . "\n" ); |
1756
|
|
|
|
|
|
|
} |
1757
|
0
|
0
|
|
|
|
|
if ( $test_exit_status == 0 ) { # UNIX process return code 0, success |
1758
|
0
|
|
|
|
|
|
RPerl::warning( |
1759
|
|
|
|
|
|
|
'WARNING WCOCOSU00, COMPILER, SUBCOMPILE: C++ compiler returned success code but produced output which may indicate an error,' . "\n" |
1760
|
|
|
|
|
|
|
. 'please run again with `rperl -D` command or RPERL_DEBUG=1 environmental variable for error messages or other output if none appear above' |
1761
|
|
|
|
|
|
|
. "\n" ); |
1762
|
|
|
|
|
|
|
} |
1763
|
|
|
|
|
|
|
} |
1764
|
|
|
|
|
|
|
|
1765
|
0
|
0
|
|
|
|
|
if ($test_exit_status) { # UNIX process return code not 0, error |
1766
|
0
|
0
|
0
|
|
|
|
if ( not( $subcompile_command_stdout_content or $subcompile_command_stderr_content ) ) { |
1767
|
0
|
|
|
|
|
|
RPerl::diag( "\n" . '[[[ SUBCOMPILE STDOUT & STDERR ARE BOTH EMPTY ]]]' . "\n\n" ); |
1768
|
|
|
|
|
|
|
} |
1769
|
0
|
|
|
|
|
|
croak 'ERROR ECOCOSU04, COMPILER, SUBCOMPILE: C++ compiler returned error code,' . "\n" |
1770
|
|
|
|
|
|
|
. 'please run again with `rperl -D` command or RPERL_DEBUG=1 environmental variable for error messages if none appear above,' . "\n" |
1771
|
|
|
|
|
|
|
. 'croaking'; |
1772
|
|
|
|
|
|
|
} |
1773
|
|
|
|
|
|
|
} |
1774
|
|
|
|
|
|
|
else { # *.pm module files |
1775
|
0
|
|
|
|
|
|
RPerl::verbose('SUBCOMPILE: Generate XS & binary...'); |
1776
|
|
|
|
|
|
|
|
1777
|
|
|
|
|
|
|
( my string $volume_pmc, my string $directories_pmc, my string $file_pmc ) |
1778
|
0
|
|
|
|
|
|
= File::Spec->splitpath( $cpp_output_file_name_group->{PMC}, my $no_file = 0 ); |
1779
|
|
|
|
|
|
|
|
1780
|
|
|
|
|
|
|
#RPerl::diag( q{in Compiler::cpp_to_xsbinary__subcompile(), have $directories_pmc = } . $directories_pmc . "\n" ); |
1781
|
|
|
|
|
|
|
|
1782
|
|
|
|
|
|
|
# strip trailing / or \ as long as they are not the only characters, which could indicate the root directory |
1783
|
0
|
0
|
0
|
|
|
|
if ( ( ( length $directories_pmc ) > 1 ) |
|
|
|
0
|
|
|
|
|
1784
|
|
|
|
|
|
|
and ( ( ( substr $directories_pmc, -1, 1 ) eq q{/} ) or ( ( substr $directories_pmc, -1, 1 ) eq q{\\} ) ) ) |
1785
|
|
|
|
|
|
|
{ |
1786
|
0
|
|
|
|
|
|
substr $directories_pmc, -1, 1, q{}; |
1787
|
|
|
|
|
|
|
} |
1788
|
|
|
|
|
|
|
|
1789
|
0
|
|
|
|
|
|
my @INC_sorted = sort { length $b <=> length $a } @INC; |
|
0
|
|
|
|
|
|
|
1790
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
#RPerl::diag( q{in Compiler::cpp_to_xsbinary__subcompile(), have @INC =} . "\n" . Dumper(\@INC) . "\n" ); |
1792
|
|
|
|
|
|
|
#RPerl::diag( q{in Compiler::cpp_to_xsbinary__subcompile(), have @INC_sorted =} . "\n" . Dumper(\@INC_sorted) . "\n" ); |
1793
|
|
|
|
|
|
|
|
1794
|
|
|
|
|
|
|
# strip leading INC directory if present |
1795
|
0
|
|
|
|
|
|
foreach my string $INC_directory (@INC_sorted) { |
1796
|
|
|
|
|
|
|
|
1797
|
|
|
|
|
|
|
#RPerl::diag( q{in Compiler::cpp_to_xsbinary__subcompile(), have $INC_directory = } . $INC_directory . "\n" ); |
1798
|
0
|
0
|
|
|
|
|
if ( $directories_pmc =~ /^$INC_directory/ ) { |
1799
|
0
|
|
|
|
|
|
substr $directories_pmc, 0, ( length $INC_directory ), q{}; |
1800
|
0
|
|
|
|
|
|
last; |
1801
|
|
|
|
|
|
|
} |
1802
|
|
|
|
|
|
|
} |
1803
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
#RPerl::diag( q{in Compiler::cpp_to_xsbinary__subcompile(), have POSSIBLY-MODIFIED $directories_pmc = } . $directories_pmc . "\n" ); |
1805
|
|
|
|
|
|
|
|
1806
|
0
|
|
|
|
|
|
my string_arrayref $directories_pmc_split = [ File::Spec->splitdir($directories_pmc) ]; |
1807
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
#RPerl::diag( q{in Compiler::cpp_to_xsbinary__subcompile(), have $directories_pmc_split =} . "\n" . Dumper($directories_pmc_split) . "\n" ); |
1809
|
|
|
|
|
|
|
|
1810
|
|
|
|
|
|
|
# discard '.' or empty directory names |
1811
|
0
|
|
|
|
|
|
my $directories_pmc_split_tmp = []; |
1812
|
0
|
|
|
|
|
|
foreach my $directory ( @{$directories_pmc_split} ) { |
|
0
|
|
|
|
|
|
|
1813
|
0
|
0
|
0
|
|
|
|
if ( ( $directory ne q{.} ) and ( $directory ne q{} ) ) { |
1814
|
0
|
|
|
|
|
|
push @{$directories_pmc_split_tmp}, $directory; |
|
0
|
|
|
|
|
|
|
1815
|
|
|
|
|
|
|
} |
1816
|
|
|
|
|
|
|
} |
1817
|
0
|
|
|
|
|
|
$directories_pmc_split = $directories_pmc_split_tmp; |
1818
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
# strip trailing .pmc file suffix |
1820
|
0
|
|
|
|
|
|
substr $file_pmc, -4, 4, q{}; |
1821
|
|
|
|
|
|
|
|
1822
|
0
|
|
|
|
|
|
my string $eval_string = join '::', @{$directories_pmc_split}, $file_pmc; |
|
0
|
|
|
|
|
|
|
1823
|
0
|
|
|
|
|
|
$eval_string = 'use ' . $eval_string . ';'; |
1824
|
|
|
|
|
|
|
|
1825
|
|
|
|
|
|
|
#RPerl::diag( q{in Compiler::cpp_to_xsbinary__subcompile(), have $eval_string =} . "\n" . $eval_string . "\n" ); |
1826
|
|
|
|
|
|
|
|
1827
|
|
|
|
|
|
|
# NEED FIX: why does Inline::CPP require double-subcompiling??? |
1828
|
|
|
|
|
|
|
# DEV NOTE: exec() and system() don't work, only backticks |
1829
|
|
|
|
|
|
|
|
1830
|
|
|
|
|
|
|
# `export RPERL_WARNINGS=0; perl -e '$eval_string'`; # should build |
1831
|
|
|
|
|
|
|
#RPerl::diag( q{in Compiler::cpp_to_xsbinary__subcompile(), done with backticks 1...} . "\n" ); |
1832
|
|
|
|
|
|
|
|
1833
|
|
|
|
|
|
|
# `export RPERL_WARNINGS=0; perl -e '$eval_string'`; # should not build, but does |
1834
|
|
|
|
|
|
|
#RPerl::diag( q{in Compiler::cpp_to_xsbinary__subcompile(), done with backticks 2...} . "\n" ); |
1835
|
|
|
|
|
|
|
|
1836
|
|
|
|
|
|
|
# `export RPERL_WARNINGS=0; perl -e '$eval_string'`; # should not build, does not seem to |
1837
|
|
|
|
|
|
|
#RPerl::diag( q{in Compiler::cpp_to_xsbinary__subcompile(), done with backticks 3...} . "\n" ); |
1838
|
|
|
|
|
|
|
|
1839
|
0
|
|
|
|
|
|
RPerl::verbose( ' deferred.' . "\n" ); |
1840
|
|
|
|
|
|
|
} |
1841
|
0
|
|
|
|
|
|
return; |
1842
|
|
|
|
|
|
|
} |
1843
|
|
|
|
|
|
|
|
1844
|
|
|
|
|
|
|
1; # end of class |