1#!/usr/local/bin/perl
2###########################################################################
3# API Sanity Checker 1.98.4
4# An automatic generator of basic unit tests for a C/C++ library API
5#
6# Copyright (C) 2009-2010 The Linux Foundation
7# Copyright (C) 2009-2011 Institute for System Programming, RAS
8# Copyright (C) 2011-2013 ROSA Laboratory
9#
10# Written by Andrey Ponomarenko
11#
12# PLATFORMS
13# =========
14#  Linux, FreeBSD, Mac OS X, MS Windows
15#
16# REQUIREMENTS
17# ============
18#  Linux
19#    - ABI Compliance Checker (1.99 or newer)
20#    - G++ (3.0-4.7, recommended 4.5 or newer)
21#    - GNU Binutils (readelf, c++filt, objdump)
22#    - Perl 5 (5.8 or newer)
23#    - Ctags (5.8 or newer)
24#
25#  Mac OS X
26#    - ABI Compliance Checker (1.99 or newer)
27#    - Xcode (gcc, c++filt, nm)
28#    - Ctags (5.8 or newer)
29#
30#  MS Windows
31#    - ABI Compliance Checker (1.99 or newer)
32#    - MinGW (3.0-4.7, recommended 4.5 or newer)
33#    - MS Visual C++ (dumpbin, undname, cl)
34#    - Active Perl 5 (5.8 or newer)
35#    - Ctags (5.8 or newer)
36#    - Add tool locations to the PATH environment variable
37#    - Run vsvars32.bat (C:\Microsoft Visual Studio 9.0\Common7\Tools\)
38#
39# This program is free software: you can redistribute it and/or modify
40# it under the terms of the GNU General Public License or the GNU Lesser
41# General Public License as published by the Free Software Foundation.
42#
43# This program is distributed in the hope that it will be useful,
44# but WITHOUT ANY WARRANTY; without even the implied warranty of
45# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
46# GNU General Public License for more details.
47#
48# You should have received a copy of the GNU General Public License
49# and the GNU Lesser General Public License along with this program.
50# If not, see <http://www.gnu.org/licenses/>.
51###########################################################################
52use Getopt::Long;
53Getopt::Long::Configure ("posix_default", "no_ignore_case");
54use POSIX qw(setsid);
55use File::Path qw(mkpath rmtree);
56use File::Temp qw(tempdir);
57use File::Copy qw(copy);
58use Cwd qw(abs_path cwd realpath);
59use Config;
60
61my $TOOL_VERSION = "1.98.4";
62my $OSgroup = get_OSgroup();
63my $ORIG_DIR = cwd();
64my $TMP_DIR = tempdir(CLEANUP=>1);
65
66my $ABICC = "/usr/local/bin/abi-compliance-checker.pl";
67my $ABICC_VERSION = "1.99";
68
69# Internal modules
70my $MODULES_DIR = get_Modules();
71push(@INC, get_dirname($MODULES_DIR));
72
73my ($Help, $InfoMsg, $TargetLibraryName, $GenerateTests, $TargetInterfaceName,
74$BuildTests, $RunTests, $CleanTests, $DisableReuse, $LongVarNames, %Descriptor,
75$UseXvfb, $TestTool, $MinimumCode, $TestDataPath, $MaximumCode, $RandomCode,
76$GenerateDescriptorTemplate, $GenerateSpecTypeTemplate, $InterfacesListPath,
77$SpecTypes_PackagePath, $CheckReturn, $DisableDefaultValues, $ShowRetVal,
78$CheckHeadersOnly, $Template2Code, $Standalone, $ShowVersion, $MakeIsolated,
79$ParameterNamesFilePath, $CleanSources, $DumpVersion, $TargetHeaderName,
80$RelativeDirectory, $TargetLibraryFullName, $TargetVersion, $StrictGen,
81$StrictBuild, $StrictRun, $Strict, $Debug, $UseCache, $NoInline, $Browse,
82$OpenReport, $UserLang, $OptimizeIncludes, $KeepInternal, $TargetCompiler);
83
84my $CmdName = get_filename($0);
85my %OS_LibExt=(
86    "linux"=>"so",
87    "macos"=>"dylib",
88    "windows"=>"dll",
89    "symbian"=>"dso",
90    "default"=>"so"
91);
92
93my %ERROR_CODE = (
94    # Passed
95    "Success"=>0,
96    # Failed
97    "Failed"=>1,
98    # Undifferentiated error code
99    "Error"=>2,
100    # Cannot access input files
101    "Access_Error"=>4,
102    # Cannot find a module
103    "Module_Error"=>9
104);
105
106my %HomePage = (
107    "Wiki"=>"http://ispras.linuxbase.org/index.php/API_Sanity_Checker",
108    "Dev"=>"https://github.com/lvc/api-sanity-checker"
109);
110
111my $ShortUsage = "API Sanity Checker $TOOL_VERSION
112Unit test generator for a C/C++ library API
113Copyright (C) 2013 ROSA Lab
114License: GNU LGPL or GNU GPL
115
116Usage: $CmdName [options]
117Example: $CmdName -lib NAME -d VER.xml -gen -build -run
118
119VER.xml is XML-descriptor:
120
121    <version>
122        1.0
123    </version>
124
125    <headers>
126        /path/to/headers/
127    </headers>
128
129    <libs>
130        /path/to/libraries/
131    </libs>
132
133More info: $CmdName --help\n";
134
135if($#ARGV==-1)
136{
137    print $ShortUsage;
138    exit(0);
139}
140
141my @INPUT_OPTIONS = @ARGV;
142
143GetOptions("h|help!" => \$Help,
144  "info!" => \$InfoMsg,
145  "v|version!" => \$ShowVersion,
146  "dumpversion!" => \$DumpVersion,
147# general options
148  "l|lib|library=s" => \$TargetLibraryName,
149  "d|descriptor=s" => \$Descriptor{"Path"},
150  "gen|generate!" => \$GenerateTests,
151  "build|make!" => \$BuildTests,
152  "run!" => \$RunTests,
153  "clean!" => \$CleanTests,
154# extra options
155  "d-tmpl|descriptor-template!" =>\$GenerateDescriptorTemplate,
156  "s-tmpl|specialized-type-template!" =>\$GenerateSpecTypeTemplate,
157  "vnum=s" =>\$TargetVersion,
158  "s|symbol|f|function|i|interface=s" => \$TargetInterfaceName,
159  "symbols-list|functions-list|interfaces-list=s" => \$InterfacesListPath,
160  "header=s" => \$TargetHeaderName,
161  "xvfb!" => \$UseXvfb,
162  "t2c|template2code" => \$Template2Code,
163  "strict-gen!" => \$StrictGen,
164  "strict-build!" => \$StrictBuild,
165  "strict-run!" => \$StrictRun,
166  "strict!" => \$Strict,
167  "r|random!" =>\$RandomCode,
168  "min!" =>\$MinimumCode,
169  "max!" =>\$MaximumCode,
170  "show-retval!" => \$ShowRetVal,
171  "check-retval!" => \$CheckReturn,
172  "st|specialized-types=s" => \$SpecTypes_PackagePath,
173  "td|test-data=s" => \$TestDataPath,
174  "headers-only!" => \$CheckHeadersOnly,
175  "no-inline!" => \$NoInline,
176  "keep-internal!" => \$KeepInternal,
177  "isolated!" => \$MakeIsolated,
178  "view-only!" => \$CleanSources,
179  "disable-default-values!" => \$DisableDefaultValues,
180  "optimize-includes=s" => \$OptimizeIncludes,
181  "p|params=s" => \$ParameterNamesFilePath,
182  "l-full|lib-full=s" => \$TargetLibraryFullName,
183  "relpath|reldir=s" => \$RelativeDirectory,
184  "lang=s" => \$UserLang,
185  "target=s" => \$TargetCompiler,
186  "debug!" => \$Debug,
187  "cache!" => \$UseCache,
188# other options
189  "test!" => \$TestTool,
190  "disable-variable-reuse!" => \$DisableReuse,
191  "long-variable-names!" => \$LongVarNames,
192  "b|browse=s" => \$Browse,
193  "open!" => \$OpenReport
194) or ERR_MESSAGE();
195
196sub ERR_MESSAGE()
197{
198    print $ShortUsage;
199    exit(1);
200}
201
202my $LIB_EXT = $OS_LibExt{$OSgroup}?$OS_LibExt{$OSgroup}:$OS_LibExt{"default"};
203
204my $HelpMessage="
205NAME:
206  API Sanity Checker ($CmdName)
207  Generate basic unit tests for a C/C++ library API
208
209DESCRIPTION:
210  API Sanity Checker is an automatic generator of basic unit tests for a C/C++
211  library. It helps to quickly generate simple (\"sanity\" or \"shallow\"
212  quality) tests for every function in an API using their signatures, data type
213  definitions and relationships between functions straight from the library
214  header files (\"Header-Driven Generation\"). Each test case contains a function
215  call with reasonable (in most, but unfortunately not all, cases) input
216  parameters. The quality of generated tests allows to check absence of critical
217  errors in simple use cases and can be greatly improved by involving of highly
218  reusable specialized types for the library.
219
220  The tool can execute generated tests and detect crashes, aborts, all kinds of
221  emitted signals, non-zero program return code, program hanging and requirement
222  failures (if specified). The tool can be considered as a tool for out-of-box
223  low-cost sanity checking of library API or as a test development framework for
224  initial generation of templates for advanced tests. Also it supports universal
225  Template2Code format of tests, splint specifications, random test generation
226  mode and other useful features.
227
228  This tool is free software: you can redistribute it and/or modify it
229  under the terms of the GNU LGPL or GNU GPL.
230
231USAGE:
232  $CmdName [options]
233
234EXAMPLE:
235  $CmdName -lib NAME -d VER.xml -gen -build -run
236
237  VERSION.xml is XML-descriptor:
238
239    <version>
240        1.0
241    </version>
242
243    <headers>
244        /path1/to/header(s)/
245        /path2/to/header(s)/
246         ...
247    </headers>
248
249    <libs>
250        /path1/to/library(ies)/
251        /path2/to/library(ies)/
252         ...
253    </libs>
254
255INFORMATION OPTIONS:
256  -h|-help
257      Print this help.
258
259  -info
260      Print complete info.
261
262  -v|-version
263      Print version information.
264
265  -dumpversion
266      Print the tool version ($TOOL_VERSION) and don't do anything else.
267
268GENERAL OPTIONS:
269  -l|-lib|-library NAME
270      Library name (without version).
271
272  -d|-descriptor PATH
273      Path to the library descriptor (VER.xml file):
274
275        <version>
276            1.0
277        </version>
278
279        <headers>
280            /path1/to/header(s)/
281            /path2/to/header(s)/
282            ...
283        </headers>
284
285        <libs>
286            /path1/to/library(ies)/
287            /path2/to/library(ies)/
288            ...
289        </libs>
290
291            ... (XML-descriptor template
292                    can be generated by -d-tmpl option)
293
294      For more information, please see:
295        http://ispras.linuxbase.org/index.php/Library_Descriptor
296
297  -gen|-generate
298      Generate test(s). Options -l and -d should be specified.
299      To generate test for the particular function use it with -f option.
300      Exit code: number of test cases failed to build.
301
302  -build|-make
303      Build test(s). Options -l and -d should be specified.
304      To build test for the particular function use it with -f option.
305      Exit code: number of test cases failed to generate.
306
307  -run
308      Run test(s), create test report. Options -l and -d should be specified.
309      To run test for the particular function use it with -f option.
310      Exit code: number of failed test cases.
311
312  -clean
313      Clean test(s). Options -l and -d should be specified.
314      To clean test for the particular function use it with -f option.\n";
315
316sub HELP_MESSAGE() {
317    print $HelpMessage."
318MORE INFO:
319     $CmdName --info\n\n";
320}
321
322sub INFO_MESSAGE()
323{
324    printMsg("INFO", "$HelpMessage
325EXTRA OPTIONS:
326  -d-tmpl|-descriptor-template
327      Create XML-descriptor template ./VERSION.xml
328
329  -s-tmpl|specialized-type-template
330      Create specialized type template ./SPECTYPES.xml
331
332  -vnum NUM
333      Specify library version outside the descriptor.
334
335  -s|-symbol NAME
336      Generate/Build/Run test for the specified function
337      (mangled name in C++).
338
339  -symbols-list PATH
340      This option allows to specify a file with a list of functions
341      (one per line, mangled name in C++) that should be tested,
342      other library functions will not be tested.
343
344  -header NAME
345      This option allows to restrict a list of functions that should be tested
346      by providing a header file name in which they are declared. This option
347      is intended for step-by-step tests development.
348
349  -xvfb
350      Use Xvfb-server instead of current X-server (default)
351      for running tests.
352
353  -t2c|-template2code
354      Generate tests in the universal Template2Code format.
355      For more information, please see:
356        http://sourceforge.net/projects/template2code/
357
358  -strict-gen
359     Terminate the process of generating tests and return
360     error code '1' if cannot generate at least one test case.
361
362  -strict-build
363     Terminate the process of building tesst and return
364     error code '1' if cannot build at least one test case.
365
366  -strict-run
367     Terminate the process of running tests and return
368     error code '1' if at least one test case failed.
369
370  -strict
371     This option enables all -strict-* options.
372
373  -r|-random
374      Random test generation mode.
375
376  -min
377      Generate minimun code, call functions with minimum number of parameters
378      to initialize parameters of other functions.
379
380  -max
381      Generate maximum code, call functions with maximum number of parameters
382      to initialize parameters of other functions.
383
384  -show-retval
385      Show the function return type in the report.
386
387  -check-retval
388      Insert requirements on return values (retval!=NULL) for each
389      called function.
390
391  -st|-specialized-types PATH
392      Path to the file with the collection of specialized types.
393      For more information, please see:
394        http://ispras.linuxbase.org/index.php/Specialized_Type
395
396  -td|-test-data PATH
397      Path to the directory with the test data files.
398      For more information, please see:
399        http://ispras.linuxbase.org/index.php/Specialized_Type
400
401  -headers-only
402      If the library consists of inline functions only and has no shared
403      objects then you should specify this option.
404
405  -no-inline
406      Don't generate tests for inline functions.
407
408  -keep-internal
409      Generate tests for internal symbols (functions with '__' prefix and
410      methods of classes declared inside other classes).
411
412  -isolated
413      Allow to restrict functions usage by the lists specified by the
414      -functions-list option or by the group devision in the descriptor.
415
416  -view-only
417      Remove all files from the test suite except *.html files. This option
418      allows to create a lightweight html-index for all tests.
419
420  -disable-default-values
421      Disable usage of default values for function parameters.
422
423  -optimize-includes LEVEL
424      Enable optimization of the list of included headers in each test case.
425      Available levels:
426        High (default)
427        Medium
428        Low
429        None - disable
430
431  -p|-params PATH
432      Path to file with the function parameter names. It can be used for
433      improving generated tests if the library header files don't contain
434      parameter names. File format:
435
436            func1;param1;param2;param3 ...
437            func2;param1;param2;param3 ...
438            ...
439
440  -l-full|-lib-full NAME
441      Library name in the report title.
442
443  -relpath|-reldir PATH
444      Replace {RELPATH} in the library descriptor by PATH.
445
446  -lang LANG
447      Set library language (C or C++). You can use this option if the tool
448      cannot auto-detect a language.
449
450  -target COMPILER
451      The compiler that should be used to build generated tests under Windows.
452      Supported:
453        gcc - GNU compiler
454        cl - MS compiler (default)
455
456  -debug
457      Write extended log for debugging.
458
459  -cache
460      Cache the ABI dump and use it on the next run.
461
462OTHER OPTIONS:
463  -test
464      Run internal tests. Create a simple library and run the tool on it.
465      This option allows to check if the tool works correctly on the system.
466
467  -disable-variable-reuse
468      Disable reusing of previously created variables in the test.
469
470  -long-variable-names
471      Enable long (complex) variable names instead of short names.
472
473  -b|-browse PROGRAM
474      Open report(s) in the browser (firefox, opera, etc.).
475
476  -open
477      Open report(s) in the default browser.
478
479EXIT CODES:
480    0 - Successful tests. The tool has run without any errors.
481    non-zero - Tests failed or the tool has run with errors.
482
483REPORT BUGS TO:
484    Andrey Ponomarenko <aponomarenko\@rosalab.ru>
485
486MORE INFORMATION:
487    ".$HomePage{"Wiki"}."
488    ".$HomePage{"Dev"}."\n");
489}
490
491my $Descriptor_Template = "
492<?xml version=\"1.0\" encoding=\"utf-8\"?>
493<descriptor>
494
495/* XML-descriptor template */
496
497/* Primary sections */
498
499<version>
500    /* Version of the library */
501</version>
502
503<headers>
504    /* The list of paths to header files and/or
505       directories with header files, one per line */
506</headers>
507
508<libs>
509    /* The list of paths to shared libraries and/or
510       directories with libraries, one per line */
511</libs>
512
513/* Optional sections */
514
515<include_paths>
516    /* The list of paths to be searched for header files
517       needed for compiling of library headers, one per line.
518       NOTE: If you define this section then the tool
519       will not automatically detect include paths */
520</include_paths>
521
522<add_include_paths>
523    /* The list of include paths that should be added
524       to the automatically detected include paths, one per line */
525</add_include_paths>
526
527<gcc_options>
528    /* Additional GCC options, one per line */
529</gcc_options>
530
531<include_preamble>
532    /* The list of header files that should be
533       included before other headers, one per line */
534</include_preamble>
535
536<test_include_preamble>
537    /* The list of header files that should be
538       included in each test case before other
539       headers, one per line */
540</test_include_preamble>
541
542<libs_depend>
543    /* The list of paths to libraries that should be
544       provided to gcc for resolving undefined symbols
545       (if NEEDED elf section doesn't include them) */
546</libs_depend>
547
548<opaque_types>
549    /* The list of opaque types, one per line */
550</opaque_types>
551
552<skip_symbols>
553    /* The list of functions (mangled names in C++)
554       that should not be called in the tests, one per line */
555</skip_symbols>
556
557<skip_headers>
558    /* The list of header files and/or directories with header files
559       that should not be processed, one name per line */
560</skip_headers>
561
562<skip_libs>
563    /* The list of shared libraries and/or directories with shared libraries
564       that should not be processed, one name per line */
565</skip_libs>
566
567<defines>
568    /* Add defines at the headers compiling stage, one per line:
569         #define A B
570         #define C D */
571</defines>
572
573<test_defines>
574    /* Add defines to test cases */
575</test_defines>
576
577<libgroup>
578    <name>
579        /* Name of the libgroup */
580    </name>
581
582    <symbols>
583        /* The list of symbols (mangled names in C++)
584           in the group that should be tested, one per line */
585    </symbols>
586</libgroup>
587
588<out_params>
589    /* Associating of out(returned)-parameters
590       with symbols, one entry per line:
591          symbol:param_name
592                or
593          symbol:param_number
594       Examples:
595          dbus_parse_address:entry
596          dbus_parse_address:2       */
597</out_params>
598
599<skip_warnings>
600    /* The list of warnings that should not be shown in the report, one pattern per line */
601</skip_warnings>
602
603</descriptor>";
604
605my $SpecType_Template="
606<?xml version=\"1.0\" encoding=\"utf-8\"?>
607<collection>
608
609<!--
610 C/C++ language extensions in the code:
611  \$(type) - instruction initializing an instance of data type
612  \$[symbol] - instruction for symbol call with properly initialized parameters
613  \$0 - an instance of the specialized type
614  \$1, \$2, ... - references to 1st, 2nd and other parameters
615  \$obj - reference to the object that current method calls on (C++ only)
616  For more information, please see:
617    http://ispras.linuxbase.org/index.php/Specialized_Type
618-->
619
620<spec_type>
621    <kind>
622        /* Kind of the specialized type.
623           Select it from the following list:
624               normal
625               common_param
626               common_retval
627               env
628               common_env */
629    </kind>
630
631    <data_type>
632        /* Name of the corresponding real data type.
633           You can specify several data types if kind is 'common_param'
634           or 'common_retval', one per line. This section is not used
635           if kind is 'env' or 'common_env' */
636    </data_type>
637
638    <value>
639        /* Value for initialization (true, 1.0, \"string\", ...) */
640    </value>
641
642    <pre_condition>
643        /* Precondition on associated function parameter.
644           Example: \$0!=NULL */
645    </pre_condition>
646
647    <post_condition>
648        /* Postcondition on associated function return value or parameter.
649           Example: \$0!=NULL && \$obj.style()==Qt::DotLine */
650    </post_condition>
651
652    <decl_code>
653        /* Code that will be pasted instead of parameter automatic declaration.
654           Example: char \$0[16]; */
655    </decl_code>
656
657    <init_code>
658        /* Code that should be invoked before function call.
659           Example: \$0->start(); */
660    </init_code>
661
662    <final_code>
663        /* Code that should be invoked after function call
664           Example: \$0->end(); */
665    </final_code>
666
667    <global_code>
668        /* Declarations of auxiliary functions
669           and global variables, header includes */
670    </global_code>
671
672    <associating>
673        /* Several \"associating\" sections
674           are allowed simultaneously */
675
676        <symbols>
677            /* List of symbols (mangled names in C++)
678               that will be associated with the specialized type, one per line */
679        </symbols>
680
681        <except>
682            /* List of symbols (mangled names in C++)
683               that will not be associated with the specialized type, one per line.
684               This section is used if kind is 'common_env', 'common_param'
685               or 'common_return' */
686        </except>
687
688        <links>
689            /* Associations with the return value, parameters
690               or/and object, one per line:
691                   param1
692                   param2
693                   param3
694                    ...
695                   object
696                   retval */
697        </links>
698
699        <param_names>
700            /* Associations with the parameters by name, one per line:
701                   param_name1
702                   param_name2
703                   param_name3
704                    ...
705                        */
706        </param_names>
707    </associating>
708
709    <name>
710        /* Name of the specialized type */
711    </name>
712
713    <libs>
714        /* External shared libraries, one per line.
715           If spectype contains call of the functions from
716           some external shared libraries then these objects
717           should be listed here. Corresponding external
718           header files should be included in global_code */
719    </libs>
720</spec_type>
721
722<spec_type>
723    /* Other specialized type */
724</spec_type>
725
726</collection>";
727
728# Constants
729my $BUFF_SIZE = 256;
730my $DEFAULT_ARRAY_AMOUNT = 4;
731my $MAX_PARAMS_INLINE = 3;
732my $MAX_PARAMS_LENGTH_INLINE = 60;
733my $HANGED_EXECUTION_TIME = 7;
734my $TOOL_SIGNATURE;
735my $MIN_PARAMS_MATRIX = 8;
736my $MATRIX_WIDTH = 4;
737my $MATRIX_MAX_ELEM_LENGTH = 7;
738my $LIBRARY_PREFIX_MAJORITY = 10;
739
740my %Operator_Indication = (
741    "not" => "~",
742    "assign" => "=",
743    "andassign" => "&=",
744    "orassign" => "|=",
745    "xorassign" => "^=",
746    "or" => "|",
747    "xor" => "^",
748    "addr" => "&",
749    "and" => "&",
750    "lnot" => "!",
751    "eq" => "==",
752    "ne" => "!=",
753    "lt" => "<",
754    "lshift" => "<<",
755    "lshiftassign" => "<<=",
756    "rshiftassign" => ">>=",
757    "call" => "()",
758    "mod" => "%",
759    "modassign" => "%=",
760    "subs" => "[]",
761    "land" => "&&",
762    "lor" => "||",
763    "rshift" => ">>",
764    "ref" => "->",
765    "le" => "<=",
766    "deref" => "*",
767    "mult" => "*",
768    "preinc" => "++",
769    "delete" => " delete",
770    "vecnew" => " new[]",
771    "vecdelete" => " delete[]",
772    "predec" => "--",
773    "postinc" => "++",
774    "postdec" => "--",
775    "plusassign" => "+=",
776    "plus" => "+",
777    "minus" => "-",
778    "minusassign" => "-=",
779    "gt" => ">",
780    "ge" => ">=",
781    "new" => " new",
782    "multassign" => "*=",
783    "divassign" => "/=",
784    "div" => "/",
785    "neg" => "-",
786    "pos" => "+",
787    "memref" => "->*",
788    "compound" => "," );
789
790my %IsKeyword= map {$_=>1} (
791    "delete",
792    "if",
793    "else",
794    "for",
795    "public",
796    "private",
797    "new",
798    "protected",
799    "main",
800    "sizeof",
801    "malloc",
802    "return",
803    "include",
804    "true",
805    "false",
806    "const",
807    "int",
808    "long",
809    "void",
810    "short",
811    "float",
812    "unsigned",
813    "char",
814    "double",
815    "class",
816    "struct",
817    "union",
818    "enum",
819    "volatile",
820    "restrict"
821);
822
823my %ShortTokens=(
824    "err"=>"error",
825    "warn"=>"warning" );
826
827# Global variables
828my $ST_ID=0;
829my $REPORT_PATH;
830my $TEST_SUITE_PATH;
831my $DEBUG_PATH;
832my $CACHE_PATH;
833my $LOG_PATH;
834my %Interface_TestDir;
835my %LibsDepend;
836my $CompilerOptions_Libs;
837my $CompilerOptions_Cflags;
838my %Language;
839my %Cache;
840my $TestedInterface;
841my $COMMON_LANGUAGE;
842my %SubClass_Created;
843my %Constants;
844my $MaxTypeId_Start;
845my $STAT_FIRST_LINE;
846
847# Mangling
848my %tr_name;
849
850# Types
851my %TypeInfo;
852my %OpaqueTypes;
853my %TName_Tid;
854my %StructUnionPName_Tid;
855my %Class_Constructors;
856my %Class_Destructors;
857my %ReturnTypeId_Interface;
858my %BaseType_PLevel_Return;
859my %OutParam_Interface;
860my %BaseType_PLevel_OutParam;
861my %Interface_OutParam;
862my %Interface_OutParam_NoUsing;
863my %OutParamInterface_Pos;
864my %OutParamInterface_Pos_NoUsing;
865my %Class_SubClasses;
866my %Type_Typedef;
867my %Typedef_BaseName;
868my %NameSpaces;
869my %NestedNameSpaces;
870my %EnumMembers;
871my %SubClass_Instance;
872my %SubClass_ObjInstance;
873my %BaseType_PLevel_Type;
874my %Struct_SubClasses;
875my %Struct_Parent;
876my %Library_Prefixes;
877my %Struct_Mapping;
878
879# Interfaces
880my %SymbolInfo;
881my %CompleteSignature;
882my %SkipInterfaces;
883my %SkipInterfaces_Pattern;
884my %Library_Class;
885my %Library_Symbol;
886my %DepLibrary_Symbol;
887my %Symbol_Library;
888my %DepSymbol_Library;
889my %UndefinedSymbols;
890my %Library_Needed;
891my %Class_PureVirtFunc;
892my %Class_Method;
893my %Class_PureMethod;
894my %Interface_Overloads;
895my %OverloadedInterface;
896my %InterfacesList;
897my %MethodNames;
898my %FuncNames;
899my %GlobalDataNames;
900my %Func_TypeId;
901my %Header_Interface;
902my %SoLib_IntPrefix;
903my $NodeInterface;
904my %LibGroups;
905my %Interface_LibGroup;
906my %AddIntParams;
907my %Func_ShortName_MangledName;
908my %UserDefinedOutParam;
909my $LibraryMallocFunc;
910my %LibraryInitFunc;
911my %LibraryExitFunc;
912
913# Headers
914my @Include_Preamble;
915my %SpecTypeHeaders;
916my %SkipWarnings;
917my %SkipWarnings_Pattern;
918my %Include_Order;
919my %Include_RevOrder;
920my $IncludeString;
921my %IncludePrefix;
922my %SkipHeaders;
923
924my %RegisteredHeaders;
925my %RegisteredHeaders_R;
926
927my %RegisteredIncludes;
928my %RegisteredIncludes_R;
929
930my %DirectIncludes;
931my %RecursiveIncludes;
932my %RecursiveIncludes_R;
933my %KnownHeaders;
934my %Include_Redirect;
935
936my $MAX_INC = 0;
937
938# Shared objects
939my %UsedSharedObjects;
940my %RegisteredLibs;
941my $LibString;
942my %KnownLibs;
943
944# Default paths
945my @DefaultLibPaths = (); # /usr/lib
946my @DefaultIncPaths = (); # /usr/include
947
948# Test results
949my %GenResult;
950my %BuildResult;
951my %RunResult;
952my %ResultCounter;
953
954#Signals
955my %SigNo;
956my %SigName;
957
958# Recursion locks
959my @RecurTypeId;
960my @RecurInterface;
961my @RecurSpecType;
962
963# Global state
964my (%ValueCollection, %Block_Variable, %UseVarEveryWhere, %SpecEnv, %Block_InsNum, $MaxTypeId, %Wrappers,
965%Wrappers_SubClasses, %IntSubClass, %IntrinsicNum, %AuxType, %AuxFunc, %UsedConstructors,
966%ConstraintNum, %RequirementsCatalog, %UsedProtectedMethods, %Create_SubClass, %SpecCode,
967%SpecLibs, %UsedInterfaces, %OpenStreams, %IntSpecType, %Block_Param, %Class_SubClassTypedef, %AuxHeaders,
968%Template2Code_Defines, %TraceFunc);
969
970# Block initialization
971my $CurrentBlock;
972
973# Special types
974my %SpecType;
975my %InterfaceSpecType;
976my %Common_SpecEnv;
977my %Common_SpecType_Exceptions;
978my %ProxyValue = ();
979
980# Report
981my $ContentSpanStart = "<span class=\"section\" onclick=\"javascript:showContent(this, 'CONTENT_ID')\"><span class='ext' style='padding-right:2px'>[+]</span>\n";
982my $ContentSpanStart_Title = "<span class=\"section_title\" onclick=\"javascript:showContent(this, 'CONTENT_ID')\"><span class='ext_title' style='padding-right:2px'>[+]</span>\n";
983my $ContentSpanEnd = "</span>\n";
984my $ContentDivStart = "<div id=\"CONTENT_ID\" style=\"display:none;\">\n";
985my $ContentDivEnd = "</div>\n";
986my $ContentID = 1;
987my $Content_Counter = 0;
988
989# Test Case
990my $TestFormat;
991
992# Recursion Locks
993my @RecurLib;
994
995# Debug
996my %DebugInfo;
997
998sub get_Modules()
999{
1000    my $TOOL_DIR = get_dirname($0);
1001    if(not $TOOL_DIR)
1002    { # patch for MS Windows
1003        $TOOL_DIR = ".";
1004    }
1005    my @SEARCH_DIRS = (
1006        # tool's directory
1007        abs_path($TOOL_DIR),
1008        # relative path to modules
1009        abs_path($TOOL_DIR)."/../share/api-sanity-checker",
1010        # install path
1011        'MODULES_INSTALL_PATH'
1012    );
1013    foreach my $DIR (@SEARCH_DIRS)
1014    {
1015        if(not is_abs($DIR))
1016        { # relative path
1017            $DIR = abs_path($TOOL_DIR)."/".$DIR;
1018        }
1019        if(-d $DIR."/modules") {
1020            return $DIR."/modules";
1021        }
1022    }
1023    exitStatus("Module_Error", "can't find modules");
1024}
1025
1026my %LoadedModules = ();
1027
1028sub loadModule($)
1029{
1030    my $Name = $_[0];
1031    if(defined $LoadedModules{$Name}) {
1032        return;
1033    }
1034    my $Path = $MODULES_DIR."/Internals/$Name.pm";
1035    if(not -f $Path) {
1036        exitStatus("Module_Error", "can't access \'$Path\'");
1037    }
1038    require $Path;
1039    $LoadedModules{$Name} = 1;
1040}
1041
1042sub readModule($$)
1043{
1044    my ($Module, $Name) = @_;
1045    my $Path = $MODULES_DIR."/Internals/$Module/".$Name;
1046    if(not -f $Path) {
1047        exitStatus("Module_Error", "can't access \'$Path\'");
1048    }
1049    return readFile($Path);
1050}
1051
1052sub is_abs($) {
1053    return ($_[0]=~/\A(\/|\w+:[\/\\])/);
1054}
1055
1056sub get_abs_path($)
1057{ # abs_path() should NOT be called for absolute inputs
1058  # because it can change them
1059    my $Path = $_[0];
1060    if(not is_abs($Path)) {
1061        $Path = abs_path($Path);
1062    }
1063    return $Path;
1064}
1065
1066sub get_OSgroup()
1067{
1068    if($Config{"osname"}=~/macos|darwin|rhapsody/i) {
1069        return "macos";
1070    }
1071    elsif($Config{"osname"}=~/freebsd|dragonfly|openbsd|netbsd/i) {
1072        return "bsd";
1073    }
1074    elsif($Config{"osname"}=~/haiku|beos/i) {
1075        return "beos";
1076    }
1077    elsif($Config{"osname"}=~/symbian|epoc/i) {
1078        return "symbian";
1079    }
1080    elsif($Config{"osname"}=~/win/i) {
1081        return "windows";
1082    }
1083    else {
1084        return $Config{"osname"};
1085    }
1086}
1087
1088sub detectDisplay()
1089{
1090    my $DISPLAY_NUM = 9; # default display number
1091    # use xprop to get a free display number
1092    foreach my $DNUM (9, 8, 7, 6, 5, 4, 3, 2, 10, 11, 12)
1093    { # try these display numbers only
1094        system("xprop -display :$DNUM".".0 -root >$TMP_DIR/null 2>&1");
1095        if($? ne 0)
1096        { # no properties found for this display, guess it is free
1097            $DISPLAY_NUM = $DNUM;
1098            last;
1099        }
1100    }
1101    return ":$DISPLAY_NUM.0";
1102}
1103
1104sub runXvfb()
1105{
1106    # Find a free display to use for Xvfb
1107    my $XT_DISPLAY = detectDisplay();
1108    my $TEST_DISPLAY = $XT_DISPLAY;
1109    my $running = `pidof Xvfb`;
1110    chomp($running);
1111    if(not $running or $OSgroup!~/\A(linux|bsd)\Z/)
1112    {
1113        printMsg("INFO", "starting X Virtual Frame Buffer on the display $TEST_DISPLAY");
1114        system("Xvfb -screen 0 1024x768x24 $TEST_DISPLAY -ac +bs +kb -fp /usr/share/fonts/misc/ >$TMP_DIR/null 2>&1 & sleep 1");
1115        if($?) {
1116            exitStatus("Error", "can't start Xvfb: $?");
1117        }
1118        $ENV{"DISPLAY"} = $TEST_DISPLAY;
1119        $ENV{"G_SLICE"} = "always-malloc";
1120        return 1;
1121    }
1122    else
1123    {
1124        # Xvfb is running, determine the display number
1125        my $CMD_XVFB = `ps -p "$running" -f | tail -n 1`;
1126        chomp($CMD_XVFB);
1127        $CMD_XVFB=~/(\:\d+\.0)/;
1128        $XT_DISPLAY = $1;
1129        $ENV{"DISPLAY"} = $XT_DISPLAY;
1130        $ENV{"G_SLICE"} = "always-malloc";
1131        printMsg("INFO", "Xvfb is already running (display: $XT_DISPLAY), so it will be used");
1132        return 0;
1133    }
1134}
1135
1136sub stopXvfb($)
1137{
1138    if($_[0]==1)
1139    {
1140        my $pid = `pidof Xvfb`;
1141        chomp($pid);
1142        if($pid) {
1143            kill(9, $pid);
1144        }
1145    }
1146}
1147
1148sub parseTag($$)
1149{
1150    my ($CodeRef, $Tag) = @_;
1151    return "" if(not $CodeRef or not ${$CodeRef} or not $Tag);
1152    if(${$CodeRef}=~s/\<\Q$Tag\E\>((.|\n)+?)\<\/\Q$Tag\E\>//)
1153    {
1154        my $Content = $1;
1155        $Content=~s/\A[\n]+//g;
1156        while($Content=~s/\A([ \t]+[\n]+)//g){}
1157        $Content=~s/\A[\n]+//g;
1158        $Content=~s/\s+\Z//g;
1159        if($Content=~/\n/) {
1160            $Content = alignSpaces($Content);
1161        }
1162        else {
1163            $Content=~s/\A[ \t]+//g;
1164        }
1165        return $Content;
1166    }
1167    else {
1168        return "";
1169    }
1170}
1171
1172sub add_os_spectypes()
1173{
1174    if($OSgroup eq "beos")
1175    { # http://www.haiku-os.org/legacy-docs/bebook/TheKernelKit_Miscellaneous.html
1176        readSpecTypes("
1177        <spec_type>
1178            <name>
1179                disable debugger in Haiku
1180            </name>
1181            <kind>
1182                common_env
1183            </kind>
1184            <global_code>
1185                #include <kernel/OS.h>
1186            </global_code>
1187            <init_code>
1188                disable_debugger(1);
1189            </init_code>
1190            <libs>
1191                libroot.so
1192            </libs>
1193            <associating>
1194                <except>
1195                    disable_debugger
1196                </except>
1197            </associating>
1198        </spec_type>");
1199    }
1200}
1201
1202sub register_out_param($$$$)
1203{
1204    my ($Interface, $ParamPos, $ParamName, $ParamTypeId) = @_;
1205    $OutParamInterface_Pos{$Interface}{$ParamPos}=1;
1206    $Interface_OutParam{$Interface}{$ParamName}=1;
1207    $BaseType_PLevel_OutParam{get_FoundationTypeId($ParamTypeId)}{get_PointerLevel($ParamTypeId)-1}{$Interface}=1;
1208    foreach my $TypeId (get_OutParamFamily($ParamTypeId, 0)) {
1209        $OutParam_Interface{$TypeId}{$Interface}=$ParamPos;
1210    }
1211}
1212
1213sub cmpVersions($$)
1214{ # compare two versions in dotted-numeric format
1215    my ($V1, $V2) = @_;
1216    return 0 if($V1 eq $V2);
1217    my @V1Parts = split(/\./, $V1);
1218    my @V2Parts = split(/\./, $V2);
1219    for (my $i = 0; $i <= $#V1Parts && $i <= $#V2Parts; $i++)
1220    {
1221        return -1 if(int($V1Parts[$i]) < int($V2Parts[$i]));
1222        return 1 if(int($V1Parts[$i]) > int($V2Parts[$i]));
1223    }
1224    return -1 if($#V1Parts < $#V2Parts);
1225    return 1 if($#V1Parts > $#V2Parts);
1226    return 0;
1227}
1228
1229sub numToStr($)
1230{
1231    my $Number = int($_[0]);
1232    if($Number>3) {
1233        return $Number."th";
1234    }
1235    elsif($Number==1) {
1236        return "1st";
1237    }
1238    elsif($Number==2) {
1239        return "2nd";
1240    }
1241    elsif($Number==3) {
1242        return "3rd";
1243    }
1244    else {
1245        return $Number;
1246    }
1247}
1248
1249sub readSpecTypes($)
1250{
1251    my $Package = $_[0];
1252    return if(not $Package);
1253    $Package=~s/\/\*(.|\n)+?\*\///g; # remove C++ comments
1254    $Package=~s/<\!--(.|\n)+?-->//g; # remove XML comments
1255    if($Package!~/<collection>/ or $Package!~/<\/collection>/)
1256    { # add <collection> tag (support for old spectype packages)
1257        $Package = "<collection>\n".$Package."\n</collection>";
1258    }
1259    while(my $Collection = parseTag(\$Package, "collection"))
1260    {
1261        # import specialized types
1262        while(my $SpecType = parseTag(\$Collection, "spec_type"))
1263        {
1264            $ST_ID+=1;
1265            my (%Attr, %DataTypes) = ();
1266            $Attr{"Kind"} = parseTag(\$SpecType, "kind");
1267            $Attr{"Kind"} = "normal" if(not $Attr{"Kind"});
1268            foreach my $DataType (split(/\n/, parseTag(\$SpecType, "data_type")),
1269            split(/\n/, parseTag(\$SpecType, "data_types")))
1270            { # data_type==data_types, support of <= 1.5 versions
1271                $DataTypes{$DataType} = 1;
1272                if(not get_TypeIdByName($DataType)) {
1273                    printMsg("ERROR", "unknown data type \'$DataType\' in one of the \'".$Attr{"Kind"}."\' spectypes, try to define it more exactly");
1274                }
1275            }
1276            if(not keys(%DataTypes) and $Attr{"Kind"}=~/\A(normal|common_param|common_retval)\Z/)
1277            {
1278                printMsg("ERROR", "missed \'data_type\' attribute in one of the \'".$Attr{"Kind"}."\' spectypes");
1279                next;
1280            }
1281            $Attr{"Name"} = parseTag(\$SpecType, "name");
1282            $Attr{"Value"} = parseTag(\$SpecType, "value");
1283            $Attr{"PreCondition"} = parseTag(\$SpecType, "pre_condition");
1284            $Attr{"PostCondition"} = parseTag(\$SpecType, "post_condition");
1285            if(not $Attr{"PostCondition"})
1286            { # constraint==post_condition, support of <= 1.6 versions
1287                $Attr{"PostCondition"} = parseTag(\$SpecType, "constraint");
1288            }
1289            $Attr{"InitCode"} = parseTag(\$SpecType, "init_code");
1290            $Attr{"DeclCode"} = parseTag(\$SpecType, "decl_code");
1291            $Attr{"FinalCode"} = parseTag(\$SpecType, "final_code");
1292            $Attr{"GlobalCode"} = parseTag(\$SpecType, "global_code");
1293            foreach my $Lib (split(/\n/, parseTag(\$SpecType, "libs"))) {
1294                $Attr{"Libs"}{$Lib} = 1;
1295            }
1296            if($Attr{"Kind"} eq "common_env") {
1297                $Common_SpecEnv{$ST_ID} = 1;
1298            }
1299            while(my $Associating = parseTag(\$SpecType, "associating"))
1300            {
1301                my (%Interfaces, %Except) = ();
1302                foreach my $Interface (split(/\n/, parseTag(\$Associating, "interfaces")),
1303                split(/\n/, parseTag(\$Associating, "symbols")))
1304                {
1305                    $Interface=~s/\A\s+|\s+\Z//g;
1306                    $Interfaces{$Interface} = 1;
1307                    $Common_SpecType_Exceptions{$Interface}{$ST_ID} = 0;
1308                    if($Interface=~/\*/)
1309                    {
1310                        $Interface=~s/\*/.*/;
1311                        foreach my $Int (keys(%CompleteSignature))
1312                        {
1313                            if($Int=~/\A$Interface\Z/)
1314                            {
1315                                $Common_SpecType_Exceptions{$Int}{$ST_ID} = 0;
1316                                $Interfaces{$Interface} = 1;
1317                            }
1318                        }
1319                    }
1320                    elsif(not defined $CompleteSignature{$Interface}
1321                    or not $CompleteSignature{$Interface}{"ShortName"}) {
1322                        printMsg("ERROR", "unknown symbol $Interface");
1323                    }
1324                }
1325                foreach my $Interface (split(/\n/, parseTag(\$Associating, "except")))
1326                {
1327                    $Interface=~s/\A\s+|\s+\Z//g;
1328                    $Except{$Interface} = 1;
1329                    $Common_SpecType_Exceptions{$Interface}{$ST_ID} = 1;
1330                    if($Interface=~/\*/)
1331                    {
1332                        $Interface=~s/\*/.*/;
1333                        foreach my $Int (keys(%CompleteSignature))
1334                        {
1335                            if($Int=~/\A$Interface\Z/)
1336                            {
1337                                $Common_SpecType_Exceptions{$Int}{$ST_ID} = 1;
1338                                $Except{$Int} = 1;
1339                            }
1340                        }
1341                    }
1342                }
1343                if($Attr{"Kind"} eq "env")
1344                {
1345                    foreach my $Interface (keys(%Interfaces))
1346                    {
1347                        next if($Except{$Interface});
1348                        $InterfaceSpecType{$Interface}{"SpecEnv"} = $ST_ID;
1349                    }
1350                }
1351                else
1352                {
1353                    foreach my $Link (split(/\n/, parseTag(\$Associating, "links").parseTag(\$Associating, "param_num")))
1354                    {
1355                        $Link=~s/\A\s+|\s+\Z//g;
1356                        if(lc($Link)=~/\Aparam(\d+)\Z/)
1357                        {
1358                            my $Param_Num = $1;
1359                            foreach my $Interface (keys(%Interfaces))
1360                            {
1361                                next if($Except{$Interface});
1362                                if(defined $InterfaceSpecType{$Interface}{"SpecParam"}{$Param_Num - 1}) {
1363                                    printMsg("ERROR", "more than one spectypes have been linked to ".numToStr($Param_Num)." parameter of $Interface");
1364                                }
1365                                $InterfaceSpecType{$Interface}{"SpecParam"}{$Param_Num - 1} = $ST_ID;
1366                            }
1367                        }
1368                        elsif(lc($Link)=~/\Aobject\Z/)
1369                        {
1370                            foreach my $Interface (keys(%Interfaces))
1371                            {
1372                                next if($Except{$Interface});
1373                                if(defined $InterfaceSpecType{$Interface}{"SpecObject"}) {
1374                                    printMsg("ERROR", "more than one spectypes have been linked to calling object of $Interface");
1375                                }
1376                                $InterfaceSpecType{$Interface}{"SpecObject"} = $ST_ID;
1377                            }
1378                        }
1379                        elsif(lc($Link)=~/\Aretval\Z/)
1380                        {
1381                            foreach my $Interface (keys(%Interfaces))
1382                            {
1383                                next if($Except{$Interface});
1384                                if(defined $InterfaceSpecType{$Interface}{"SpecReturn"}) {
1385                                    printMsg("ERROR", "more than one spectypes have been linked to return value of $Interface");
1386                                }
1387                                $InterfaceSpecType{$Interface}{"SpecReturn"} = $ST_ID;
1388                            }
1389                        }
1390                        else {
1391                            printMsg("ERROR", "unrecognized link \'$Link\' in one of the \'".$Attr{"Kind"}."\' spectypes");
1392                        }
1393                    }
1394                    foreach my $Name (split(/\n/, parseTag(\$Associating, "param_name")))
1395                    {
1396                        $Name=~s/\A\s+|\s+\Z//g;
1397                        if(keys(%Interfaces))
1398                        {
1399                            foreach my $Interface (keys(%Interfaces))
1400                            {
1401                                next if($Except{$Interface});
1402                                foreach my $ParamPos (keys(%{$CompleteSignature{$Interface}{"Param"}}))
1403                                {
1404                                    if($Name eq $CompleteSignature{$Interface}{"Param"}{$ParamPos}{"name"}) {
1405                                        $InterfaceSpecType{$Interface}{"SpecParam"}{$ParamPos} = $ST_ID;
1406                                    }
1407                                }
1408                            }
1409                        }
1410                        else
1411                        {
1412                            foreach my $Interface (keys(%CompleteSignature))
1413                            {
1414                                next if($Except{$Interface});
1415                                foreach my $ParamPos (keys(%{$CompleteSignature{$Interface}{"Param"}}))
1416                                {
1417                                    if($Name eq $CompleteSignature{$Interface}{"Param"}{$ParamPos}{"name"})
1418                                    {
1419                                        my $TypeId_Param = $CompleteSignature{$Interface}{"Param"}{$ParamPos}{"type"};
1420                                        my $FTypeId_Param = get_FoundationTypeId($TypeId_Param);
1421                                        my $FTypeType_Param = get_TypeType($FTypeId_Param);
1422                                        foreach my $DataType (keys(%DataTypes))
1423                                        {
1424                                            my $TypeId = get_TypeIdByName($DataType);
1425                                            if(my $FTypeId = get_FoundationTypeId($TypeId) and $FTypeId_Param)
1426                                            {
1427                                                if($FTypeType_Param eq "Intrinsic"?$TypeId==$TypeId_Param:$FTypeId==$FTypeId_Param) {
1428                                                    $InterfaceSpecType{$Interface}{"SpecParam"}{$ParamPos} = $ST_ID;
1429                                                }
1430                                            }
1431                                        }
1432                                    }
1433                                }
1434                            }
1435                        }
1436                    }
1437                }
1438            }
1439            if($Attr{"Kind"}=~/\A(common_param|common_retval)\Z/)
1440            {
1441                foreach my $DataType (keys(%DataTypes))
1442                {
1443                    $Attr{"DataType"} = $DataType;
1444                    %{$SpecType{$ST_ID}} = %Attr;
1445                    $ST_ID+=1;
1446                }
1447            }
1448            elsif($Attr{"Kind"} eq "normal")
1449            {
1450                $Attr{"DataType"} = (keys(%DataTypes))[0];
1451                %{$SpecType{$ST_ID}} = %Attr;
1452            }
1453            else {
1454                %{$SpecType{$ST_ID}} = %Attr;
1455            }
1456        }
1457    }
1458}
1459
1460sub join_P($$)
1461{
1462    my $S = "/";
1463    if($OSgroup eq "windows") {
1464        $S = "\\";
1465    }
1466    return join($S, @_);
1467}
1468
1469sub registerHeader($$)
1470{
1471    my ($Path, $To) = @_;
1472    my $Name = get_filename($Path);
1473    if(not defined $To->{$Name})
1474    {
1475        $To->{$Name} = $Path;
1476        if(my $Prefix = getFilePrefix($Path)) {
1477            $To->{join_P($Prefix, $Name)} = $Path;
1478        }
1479    }
1480}
1481
1482sub registerDir($)
1483{
1484    my $Path = $_[0];
1485    foreach my $P (sort {length($b)<=>length($a)} cmd_find($Path,"f","",""))
1486    { # NOTE: duplicated
1487        registerHeader($P, \%RegisteredHeaders);
1488        $RegisteredHeaders_R{$P} = 1;
1489    }
1490}
1491
1492sub getFilePrefix($)
1493{
1494    if(my $Dir = get_dirname($_[0]))
1495    {
1496        if($Dir = get_filename($Dir))
1497        {
1498            if($Dir ne "include"
1499            and $Dir=~/\A[a-z]+\Z/i) {
1500                return $Dir;
1501            }
1502        }
1503    }
1504    return undef;
1505}
1506
1507sub registerHeaders($)
1508{
1509    my $Path = $_[0];
1510    if(-d $Path) {
1511        registerDir($Path);
1512    }
1513    elsif(-f $Path)
1514    {
1515        registerHeader($Path, \%RegisteredHeaders);
1516        $RegisteredHeaders_R{$Path} = 1;
1517
1518        if(my $Dir = get_dirname($Path)) {
1519            registerDir($Dir);
1520        }
1521    }
1522}
1523
1524sub registerLibs($)
1525{
1526    my $Path = $_[0];
1527    $Path = get_abs_path($Path);
1528    if(-d $Path)
1529    {
1530        foreach my $P (cmd_find($Path,"f","","")) {
1531            $RegisteredLibs{get_filename($P)} = $P;
1532        }
1533    }
1534    elsif(-f $Path) {
1535        $RegisteredLibs{get_filename($Path)} = $Path;
1536    }
1537}
1538
1539sub push_U($@)
1540{ # push unique
1541    if(my $Array = shift @_)
1542    {
1543        if(@_)
1544        {
1545            my %Exist = map {$_=>1} @{$Array};
1546            foreach my $Elem (@_)
1547            {
1548                if(not defined $Exist{$Elem})
1549                {
1550                    push(@{$Array}, $Elem);
1551                    $Exist{$Elem} = 1;
1552                }
1553            }
1554        }
1555    }
1556}
1557
1558sub readDescriptor($)
1559{
1560    my $Path = $_[0];
1561
1562    my $Content = readFile($Path);
1563    if(not $Content) {
1564        exitStatus("Error", "library descriptor is empty");
1565    }
1566    if($Content!~/\</) {
1567        exitStatus("Error", "incorrect descriptor (see -d option)");
1568    }
1569    $Content=~s/\/\*(.|\n)+?\*\///g;
1570    $Content=~s/<\!--(.|\n)+?-->//g;
1571
1572    $Descriptor{"Version"} = parseTag(\$Content, "version");
1573    $Descriptor{"Version"} = $TargetVersion if($TargetVersion);
1574    if(not $Descriptor{"Version"}) {
1575        exitStatus("Error", "version in the descriptor is not specified (section <version>)");
1576    }
1577    if($Content=~/{RELPATH}/)
1578    {
1579        if($RelativeDirectory)  {
1580            $Content =~ s/{RELPATH}/$RelativeDirectory/g;
1581        }
1582        else {
1583            exitStatus("Error", "you have not specified -relpath option, but the descriptor contains {RELPATH} macro");
1584        }
1585    }
1586
1587    $Descriptor{"Headers"} = parseTag(\$Content, "headers");
1588    $Descriptor{"Libs"} = parseTag(\$Content, "libs");
1589
1590    $Descriptor{"SkipHeaders"} = parseTag(\$Content, "skip_headers");
1591    $Descriptor{"SkipIncluding"} = parseTag(\$Content, "skip_including");
1592
1593    foreach my $Header (split(/\s*\n\s*/, parseTag(\$Content, "test_include_preamble")))
1594    {
1595        push_U(\@Include_Preamble, $Header);
1596    }
1597    foreach my $Order (split(/\s*\n\s*/, parseTag(\$Content, "include_order")))
1598    {
1599        if($Order=~/\A(.+):(.+)\Z/) {
1600            $Include_Order{$2} = $1;
1601        }
1602    }
1603    # $Include_Order{"freetype.h"} = "ft2build.h";
1604    %Include_RevOrder = reverse(%Include_Order);
1605
1606    foreach my $Interface_Name (split(/\s*\n\s*/, parseTag(\$Content, "skip_interfaces")),
1607    split(/\s*\n\s*/, parseTag(\$Content, "skip_symbols")))
1608    {
1609        if($Interface_Name=~s/\*/.*/g) {
1610            $SkipInterfaces_Pattern{$Interface_Name} = 1;
1611        }
1612        else {
1613            $SkipInterfaces{$Interface_Name} = 1;
1614        }
1615    }
1616    foreach my $Type_Name (split(/\s*\n\s*/, parseTag(\$Content, "opaque_types")))
1617    {
1618        $OpaqueTypes{$Type_Name} = 1;
1619    }
1620    foreach my $Warning (split(/\s*\n\s*/, parseTag(\$Content, "skip_warnings")))
1621    {
1622        if($Warning=~s/\*/.*/g) {
1623            $SkipWarnings_Pattern{$Warning} = 1;
1624        }
1625        else {
1626            $SkipWarnings{$Warning} = 1;
1627        }
1628    }
1629
1630    while(my $LibGroupTag = parseTag(\$Content, "libgroup"))
1631    {
1632        my $LibGroupName = parseTag(\$LibGroupTag, "name");
1633        foreach my $Interface (split(/\s*\n\s*/, parseTag(\$LibGroupTag, "interfaces")),
1634        split(/\s*\n\s*/, parseTag(\$LibGroupTag, "symbols")))
1635        {
1636            $LibGroups{$LibGroupName}{$Interface} = 1;
1637            $Interface_LibGroup{$Interface}=$LibGroupName;
1638        }
1639    }
1640    if(keys(%Interface_LibGroup))
1641    {
1642        if(keys(%InterfacesList)) {
1643            %InterfacesList=();
1644        }
1645        foreach my $LibGroup (keys(%LibGroups))
1646        {
1647            foreach my $Interface (keys(%{$LibGroups{$LibGroup}})) {
1648                $InterfacesList{$Interface}=1;
1649            }
1650        }
1651    }
1652
1653    foreach my $Option (split(/\s*\n\s*/, parseTag(\$Content, "gcc_options")))
1654    {
1655        if($Option=~/\A\-(Wl|l|L)/
1656        or $Option=~/\.$LIB_EXT[0-9.]*\Z/)
1657        { # to linker
1658            $CompilerOptions_Libs .= " ".$Option;
1659        }
1660        else {
1661            $CompilerOptions_Cflags .= " ".$Option;
1662        }
1663    }
1664    if(my $DDefines = parseTag(\$Content, "test_defines"))
1665    {
1666        $Descriptor{"Defines"} .= "\n".$DDefines;
1667    }
1668    foreach my $Dep (split(/\s*\n\s*/, parseTag(\$Content, "libs_depend")))
1669    {
1670        if(not -f $Dep) {
1671            exitStatus("Access_Error", "can't access \'$Dep\': no such file");
1672        }
1673        $Dep = abs_path($Dep) if($Dep!~/\A(\/|\w+:[\/\\])/);
1674        $LibsDepend{$Dep} = 1;
1675    }
1676    foreach my $IntParam (split(/\s*\n\s*/, parseTag(\$Content, "out_params")))
1677    {
1678        if($IntParam=~/(.+)(:|;)(.+)/) {
1679            $UserDefinedOutParam{$1}{$3} = 1;
1680        }
1681    }
1682}
1683
1684sub getArch()
1685{
1686    my $Arch = $ENV{"CPU"};
1687    if(not $Arch)
1688    {
1689        if($OSgroup=~/linux|bsd|macos/)
1690        {
1691            $Arch = `uname -m`;
1692            chomp($Arch);
1693            if(not $Arch)
1694            {
1695                $Arch = `uname -p`;
1696                chomp($Arch);
1697            }
1698        }
1699    }
1700    if(not $Arch) {
1701        $Arch = $Config{"archname"};
1702    }
1703    $Arch = "x86" if($Arch=~/i[3-7]86/);
1704    if($OSgroup eq "windows")
1705    {
1706        $Arch = "x86" if($Arch=~/win32/i);
1707        $Arch = "x86-64" if($Arch=~/win64/i);
1708    }
1709    $Arch=~s/\-multi\-thread(-|\Z)//g;
1710    return $Arch;
1711}
1712
1713sub get_Summary()
1714{
1715    my $Summary = "<h2>Summary</h2><hr/>";
1716    $Summary .= "<table cellpadding='3' class='summary'>";
1717    my $Verdict = "";
1718    if($ResultCounter{"Run"}{"Fail"} > 0)
1719    {
1720        $Verdict = "<span style='color:Red;'><b>Test Failed</b></span>";
1721        $STAT_FIRST_LINE .= "verdict:failed;";
1722    }
1723    else
1724    {
1725        $Verdict = "<span style='color:Green;'><b>Test Passed</b></span>";
1726        $STAT_FIRST_LINE .= "verdict:passed;";
1727    }
1728    $Summary .= "<tr><td class='table_header summary_item'>Total tests</td><td align='right' class='summary_item_value'>".($ResultCounter{"Run"}{"Success"}+$ResultCounter{"Run"}{"Fail"})."</td></tr>";
1729    $STAT_FIRST_LINE .= "total:".($ResultCounter{"Run"}{"Success"}+$ResultCounter{"Run"}{"Fail"}).";";
1730    my $Success_Tests_Link = "0";
1731    $Success_Tests_Link = $ResultCounter{"Run"}{"Success"} if($ResultCounter{"Run"}{"Success"}>0);
1732    $STAT_FIRST_LINE .= "passed:".$ResultCounter{"Run"}{"Success"}.";";
1733    my $Failed_Tests_Link = "0";
1734    $Failed_Tests_Link = "<a href='#Failed_Tests' style='color:Blue;'>".$ResultCounter{"Run"}{"Fail"}."</a>" if($ResultCounter{"Run"}{"Fail"}>0);
1735    $STAT_FIRST_LINE .= "failed:".$ResultCounter{"Run"}{"Fail"}.";";
1736    $Summary .= "<tr><td class='table_header summary_item'>Passed / Failed tests</td><td align='right' class='summary_item_value'>$Success_Tests_Link / $Failed_Tests_Link</td></tr>";
1737    if($ResultCounter{"Run"}{"Warnings"}>0)
1738    {
1739        my $Warnings_Link = "<a href='#Warnings' style='color:Blue;'>".$ResultCounter{"Run"}{"Warnings"}."</a>";
1740        $Summary .= "<tr><td class='table_header summary_item'>Warnings</td><td align='right' class='summary_item_value'>$Warnings_Link</td></tr>";
1741    }
1742    $STAT_FIRST_LINE .= "warnings:".$ResultCounter{"Run"}{"Warnings"};
1743    $Summary .= "<tr><td class='table_header summary_item'>Verdict</td><td align='right'>$Verdict</td></tr>";
1744    $Summary .= "</table>\n";
1745    return $Summary;
1746}
1747
1748sub get_Problem_Summary()
1749{
1750    my $Problem_Summary = "";
1751    my %ProblemType_Interface = ();
1752    foreach my $Interface (keys(%RunResult))
1753    {
1754        next if($RunResult{$Interface}{"Warnings"});
1755        $ProblemType_Interface{$RunResult{$Interface}{"Type"}}{$Interface} = 1;
1756    }
1757    my $ColSpan = 1;
1758    my $SignalException = ($OSgroup eq "windows")?"Exception":"Signal";
1759    my $ProblemType = "Received_".$SignalException;
1760    if(keys(%{$ProblemType_Interface{$ProblemType}}))
1761    {
1762        my %SignalName_Interface = ();
1763        foreach my $Interface (keys(%{$ProblemType_Interface{"Received_$SignalException"}})) {
1764            $SignalName_Interface{$RunResult{$Interface}{"Value"}}{$Interface} = 1;
1765        }
1766        if(keys(%SignalName_Interface)==1)
1767        {
1768            my $SignalName = (keys(%SignalName_Interface))[0];
1769            my $Amount = keys(%{$SignalName_Interface{$SignalName}});
1770            my $Link = "<a href=\'#".$ProblemType."_".$SignalName."\' style='color:Blue;'>$Amount</a>";
1771            $STAT_FIRST_LINE .= lc($ProblemType."_".$SignalName.":$Amount;");
1772            $Problem_Summary .= "<tr><td class='table_header summary_item'>Received ".lc($SignalException)." $SignalName</td><td align='right' class='summary_item_value'>$Link</td></tr>";
1773        }
1774        elsif(keys(%SignalName_Interface)>1)
1775        {
1776            $Problem_Summary .= "<tr><td class='table_header summary_item' rowspan='".keys(%SignalName_Interface)."'>Received ".lc($SignalException)."</td>";
1777            my $num = 1;
1778            foreach my $SignalName (sort keys(%SignalName_Interface))
1779            {
1780                my $Amount = keys(%{$SignalName_Interface{$SignalName}});
1781                my $Link = "<a href=\'#".$ProblemType."_".$SignalName."\' style='color:Blue;'>$Amount</a>";
1782                $STAT_FIRST_LINE .= lc($ProblemType."_".$SignalName.":$Amount;");
1783                $Problem_Summary .= (($num!=1)?"<tr>":"")."<td class='table_header summary_item'>$SignalName</td><td align='right' class='summary_item_value'>$Link</td></tr>";
1784                $num+=1;
1785            }
1786            $ColSpan = 2;
1787        }
1788    }
1789    if(keys(%{$ProblemType_Interface{"Exited_With_Value"}}))
1790    {
1791        my %ExitValue_Interface = ();
1792        foreach my $Interface (keys(%{$ProblemType_Interface{"Exited_With_Value"}}))
1793        {
1794            $ExitValue_Interface{$RunResult{$Interface}{"Value"}}{$Interface} = 1;
1795        }
1796        if(keys(%ExitValue_Interface)==1)
1797        {
1798            my $ExitValue = (keys(%ExitValue_Interface))[0];
1799            my $Amount = keys(%{$ExitValue_Interface{$ExitValue}});
1800            my $Link = "<a href=\'#Exited_With_Value_$ExitValue\' style='color:Blue;'>$Amount</a>";
1801            $STAT_FIRST_LINE .= lc("Exited_With_Value_$ExitValue:$Amount;");
1802            $Problem_Summary .= "<tr><td class='table_header summary_item' colspan=\'$ColSpan\'>Exited with value \"$ExitValue\"</td><td align='right' class='summary_item_value'>$Link</td></tr>";
1803        }
1804        elsif(keys(%ExitValue_Interface)>1)
1805        {
1806            $Problem_Summary .= "<tr><td class='table_header summary_item' rowspan='".keys(%ExitValue_Interface)."'>Exited with value</td>";
1807            foreach my $ExitValue (sort keys(%ExitValue_Interface))
1808            {
1809                my $Amount = keys(%{$ExitValue_Interface{$ExitValue}});
1810                my $Link = "<a href=\'#Exited_With_Value_$ExitValue\' style='color:Blue;'>$Amount</a>";
1811                $STAT_FIRST_LINE .= lc("Exited_With_Value_$ExitValue:$Amount;");
1812                $Problem_Summary .= "<td class='table_header summary_item'>\"$ExitValue\"</td><td align='right' class='summary_item_value'>$Link</td></tr>";
1813            }
1814            $Problem_Summary .= "</tr>";
1815            $ColSpan = 2;
1816        }
1817    }
1818    if(keys(%{$ProblemType_Interface{"Hanged_Execution"}}))
1819    {
1820        my $Amount = keys(%{$ProblemType_Interface{"Hanged_Execution"}});
1821        my $Link = "<a href=\'#Hanged_Execution\' style='color:Blue;'>$Amount</a>";
1822        $STAT_FIRST_LINE .= "hanged_execution:$Amount;";
1823        $Problem_Summary .= "<tr><td class='table_header summary_item' colspan=\'$ColSpan\'>Hanged execution</td><td align='right' class='summary_item_value'>$Link</td></tr>";
1824    }
1825    if(keys(%{$ProblemType_Interface{"Requirement_Failed"}}))
1826    {
1827        my $Amount = keys(%{$ProblemType_Interface{"Requirement_Failed"}});
1828        my $Link = "<a href=\'#Requirement_Failed\' style='color:Blue;'>$Amount</a>";
1829        $STAT_FIRST_LINE .= "requirement_failed:$Amount;";
1830        $Problem_Summary .= "<tr><td class='table_header summary_item' colspan=\'$ColSpan\'>Requirement failed</td><td align='right' class='summary_item_value'>$Link</td></tr>";
1831    }
1832    if(keys(%{$ProblemType_Interface{"Other_Problems"}}))
1833    {
1834        my $Amount = keys(%{$ProblemType_Interface{"Other_Problems"}});
1835        my $Link = "<a href=\'#Other_Problems\' style='color:Blue;'>$Amount</a>";
1836        $STAT_FIRST_LINE .= "other_problems:$Amount;";
1837        $Problem_Summary .= "<tr><td class='table_header summary_item' colspan=\'$ColSpan\'>Other problems</td><td align='right' class='summary_item_value'>$Link</td></tr>";
1838    }
1839    if($Problem_Summary)
1840    {
1841        $Problem_Summary = "<h2>Problem Summary</h2><hr/>"."<table cellpadding='3' class='summary'>".$Problem_Summary."</table>\n";
1842        return $Problem_Summary;
1843    }
1844    else
1845    {
1846        return "";
1847    }
1848}
1849
1850sub get_Report_Header()
1851{
1852    my $Report_Header = "<h1>Test results for the <span style='color:Blue;'>$TargetLibraryFullName</span>-<span style='color:Blue;'>".$Descriptor{"Version"}."</span> library on <span style='color:Blue;'>".getArch()."</span></h1>\n";
1853    return $Report_Header;
1854}
1855
1856sub get_TestSuite_Header()
1857{
1858    my $Report_Header = "<h1>Test suite for the <span style='color:Blue;'>$TargetLibraryFullName</span>-<span style='color:Blue;'>".$Descriptor{"Version"}."</span> library on <span style='color:Blue;'>".getArch()."</span></h1>\n";
1859    return $Report_Header;
1860}
1861
1862sub get_problem_title($$)
1863{
1864    my ($ProblemType, $Value) = @_;
1865    if($ProblemType eq "Received_Signal") {
1866        return "Received signal $Value";
1867    }
1868    elsif($ProblemType eq "Received_Exception") {
1869        return "Received exception $Value";
1870    }
1871    elsif($ProblemType eq "Exited_With_Value") {
1872        return "Exited with value \"$Value\"";
1873    }
1874    elsif($ProblemType eq "Requirement_Failed") {
1875        return "Requirement failed";
1876    }
1877    elsif($ProblemType eq "Hanged_Execution") {
1878        return "Hanged execution";
1879    }
1880    elsif($ProblemType eq "Unexpected_Output") {
1881        return "Unexpected Output";
1882    }
1883    elsif($ProblemType eq "Other_Problems") {
1884        return "Other problems";
1885    }
1886    else {
1887        return "";
1888    }
1889}
1890
1891sub get_count_title($$)
1892{
1893    my ($Word, $Number) = @_;
1894    if($Number>=2 or $Number==0) {
1895        return "$Number $Word"."s";
1896    }
1897    elsif($Number==1) {
1898        return "1 $Word";
1899    }
1900}
1901
1902sub get_TestView($$)
1903{
1904    my ($Test, $Interface) = @_;
1905    $Test = highlight_code($Test, $Interface);
1906    $Test = htmlSpecChars($Test);
1907    $Test=~s/\@LT\@/</g;
1908    $Test=~s/\@GT\@/>/g;
1909    $Test=~s/\@SP\@/ /g;
1910    $Test=~s/\@NL\@/\n/g;
1911    return "<table class='test_view'><tr><td>".$Test."</td></tr></table>\n";
1912}
1913
1914sub rm_prefix($)
1915{
1916    my $Str = $_[0];
1917    $Str=~s/\A[_~]+//g;
1918    return $Str;
1919}
1920
1921sub select_Symbol_NS($)
1922{
1923    my $Symbol = $_[0];
1924    return "" if(not $Symbol);
1925    my $NS = $CompleteSignature{$Symbol}{"NameSpace"};
1926    if(not $NS)
1927    {
1928        if(my $Class = $CompleteSignature{$Symbol}{"Class"}) {
1929            $NS = $TypeInfo{$Class}{"NameSpace"};
1930        }
1931    }
1932    if($NS)
1933    {
1934        if(defined $NestedNameSpaces{$NS}) {
1935            return $NS;
1936        }
1937        else
1938        {
1939            while($NS=~s/::[^:]+\Z//)
1940            {
1941                if(defined $NestedNameSpaces{$NS}) {
1942                    return $NS;
1943                }
1944            }
1945        }
1946    }
1947
1948    return "";
1949}
1950
1951sub get_TestSuite_List()
1952{
1953    my ($TEST_LIST, %LibGroup_Header_Interface);
1954    my $Tests_Num = 0;
1955    return "" if(not keys(%Interface_TestDir));
1956    foreach my $Interface (keys(%Interface_TestDir))
1957    {
1958        my $Header = get_filename($CompleteSignature{$Interface}{"Header"});
1959        my $SharedObject = get_filename($Symbol_Library{$Interface});
1960        $SharedObject = get_filename($DepSymbol_Library{$Interface}) if(not $SharedObject);
1961        $LibGroup_Header_Interface{$Interface_LibGroup{$Interface}}{$SharedObject}{$Header}{$Interface} = 1;
1962        $Tests_Num += 1;
1963    }
1964    foreach my $LibGroup (sort {lc($a) cmp lc($b)} keys(%LibGroup_Header_Interface))
1965    {
1966        foreach my $SoName (sort {($a eq "") cmp ($b eq "")} sort {lc($a) cmp lc($b)} keys(%{$LibGroup_Header_Interface{$LibGroup}}))
1967        {
1968            foreach my $HeaderName (sort {lc($a) cmp lc($b)} keys(%{$LibGroup_Header_Interface{$LibGroup}{$SoName}}))
1969            {
1970                my %NameSpace_Interface = ();
1971                foreach my $Interface (keys(%{$LibGroup_Header_Interface{$LibGroup}{$SoName}{$HeaderName}})) {
1972                    $NameSpace_Interface{select_Symbol_NS($Interface)}{$Interface} = 1;
1973                }
1974                foreach my $NameSpace (sort keys(%NameSpace_Interface))
1975                {
1976                    $TEST_LIST .= getTitle($HeaderName, $SoName, $LibGroup, $NameSpace);
1977                    my @SortedInterfaces = sort {lc(rm_prefix($CompleteSignature{$a}{"ShortName"})) cmp lc(rm_prefix($CompleteSignature{$b}{"ShortName"}))} keys(%{$NameSpace_Interface{$NameSpace}});
1978                    @SortedInterfaces = sort {$CompleteSignature{$a}{"Destructor"} <=> $CompleteSignature{$b}{"Destructor"}} @SortedInterfaces;
1979                    @SortedInterfaces = sort {lc(get_TypeName($CompleteSignature{$a}{"Class"})) cmp lc(get_TypeName($CompleteSignature{$b}{"Class"}))} @SortedInterfaces;
1980                    foreach my $Interface (@SortedInterfaces)
1981                    {
1982                        my $RelPath = $Interface_TestDir{$Interface};
1983                        $RelPath=~s/\A\Q$TEST_SUITE_PATH\E[\/\\]*//g;
1984                        my $Signature = get_Signature($Interface);
1985                        if($NameSpace) {
1986                            $Signature=~s/(\W|\A)\Q$NameSpace\E\:\:(\w)/$1$2/g;
1987                        }
1988                        $RelPath=~s/:/\%3A/g;
1989                        $TEST_LIST .= "<a class='link' href=\'$RelPath/view.html\'><span class='int'>";
1990                        $TEST_LIST .= highLight_Signature_Italic_Color($Signature);
1991                        $TEST_LIST .= "</span></a><br/>\n";
1992                    }
1993                    $TEST_LIST .= "<br/>\n";
1994                }
1995            }
1996        }
1997    }
1998    $STAT_FIRST_LINE .= "total:$Tests_Num";
1999    return "<h2>Tests ($Tests_Num)</h2><hr/>\n".$TEST_LIST."<a style='font-size:11px;' href='#Top'>to the top</a><br/>\n";
2000}
2001
2002sub getTitle($$$$)
2003{
2004    my ($Header, $Library, $LibGroup, $NameSpace) = @_;
2005
2006    if($Library and $Library!~/\.\w+\Z/) {
2007        $Library .= " (.$LIB_EXT)";
2008    }
2009
2010    my $Title = "";
2011    if($Header and $Library)
2012    {
2013        $Title .= "<span class='header'>$Header</span>";
2014        $Title .= ", <span class='lib_name'>$Library</span><br/>\n";
2015    }
2016    elsif($Library) {
2017        $Title .= "<span class='lib_name'>$Library</span><br/>\n";
2018    }
2019    elsif($Header) {
2020        $Title .= "<span class='header'>$Header</span><br/>\n";
2021    }
2022    if($LibGroup) {
2023        $Title .= "&nbsp;<span class='libgroup'>\"$LibGroup\"</span>\n";
2024    }
2025    if($NameSpace) {
2026        $Title .= "<span class='ns'>namespace <b>$NameSpace</b></span><br/>\n";
2027    }
2028    return $Title;
2029}
2030
2031sub get_FailedTests($)
2032{
2033    my $Kind = $_[0];# Failures or Warnings
2034    my ($FAILED_TESTS, %Type_Value_LibGroup_Header_Interface);
2035    foreach my $Interface (keys(%RunResult))
2036    {
2037        if($Kind eq "Failures") {
2038            next if($RunResult{$Interface}{"Warnings"});
2039        }
2040        elsif($Kind eq "Warnings") {
2041            next if(not $RunResult{$Interface}{"Warnings"});
2042        }
2043        my $Header = get_filename($RunResult{$Interface}{"Header"});
2044        my $SharedObject = $RunResult{$Interface}{"SharedObject"};
2045        my $ProblemType = $RunResult{$Interface}{"Type"};
2046        my $ProblemValue = $RunResult{$Interface}{"Value"};
2047        $Type_Value_LibGroup_Header_Interface{$ProblemType}{$ProblemValue}{$Interface_LibGroup{$Interface}}{$SharedObject}{$Header}{$Interface} = 1;
2048    }
2049    foreach my $ProblemType ("Received_Signal", "Received_Exception", "Exited_With_Value", "Hanged_Execution", "Requirement_Failed", "Unexpected_Output", "Other_Problems")
2050    {
2051        next if(not keys(%{$Type_Value_LibGroup_Header_Interface{$ProblemType}}));
2052        foreach my $ProblemValue (sort keys(%{$Type_Value_LibGroup_Header_Interface{$ProblemType}}))
2053        {
2054            my $PROBLEM_REPORT = "<br/>\n";
2055            my $Problems_Count = 0;
2056            foreach my $LibGroup (sort {lc($a) cmp lc($b)} keys(%{$Type_Value_LibGroup_Header_Interface{$ProblemType}{$ProblemValue}}))
2057            {
2058                foreach my $SoName (sort {($a eq "") cmp ($b eq "")} sort {lc($a) cmp lc($b)} keys(%{$Type_Value_LibGroup_Header_Interface{$ProblemType}{$ProblemValue}{$LibGroup}}))
2059                {
2060                    foreach my $HeaderName (sort {lc($a) cmp lc($b)} keys(%{$Type_Value_LibGroup_Header_Interface{$ProblemType}{$ProblemValue}{$LibGroup}{$SoName}}))
2061                    {
2062                        next if(not $HeaderName or not $SoName);
2063                        my $HEADER_LIB_REPORT = "";
2064
2065                        my %NameSpace_Interface = ();
2066                        foreach my $Interface (keys(%{$Type_Value_LibGroup_Header_Interface{$ProblemType}{$ProblemValue}{$LibGroup}{$SoName}{$HeaderName}})) {
2067                            $NameSpace_Interface{$RunResult{$Interface}{"NameSpace"}}{$Interface} = 1;
2068                        }
2069                        foreach my $NameSpace (sort keys(%NameSpace_Interface))
2070                        {
2071                            $HEADER_LIB_REPORT .= getTitle($HeaderName, $SoName, $LibGroup, $NameSpace);
2072                            my @SortedInterfaces = sort {$RunResult{$a}{"Signature"} cmp $RunResult{$b}{"Signature"}} keys(%{$NameSpace_Interface{$NameSpace}});
2073                            foreach my $Interface (@SortedInterfaces)
2074                            {
2075                                my $Signature = $RunResult{$Interface}{"Signature"};
2076                                if($NameSpace) {
2077                                    $Signature=~s/(\W|\A)\Q$NameSpace\E\:\:(\w)/$1$2/g;
2078                                }
2079                                my $Info = $RunResult{$Interface}{"Info"};
2080                                my $Test = $RunResult{$Interface}{"Test"};
2081                                $HEADER_LIB_REPORT .= $ContentSpanStart;
2082                                if($Signature) {
2083                                    $HEADER_LIB_REPORT .= highLight_Signature_Italic_Color($Signature);
2084                                }
2085                                else {
2086                                    $HEADER_LIB_REPORT .= $Interface;
2087                                }
2088                                $HEADER_LIB_REPORT .= $ContentSpanEnd."<br/>\n";
2089                                $HEADER_LIB_REPORT .= $ContentDivStart;
2090                                my $RESULT_INFO = "<table class='test_result' cellpadding='2'><tr><td>".htmlSpecChars($Info)."</td></tr></table>";
2091                                $HEADER_LIB_REPORT .= $RESULT_INFO.$Test."<br/>".$ContentDivEnd;
2092                                $HEADER_LIB_REPORT = insertIDs($HEADER_LIB_REPORT);
2093                                $Problems_Count += 1;
2094                            }
2095                            $HEADER_LIB_REPORT .= "<br/>\n";
2096                        }
2097                        $PROBLEM_REPORT .= $HEADER_LIB_REPORT;
2098                    }
2099                }
2100            }
2101            if($PROBLEM_REPORT)
2102            {
2103                my $Title = "<a name=\'".$ProblemType.(($ProblemValue)?"_".$ProblemValue:"")."\'></a>";
2104                $Title .= $ContentSpanStart_Title;
2105                $Title .= get_problem_title($ProblemType, $ProblemValue)." <span class='ext_title'>(".get_count_title(($Kind eq "Failures")?"problem":"warning", $Problems_Count).")</span>";
2106                $Title .= $ContentSpanEnd."<br/>\n";
2107                $Title .= $ContentDivStart."\n";
2108
2109                $PROBLEM_REPORT = insertIDs($Title).$PROBLEM_REPORT."<a style='font-size:11px;' href='#Top'>to the top</a><br/>\n".$ContentDivEnd;
2110                $FAILED_TESTS .= $PROBLEM_REPORT;
2111            }
2112        }
2113    }
2114    if($FAILED_TESTS)
2115    {
2116        if($Kind eq "Failures") {
2117            $FAILED_TESTS = "<a name='Failed_Tests'></a><h2>Failed Tests (".$ResultCounter{"Run"}{"Fail"}.")</h2><hr/>\n".$FAILED_TESTS;
2118        }
2119        elsif($Kind eq "Warnings") {
2120            $FAILED_TESTS = "<a name='Warnings'></a><h2>Warnings (".$ResultCounter{"Run"}{"Warnings"}.")</h2><hr/>\n".$FAILED_TESTS;
2121        }
2122    }
2123    return $FAILED_TESTS;
2124}
2125
2126sub composeHTML_Head($$$$$)
2127{
2128    my ($Title, $Keywords, $Description, $Styles, $Scripts) = @_;
2129    return "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">
2130    <html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
2131    <head>
2132    <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />
2133    <meta name=\"keywords\" content=\"$Keywords\" />
2134    <meta name=\"description\" content=\"$Description\" />
2135    <title>
2136        $Title
2137    </title>
2138    <style type=\"text/css\">
2139    $Styles
2140    </style>
2141    <script type=\"text/javascript\" language=\"JavaScript\">
2142    <!--
2143    $Scripts
2144    -->
2145    </script>
2146    </head>";
2147}
2148
2149sub create_Index()
2150{
2151    my $Title = $TargetLibraryFullName."-".$Descriptor{"Version"}.": Test suite";
2152    my $Keywords = "$TargetLibraryFullName, tests, API";
2153    my $Description = "Test suite for the $TargetLibraryFullName-".$Descriptor{"Version"}." library on ".getArch();
2154
2155    my $Header = get_TestSuite_Header();
2156    my $CssStyles = readModule("Styles", "List.css");
2157    my $Report = get_TestSuite_List(); # initialized $STAT_FIRST_LINE variable
2158
2159    $Report = "<!-- $STAT_FIRST_LINE -->\n".composeHTML_Head($Title, $Keywords, $Description, $CssStyles, "")."\n<body>\n<div><a name='Top'></a>\n$Header<br/>\n$Report</div>\n"."<br/><br/>$TOOL_SIGNATURE\n<div style='height:99px;'></div>\n</body></html>";
2160
2161    writeFile("$TEST_SUITE_PATH/view_tests.html", $Report);
2162
2163    if($Browse or $OpenReport) {
2164        openReport("$TEST_SUITE_PATH/view_tests.html");
2165    }
2166}
2167
2168sub createReport()
2169{
2170    my $Title = $TargetLibraryFullName."-".$Descriptor{"Version"}.": test results";
2171    my $Keywords = "$TargetLibraryFullName, test, API";
2172    my $Description = "Test results for the $TargetLibraryFullName-".$Descriptor{"Version"}." library on ".getArch();
2173
2174    my $CssStyles = readModule("Styles", "Report.css");
2175    my $JScripts = readModule("Scripts", "Sections.js");
2176
2177    my $Summary = get_Summary(); # initialized $STAT_FIRST_LINE variable
2178    my $Report = get_Report_Header()."<br/>\n$Summary<br/>\n".get_Problem_Summary()."<br/>\n".get_FailedTests("Failures")."<br/>\n".get_FailedTests("Warnings");
2179    $Report = "<!-- $STAT_FIRST_LINE -->\n".composeHTML_Head($Title, $Keywords, $Description, $CssStyles, $JScripts)."\n<body>\n<div><a name='Top'></a>\n".$Report."</div>\n"."<br/><br/>$TOOL_SIGNATURE\n<div style='height:999px;'></div>\n</body></html>";
2180
2181    writeFile("$REPORT_PATH/test_results.html", $Report);
2182
2183    if($Browse or $OpenReport) {
2184        openReport("$REPORT_PATH/test_results.html");
2185    }
2186}
2187
2188sub check_Cmd($)
2189{
2190    my $Cmd = $_[0];
2191    foreach my $Path (sort {length($a)<=>length($b)} split(/:/, $ENV{"PATH"}))
2192    {
2193        if(-x $Path."/".$Cmd) {
2194            return 1;
2195        }
2196    }
2197    return 0;
2198}
2199
2200sub openReport($)
2201{
2202    my $Path = $_[0];
2203    my $Cmd = "";
2204    if($Browse)
2205    { # user-defined browser
2206        $Cmd = $Browse." \"$Path\"";
2207    }
2208    if(not $Cmd)
2209    { # default browser
2210        if($OSgroup eq "macos") {
2211            $Cmd = "open \"$Path\"";
2212        }
2213        elsif($OSgroup eq "windows") {
2214            $Cmd = "start ".path_format($Path, $OSgroup);
2215        }
2216        else
2217        { # linux, freebsd, solaris
2218            my @Browsers = (
2219                "x-www-browser",
2220                "sensible-browser",
2221                "firefox",
2222                "opera",
2223                "xdg-open",
2224                "lynx",
2225                "links"
2226            );
2227            foreach my $Br (@Browsers)
2228            {
2229                if(check_Cmd($Br))
2230                {
2231                    $Cmd = $Br." \"$Path\"";
2232                    last;
2233                }
2234            }
2235        }
2236    }
2237    if($Cmd)
2238    {
2239        if($Debug) {
2240            printMsg("INFO", "running $Cmd");
2241        }
2242        if($OSgroup ne "windows"
2243        and $OSgroup ne "macos")
2244        {
2245            if($Cmd!~/lynx|links/) {
2246                $Cmd .= "  >\"/dev/null\" 2>&1 &";
2247            }
2248        }
2249        system($Cmd);
2250    }
2251    else {
2252        printMsg("ERROR", "cannot open report in browser");
2253    }
2254}
2255
2256sub cmd_find($;$$$$)
2257{ # native "find" is much faster than File::Find (~6x)
2258  # also the File::Find doesn't support --maxdepth N option
2259  # so using the cross-platform wrapper for the native one
2260    my ($Path, $Type, $Name, $MaxDepth, $UseRegex) = @_;
2261    return () if(not $Path or not -e $Path);
2262    if($OSgroup eq "windows")
2263    {
2264        $Path = get_abs_path($Path);
2265        $Path = path_format($Path, $OSgroup);
2266        my $Cmd = "dir \"$Path\" /B /O";
2267        if($MaxDepth!=1) {
2268            $Cmd .= " /S";
2269        }
2270        if($Type eq "d") {
2271            $Cmd .= " /AD";
2272        }
2273        elsif($Type eq "f") {
2274            $Cmd .= " /A-D";
2275        }
2276        my @Files = split(/\n/, `$Cmd 2>\"$TMP_DIR/null\"`);
2277        if($Name)
2278        {
2279            if(not $UseRegex)
2280            { # FIXME: how to search file names in MS shell?
2281              # wildcard to regexp
2282                $Name=~s/\*/.*/g;
2283                $Name='\A'.$Name.'\Z';
2284            }
2285            @Files = grep { /$Name/i } @Files;
2286        }
2287        my @AbsPaths = ();
2288        foreach my $File (@Files)
2289        {
2290            if(not is_abs($File)) {
2291                $File = join_P($Path, $File);
2292            }
2293            if($Type eq "f" and not -f $File)
2294            { # skip dirs
2295                next;
2296            }
2297            push(@AbsPaths, path_format($File, $OSgroup));
2298        }
2299        if($Type eq "d") {
2300            push(@AbsPaths, $Path);
2301        }
2302        return @AbsPaths;
2303    }
2304    else
2305    {
2306        $Path = get_abs_path($Path);
2307        if(-d $Path and -l $Path
2308        and $Path!~/\/\Z/)
2309        { # for directories that are symlinks
2310            $Path.="/";
2311        }
2312        my $Cmd = "find \"$Path\"";
2313        if($MaxDepth) {
2314            $Cmd .= " -maxdepth $MaxDepth";
2315        }
2316        if($Type) {
2317            $Cmd .= " -type $Type";
2318        }
2319        if($Name and not $UseRegex)
2320        { # wildcards
2321            $Cmd .= " -name \"$Name\"";
2322        }
2323        my $Res = `$Cmd 2>\"$TMP_DIR/null\"`;
2324        if($? and $!) {
2325            printMsg("ERROR", "problem with \'find\' utility ($?): $!");
2326        }
2327        my @Files = split(/\n/, $Res);
2328        if($Name and $UseRegex)
2329        { # regex
2330            @Files = grep { /$Name/ } @Files;
2331        }
2332        return @Files;
2333    }
2334}
2335
2336sub get_filename($)
2337{ # much faster than basename() from File::Basename module
2338    return $Cache{"get_filename"}{$_[0]} if($Cache{"get_filename"}{$_[0]});
2339    if($_[0]=~/([^\/\\]+)\Z/) {
2340        return ($Cache{"get_filename"}{$_[0]} = $1);
2341    }
2342    return "";
2343}
2344
2345sub get_dirname($)
2346{ # much faster than dirname() from File::Basename module
2347    if($_[0]=~/\A(.*)[\/\\]+([^\/\\]*)\Z/) {
2348        return $1;
2349    }
2350    return "";
2351}
2352
2353sub get_depth($$)
2354{
2355    my ($Str, $Sym) = @_;
2356    return $Cache{"get_depth"}{$Str}{$Sym} if(defined $Cache{"get_depth"}{$Str}{$Sym});
2357    $Cache{"get_depth"}{$Str}{$Sym} = scalar ( ( ) = $Str=~/($Sym)/g );
2358    return $Cache{"get_depth"}{$Str}{$Sym};
2359}
2360
2361sub getPrefix($)
2362{
2363    my $Str = $_[0];
2364    if($Str=~/\A[_]*(([a-z]|[A-Z])[a-z]+)[A-Z]/) {
2365        return $1;
2366    }
2367    elsif($Str=~/\A[_]*([A-Z]+)[A-Z][a-z]+([A-Z][a-z]+|\Z)/) {
2368        return $1;
2369    }
2370    elsif($Str=~/\A([a-z0-9]+_)[a-z]+/i) {
2371        return $1;
2372    }
2373    elsif($Str=~/\A(([a-z])\2{1,})/i)
2374    { # ffopen
2375        return $1;
2376    }
2377    else {
2378        return "";
2379    }
2380}
2381
2382sub get_Type($)
2383{
2384    my $TypeId = $_[0];
2385    return "" if(not $TypeId or not $TypeInfo{$TypeId});
2386    return %{$TypeInfo{$TypeId}};
2387}
2388
2389sub uncover_typedefs($)
2390{
2391    my $TypeName = $_[0];
2392    return "" if(not $TypeName);
2393    return $Cache{"uncover_typedefs"}{$TypeName} if(defined $Cache{"uncover_typedefs"}{$TypeName});
2394    my ($TypeName_New, $TypeName_Pre) = (formatName($TypeName, "T"), "");
2395    while($TypeName_New ne $TypeName_Pre)
2396    {
2397        $TypeName_Pre = $TypeName_New;
2398        my $TypeName_Copy = $TypeName_New;
2399        my %Words = ();
2400        while($TypeName_Copy=~s/(\W|\A)([a-z_][\w:]*)(\W|\Z)//io)
2401        {
2402            my $Word = $2;
2403            next if(not $Word or $Word=~/\A(true|false|const|int|long|void|short|float|unsigned|char|double|class|struct|union|enum)\Z/);
2404            $Words{$Word} = 1;
2405        }
2406        foreach my $Word (sort keys(%Words))
2407        {
2408            my $BaseType_Name = $Typedef_BaseName{$Word};
2409            next if($TypeName_New=~/(\W|\A)(class|struct|union|enum)\s+\Q$Word\E(\W|\Z)/);
2410            next if(not $BaseType_Name);
2411            if($BaseType_Name=~/\([\*]+\)/)
2412            {
2413                if($TypeName_New=~/\Q$Word\E(.*)\Z/)
2414                {
2415                    my $Type_Suffix = $1;
2416                    $TypeName_New = $BaseType_Name;
2417                    if($TypeName_New=~s/\(([\*]+)\)/($1 $Type_Suffix)/) {
2418                        $TypeName_New = formatName($TypeName_New, "T");
2419                    }
2420                }
2421            }
2422            else
2423            {
2424                if($TypeName_New=~s/(\W|\A)\Q$Word\E(\W|\Z)/$1$BaseType_Name$2/g) {
2425                    $TypeName_New = formatName($TypeName_New, "T");
2426                }
2427            }
2428        }
2429    }
2430    $Cache{"uncover_typedefs"}{$TypeName} = $TypeName_New;
2431    return $TypeName_New;
2432}
2433
2434sub get_type_short_name($)
2435{
2436    my $TypeName = $_[0];
2437    $TypeName=~s/[ ]*<.*>[ ]*//g;
2438    $TypeName=~s/\Astruct //g;
2439    $TypeName=~s/\Aunion //g;
2440    $TypeName=~s/\Aclass //g;
2441    return $TypeName;
2442}
2443
2444sub is_transit_function($)
2445{
2446    my $ShortName = $_[0];
2447    return 1 if($ShortName=~/(_|\A)dup(_|\Z)|(dup\Z)|_dup/i);
2448    return 1 if($ShortName=~/replace|merge|search|copy|append|duplicat|find|query|open|handle|first|next|entry/i);
2449    return grep(/\A(get|prev|last|from|of|dup)\Z/i, @{get_tokens($ShortName)});
2450}
2451
2452sub get_TypeLib($)
2453{
2454    my $TypeId = $_[0];
2455    if(defined $Cache{"get_TypeLib"}{$TypeId}
2456    and not defined $AuxType{$TypeId}) {
2457        return $Cache{"get_TypeLib"}{$TypeId};
2458    }
2459    my $Header = $TypeInfo{$TypeId}{"Header"};
2460    foreach my $Interface (sort keys(%{$Header_Interface{$Header}}))
2461    {
2462        if(my $SoLib = get_filename($Symbol_Library{$Interface}))
2463        {
2464            $Cache{"get_TypeLib"}{$TypeId} = $SoLib;
2465            return $SoLib;
2466        }
2467        elsif(my $SoLib = get_filename($DepSymbol_Library{$Interface}))
2468        {
2469            $Cache{"get_TypeLib"}{$TypeId} = $SoLib;
2470            return $SoLib;
2471        }
2472    }
2473    $Cache{"get_TypeLib"}{$TypeId} = "unknown";
2474    return $Cache{"get_TypeLib"}{$TypeId};
2475}
2476
2477sub detect_typedef($)
2478{
2479    my $Type_Id = $_[0];
2480    return "" if(not $Type_Id);
2481    my $Typedef_Id = get_base_typedef($Type_Id);
2482    if(not $Typedef_Id) {
2483        $Typedef_Id = get_type_typedef(get_FoundationTypeId($Type_Id));
2484    }
2485    return $Typedef_Id;
2486}
2487
2488sub get_symbol_suffix($)
2489{
2490    my $Symbol = $_[0];
2491    my $Signature = $tr_name{$Symbol};
2492    my $Suffix = substr($Signature, find_center($Signature, "("));
2493    return $Suffix;
2494}
2495
2496sub get_Signature($)
2497{
2498    my $Interface = $_[0];
2499    if(defined $Cache{"get_Signature"}{$Interface}) {
2500        return $Cache{"get_Signature"}{$Interface};
2501    }
2502    my $Func_Signature = "";
2503    my $ShortName = $CompleteSignature{$Interface}{"ShortName"};
2504    if($Interface=~/\A(_Z|\?)/)
2505    {
2506        if(my $ClassId = $CompleteSignature{$Interface}{"Class"})
2507        {
2508            if(get_TypeName($ClassId)=~/<|>|::/
2509            and my $Typedef_Id = detect_typedef($ClassId)) {
2510                $ClassId = $Typedef_Id;
2511            }
2512            $Func_Signature = get_TypeName($ClassId)."::".((($CompleteSignature{$Interface}{"Destructor"}))?"~":"").$ShortName;
2513        }
2514        elsif(my $NameSpace = $CompleteSignature{$Interface}{"NameSpace"}) {
2515            $Func_Signature = $NameSpace."::".$ShortName;
2516        }
2517        else {
2518            $Func_Signature = $ShortName;
2519        }
2520    }
2521    else {
2522        $Func_Signature = $Interface;
2523    }
2524    my @ParamArray = ();
2525    foreach my $Pos (sort {int($a) <=> int($b)} keys(%{$CompleteSignature{$Interface}{"Param"}}))
2526    {
2527        next if($Pos eq "");
2528        my $ParamTypeId = $CompleteSignature{$Interface}{"Param"}{$Pos}{"type"};
2529        next if(not $ParamTypeId);
2530        my $ParamTypeName = get_TypeName($ParamTypeId);
2531        my $ParamFTypeId = get_FoundationTypeId($ParamTypeId);
2532        if($ParamTypeName=~/<|>|::/ and get_TypeType($ParamFTypeId)=~/\A(Class|Struct)\Z/)
2533        {
2534            if(my $Typedef_Id = detect_typedef($ParamTypeId)) {
2535                $ParamTypeName = cover_by_typedef($ParamTypeName, $ParamFTypeId, $Typedef_Id);
2536            }
2537        }
2538        if(my $ParamName = $CompleteSignature{$Interface}{"Param"}{$Pos}{"name"}) {
2539            push(@ParamArray, create_member_decl($ParamTypeName, $ParamName));
2540        }
2541        else {
2542            push(@ParamArray, $ParamTypeName);
2543        }
2544    }
2545    if(not $CompleteSignature{$Interface}{"Data"})
2546    {
2547        if($Interface=~/\A(_Z|\?)/)
2548        {
2549            if(my $ChargeLevel = get_ChargeLevel($Interface)) {
2550                $Func_Signature .= " [".$ChargeLevel."]";
2551            }
2552        }
2553        $Func_Signature .= " (".join(", ", @ParamArray).")";
2554        if($Interface=~/\A_ZNK/) {
2555            $Func_Signature .= " const";
2556        }
2557        if($CompleteSignature{$Interface}{"Static"}) {
2558            $Func_Signature .= " [static]";
2559        }
2560    }
2561    if(defined $ShowRetVal
2562    and my $ReturnTId = $CompleteSignature{$Interface}{"Return"})
2563    {
2564        my $ReturnTypeName = get_TypeName($ReturnTId);
2565        my $ReturnFTypeId = get_FoundationTypeId($ReturnTId);
2566        if($ReturnTypeName=~/<|>|::/ and get_TypeType($ReturnFTypeId)=~/\A(Class|Struct)\Z/)
2567        {
2568            if(my $Typedef_Id = detect_typedef($ReturnTId)) {
2569                $ReturnTypeName = cover_by_typedef($ReturnTypeName, $ReturnFTypeId, $Typedef_Id);
2570            }
2571        }
2572        $Func_Signature .= " :".$ReturnTypeName;
2573    }
2574    return ($Cache{"get_Signature"}{$Interface} = $Func_Signature);
2575}
2576
2577sub get_ChargeLevel($)
2578{
2579    my $Symbol = $_[0];
2580    if($CompleteSignature{$Symbol}{"Constructor"})
2581    {
2582        if($Symbol=~/C1E/) {
2583            return "in-charge";
2584        }
2585        elsif($Symbol=~/C2E/) {
2586            return "not-in-charge";
2587        }
2588    }
2589    elsif($CompleteSignature{$Symbol}{"Destructor"})
2590    {
2591        if($Symbol=~/D1E/) {
2592            return "in-charge";
2593        }
2594        elsif($Symbol=~/D2E/) {
2595            return "not-in-charge";
2596        }
2597        elsif($Symbol=~/D0E/) {
2598            return "in-charge-deleting";
2599        }
2600    }
2601    return "";
2602}
2603
2604sub htmlSpecChars($)
2605{
2606    my $Str = $_[0];
2607    # $Str=~s/\&([^#]|\Z)/&amp;$1/g;
2608    $Str=~s/\&/&amp;/g;
2609    $Str=~s/</&lt;/g;
2610    $Str=~s/>/&gt;/g;
2611    $Str=~s/([^ ]) ([^ ])/$1\@SP1\@$2/g;
2612    $Str=~s/([^ ]) ([^ ])/$1\@SP1\@$2/g;
2613    $Str=~s/ /&nbsp;/g;
2614    $Str=~s/\@SP1\@/ /g;
2615    $Str=~s/\n/<br\/>/g;
2616    return $Str;
2617}
2618
2619sub highLight_Signature_Italic_Color($)
2620{
2621    my $Signature = $_[0];
2622    return highLight_Signature_PPos_Italic($Signature, "", 1, 1);
2623}
2624
2625sub highLight_Signature_PPos_Italic($$$$)
2626{
2627    my ($Signature, $Param_Pos, $ItalicParams, $ColorParams) = @_;
2628    my ($Begin, $End, $Return) = (substr($Signature, 0, find_center($Signature, "(")), "", "");
2629    if($ShowRetVal and $Signature=~s/([^:])\s*:([^:].+?)\Z/$1/g) {
2630        $Return = $2;
2631    }
2632    if($Signature=~/\)((| const)(| \[static\]))\Z/) {
2633        $End = $1;
2634    }
2635    my @Parts = ();
2636    my @SParts = get_Signature_Parts($Signature, 1);
2637    foreach my $Pos (0 .. $#SParts)
2638    {
2639        my $Part = $SParts[$Pos];
2640        $Part=~s/\A\s+|\s+\Z//g;
2641        my ($Part_Styled, $ParamName) = (htmlSpecChars($Part), "");
2642        if($Part=~/\([\*]+(\w+)\)/i) {
2643            $ParamName = $1;#func-ptr
2644        }
2645        elsif($Part=~/(\w+)[\,\)]*\Z/i) {
2646            $ParamName = $1;
2647        }
2648        if(not $ParamName)
2649        {
2650            push(@Parts, $Part_Styled);
2651            next;
2652        }
2653        if($ItalicParams
2654        and not $TName_Tid{$Part})
2655        {
2656            my $Style = "param";
2657            if($Param_Pos ne ""
2658            and $Pos==$Param_Pos) {
2659                $Style = "focus_p";
2660            }
2661            elsif($ColorParams) {
2662                $Style = "color_p";
2663            }
2664            $Part_Styled =~ s!(\W)$ParamName([\,\)]|\Z)!$1<span class=\'$Style\'>$ParamName</span>$2!ig;
2665        }
2666        $Part_Styled=~s/,(\w)/, $1/g;
2667        push(@Parts, $Part_Styled);
2668    }
2669    if(@Parts)
2670    {
2671        foreach my $Num (0 .. $#Parts)
2672        {
2673            if($Num==$#Parts)
2674            { # add ")" to the last parameter
2675                $Parts[$Num] = "<span class='nowrap'>".$Parts[$Num]." )</span>";
2676            }
2677            elsif(length($Parts[$Num])<=45) {
2678                $Parts[$Num] = "<span class='nowrap'>".$Parts[$Num]."</span>";
2679            }
2680        }
2681        $Signature = htmlSpecChars($Begin)."<span class='sym_p'>(&#160;".join(" ", @Parts)."</span>".$End;
2682    }
2683    else {
2684        $Signature = htmlSpecChars($Begin)."<span class='sym_p'>(&#160;)</span>".$End;
2685    }
2686    if($Return and $ShowRetVal) {
2687        $Signature .= "<span class='sym_p nowrap'> &#160;<b>:</b>&#160;&#160;".htmlSpecChars($Return)."</span>";
2688    }
2689    $Signature=~s!\[\]![&#160;]!g;
2690    $Signature=~s!operator=!operator&#160;=!g;
2691    $Signature=~s!(\[in-charge\]|\[not-in-charge\]|\[in-charge-deleting\]|\[static\])!<span class='attr'>$1</span>!g;
2692    return $Signature;
2693}
2694
2695sub get_Signature_Parts($$)
2696{
2697    my ($Signature, $Comma) = @_;
2698    my @Parts = ();
2699    my ($Bracket_Num, $Bracket2_Num) = (0, 0);
2700    my $Parameters = $Signature;
2701    my $ShortName = substr($Parameters, 0, find_center($Parameters, "("));
2702    $Parameters=~s/\A\Q$ShortName\E\(//g;
2703    $Parameters=~s/\)(| const)(| \[static\])\Z//g;
2704    my $Part_Num = 0;
2705    foreach my $Pos (0 .. length($Parameters) - 1)
2706    {
2707        my $Symbol = substr($Parameters, $Pos, 1);
2708        $Bracket_Num += 1 if($Symbol eq "(");
2709        $Bracket_Num -= 1 if($Symbol eq ")");
2710        $Bracket2_Num += 1 if($Symbol eq "<");
2711        $Bracket2_Num -= 1 if($Symbol eq ">");
2712        if($Symbol eq "," and $Bracket_Num==0 and $Bracket2_Num==0)
2713        {
2714            $Parts[$Part_Num] .= $Symbol if($Comma);
2715            $Part_Num += 1;
2716        }
2717        else
2718        {
2719            $Parts[$Part_Num] .= $Symbol;
2720        }
2721    }
2722    return @Parts;
2723}
2724
2725sub isAnon($) {
2726    return (($_[0]=~/\.\_\d+/) or ($_[0]=~/anon-/));
2727}
2728
2729sub formatName($$)
2730{ # type name correction
2731    if(defined $Cache{"formatName"}{$_[1]}{$_[0]}) {
2732        return $Cache{"formatName"}{$_[1]}{$_[0]};
2733    }
2734
2735    my $N = $_[0];
2736
2737    if($_[1] ne "S")
2738    {
2739        $N=~s/\A[ ]+//g;
2740        $N=~s/[ ]+\Z//g;
2741        $N=~s/[ ]{2,}/ /g;
2742    }
2743
2744    $N=~s/[ ]*(\W)[ ]*/$1/g; # std::basic_string<char> const
2745
2746    $N=~s/\bvolatile const\b/const volatile/g;
2747
2748    $N=~s/\b(long long|short|long) unsigned\b/unsigned $1/g;
2749    $N=~s/\b(short|long) int\b/$1/g;
2750
2751    $N=~s/([\)\]])(const|volatile)\b/$1 $2/g;
2752
2753    while($N=~s/>>/> >/g) {};
2754
2755    if($_[1] eq "S")
2756    {
2757        if(index($N, "operator")!=-1) {
2758            $N=~s/\b(operator[ ]*)> >/$1>>/;
2759        }
2760    }
2761
2762    return ($Cache{"formatName"}{$_[1]}{$_[0]} = $N);
2763}
2764
2765sub prepareInterfaces()
2766{
2767    foreach my $InfoId (keys(%SymbolInfo))
2768    {
2769        my $MnglName = $SymbolInfo{$InfoId}{"MnglName"};
2770        %{$CompleteSignature{$MnglName}} = %{$SymbolInfo{$InfoId}};
2771        delete($SymbolInfo{$InfoId});
2772    }
2773    %SymbolInfo = ();
2774}
2775
2776sub setRegularities()
2777{
2778    foreach my $Symbol (keys(%CompleteSignature))
2779    {
2780        if(my $ClassId = $CompleteSignature{$Symbol}{"Class"})
2781        {
2782            if(not $CompleteSignature{$Symbol}{"Destructor"}
2783            and ($Symbol!~/C2E/ or not $CompleteSignature{$Symbol}{"Constructor"})) {
2784                $Interface_Overloads{$CompleteSignature{$Symbol}{"NameSpace"}}{get_ShortType($ClassId)}{$CompleteSignature{$Symbol}{"ShortName"}}{$Symbol} = 1;
2785            }
2786            if($CompleteSignature{$Symbol}{"PureVirt"}) {
2787                $Class_PureMethod{$ClassId}{$Symbol} = 1;
2788            }
2789            else {
2790                $Class_Method{$ClassId}{$Symbol} = 1;
2791            }
2792        }
2793
2794        if(not $CompleteSignature{$Symbol}{"Private"})
2795        {
2796            setOutParams_Simple($Symbol);
2797            setOutParams_Complex($Symbol);
2798            setRelationships($Symbol);
2799        }
2800
2801        if($CompleteSignature{$Symbol}{"Data"})
2802        {
2803            if($Symbol=~/\A(_Z|\?)/)
2804            {
2805                my $Name = $CompleteSignature{$Symbol}{"ShortName"};
2806                if(my $Class = $CompleteSignature{$Symbol}{"Class"}) {
2807                    $Name = get_TypeName($Class)."::".$Name;
2808                }
2809                $GlobalDataNames{$Name} = 1;
2810            }
2811            else {
2812                 $GlobalDataNames{$CompleteSignature{$Symbol}{"ShortName"}} = 1;
2813            }
2814        }
2815        else
2816        {
2817            if($Symbol=~/\A(_Z|\?)/) {
2818                $MethodNames{$CompleteSignature{$Symbol}{"ShortName"}} = 1;
2819            }
2820            else {
2821                $FuncNames{$CompleteSignature{$Symbol}{"ShortName"}} = 1;
2822            }
2823        }
2824
2825        if(my $Prefix = getPrefix($CompleteSignature{$Symbol}{"ShortName"})) {
2826            $Library_Prefixes{$Prefix} += 1;
2827        }
2828    }
2829    foreach my $NameSpace (keys(%Interface_Overloads))
2830    {
2831        foreach my $ClassName (keys(%{$Interface_Overloads{$NameSpace}}))
2832        {
2833            foreach my $ShortName (keys(%{$Interface_Overloads{$NameSpace}{$ClassName}}))
2834            {
2835                if(keys(%{$Interface_Overloads{$NameSpace}{$ClassName}{$ShortName}})>1)
2836                {
2837                    foreach my $Symbol (keys(%{$Interface_Overloads{$NameSpace}{$ClassName}{$ShortName}})) {
2838                        $OverloadedInterface{$Symbol} = keys(%{$Interface_Overloads{$NameSpace}{$ClassName}{$ShortName}});
2839                    }
2840                }
2841                delete($Interface_Overloads{$NameSpace}{$ClassName}{$ShortName});
2842            }
2843        }
2844    }
2845
2846    my %Struct_Mapping = ();
2847
2848    foreach my $TypeId (keys(%TypeInfo))
2849    {
2850        my %Type = %{$TypeInfo{$TypeId}};
2851        my $BaseTypeId = get_FoundationTypeId($TypeId);
2852        my $PLevel = get_PointerLevel($TypeId);
2853        $BaseType_PLevel_Type{$BaseTypeId}{$PLevel}{$TypeId} = 1;
2854
2855        if($Type{"Type"} eq "Struct")
2856        {
2857
2858            next if(not keys(%{$Type{"Memb"}}));
2859            my $FirstId = $Type{"Memb"}{0}{"type"};
2860            if($Type{"Memb"}{0}{"name"}=~/parent/i
2861            and get_TypeType(get_FoundationTypeId($FirstId)) eq "Struct"
2862            and get_TypeName($FirstId)!~/gobject/i) {
2863                $Struct_Parent{$TypeId} = $FirstId;
2864            }
2865            my @Keys = ();
2866            foreach my $MembPos (sort {int($a)<=>int($b)} keys(%{$Type{"Memb"}})) {
2867                push(@Keys, $Type{"Memb"}{$MembPos}{"name"}.":".$Type{"Memb"}{$MembPos}{"type"});
2868            }
2869            init_struct_mapping($TypeId, \%Struct_Mapping, \@Keys);
2870        }
2871    }
2872
2873    read_struct_mapping(\%Struct_Mapping);
2874}
2875
2876sub init_struct_mapping($$$)
2877{
2878    my ($TypeId, $Ref, $KeysRef) = @_;
2879    my @Keys = @{$KeysRef};
2880    if($#Keys>=1)
2881    {
2882        my $FirstKey = $Keys[0];
2883        splice(@Keys, 0, 1);
2884        if(not defined $Ref->{$FirstKey}) {
2885            %{$Ref->{$FirstKey}} = ();
2886        }
2887        init_struct_mapping($TypeId, $Ref->{$FirstKey}, \@Keys);
2888    }
2889    elsif($#Keys==0) {
2890        $Ref->{$Keys[0]}{"Types"}{$TypeId} = 1;
2891    }
2892}
2893
2894sub read_struct_mapping($)
2895{
2896    my $Ref = $_[0];
2897    my %LevelTypes = ();
2898    @LevelTypes{keys(%{$Ref->{"Types"}})} = values(%{$Ref->{"Types"}});
2899    foreach my $Key (keys(%{$Ref}))
2900    {
2901        next if($Key eq "Types");
2902        foreach my $SubClassId (read_struct_mapping($Ref->{$Key}))
2903        {
2904            $LevelTypes{$SubClassId} = 1;
2905            foreach my $ParentId (keys(%{$Ref->{"Types"}})) {
2906                $Struct_SubClasses{$ParentId}{$SubClassId} = 1;
2907            }
2908        }
2909    }
2910    return keys(%LevelTypes);
2911}
2912
2913sub get_ShortType($)
2914{
2915    my $TypeId = $_;
2916    my $TypeName = uncover_typedefs($TypeInfo{$TypeId}{"Name"});
2917    if(my $NameSpace = $TypeInfo{$TypeId}{"NameSpace"}) {
2918        $TypeName=~s/\A$NameSpace\:\://g;
2919    }
2920    return $TypeName;
2921}
2922
2923sub setRelationships($)
2924{
2925    my $Interface = $_[0];
2926    my $ShortName = $CompleteSignature{$Interface}{"ShortName"};
2927
2928    if($Interface=~/\A(_Z|\?)/ and not $CompleteSignature{$Interface}{"Class"}) {
2929        $Func_ShortName_MangledName{$CompleteSignature{$Interface}{"ShortName"}}{$Interface}=1;
2930    }
2931    if(not $CompleteSignature{$Interface}{"PureVirt"})
2932    {
2933        if($CompleteSignature{$Interface}{"Constructor"}) {
2934            $Class_Constructors{$CompleteSignature{$Interface}{"Class"}}{$Interface} = 1;
2935        }
2936        elsif($CompleteSignature{$Interface}{"Destructor"}) {
2937            $Class_Destructors{$CompleteSignature{$Interface}{"Class"}}{$Interface} = 1;
2938        }
2939        else
2940        {
2941            if(get_TypeName($CompleteSignature{$Interface}{"Return"}) ne "void")
2942            {
2943                my $DoNotUseReturn = 0;
2944                if(is_transit_function($ShortName))
2945                {
2946                    my $Return_FId = get_FoundationTypeId($CompleteSignature{$Interface}{"Return"});
2947                    foreach my $Pos (keys(%{$CompleteSignature{$Interface}{"Param"}}))
2948                    {
2949                        next if($InterfaceSpecType{$Interface}{"SpecParam"}{$Pos});
2950                        my $Param_FId = get_FoundationTypeId($CompleteSignature{$Interface}{"Param"}{$Pos}{"type"});
2951                        if(($CompleteSignature{$Interface}{"Param"}{$Pos}{"type"} eq $CompleteSignature{$Interface}{"Return"})
2952                        or (get_TypeType($Return_FId)!~/\A(Intrinsic|Enum|Array)\Z/ and $Return_FId eq $Param_FId))
2953                        {
2954                            $DoNotUseReturn = 1;
2955                            last;
2956                        }
2957                    }
2958                }
2959                if(not $DoNotUseReturn)
2960                {
2961                    $ReturnTypeId_Interface{$CompleteSignature{$Interface}{"Return"}}{$Interface}=1;
2962                    my $Return_FId = get_FoundationTypeId($CompleteSignature{$Interface}{"Return"});
2963                    my $PLevel = get_PointerLevel($CompleteSignature{$Interface}{"Return"});
2964                    if(get_TypeType($Return_FId) ne "Intrinsic") {
2965                        $BaseType_PLevel_Return{$Return_FId}{$PLevel}{$Interface}=1;
2966                    }
2967                }
2968            }
2969        }
2970    }
2971
2972    $Header_Interface{$CompleteSignature{$Interface}{"Header"}}{$Interface} = 1;
2973    if(not $CompleteSignature{$Interface}{"Class"} and not $LibraryMallocFunc
2974    and $Symbol_Library{$Interface} and $Interface ne "malloc"
2975    and $ShortName!~/try|slice|trim|\d\Z/i and $ShortName=~/(\A|_|\d)(malloc|alloc)(\Z|_|\d)/i
2976    and keys(%{$CompleteSignature{$Interface}{"Param"}})==1
2977    and isIntegerType(get_TypeName($CompleteSignature{$Interface}{"Param"}{0}{"type"}))) {
2978        $LibraryMallocFunc = $Interface;
2979    }
2980    if(not $CompleteSignature{$Interface}{"Class"} and $Symbol_Library{$Interface}
2981    and $ShortName=~/(\A[a-z]*_)(init|initialize|initializer|install)\Z/i) {
2982        $LibraryInitFunc{$Interface} = 1;
2983    }
2984    elsif(not $CompleteSignature{$Interface}{"Class"} and $Symbol_Library{$Interface}
2985    and $ShortName=~/\A([a-z]*_)(exit|finalize|finish|clean|close|deinit|shutdown|cleanup|uninstall|end)\Z/i) {
2986        $LibraryExitFunc{$Interface} = 1;
2987    }
2988}
2989
2990sub setOutParams_Simple($)
2991{
2992    my $Interface = $_[0];
2993    my $ReturnType_Id = $CompleteSignature{$Interface}{"Return"};
2994    my $ReturnType_Name_Short = get_TypeName($ReturnType_Id);
2995    while($ReturnType_Name_Short=~s/(\*|\&)([^<>()]+|)\Z/$2/g){};
2996    my ($ParamName_Prev, $ParamTypeId_Prev) = ();
2997    foreach my $ParamPos (sort {int($a)<=>int($b)} keys(%{$CompleteSignature{$Interface}{"Param"}}))
2998    { # detecting out-parameters by name
2999        if($CompleteSignature{$Interface}{"Param"}{$ParamPos}{"name"}=~/\Ap\d+\Z/
3000        and (my $NewParamName = $AddIntParams{$Interface}{$ParamPos}))
3001        { # names from the external file
3002            $CompleteSignature{$Interface}{"Param"}{$ParamPos}{"name"} = $NewParamName;
3003        }
3004        my $ParamName = $CompleteSignature{$Interface}{"Param"}{$ParamPos}{"name"};
3005        my $ParamTypeId = $CompleteSignature{$Interface}{"Param"}{$ParamPos}{"type"};
3006        my $ParamPLevel = get_PointerLevel($ParamTypeId);
3007        my $ParamFTypeId = get_FoundationTypeId($ParamTypeId);
3008        my $ParamFTypeName = get_TypeName($ParamFTypeId);
3009        my $ParamTypeName = get_TypeName($ParamTypeId);
3010
3011        if($UserDefinedOutParam{$Interface}{$ParamPos+1}
3012        or $UserDefinedOutParam{$Interface}{$ParamName})
3013        { # user defined by <out_params> section in the descriptor
3014            register_out_param($Interface, $ParamPos, $ParamName, $ParamTypeId);
3015            next;
3016        }
3017
3018        # particular accept
3019        if($ParamPLevel>=2 and isCharType($ParamFTypeName)
3020        and not is_const_type($ParamTypeName) and $ParamName!~/argv/i and $ParamName!~/\A(s|str|string)\Z/i)
3021        { # soup_form_decode_multipart ( SoupMessage* msg, char const* file_control_name, char** filename, char** content_type, SoupBuffer** file )
3022          # direct_trim ( char** s )
3023            register_out_param($Interface, $ParamPos, $ParamName, $ParamTypeId);
3024            next;
3025        }
3026        if($ParamPLevel>=2 and not is_const_type($ParamTypeName) and $ParamName=~/handle/i and $CompleteSignature{$Interface}{"ShortName"}=~/_init\Z/i)
3027        { # gnutls_cipher_init ( gnutls_cipher_hd_t* handle, gnutls_cipher_algorithm_t cipher, gnutls_datum_t const* key, gnutls_datum_t const* iv )
3028            register_out_param($Interface, $ParamPos, $ParamName, $ParamTypeId);
3029            next;
3030        }
3031        if($ParamPLevel==1 and isNumericType($ParamFTypeName)
3032        and not is_const_type($ParamTypeName) and ($ParamName=~/((\A|_)(x|y|(lat|long|alt)itude)(\Z|_))|errnum|errcode|used|horizontal|vertical|width|height|error|length|count|time|status|state|min|max|weight|\An[_]*(row|col|axe|found|memb|key|space)|\An_/i or $ParamTypeName=~/bool/i
3033        or $ParamName=~/(\A|_)n(_|)(elem|item)/i or is_out_word($ParamName) or $ParamName=~/\Ais/i))
3034        { # gail_misc_get_origins ( GtkWidget* widget, gint* x_window, gint* y_window, gint* x_toplevel, gint* y_toplevel )
3035          # glXGetFBConfigs ( Display* dpy, int screen, int* nelements )
3036            register_out_param($Interface, $ParamPos, $ParamName, $ParamTypeId);
3037            next;
3038        }
3039        if(($ParamName=~/err/i and $ParamPLevel>=2 and $ParamTypeName=~/err/i)
3040        or ($ParamName=~/\A(error|err)(_|)(p|ptr)\Z/i and $ParamPLevel>=1))
3041        { # g_app_info_add_supports_type ( GAppInfo* appinfo, char const* content_type, GError** error )
3042          # rsvg_handle_new_from_data ( guint8 const* data, gsize data_len, GError** error )
3043            register_out_param($Interface, $ParamPos, $ParamName, $ParamTypeId);
3044            next;
3045        }
3046
3047        # strong reject
3048        next if(get_TypeType(get_FoundationTypeId($ReturnType_Id))!~/\A(Intrinsic|Enum)\Z/
3049        or $CompleteSignature{$Interface}{"ShortName"}=~/\Q$ReturnType_Name_Short\E/
3050        or $CompleteSignature{$Interface}{"ShortName"}=~/$ParamName(_|)get(_|)\w+/i
3051        or $ReturnType_Name_Short=~/pointer|ptr/i);
3052        next if($ParamPLevel<=0);
3053        next if($ParamPLevel==1 and (isOpaque($ParamFTypeId)
3054        or get_TypeName($ParamFTypeId)=~/\A(((struct |)(_IO_FILE|__FILE|FILE))|void)\Z/));
3055        next if(is_const_type($ParamTypeName) and $ParamPLevel<=2);
3056        next if($CompleteSignature{$Interface}{"ShortName"}=~/memcpy|already/i);
3057
3058        # allowed
3059        if((is_out_word($ParamName) and $CompleteSignature{$Interface}{"ShortName"}!~/free/i
3060        #! xmlC14NDocSaveTo (xmlDocPtr doc, xmlNodeSetPtr nodes, int exclusive, xmlChar** inclusive_ns_prefixes, int with_comments, xmlOutputBufferPtr buf)
3061        # XGetMotionEvents (Display* display, Window w, Time start, Time stop, int* nevents_return)
3062
3063        and ($ParamTypeName=~/\*/ or $ParamTypeName!~/(ptr|pointer|p\Z)/i)
3064
3065        # gsl_sf_bessel_il_scaled_array (int const lmax, double const x, double* result_array)
3066        and not grep(/\A(array)\Z/i, @{get_tokens($ParamName)})
3067
3068        #! mysql_free_result ( MYSQL_RES* result )
3069        and not is_out_word($ParamTypeName))
3070
3071        # snd_card_get_name (int card, char** name)
3072        # FMOD_Channel_GetMode (FMOD_CHANNEL* channel, FMOD_MODE* mode)
3073        or $CompleteSignature{$Interface}{"ShortName"}=~/(get|create)[_]*[0-9a-z]*$ParamName\Z/i
3074
3075        # snd_config_get_ascii (snd_config_t const* config, char** value)
3076        or ($ParamPos==1 and $ParamName=~/value/i and $CompleteSignature{$Interface}{"ShortName"}=~/$ParamName_Prev[_]*get/i)
3077
3078        # poptDupArgv (int argc, char const** argv, int* argcPtr, char const*** argvPtr)
3079        or ($ParamName=~/ptr|pointer|(p\Z)/i and $ParamPLevel>=3))
3080        {
3081            my $IsTransit = 0;
3082            foreach my $Pos (keys(%{$CompleteSignature{$Interface}{"Param"}}))
3083            {
3084                my $OtherParamTypeId = $CompleteSignature{$Interface}{"Param"}{$Pos}{"type"};
3085                my $OtherParamName = $CompleteSignature{$Interface}{"Param"}{$Pos}{"name"};
3086                next if($OtherParamName eq $ParamName);
3087                my $OtherParamFTypeId = get_FoundationTypeId($OtherParamTypeId);
3088                if($ParamFTypeId eq $OtherParamFTypeId)
3089                {
3090                    $IsTransit = 1;
3091                    last;
3092                }
3093            }
3094            if($IsTransit or get_TypeType($ParamFTypeId)=~/\A(Intrinsic|Enum|Array)\Z/)
3095            {
3096                $OutParamInterface_Pos_NoUsing{$Interface}{$ParamPos}=1;
3097                $Interface_OutParam_NoUsing{$Interface}{$ParamName}=1;
3098            }
3099            else {
3100                register_out_param($Interface, $ParamPos, $ParamName, $ParamTypeId);
3101            }
3102        }
3103        ($ParamName_Prev, $ParamTypeId_Prev) = ($ParamName, $ParamTypeId);
3104    }
3105}
3106
3107sub setOutParams_Complex($)
3108{ # detect out-parameters by function name and parameter type
3109    my $Interface = $_[0];
3110    my $Func_ShortName = $CompleteSignature{$Interface}{"ShortName"};
3111    my $ReturnType_Id = $CompleteSignature{$Interface}{"Return"};
3112    my $ReturnType_Name_Short = get_TypeName($ReturnType_Id);
3113    while($ReturnType_Name_Short=~s/(\*|\&)([^<>()]+|)\Z/$2/g){};
3114    return if(get_TypeType(get_FoundationTypeId($ReturnType_Id))!~/\A(Intrinsic|Enum)\Z/
3115    or $Func_ShortName=~/\Q$ReturnType_Name_Short\E/);
3116    if(get_TypeName($ReturnType_Id) eq "void*" and $Func_ShortName=~/data/i)
3117    { # void* repo_sidedata_create ( Repo* repo, size_t size )
3118        return;
3119    }
3120    return if($Func_ShortName!~/(new|create|open|top|update|start)/i and not is_alloc_func($Func_ShortName)
3121    and ($Func_ShortName!~/init/i or get_TypeName($ReturnType_Id) ne "void") and not $UserDefinedOutParam{$Interface});
3122    return if($Func_ShortName=~/obsolete|createdup|updates/i);
3123    return if(not keys(%{$CompleteSignature{$Interface}{"Param"}}));
3124    return if($Func_ShortName=~/(already)/i);
3125    if(not detect_out_parameters($Interface, 1)) {
3126        detect_out_parameters($Interface, 0);
3127    }
3128}
3129
3130sub detect_out_parameters($$)
3131{
3132    my ($Interface, $Strong) = @_;
3133    foreach my $ParamPos (sort{int($a)<=>int($b)} keys(%{$CompleteSignature{$Interface}{"Param"}}))
3134    {
3135        my $ParamTypeId = $CompleteSignature{$Interface}{"Param"}{$ParamPos}{"type"};
3136        my $ParamName = $CompleteSignature{$Interface}{"Param"}{$ParamPos}{"name"};
3137        if(isOutParam($ParamTypeId, $ParamPos, $Interface, $Strong))
3138        {
3139            register_out_param($Interface, $ParamPos, $ParamName, $ParamTypeId);
3140            return 1;
3141        }
3142    }
3143    return 0;
3144}
3145
3146sub get_outparam_candidate($$)
3147{
3148    my ($Interface, $Right) = @_;
3149    my $Func_ShortName = $CompleteSignature{$Interface}{"ShortName"};
3150    if($Right)
3151    {
3152        if($Func_ShortName=~/([a-z0-9]+)(_|)(new|open|init)\Z/i) {
3153            return $1;
3154        }
3155    }
3156    else
3157    {
3158        if($Func_ShortName=~/(new|open|init)(_|)([a-z0-9]+)/i) {
3159            return $3;
3160        }
3161    }
3162}
3163
3164sub isOutParam($$$$)
3165{
3166    my ($Param_TypeId, $ParamPos, $Interface, $Strong) = @_;
3167    my $Param_Name = $CompleteSignature{$Interface}{"Param"}{$ParamPos}{"name"};
3168    my $PLevel = get_PointerLevel($Param_TypeId);
3169    my $TypeName = get_TypeName($Param_TypeId);
3170    my $Param_FTypeId = get_FoundationTypeId($Param_TypeId);
3171    my $Param_FTypeName = get_TypeName($Param_FTypeId);
3172    $Param_FTypeName=~s/\A(struct|union) //g;
3173    my $Param_FTypeType = get_TypeType($Param_FTypeId);
3174    return 0 if($PLevel<=0);
3175    return 0 if($PLevel==1 and isOpaque($Param_FTypeId));
3176    return 0 if($Param_FTypeType!~/\A(Struct|Union|Class)\Z/);
3177    return 0 if(keys(%{$BaseType_PLevel_Return{$Param_FTypeId}{$PLevel}}));
3178    return 0 if(keys(%{$ReturnTypeId_Interface{$Param_TypeId}}));
3179    return 0 if(is_const_type($TypeName));
3180    my $Func_ShortName = $CompleteSignature{$Interface}{"ShortName"};
3181    return 1 if($Func_ShortName=~/\A\Q$Param_FTypeName\E(_|)init/);
3182    if($Strong)
3183    {
3184        if(my $Candidate = get_outparam_candidate($Interface, 1)) {
3185            return ($Param_Name=~/\Q$Candidate\E/i);
3186        }
3187    }
3188    if(my $Candidate = get_outparam_candidate($Interface, 0)) {
3189        return 0 if($Param_Name!~/\Q$Candidate\E/i);
3190    }
3191    return 1 if(($Func_ShortName=~/(new|create|open|start)/i and $Func_ShortName!~/get|restart|set|test/)
3192    or is_alloc_func($Func_ShortName));
3193    return 1 if($Func_ShortName=~/top/i and $PLevel==2);
3194    # snd_config_top
3195    return 1 if($UserDefinedOutParam{$Interface}{$Param_Name}
3196    or $UserDefinedOutParam{$Interface}{$ParamPos+1});
3197    return 1 if($Func_ShortName=~/update/i and $Func_ShortName!~/add|append/i
3198    and $Func_ShortName=~/$Param_Name/i and $PLevel>=1);
3199    if($Func_ShortName=~/init/i)
3200    {
3201        if(keys(%{$CompleteSignature{$Interface}{"Param"}})==1
3202        or number_of_simple_params($Interface)==keys(%{$CompleteSignature{$Interface}{"Param"}})-1) {
3203            return 1;
3204        }
3205    }
3206
3207    return 0;
3208}
3209
3210sub number_of_simple_params($)
3211{
3212    my $Interface = $_[0];
3213    return 0 if(not $Interface);
3214    my $Count = 0;
3215    foreach my $Pos (keys(%{$CompleteSignature{$Interface}{"Param"}}))
3216    {
3217        my $TypeId = $CompleteSignature{$Interface}{"Param"}{$Pos}{"type"};
3218        my $PName = $CompleteSignature{$Interface}{"Param"}{$Pos}{"name"};
3219        if(get_TypeType($TypeId)=~/\A(Intrinsic|Enum)\Z/
3220        or isString($TypeId, $PName, $Interface)) {
3221            $Count+=1;
3222        }
3223    }
3224    return $Count;
3225}
3226
3227sub get_OutParamFamily($$)
3228{
3229    my ($TypeId, $IncludeOuter) = @_;
3230    my $FTypeId = get_FoundationTypeId($TypeId);
3231    if(get_TypeType($FTypeId)=~/Struct|Union|Class/)
3232    {
3233        my @Types = ($IncludeOuter and ($TypeId ne $FTypeId))?($TypeId, $FTypeId):($FTypeId);
3234        while(my $ReducedTypeId = reduce_pointer_level($TypeId))
3235        {
3236            push(@Types, $ReducedTypeId);
3237            $TypeId = $ReducedTypeId;
3238        }
3239        return @Types;
3240    }
3241    else
3242    {
3243        my @Types = ($IncludeOuter)?($TypeId):();
3244        my $ReducedTypeId = reduce_pointer_level($TypeId);
3245        if(get_TypeType($ReducedTypeId) eq "Typedef") {
3246            push(@Types, $ReducedTypeId);
3247        }
3248        return @Types;
3249    }
3250    return ();
3251}
3252
3253sub is_alloc_func($)
3254{
3255    my $FuncName = $_[0];
3256    return ($FuncName=~/alloc/i and $FuncName!~/dealloc|realloc/i);
3257}
3258
3259sub markAbstractClasses()
3260{
3261    foreach my $Interface (keys(%CompleteSignature))
3262    {
3263        if($CompleteSignature{$Interface}{"PureVirt"}) {
3264            markAbstractSubClasses($CompleteSignature{$Interface}{"Class"}, $Interface);
3265        }
3266    }
3267}
3268
3269sub markAbstractSubClasses($$)
3270{
3271    my ($ClassId, $Interface) = @_;
3272    return if(not $ClassId or not $Interface);
3273    my $TargetSuffix = get_symbol_suffix($Interface);
3274    my $TargetShortName = $CompleteSignature{$Interface}{"ShortName"};
3275    foreach my $InterfaceCandidate (keys(%{$Class_Method{$ClassId}}))
3276    {
3277        if($TargetSuffix eq get_symbol_suffix($InterfaceCandidate))
3278        {
3279            if($CompleteSignature{$Interface}{"Constructor"})
3280            {
3281                if($CompleteSignature{$InterfaceCandidate}{"Constructor"}) {
3282                    return;
3283                }
3284            }
3285            elsif($CompleteSignature{$Interface}{"Destructor"})
3286            {
3287                if($CompleteSignature{$InterfaceCandidate}{"Destructor"}) {
3288                    return;
3289                }
3290            }
3291            else
3292            {
3293                if($TargetShortName eq $CompleteSignature{$InterfaceCandidate}{"ShortName"}) {
3294                    return;
3295                }
3296            }
3297        }
3298    }
3299    $Class_PureVirtFunc{get_TypeName($ClassId)}{$Interface} = 1;
3300    foreach my $SubClass_Id (keys(%{$Class_SubClasses{$ClassId}})) {
3301        markAbstractSubClasses($SubClass_Id, $Interface);
3302    }
3303}
3304
3305sub cleanName($)
3306{
3307    my $Name = $_[0];
3308    return "" if(not $Name);
3309    foreach my $Token (sort keys(%Operator_Indication))
3310    {
3311        my $Token_Translate = $Operator_Indication{$Token};
3312        $Name=~s/\Q$Token_Translate\E/\_$Token\_/g;
3313    }
3314    $Name=~s/\,/_/g;
3315    $Name=~s/\./_p_/g;
3316    $Name=~s/\:/_/g;
3317    $Name=~s/\]/_rb_/g;
3318    $Name=~s/\[/_lb_/g;
3319    $Name=~s/\(/_/g;
3320    $Name=~s/\)/_/g;
3321    $Name=~s/ /_/g;
3322    while($Name=~/__/) {
3323        $Name=~s/__/_/g;
3324    }
3325    $Name=~s/\_\Z//;
3326    return $Name;
3327}
3328
3329sub getTestName($)
3330{
3331    my $Interface = $_[0];
3332    $Interface=~s/\?//g;
3333    return $Interface;
3334}
3335
3336sub getTestPath($)
3337{
3338    my $Interface = $_[0];
3339    my $TestPath = "";
3340    if($Interface_LibGroup{$Interface}) {
3341        $TestPath = $TEST_SUITE_PATH."/groups/".cleanGroup($Interface_LibGroup{$Interface})."/".getTestName($Interface);
3342    }
3343    else
3344    {
3345        my $ClassName = get_TypeName($CompleteSignature{$Interface}{"Class"});
3346        if($OSgroup eq "windows") {
3347            $ClassName = cleanName($ClassName);
3348        }
3349        my $Header = $CompleteSignature{$Interface}{"Header"};
3350        $Header=~s/(\.\w+)\Z//g;
3351        $TestPath = $TEST_SUITE_PATH."/groups/".get_filename($Header)."/".(($ClassName)?"classes/".get_type_short_name($ClassName):"functions")."/".getTestName($Interface);
3352    }
3353    return $TestPath;
3354}
3355
3356sub getLibGroupPath($$$)
3357{
3358    my ($C1, $C2, $TwoComponets) = @_;
3359    return () if(not $C1);
3360    $C1 = cleanGroup($C1);
3361    if($TwoComponets)
3362    {
3363        if($C2) {
3364            return ($TEST_SUITE_PATH."/$TargetLibraryName-t2c/", $C1, $C2);
3365        }
3366        else {
3367            return ($TEST_SUITE_PATH."/$TargetLibraryName-t2c/", $C1, "functions");
3368        }
3369    }
3370    else {
3371        return ($TEST_SUITE_PATH."/$TargetLibraryName-t2c/", "", $C1);
3372    }
3373}
3374
3375sub getLibGroupName($$)
3376{
3377    my ($C1, $C2) = @_;
3378    return "" if(not $C1);
3379    if($C2) {
3380        return $C2;
3381    }
3382    else {
3383        return $C1;
3384    }
3385}
3386
3387sub cleanGroup($)
3388{
3389    my $Name = $_[0];
3390    $Name=~s/(\.\w+)\Z//g;
3391    $Name=~s/( |-)/_/g;
3392    $Name=~s/\([^()]+\)//g;
3393    $Name=~s/[_]{2,}/_/g;
3394    return $Name;
3395}
3396
3397sub find_center($$)
3398{
3399    my ($Sign, $Target) = @_;
3400    my %B = ( "("=>0, "<"=>0, ")"=>0, ">"=>0 );
3401    my $Center = 0;
3402    if($Sign=~s/(operator([^\w\s\(\)]+|\(\)))//g)
3403    { # operators
3404        $Center+=length($1);
3405    }
3406    foreach my $Pos (0 .. length($Sign)-1)
3407    {
3408        my $S = substr($Sign, $Pos, 1);
3409        if($S eq $Target)
3410        {
3411            if($B{"("}==$B{")"}
3412            and $B{"<"}==$B{">"}) {
3413                return $Center;
3414            }
3415        }
3416        if(defined $B{$S}) {
3417            $B{$S}+=1;
3418        }
3419        $Center+=1;
3420    }
3421    return 0;
3422}
3423
3424sub skipSymbol($)
3425{
3426    my $Symbol = $_[0];
3427    return 1 if($SkipInterfaces{$Symbol});
3428    foreach my $SkipPattern (keys(%SkipInterfaces_Pattern)) {
3429        return 1 if($Symbol=~/$SkipPattern/);
3430    }
3431    return 0;
3432}
3433
3434sub symbolFilter($)
3435{
3436    my $Symbol = $_[0];
3437
3438    return 0 if(skipSymbol($Symbol));
3439    return 0 if(index($Symbol, "_aux_")==0);
3440
3441    return 0 if(not $CompleteSignature{$Symbol}{"Header"});
3442    return 0 if($CompleteSignature{$Symbol}{"Private"});
3443    return 0 if($CompleteSignature{$Symbol}{"Data"});
3444
3445    my $ClassId = $CompleteSignature{$Symbol}{"Class"};
3446
3447    if(not $TargetInterfaceName
3448    and not keys(%InterfacesList))
3449    {
3450        return 0 if($Symbol=~/\A(_ZS|_ZNS|_ZNKS)/); # stdc++ symbols
3451        if(not defined $KeepInternal)
3452        { # --keep-internal
3453            if(index($Symbol, "__")==0)
3454            { # __argz_count
3455                return 0;
3456            }
3457            if(index($CompleteSignature{$Symbol}{"ShortName"}, "__")==0)
3458            {
3459                return 0;
3460            }
3461            if($ClassId)
3462            {
3463                if(my $NameSpace = $TypeInfo{$ClassId}{"NameSpace"})
3464                {
3465                    if(my $NSId = $TName_Tid{$NameSpace})
3466                    {
3467                        if($TypeInfo{$NSId}{"Type"}=~/Struct|Class/)
3468                        { # internal classes
3469                            return 0;
3470                        }
3471                    }
3472
3473                }
3474            }
3475        }
3476        return 0 if($CompleteSignature{$Symbol}{"Weak"});
3477    }
3478    if(index($Symbol, "_ZN9__gnu_cxx")==0) {
3479        return 0;
3480    }
3481    if($CompleteSignature{$Symbol}{"Constructor"}) {
3482        return ( not ($Symbol=~/C1E/ and ($CompleteSignature{$Symbol}{"Protected"} or isAbstractClass($ClassId))) );
3483    }
3484    elsif($CompleteSignature{$Symbol}{"Destructor"}) {
3485        return ( not ($Symbol=~/D0E|D1E/ and ($CompleteSignature{$Symbol}{"Protected"} or isAbstractClass($ClassId))) );
3486    }
3487    return 1;
3488}
3489
3490sub addHeaders($$)
3491{
3492    my ($NewHeaders, $OldHeaders) = @_;
3493    my (%Old, @Before, @After) = ();
3494    if($OldHeaders)
3495    {
3496        foreach (@{$OldHeaders})
3497        {
3498            if($_)
3499            {
3500                $Old{$_} = 1;
3501                push(@After, $_);
3502            }
3503        }
3504    }
3505    if($NewHeaders)
3506    {
3507        foreach (@{$NewHeaders})
3508        {
3509            if($_)
3510            {
3511                if(not defined $Old{$_}) {
3512                    push(@Before, $_);
3513                }
3514            }
3515        }
3516    }
3517    my @Result = (@Before, @After);
3518    return \@Result;
3519}
3520
3521sub getTypeHeaders($)
3522{
3523    my $TypeId = $_[0];
3524    return [] if(not $TypeId);
3525    my %Type = delete_quals($TypeId);
3526    my $Headers = [$TypeInfo{$Type{"Tid"}}{"Header"}];
3527    if(defined $Type{"TParam"})
3528    { # template parameters
3529        foreach my $Pos (sort {int($a)<=>int($b)} keys(%{$Type{"TParam"}}))
3530        {
3531            if(my $Tid = $TName_Tid{$Type{"TParam"}{$Pos}}) {
3532                $Headers = addHeaders(getTypeHeaders($Tid), $Headers);
3533            }
3534        }
3535    }
3536    if(my $NS = $Type{"NameSpaceClassId"}) {
3537        $Headers = addHeaders(getTypeHeaders($NS), $Headers);
3538    }
3539    return $Headers;
3540}
3541
3542sub get_TypeName($)
3543{
3544    my $TypeId = $_[0];
3545    return $TypeInfo{$TypeId}{"Name"};
3546}
3547
3548sub get_TypeType($)
3549{
3550    my $TypeId = $_[0];
3551    return $TypeInfo{$TypeId}{"Type"};
3552}
3553
3554sub get_TypeAttr($$)
3555{
3556    my ($TypeId, $Attr) = @_;
3557    return $TypeInfo{$TypeId}{$Attr};
3558}
3559
3560sub isNotInCharge($)
3561{
3562    my $Interface = $_[0];
3563    return ($CompleteSignature{$Interface}{"Constructor"}
3564    and $Interface=~/C2E/);
3565}
3566
3567sub isInCharge($)
3568{
3569    my $Interface = $_[0];
3570    return ($CompleteSignature{$Interface}{"Constructor"}
3571    and $Interface=~/C1E/);
3572}
3573
3574sub replace_c2c1($)
3575{
3576    my $Interface = $_[0];
3577    if($CompleteSignature{$Interface}{"Constructor"}) {
3578        $Interface=~s/C2E/C1E/;
3579    }
3580    return $Interface;
3581}
3582
3583sub getSubClassName($)
3584{
3585    my $ClassName = $_[0];
3586    return getSubClassBaseName($ClassName)."_SubClass";
3587}
3588
3589sub getSubClassBaseName($)
3590{
3591    my $ClassName = $_[0];
3592    $ClassName=~s/\:\:|<|>|\(|\)|\[|\]|\ |,|\*/_/g;
3593    $ClassName=~s/[_][_]+/_/g;
3594    return $ClassName;
3595}
3596
3597sub getNumOfParams($)
3598{
3599    my $Interface = $_[0];
3600    my @Params = keys(%{$CompleteSignature{$Interface}{"Param"}});
3601    return ($#Params + 1);
3602}
3603
3604sub sort_byCriteria($$)
3605{
3606    my ($Interfaces, $Criteria) = @_;
3607    my (@NewInterfaces1, @NewInterfaces2) = ();
3608    foreach my $Interface (@{$Interfaces})
3609    {
3610        if(compare_byCriteria($Interface, $Criteria)) {
3611            push(@NewInterfaces1, $Interface);
3612        }
3613        else {
3614            push(@NewInterfaces2, $Interface);
3615        }
3616    }
3617    @{$Interfaces} = (@NewInterfaces1, @NewInterfaces2);
3618}
3619
3620sub get_int_prefix($)
3621{
3622    if($_[0]=~/\A([a-z0-9]+)_[a-z0-9]/i) {
3623        return $1;
3624    }
3625    return "";
3626}
3627
3628sub sort_byLibrary($$)
3629{
3630    my ($Interfaces, $Library) = @_;
3631    return if(not $Library);
3632    my $LibPrefix = $SoLib_IntPrefix{$Library};
3633    my (@NewInterfaces1, @NewInterfaces2, @NewInterfaces3) = ();
3634    foreach my $Interface (@{$Interfaces})
3635    {
3636        my $IntPrefix = get_int_prefix($Interface);
3637        if(get_filename($Symbol_Library{$Interface}) eq $Library
3638        or get_filename($DepSymbol_Library{$Interface}) eq $Library) {
3639            push(@NewInterfaces1, $Interface);
3640        }
3641        elsif(not $Symbol_Library{$Interface}
3642        and not $DepSymbol_Library{$Interface}) {
3643            push(@NewInterfaces1, $Interface);
3644        }
3645        elsif($Interface=~/environment/i)
3646        { # functions to set evironment should NOT be sorted
3647            push(@NewInterfaces1, $Interface);
3648        }
3649        elsif($LibPrefix and ($LibPrefix eq $IntPrefix)) {
3650            push(@NewInterfaces2, $Interface);
3651        }
3652        else {
3653            push(@NewInterfaces3, $Interface);
3654        }
3655    }
3656    @{$Interfaces} = (@NewInterfaces1, @NewInterfaces2, @NewInterfaces3);
3657}
3658
3659sub get_tokens($)
3660{
3661    my $Word = $_[0];
3662    return $Cache{"get_tokens"}{$Word} if(defined $Cache{"get_tokens"}{$Word});
3663    my @Tokens = ();
3664    if($Word=~/\s+|[_]+/)
3665    {
3666        foreach my $Elem (split(/[_:\s]+/, $Word))
3667        {
3668            foreach my $SubElem (@{get_tokens($Elem)}) {
3669                push(@Tokens, $SubElem);
3670            }
3671        }
3672    }
3673    else
3674    {
3675        my $WCopy = $Word;
3676        while($WCopy=~s/([A-Z]*[a-z]+|\d+)//) {
3677            push(@Tokens, lc($1));
3678        }
3679        $WCopy=$Word;
3680        while($WCopy=~s/([A-Z]{2,})//) {
3681            push(@Tokens, lc($1));
3682        }
3683        $WCopy=$Word;
3684        while($WCopy=~s/([A-Z][a-z]+)([A-Z]|\Z)/$2/) {
3685            push(@Tokens, lc($1));
3686        }
3687    }
3688    @Tokens = unique_array(@Tokens);
3689    $Cache{"get_tokens"}{$Word} = \@Tokens;
3690    return \@Tokens;
3691}
3692
3693sub unique_array(@)
3694{
3695    my %seen = ();
3696    my @uniq = ();
3697    foreach my $item (@_)
3698    {
3699        unless ($seen{$item})
3700        { # if we get here, we have not seen it before
3701            $seen{$item} = 1;
3702            push(@uniq, $item);
3703        }
3704    }
3705    return @uniq;
3706}
3707
3708sub sort_byName($$$)
3709{
3710    my ($Words, $KeyWords, $Type) = @_;
3711    my %Word_Coincidence = ();
3712    foreach my $Word (@{$Words})
3713    {
3714        my $TargetWord = $Word;
3715        if($Word=~/\A(_Z|\?)/) {
3716            $TargetWord = $CompleteSignature{$Word}{"ShortName"}." ".get_TypeName($CompleteSignature{$Word}{"Class"});
3717        }
3718        $Word_Coincidence{$Word} = get_word_coinsidence($TargetWord, $KeyWords);
3719    }
3720    @{$Words} = sort {$Word_Coincidence{$b} <=> $Word_Coincidence{$a}} @{$Words};
3721    if($Type eq "Constants")
3722    {
3723        my @Words_With_Tokens = ();
3724        foreach my $Word (@{$Words})
3725        {
3726            if($Word_Coincidence{$Word}>0) {
3727                push(@Words_With_Tokens, $Word);
3728            }
3729        }
3730        @{$Words} = @Words_With_Tokens;
3731    }
3732}
3733
3734sub sort_FileOpen($)
3735{
3736    my @Interfaces = @{$_[0]};
3737    my (@FileOpen, @Other) = ();
3738    foreach my $Interface (sort {length($a) <=> length($b)} @Interfaces)
3739    {
3740        if($CompleteSignature{$Interface}{"ShortName"}=~/fopen/i) {
3741            push(@FileOpen, $Interface);
3742        }
3743        else {
3744            push(@Other, $Interface);
3745        }
3746    }
3747    @{$_[0]} = (@FileOpen, @Other);
3748}
3749
3750sub get_word_coinsidence($$)
3751{
3752    my ($Word, $KeyWords) = @_;
3753    my @WordTokens1 = @{get_tokens($Word)};
3754    return 0 if($#WordTokens1==-1);
3755    my %WordTokens_Inc = ();
3756    my $WordTokens_Num = 0;
3757    foreach my $Token (@WordTokens1)
3758    {
3759        next if($Token=~/\A(get|create|new|insert)\Z/);
3760        $WordTokens_Inc{$Token} = ++$WordTokens_Num;
3761    }
3762    my @WordTokens2 = @{get_tokens($KeyWords)};
3763    return 0 if($#WordTokens2==-1);
3764    my $Weight=$#WordTokens2+2;
3765    my $StartWeight = $Weight;
3766    my $WordCoincidence = 0;
3767    foreach my $Token (@WordTokens2)
3768    {
3769        next if($Token=~/\A(get|create|new|insert)\Z/);
3770        if(defined $WordTokens_Inc{$Token} or defined $WordTokens_Inc{$ShortTokens{$Token}})
3771        {
3772            if($WordTokens_Inc{$Token}==1
3773            and $Library_Prefixes{$Token}+$Library_Prefixes{$Token."_"}>=$LIBRARY_PREFIX_MAJORITY)
3774            { # first token is usually a library prefix
3775                $WordCoincidence+=$Weight;
3776            }
3777            else {
3778                $WordCoincidence+=$Weight-$WordTokens_Num/($StartWeight+$WordTokens_Num);
3779            }
3780        }
3781        $Weight-=1;
3782    }
3783    return $WordCoincidence*100/($#WordTokens2+1);
3784}
3785
3786sub compare_byCriteria($$)
3787{
3788    my ($Interface, $Criteria) = @_;
3789    if($Criteria eq "DeleteSmth") {
3790        return $CompleteSignature{$Interface}{"ShortName"}!~/delete|remove|destroy|cancel/i;
3791    }
3792    elsif($Criteria eq "InLine") {
3793        return $CompleteSignature{$Interface}{"InLine"};
3794    }
3795    elsif($Criteria eq "Function") {
3796        return $CompleteSignature{$Interface}{"Type"} eq "Function";
3797    }
3798    elsif($Criteria eq "WithParams") {
3799        return getNumOfParams($Interface);
3800    }
3801    elsif($Criteria eq "WithoutParams") {
3802        return getNumOfParams($Interface)==0;
3803    }
3804    elsif($Criteria eq "Public") {
3805        return (not $CompleteSignature{$Interface}{"Protected"});
3806    }
3807    elsif($Criteria eq "Default") {
3808        return ($Interface=~/default/i);
3809    }
3810    elsif($Criteria eq "VaList") {
3811        return ($Interface!~/valist/i);
3812    }
3813    elsif($Criteria eq "NotInCharge") {
3814        return (not isNotInCharge($Interface));
3815    }
3816    elsif($Criteria eq "Class") {
3817        return (get_TypeName($CompleteSignature{$Interface}{"Class"}) ne "QApplication");
3818    }
3819    elsif($Criteria eq "Data") {
3820        return (not $CompleteSignature{$Interface}{"Data"});
3821    }
3822    elsif($Criteria eq "FirstParam_Intrinsic")
3823    {
3824        if(defined $CompleteSignature{$Interface}{"Param"}
3825        and defined $CompleteSignature{$Interface}{"Param"}{"0"})
3826        {
3827            my $FirstParamType_Id = $CompleteSignature{$Interface}{"Param"}{"0"}{"type"};
3828            return (get_TypeType(get_FoundationTypeId($FirstParamType_Id)) eq "Intrinsic");
3829        }
3830        else {
3831            return 0;
3832        }
3833    }
3834    elsif($Criteria eq "FirstParam_Enum")
3835    {
3836        if(defined $CompleteSignature{$Interface}{"Param"}
3837        and defined $CompleteSignature{$Interface}{"Param"}{"0"})
3838        {
3839            my $FirstParamType_Id = $CompleteSignature{$Interface}{"Param"}{"0"}{"type"};
3840            return (get_TypeType(get_FoundationTypeId($FirstParamType_Id)) eq "Enum");
3841        }
3842        else {
3843            return 0;
3844        }
3845    }
3846    elsif($Criteria eq "FirstParam_PKc")
3847    {
3848        if(defined $CompleteSignature{$Interface}{"Param"}
3849        and defined $CompleteSignature{$Interface}{"Param"}{"0"})
3850        {
3851            my $FirstParamType_Id = $CompleteSignature{$Interface}{"Param"}{"0"}{"type"};
3852            return (get_TypeName($FirstParamType_Id) eq "char const*");
3853        }
3854        else {
3855            return 0;
3856        }
3857    }
3858    elsif($Criteria eq "FirstParam_char")
3859    {
3860        if(defined $CompleteSignature{$Interface}{"Param"}
3861        and defined $CompleteSignature{$Interface}{"Param"}{"0"})
3862        {
3863            my $FirstParamType_Id = $CompleteSignature{$Interface}{"Param"}{"0"}{"type"};
3864            return (get_TypeName($FirstParamType_Id) eq "char");
3865        }
3866        else {
3867            return 0;
3868        }
3869    }
3870    elsif($Criteria eq "Operator") {
3871        return ($CompleteSignature{$Interface}{"ShortName"}!~/operator[^a-z]/i);
3872    }
3873    elsif($Criteria eq "Library") {
3874        return ($Symbol_Library{$Interface} or $Library_Class{$CompleteSignature{$Interface}{"Class"}});
3875    }
3876    elsif($Criteria eq "Internal") {
3877        return ($CompleteSignature{$Interface}{"ShortName"}!~/\A_/);
3878    }
3879    elsif($Criteria eq "Internal") {
3880        return ($CompleteSignature{$Interface}{"ShortName"}!~/debug/i);
3881    }
3882    elsif($Criteria eq "FileManipulating")
3883    {
3884        return 0 if($CompleteSignature{$Interface}{"ShortName"}=~/fopen|file/);
3885        foreach my $ParamPos (keys(%{$CompleteSignature{$Interface}{"Param"}}))
3886        {
3887            my $ParamTypeId = $CompleteSignature{$Interface}{"Param"}{$ParamPos}{"type"};
3888            my $ParamName = $CompleteSignature{$Interface}{"Param"}{$ParamPos}{"name"};
3889            if(isString($ParamTypeId, $ParamName, $Interface))
3890            {
3891                return 0 if(isStr_FileName($ParamPos, $ParamName, $CompleteSignature{$Interface}{"ShortName"})
3892                or isStr_Dir($ParamName, $CompleteSignature{$Interface}{"ShortName"}));
3893            }
3894            else {
3895                return 0 if(isFD($ParamTypeId, $ParamName));
3896            }
3897        }
3898        return 1;
3899    }
3900    else {
3901        return 1;
3902    }
3903}
3904
3905sub sort_byRecurParams($)
3906{
3907    my @Interfaces = @{$_[0]};
3908    my (@Other, @WithRecurParams) = ();
3909    foreach my $Interface (@Interfaces)
3910    {
3911        my $WithRecur = 0;
3912        foreach my $ParamPos (keys(%{$CompleteSignature{$Interface}{"Param"}}))
3913        {
3914            my $ParamType_Id = $CompleteSignature{$Interface}{"Param"}{$ParamPos}{"type"};
3915            if(isCyclical(\@RecurTypeId, get_TypeStackId($ParamType_Id))) {
3916                $WithRecur=1;
3917                last;
3918            }
3919        }
3920        if($WithRecur) {
3921            push(@WithRecurParams, $Interface);
3922        }
3923        else
3924        {
3925            if($CompleteSignature{$Interface}{"ShortName"}!~/copy|duplicate/i) {
3926                push(@Other, $Interface);
3927            }
3928        }
3929    }
3930    @{$_[0]} = (@Other, @WithRecurParams);
3931    return $#WithRecurParams;
3932}
3933
3934sub sort_LibMainFunc($)
3935{
3936    my @Interfaces = @{$_[0]};
3937    my (@First, @Other) = ();
3938    foreach my $Interface (@Interfaces)
3939    {
3940        my $ShortName = cut_NamePrefix($CompleteSignature{$Interface}{"ShortName"});
3941        if($ShortName=~/\A(create|default|get|new|init)\Z/i) {
3942            push(@First, $Interface);
3943        }
3944        else {
3945             push(@Other, $Interface);
3946        }
3947    }
3948    @{$_[0]} = (@First, @Other);
3949}
3950
3951sub sort_CreateParam($$)
3952{
3953    my @Interfaces = @{$_[0]};
3954    my $KeyWords = $_[1];
3955    foreach my $Prefix (keys(%Library_Prefixes))
3956    {
3957        if($Library_Prefixes{$Prefix}>=$LIBRARY_PREFIX_MAJORITY) {
3958            $KeyWords=~s/(\A| )$Prefix/$1/g;
3959        }
3960    }
3961    $KeyWords=~s/(\A|_)(new|get|create|default|alloc|init)(_|\Z)//g;
3962    my (@First, @Other) = ();
3963    foreach my $Interface (@Interfaces)
3964    {
3965        my $ShortName = $CompleteSignature{$Interface}{"ShortName"};
3966        if($ShortName=~/create|default|get|new|init/i
3967        and get_word_coinsidence($ShortName, $KeyWords)>0) {
3968            push(@First, $Interface);
3969        }
3970        else {
3971             push(@Other, $Interface);
3972        }
3973    }
3974    @{$_[0]} = (@First, @Other);
3975}
3976
3977sub grep_token($$)
3978{
3979    my ($Word, $Token) = @_;
3980    return grep(/\A($Token)\Z/i, @{get_tokens($Word)});
3981}
3982
3983sub cut_NamePrefix($)
3984{
3985    my $Name = $_[0];
3986    return "" if(not $Name);
3987    if(my $Prefix = getPrefix($Name))
3988    {
3989        if($Library_Prefixes{$Prefix}>=$LIBRARY_PREFIX_MAJORITY) {
3990            $Name=~s/\A\Q$Prefix\E//;
3991        }
3992    }
3993    return $Name;
3994}
3995
3996sub sort_GetCreate($)
3997{
3998    my @Interfaces = @{$_[0]};
3999    my (@Open, @Root, @Create, @Default, @New, @Alloc, @Init, @Get, @Other, @Copy, @Wait) = ();
4000    foreach my $Interface (@Interfaces)
4001    {
4002        my $ShortName = $CompleteSignature{$Interface}{"ShortName"};
4003        if(grep_token($ShortName, "open")) {
4004            push(@Open, $Interface);
4005        }
4006        elsif(grep_token($ShortName, "root")
4007        and grep_token($ShortName, "default")) {
4008            push(@Root, $Interface);
4009        }
4010        elsif(grep_token($ShortName, "create")) {
4011            push(@Create, $Interface);
4012        }
4013        elsif(grep_token($ShortName, "default")
4014        and not grep_token($ShortName, "get")) {
4015            push(@Default, $Interface);
4016        }
4017        elsif(grep_token($ShortName, "new")) {
4018            push(@New, $Interface);
4019        }
4020        elsif(is_alloc_func($ShortName)) {
4021            push(@Alloc, $Interface);
4022        }
4023        elsif(grep_token($ShortName, "init")) {
4024            push(@Init, $Interface);
4025        }
4026        elsif(grep_token($ShortName, "get")) {
4027            push(@Get, $Interface);
4028        }
4029        elsif(grep_token($ShortName, "copy")) {
4030            push(@Copy, $Interface);
4031        }
4032        elsif(grep_token($ShortName, "wait")) {
4033            push(@Wait, $Interface);
4034        }
4035        else {
4036            push(@Other, $Interface);
4037        }
4038    }
4039    my @PrimaryGroup = (@Open, @Root, @Create, @Default);
4040    sort_byCriteria(\@PrimaryGroup, "WithoutParams");
4041    @{$_[0]} = (@PrimaryGroup, @New, @Alloc, @Init, @Get, @Other, @Copy, @Wait);
4042}
4043
4044sub get_CompatibleInterfaces($$$)
4045{
4046    my ($TypeId, $Method, $KeyWords) = @_;
4047    return () if(not $TypeId or not $Method);
4048    my @Ints = compatible_interfaces($TypeId, $Method, $KeyWords);
4049    sort_byRecurParams(\@Ints) if(get_TypeName($TypeId)!~/time_t/);
4050    return @Ints;
4051}
4052
4053sub compatible_interfaces($$$)
4054{
4055    my ($TypeId, $Method, $KeyWords) = @_;
4056    return () if(not $TypeId or not $Method);
4057    if(defined $Cache{"compatible_interfaces"}{$TypeId}{$Method}{$KeyWords}
4058    and not defined $RandomCode and not defined $AuxType{$TypeId}) {
4059        return @{$Cache{"compatible_interfaces"}{$TypeId}{$Method}{$KeyWords}};
4060    }
4061    my @Symbols = ();
4062    if($Method eq "Construct")
4063    {
4064        foreach my $Constructor (keys(%{$Class_Constructors{$TypeId}})) {
4065            @Symbols = (@Symbols, $Constructor);
4066        }
4067    }
4068    elsif($Method eq "Return")
4069    {
4070        foreach my $Interface (keys(%{$ReturnTypeId_Interface{$TypeId}}))
4071        {
4072            next if($CompleteSignature{$Interface}{"PureVirt"});
4073            @Symbols = (@Symbols, $Interface);
4074        }
4075    }
4076    elsif($Method eq "OutParam")
4077    {
4078        foreach my $Interface (keys(%{$OutParam_Interface{$TypeId}}))
4079        {
4080            next if($CompleteSignature{$Interface}{"Protected"});
4081            next if($CompleteSignature{$Interface}{"PureVirt"});
4082            @Symbols = (@Symbols, $Interface);
4083        }
4084    }
4085    elsif($Method eq "OnlyReturn")
4086    {
4087        foreach my $Interface (keys(%{$ReturnTypeId_Interface{$TypeId}}))
4088        {
4089            next if($CompleteSignature{$Interface}{"PureVirt"});
4090            next if($CompleteSignature{$Interface}{"Data"});
4091            @Symbols = (@Symbols, $Interface);
4092        }
4093    }
4094    elsif($Method eq "OnlyData")
4095    {
4096        foreach my $Interface (keys(%{$ReturnTypeId_Interface{$TypeId}}))
4097        {
4098            next if(not $CompleteSignature{$Interface}{"Data"});
4099            @Symbols = (@Symbols, $Interface);
4100        }
4101    }
4102    else
4103    {
4104        @{$Cache{"compatible_interfaces"}{$TypeId}{$Method}{$KeyWords}} = ();
4105        return ();
4106    }
4107
4108    my @CompatibleInterfaces = ();
4109
4110    foreach my $Symbol (@Symbols)
4111    {
4112        next if(skipSymbol($Symbol));
4113        next if($CompleteSignature{$Symbol}{"Private"});
4114
4115        push(@CompatibleInterfaces, $Symbol);
4116    }
4117
4118    if($#CompatibleInterfaces==-1)
4119    {
4120        @{$Cache{"compatible_interfaces"}{$TypeId}{$Method}{$KeyWords}} = ();
4121        return ();
4122    }
4123    elsif($#CompatibleInterfaces==0)
4124    {
4125        @{$Cache{"compatible_interfaces"}{$TypeId}{$Method}{$KeyWords}} = @CompatibleInterfaces;
4126        return @CompatibleInterfaces;
4127    }
4128    # sort by name
4129    @CompatibleInterfaces = sort @CompatibleInterfaces;
4130    @CompatibleInterfaces = sort {$CompleteSignature{$a}{"ShortName"} cmp $CompleteSignature{$b}{"ShortName"}} (@CompatibleInterfaces);
4131    @CompatibleInterfaces = sort {length($CompleteSignature{$a}{"ShortName"}) <=> length($CompleteSignature{$b}{"ShortName"})} (@CompatibleInterfaces);
4132    # sort by number of parameters
4133    if(defined $MinimumCode) {
4134        @CompatibleInterfaces = sort {int(keys(%{$CompleteSignature{$a}{"Param"}}))<=>int(keys(%{$CompleteSignature{$b}{"Param"}}))} (@CompatibleInterfaces);
4135    }
4136    elsif(defined $MaximumCode) {
4137        @CompatibleInterfaces = sort {int(keys(%{$CompleteSignature{$b}{"Param"}}))<=>int(keys(%{$CompleteSignature{$a}{"Param"}}))} (@CompatibleInterfaces);
4138    }
4139    else
4140    {
4141        sort_byCriteria(\@CompatibleInterfaces, "FirstParam_Intrinsic");
4142        sort_byCriteria(\@CompatibleInterfaces, "FirstParam_char");
4143        sort_byCriteria(\@CompatibleInterfaces, "FirstParam_PKc");
4144        sort_byCriteria(\@CompatibleInterfaces, "FirstParam_Enum") if(get_TypeName($TypeId)!~/char|string/i or $Method ne "Construct");
4145        @CompatibleInterfaces = sort {int(keys(%{$CompleteSignature{$a}{"Param"}}))<=>int(keys(%{$CompleteSignature{$b}{"Param"}}))} (@CompatibleInterfaces);
4146        @CompatibleInterfaces = sort {$b=~/virtual/i <=> $a=~/virtual/i} (@CompatibleInterfaces);
4147        sort_byCriteria(\@CompatibleInterfaces, "WithoutParams");
4148        sort_byCriteria(\@CompatibleInterfaces, "WithParams") if($Method eq "Construct");
4149    }
4150    sort_byCriteria(\@CompatibleInterfaces, "Operator");
4151    sort_byCriteria(\@CompatibleInterfaces, "FileManipulating");
4152    if($Method ne "Construct")
4153    {
4154        sort_byCriteria(\@CompatibleInterfaces, "Class");
4155        sort_CreateParam(\@CompatibleInterfaces, $KeyWords);
4156        sort_GetCreate(\@CompatibleInterfaces);
4157        sort_byName(\@CompatibleInterfaces, $KeyWords, "Interfaces");
4158        sort_FileOpen(\@CompatibleInterfaces) if(get_TypeName(get_FoundationTypeId($TypeId))=~/\A(struct |)(_IO_FILE|__FILE|FILE|_iobuf)\Z/);
4159        sort_LibMainFunc(\@CompatibleInterfaces);
4160        sort_byCriteria(\@CompatibleInterfaces, "Data");
4161        sort_byCriteria(\@CompatibleInterfaces, "Function");
4162        sort_byCriteria(\@CompatibleInterfaces, "Library");
4163        sort_byCriteria(\@CompatibleInterfaces, "Internal");
4164        sort_byCriteria(\@CompatibleInterfaces, "Debug");
4165        if(get_TypeName($TypeId) ne "GType"
4166        and (my $Lib = get_TypeLib($TypeId)) ne "unknown") {
4167            sort_byLibrary(\@CompatibleInterfaces, $Lib);
4168        }
4169    }
4170    if(defined $RandomCode) {
4171        @CompatibleInterfaces = mix_array(@CompatibleInterfaces);
4172    }
4173    sort_byCriteria(\@CompatibleInterfaces, "Public");
4174    sort_byCriteria(\@CompatibleInterfaces, "NotInCharge") if($Method eq "Construct");
4175    @{$Cache{"compatible_interfaces"}{$TypeId}{$Method}{$KeyWords}} = @CompatibleInterfaces if(not defined $RandomCode);
4176    return @CompatibleInterfaces;
4177}
4178
4179sub mix_array(@)
4180{
4181    my @Array = @_;
4182    return sort {2 * rand($#Array) - $#Array} @_;
4183}
4184
4185sub getSomeConstructor($)
4186{
4187    my $ClassId = $_[0];
4188    my @Constructors = get_CompatibleInterfaces($ClassId, "Construct", "");
4189    return $Constructors[0];
4190}
4191
4192sub getTypeParString($)
4193{
4194    my $Interface = $_[0];
4195    my $NumOfParams = getNumOfParams($Interface);
4196    if($NumOfParams == 0) {
4197        return ("()", "()", "()");
4198    }
4199    else
4200    {
4201        my (@TypeParList, @ParList, @TypeList) = ();
4202        foreach my $Param_Pos (sort {int($a)<=>int($b)} keys(%{$CompleteSignature{$Interface}{"Param"}}))
4203        {
4204            next if(apply_default_value($Interface, $Param_Pos) and not $CompleteSignature{$Interface}{"PureVirt"});
4205            my $ParamName = $CompleteSignature{$Interface}{"Param"}{$Param_Pos}{"name"};
4206            $ParamName = "p".($Param_Pos + 1) if(not $ParamName);
4207            my $TypeId = $CompleteSignature{$Interface}{"Param"}{$Param_Pos}{"type"};
4208            my %Type = get_Type($TypeId);
4209            next if($Type{"Name"} eq "...");
4210            push(@ParList, $ParamName);
4211            push(@TypeList, $Type{"Name"});
4212            push(@TypeParList, create_member_decl($Type{"Name"}, $ParamName));
4213        }
4214        my $TypeParString .= "(".create_list(\@TypeParList, "    ").")";
4215        my $ParString .= "(".create_list(\@ParList, "    ").")";
4216        my $TypeString .= "(".create_list(\@TypeList, "    ").")";
4217        return ($TypeParString, $ParString, $TypeString);
4218    }
4219}
4220
4221sub getValueClass($)
4222{
4223    my $Value = $_[0];
4224    $Value=~/([^()"]+)\(.*\)[^()]*/;
4225    my $ValueClass = $1;
4226    $ValueClass=~s/[ ]+\Z//g;
4227    if(get_TypeIdByName($ValueClass)) {
4228        return $ValueClass;
4229    }
4230    return "";
4231}
4232
4233sub get_FoundationType($)
4234{
4235    my $TypeId = $_[0];
4236    return "" if(not $TypeId);
4237    if(defined $Cache{"get_FoundationType"}{$TypeId}
4238    and not defined $AuxType{$TypeId}) {
4239        return %{$Cache{"get_FoundationType"}{$TypeId}};
4240    }
4241    return "" if(not $TypeInfo{$TypeId});
4242    my %Type = %{$TypeInfo{$TypeId}};
4243    return %Type if(not $Type{"BaseType"});
4244
4245    return %Type if($Type{"Type"} eq "Array");
4246
4247    %Type = get_FoundationType($Type{"BaseType"});
4248    $Cache{"get_FoundationType"}{$TypeId} = \%Type;
4249    return %Type;
4250}
4251
4252sub get_BaseType($)
4253{
4254    my $TypeId = $_[0];
4255    return "" if(not $TypeId);
4256    if(defined $Cache{"get_BaseType"}{$TypeId}
4257    and not defined $AuxType{$TypeId}) {
4258        return %{$Cache{"get_BaseType"}{$TypeId}};
4259    }
4260    return "" if(not $TypeInfo{$TypeId});
4261    my %Type = %{$TypeInfo{$TypeId}};
4262    return %Type if(not $Type{"BaseType"});
4263    %Type = get_BaseType($Type{"BaseType"});
4264    $Cache{"get_BaseType"}{$TypeId} = \%Type;
4265    return %Type;
4266}
4267
4268sub get_FoundationTypeId($)
4269{
4270    my $TypeId = $_[0];
4271    if(defined $Cache{"get_FoundationTypeId"}{$TypeId}
4272    and not defined $AuxType{$TypeId}) {
4273        return $Cache{"get_FoundationTypeId"}{$TypeId};
4274    }
4275    my %BaseType = get_FoundationType($TypeId);
4276    return ($Cache{"get_FoundationTypeId"}{$TypeId} = $BaseType{"Tid"});
4277}
4278
4279sub create_SubClass($)
4280{
4281    my $ClassId = $_[0];
4282    return () if(not $ClassId);
4283    my ($Declaration, $Headers, $Code);
4284    foreach my $Constructor (keys(%{$UsedConstructors{$ClassId}}))
4285    {
4286        if(isNotInCharge($Constructor)
4287        and my $InChargeConstructor = replace_c2c1($Constructor))
4288        {
4289            if($CompleteSignature{$InChargeConstructor})
4290            {
4291                $UsedConstructors{$ClassId}{$Constructor} = 0;
4292                $UsedConstructors{$ClassId}{$InChargeConstructor} = 1;
4293            }
4294        }
4295    }
4296    $Headers = addHeaders(getTypeHeaders($ClassId), $Headers);
4297    my $ClassName = ($Class_SubClassTypedef{$ClassId})?get_TypeName($Class_SubClassTypedef{$ClassId}):get_TypeName($ClassId);
4298    my $ClassNameChild = getSubClassName($ClassName);
4299    $Declaration .= "class $ClassNameChild".": public $ClassName\n{\n";
4300    $Declaration .= "public:\n";
4301    if(not keys(%{$UsedConstructors{$ClassId}}))
4302    {
4303        if(my $SomeConstructor = getSomeConstructor($ClassId)) {
4304            $UsedConstructors{$ClassId}{$SomeConstructor} = 1;
4305        }
4306    }
4307    if(defined $UsedConstructors{$ClassId}
4308    and keys(%{$UsedConstructors{$ClassId}}))
4309    {
4310        foreach my $Constructor (sort keys(%{$UsedConstructors{$ClassId}}))
4311        {
4312            next if(not $Constructor);
4313            my $PreviousBlock = $CurrentBlock;
4314            $CurrentBlock = $Constructor;
4315            if($UsedConstructors{$ClassId}{$Constructor})
4316            {
4317                my ($TypeParString, $ParString, $TypeString) = getTypeParString($Constructor);
4318                $TypeParString = alignCode($TypeParString, "    ", 1);
4319                $ParString = alignCode($ParString, "        ", 1);
4320                $Declaration .= "    $ClassNameChild"."$TypeParString\:$ClassName"."$ParString\{\}\n\n";
4321                foreach my $Param_Pos (sort {int($b)<=>int($a)} keys(%{$CompleteSignature{$Constructor}{"Param"}}))
4322                {
4323                    my $Param_TypeId = $CompleteSignature{$Constructor}{"Param"}{$Param_Pos}{"type"};
4324                    my $Param_Name = $CompleteSignature{$Constructor}{"Param"}{$Param_Pos}{"name"};
4325                    $Param_Name = "p".($Param_Pos + 1) if(not $Param_Name);
4326                    $ValueCollection{$CurrentBlock}{$Param_Name} = $Param_TypeId;
4327                    $Block_Param{$CurrentBlock}{$Param_Name} = $Param_TypeId;
4328                    $Block_Variable{$CurrentBlock}{$Param_Name} = 1;
4329                }
4330            }
4331            $CurrentBlock = $PreviousBlock;
4332        }
4333    }
4334    else {
4335        $Declaration .= "    ".$ClassNameChild."();\n";
4336    }
4337    if(defined $Class_PureVirtFunc{$ClassName})
4338    {
4339        my %RedefinedTwice = ();
4340        my @PureVirtuals = keys(%{$Class_PureVirtFunc{$ClassName}});
4341        @PureVirtuals = sort {lc($CompleteSignature{$a}{"ShortName"}) cmp lc($CompleteSignature{$b}{"ShortName"})} @PureVirtuals;
4342        @PureVirtuals = sort {defined $Class_PureMethod{$ClassId}{$b} cmp defined $Class_PureMethod{$ClassId}{$a}} @PureVirtuals;
4343        foreach my $PureVirtualMethod (@PureVirtuals)
4344        {
4345            my $PreviousBlock = $CurrentBlock;
4346            $CurrentBlock = $PureVirtualMethod;
4347            delete($ValueCollection{$CurrentBlock});
4348            delete($Block_Variable{$CurrentBlock});
4349            my $ReturnTypeId = $CompleteSignature{$PureVirtualMethod}{"Return"};
4350            my $ReturnTypeName = get_TypeName($ReturnTypeId);
4351            my ($TypeParString, $ParString, $TypeString) = getTypeParString($PureVirtualMethod);
4352            $TypeParString = alignCode($TypeParString, "    ", 1);
4353            my ($PureVirtualMethodName, $ShortName) = ("", "");
4354            if($CompleteSignature{$PureVirtualMethod}{"Constructor"})
4355            {
4356                $ShortName = $ClassNameChild;
4357                $PureVirtualMethodName = "    ".$ShortName.$TypeParString;
4358            }
4359            if($CompleteSignature{$PureVirtualMethod}{"Destructor"})
4360            {
4361                $ShortName = "~".$ClassNameChild;
4362                $PureVirtualMethodName = "   ".$ShortName.$TypeParString;
4363            }
4364            else
4365            {
4366                $ShortName = $CompleteSignature{$PureVirtualMethod}{"ShortName"};
4367                $PureVirtualMethodName = "    ".$ReturnTypeName." ".$ShortName.$TypeParString;
4368            }
4369            if($CompleteSignature{$PureVirtualMethod}{"Throw"}) {
4370                $PureVirtualMethodName .= " throw()";
4371            }
4372            my $Const = ($PureVirtualMethod=~/\A_ZNK/)?" const":"";
4373            if($RedefinedTwice{$ShortName.$TypeString.$Const})
4374            { # skip pure methods from the base with the same signature
4375                next;
4376            }
4377            $RedefinedTwice{$ShortName.$TypeString.$Const} = 1;
4378            $Declaration .= "\n" if($PureVirtualMethodName=~/\n/);
4379            foreach my $Param_Pos (sort {int($b)<=>int($a)} keys(%{$CompleteSignature{$PureVirtualMethod}{"Param"}}))
4380            {
4381                my $Param_TypeId = $CompleteSignature{$PureVirtualMethod}{"Param"}{$Param_Pos}{"type"};
4382                my $Param_Name = $CompleteSignature{$PureVirtualMethod}{"Param"}{$Param_Pos}{"name"};
4383                $Param_Name = "p".($Param_Pos + 1) if(not $Param_Name);
4384                $ValueCollection{$CurrentBlock}{$Param_Name} = $Param_TypeId;
4385                $Block_Param{$CurrentBlock}{$Param_Name} = $Param_TypeId;
4386                $Block_Variable{$CurrentBlock}{$Param_Name} = 1;
4387            }
4388            if(get_TypeName($ReturnTypeId) eq "void"
4389            or $CompleteSignature{$PureVirtualMethod}{"Constructor"}
4390            or $CompleteSignature{$PureVirtualMethod}{"Destructor"}) {
4391                $Declaration .= $PureVirtualMethodName.$Const."\{\}\n\n";
4392            }
4393            elsif(get_TypeName($ReturnTypeId) eq get_TypeName($ClassId)."*")
4394            { # clone, copy, etc.
4395                $Declaration .= $PureVirtualMethodName.$Const."\{\n       return (".get_TypeName($ReturnTypeId).")this;\n    \}\n\n";
4396            }
4397            else
4398            {
4399                $Declaration .= $PureVirtualMethodName.$Const." {\n";
4400                my $ReturnTypeHeaders = getTypeHeaders($ReturnTypeId);
4401                push(@RecurInterface, $PureVirtualMethod);
4402                my %Param_Init = initializeParameter((
4403                    "ParamName" => "retval",
4404                    "AccessToParam" => {"obj"=>"no object"},
4405                    "TypeId" => $ReturnTypeId,
4406                    "Key" => "_ret",
4407                    "InLine" => 1,
4408                    "Value" => "no value",
4409                    "CreateChild" => 0,
4410                    "SpecType" => 0,
4411                    "Usage" => "Common",
4412                    "RetVal" => 1));
4413                pop(@RecurInterface);
4414                $Code .= $Param_Init{"Code"};
4415                $Headers = addHeaders($Param_Init{"Headers"}, $Headers);
4416                $Headers = addHeaders($ReturnTypeHeaders, $Headers);
4417                $Param_Init{"Init"} = alignCode($Param_Init{"Init"}, "       ", 0);
4418                $Param_Init{"Call"} = alignCode($Param_Init{"Call"}, "       ", 1);
4419                $Declaration .= $Param_Init{"Init"}."       return ".$Param_Init{"Call"}.";\n    }\n\n";
4420            }
4421            $CurrentBlock = $PreviousBlock;
4422        }
4423    }
4424    if(defined $UsedProtectedMethods{$ClassId})
4425    {
4426        foreach my $ProtectedMethod (sort {lc($CompleteSignature{$a}{"ShortName"}) cmp lc($CompleteSignature{$b}{"ShortName"})} keys(%{$UsedProtectedMethods{$ClassId}}))
4427        {
4428            my $ReturnType_Id = $CompleteSignature{$ProtectedMethod}{"Return"};
4429            my $ReturnType_Name = get_TypeName($ReturnType_Id);
4430            my $ReturnType_PointerLevel = get_PointerLevel($ReturnType_Id);
4431            my $ReturnFType_Id = get_FoundationTypeId($ReturnType_Id);
4432            my $ReturnFType_Name = get_TypeName($ReturnFType_Id);
4433            my $Break = ((length($ReturnType_Name)>20)?"\n":" ");
4434            my $ShortName = $CompleteSignature{$ProtectedMethod}{"ShortName"};
4435            my $ShortNameAdv = $ShortName."_Wrapper";
4436            $ShortNameAdv = cleanName($ShortNameAdv);
4437            $Declaration .= "    ".$ReturnType_Name." ".$ShortNameAdv."() {\n";
4438            if($Wrappers{$ProtectedMethod}{"Init"}) {
4439                $Declaration .= alignCode($Wrappers{$ProtectedMethod}{"Init"}, "       ", 0);
4440            }
4441            $Declaration .= alignCode($Wrappers{$ProtectedMethod}{"PreCondition"}, "      ", 0);
4442            my $FuncCall = "this->".alignCode($ShortName.$Wrappers{$ProtectedMethod}{"Parameters_Call"}, "      ", 1);
4443            if($Wrappers{$ProtectedMethod}{"PostCondition"} or $Wrappers{$ProtectedMethod}{"FinalCode"})
4444            {
4445                my $PostCode = alignCode($Wrappers{$ProtectedMethod}{"PostCondition"}, "      ", 0).alignCode($Wrappers{$ProtectedMethod}{"FinalCode"}, "      ", 0);
4446                # FIXME: destructors
4447                if($ReturnFType_Name eq "void" and $ReturnType_PointerLevel==0) {
4448                    $Declaration .= "       $FuncCall;\n".$PostCode;
4449                }
4450                else
4451                {
4452                    my $RetVal = select_var_name("retval", "");
4453                    my ($InitializedEType_Id, $Ret_Declarations, $Ret_Headers) = get_ExtTypeId($RetVal, $ReturnType_Id);
4454                    $Code .= $Ret_Declarations;
4455                    $Headers = addHeaders($Ret_Headers, $Headers);
4456                    my $InitializedType_Name = get_TypeName($InitializedEType_Id);
4457                    if($InitializedType_Name eq $ReturnType_Name) {
4458                        $Declaration .= "      ".$InitializedType_Name.$Break.$RetVal." = $FuncCall;\n".$PostCode;
4459                    }
4460                    else {
4461                        $Declaration .= "      ".$InitializedType_Name.$Break.$RetVal." = ($InitializedType_Name)$FuncCall;\n".$PostCode;
4462                    }
4463                    $Block_Variable{$ProtectedMethod}{$RetVal} = 1;
4464                    $Declaration .= "       return $RetVal;\n";
4465                }
4466            }
4467            else
4468            {
4469                if($ReturnFType_Name eq "void" and $ReturnType_PointerLevel==0) {
4470                    $Declaration .= "       $FuncCall;\n";
4471                }
4472                else {
4473                    $Declaration .= "       return $FuncCall;\n";
4474                }
4475            }
4476            $Code .= $Wrappers{$ProtectedMethod}{"Code"};
4477            $Declaration .= "    }\n\n";
4478            foreach my $ClassId (keys(%{$Wrappers_SubClasses{$ProtectedMethod}})) {
4479                $Create_SubClass{$ClassId} = 1;
4480            }
4481        }
4482    }
4483    $Declaration .= "};//$ClassNameChild\n\n";
4484    return ($Code.$Declaration, $Headers);
4485}
4486
4487sub create_SubClasses(@)
4488{
4489    my ($Code, $Headers) = ("", []);
4490    foreach my $ClassId (sort @_)
4491    {
4492        my (%Before, %After, %New) = ();
4493        next if(not $ClassId or $SubClass_Created{$ClassId});
4494        %Create_SubClass = ();
4495        push(@RecurTypeId, $ClassId);
4496        my ($Code_SubClass, $Headers_SubClass) = create_SubClass($ClassId);
4497        $SubClass_Created{$ClassId} = 1;
4498        if(keys(%Create_SubClass))
4499        {
4500            my ($Code_Depend, $Headers_Depend) = create_SubClasses(keys(%Create_SubClass));
4501            $Code_SubClass = $Code_Depend.$Code_SubClass;
4502            $Headers_SubClass = addHeaders($Headers_Depend, $Headers_SubClass);
4503        }
4504        pop(@RecurTypeId);
4505        $Code .= $Code_SubClass;
4506        $Headers = addHeaders($Headers_SubClass, $Headers);
4507    }
4508    return ($Code, $Headers);
4509}
4510
4511sub save_state()
4512{
4513    my %Saved_State = ();
4514    foreach (keys(%IntSubClass))
4515    {
4516        @{$Saved_State{"IntSubClass"}{$_}}{keys(%{$IntSubClass{$_}})} = values %{$IntSubClass{$_}};
4517    }
4518    foreach (keys(%Wrappers))
4519    {
4520        @{$Saved_State{"Wrappers"}{$_}}{keys(%{$Wrappers{$_}})} = values %{$Wrappers{$_}};
4521    }
4522    foreach (keys(%Wrappers_SubClasses))
4523    {
4524        @{$Saved_State{"Wrappers_SubClasses"}{$_}}{keys(%{$Wrappers_SubClasses{$_}})} = values %{$Wrappers_SubClasses{$_}};
4525    }
4526    foreach (keys(%ValueCollection))
4527    {
4528        @{$Saved_State{"ValueCollection"}{$_}}{keys(%{$ValueCollection{$_}})} = values %{$ValueCollection{$_}};
4529    }
4530    foreach (keys(%Block_Variable))
4531    {
4532        @{$Saved_State{"Block_Variable"}{$_}}{keys(%{$Block_Variable{$_}})} = values %{$Block_Variable{$_}};
4533    }
4534    foreach (keys(%UseVarEveryWhere))
4535    {
4536        @{$Saved_State{"UseVarEveryWhere"}{$_}}{keys(%{$UseVarEveryWhere{$_}})} = values %{$UseVarEveryWhere{$_}};
4537    }
4538    foreach (keys(%OpenStreams))
4539    {
4540        @{$Saved_State{"OpenStreams"}{$_}}{keys(%{$OpenStreams{$_}})} = values %{$OpenStreams{$_}};
4541    }
4542    foreach (keys(%Block_Param))
4543    {
4544        @{$Saved_State{"Block_Param"}{$_}}{keys(%{$Block_Param{$_}})} = values %{$Block_Param{$_}};
4545    }
4546    foreach (keys(%UsedConstructors))
4547    {
4548        @{$Saved_State{"UsedConstructors"}{$_}}{keys(%{$UsedConstructors{$_}})} = values %{$UsedConstructors{$_}};
4549    }
4550    foreach (keys(%UsedProtectedMethods))
4551    {
4552        @{$Saved_State{"UsedProtectedMethods"}{$_}}{keys(%{$UsedProtectedMethods{$_}})} = values %{$UsedProtectedMethods{$_}};
4553    }
4554    foreach (keys(%IntSpecType))
4555    {
4556        @{$Saved_State{"IntSpecType"}{$_}}{keys(%{$IntSpecType{$_}})} = values %{$IntSpecType{$_}};
4557    }
4558    foreach (keys(%RequirementsCatalog))
4559    {
4560        @{$Saved_State{"RequirementsCatalog"}{$_}}{keys(%{$RequirementsCatalog{$_}})} = values %{$RequirementsCatalog{$_}};
4561    }
4562    @{$Saved_State{"Template2Code_Defines"}}{keys(%Template2Code_Defines)} = values %Template2Code_Defines;
4563    @{$Saved_State{"TraceFunc"}}{keys(%TraceFunc)} = values %TraceFunc;
4564    $Saved_State{"MaxTypeId"} = $MaxTypeId;
4565    @{$Saved_State{"IntrinsicNum"}}{keys(%IntrinsicNum)} = values %IntrinsicNum;
4566    @{$Saved_State{"AuxHeaders"}}{keys(%AuxHeaders)} = values %AuxHeaders;
4567    @{$Saved_State{"Class_SubClassTypedef"}}{keys(%Class_SubClassTypedef)} = values %Class_SubClassTypedef;
4568    @{$Saved_State{"SubClass_Instance"}}{keys(%SubClass_Instance)} = values %SubClass_Instance;
4569    @{$Saved_State{"SubClass_ObjInstance"}}{keys(%SubClass_ObjInstance)} = values %SubClass_ObjInstance;
4570    @{$Saved_State{"SpecEnv"}}{keys(%SpecEnv)} = values %SpecEnv;
4571    @{$Saved_State{"Block_InsNum"}}{keys(%Block_InsNum)} = values %Block_InsNum;
4572    @{$Saved_State{"AuxType"}}{keys %AuxType} = values %AuxType;
4573    @{$Saved_State{"AuxFunc"}}{keys %AuxFunc} = values %AuxFunc;
4574    @{$Saved_State{"Create_SubClass"}}{keys %Create_SubClass} = values %Create_SubClass;
4575    @{$Saved_State{"SpecCode"}}{keys %SpecCode} = values %SpecCode;
4576    @{$Saved_State{"SpecLibs"}}{keys %SpecLibs} = values %SpecLibs;
4577    @{$Saved_State{"UsedInterfaces"}}{keys %UsedInterfaces} = values %UsedInterfaces;
4578    @{$Saved_State{"ConstraintNum"}}{keys %ConstraintNum} = values %ConstraintNum;
4579    return \%Saved_State;
4580}
4581
4582sub restore_state($)
4583{
4584    restore_state_I($_[0], 0);
4585}
4586
4587sub restore_local_state($)
4588{
4589    restore_state_I($_[0], 1);
4590}
4591
4592sub restore_state_I($$)
4593{
4594    my ($Saved_State, $Local) = @_;
4595    if(not $Local)
4596    {
4597        foreach my $AuxType_Id (keys(%AuxType))
4598        {
4599            if(my $OldName = $TypeInfo{$AuxType_Id}{"Name_Old"})
4600            {
4601                $TypeInfo{$AuxType_Id}{"Name"} = $OldName;
4602            }
4603        }
4604        if(not $Saved_State)
4605        { # restore aux types
4606            foreach my $AuxType_Id (sort {int($a)<=>int($b)} keys(%AuxType))
4607            {
4608                if(not $TypeInfo{$AuxType_Id}{"Name_Old"})
4609                {
4610                    delete($TypeInfo{$AuxType_Id});
4611                }
4612                delete($TName_Tid{$AuxType{$AuxType_Id}});
4613                delete($AuxType{$AuxType_Id});
4614            }
4615            $MaxTypeId = $MaxTypeId_Start;
4616        }
4617        elsif($Saved_State->{"MaxTypeId"})
4618        {
4619            foreach my $AuxType_Id (sort {int($a)<=>int($b)} keys(%AuxType))
4620            {
4621                if($AuxType_Id<=$MaxTypeId and $AuxType_Id>$Saved_State->{"MaxTypeId"})
4622                {
4623                    if(not $TypeInfo{$AuxType_Id}{"Name_Old"})
4624                    {
4625                        delete($TypeInfo{$AuxType_Id});
4626                    }
4627                    delete($TName_Tid{$AuxType{$AuxType_Id}});
4628                    delete($AuxType{$AuxType_Id});
4629                }
4630            }
4631        }
4632    }
4633    (%Block_Variable, %UseVarEveryWhere, %OpenStreams, %SpecEnv, %Block_InsNum,
4634    %ValueCollection, %IntrinsicNum, %ConstraintNum, %SubClass_Instance,
4635    %SubClass_ObjInstance, %Block_Param,%Class_SubClassTypedef, %AuxHeaders, %Template2Code_Defines) = ();
4636    if(not $Local)
4637    {
4638        (%Wrappers, %Wrappers_SubClasses, %IntSubClass, %AuxType, %AuxFunc,
4639        %UsedConstructors, %UsedProtectedMethods, %Create_SubClass, %SpecCode,
4640        %SpecLibs, %UsedInterfaces, %IntSpecType, %RequirementsCatalog, %TraceFunc) = ();
4641    }
4642    if(not $Saved_State)
4643    { # initializing
4644        %IntrinsicNum=(
4645            "Char"=>64,
4646            "Int"=>0,
4647            "Str"=>0,
4648            "Float"=>0);
4649        return;
4650    }
4651    foreach (keys(%{$Saved_State->{"Block_Variable"}}))
4652    {
4653        @{$Block_Variable{$_}}{keys(%{$Saved_State->{"Block_Variable"}{$_}})} = values %{$Saved_State->{"Block_Variable"}{$_}};
4654    }
4655    foreach (keys(%{$Saved_State->{"UseVarEveryWhere"}}))
4656    {
4657        @{$UseVarEveryWhere{$_}}{keys(%{$Saved_State->{"UseVarEveryWhere"}{$_}})} = values %{$Saved_State->{"UseVarEveryWhere"}{$_}};
4658    }
4659    foreach (keys(%{$Saved_State->{"OpenStreams"}}))
4660    {
4661        @{$OpenStreams{$_}}{keys(%{$Saved_State->{"OpenStreams"}{$_}})} = values %{$Saved_State->{"OpenStreams"}{$_}};
4662    }
4663    @SpecEnv{keys(%{$Saved_State->{"SpecEnv"}})} = values %{$Saved_State->{"SpecEnv"}};
4664    @Block_InsNum{keys(%{$Saved_State->{"Block_InsNum"}})} = values %{$Saved_State->{"Block_InsNum"}};
4665    foreach (keys(%{$Saved_State->{"ValueCollection"}}))
4666    {
4667        @{$ValueCollection{$_}}{keys(%{$Saved_State->{"ValueCollection"}{$_}})} = values %{$Saved_State->{"ValueCollection"}{$_}};
4668    }
4669    @Template2Code_Defines{keys(%{$Saved_State->{"Template2Code_Defines"}})} = values %{$Saved_State->{"Template2Code_Defines"}};
4670    @IntrinsicNum{keys(%{$Saved_State->{"IntrinsicNum"}})} = values %{$Saved_State->{"IntrinsicNum"}};
4671    @ConstraintNum{keys(%{$Saved_State->{"ConstraintNum"}})} = values %{$Saved_State->{"ConstraintNum"}};
4672    @SubClass_Instance{keys(%{$Saved_State->{"SubClass_Instance"}})} = values %{$Saved_State->{"SubClass_Instance"}};
4673    @SubClass_ObjInstance{keys(%{$Saved_State->{"SubClass_ObjInstance"}})} = values %{$Saved_State->{"SubClass_ObjInstance"}};
4674    foreach (keys(%{$Saved_State->{"Block_Param"}}))
4675    {
4676        @{$Block_Param{$_}}{keys(%{$Saved_State->{"Block_Param"}{$_}})} = values %{$Saved_State->{"Block_Param"}{$_}};
4677    }
4678    @Class_SubClassTypedef{keys(%{$Saved_State->{"Class_SubClassTypedef"}})} = values %{$Saved_State->{"Class_SubClassTypedef"}};
4679    @AuxHeaders{keys(%{$Saved_State->{"AuxHeaders"}})} = values %{$Saved_State->{"AuxHeaders"}};
4680    if(not $Local)
4681    {
4682        foreach my $AuxType_Id (sort {int($a)<=>int($b)} keys(%{$Saved_State->{"AuxType"}}))
4683        {
4684            $TypeInfo{$AuxType_Id}{"Name"} = $Saved_State->{"AuxType"}{$AuxType_Id};
4685            $TName_Tid{$Saved_State->{"AuxType"}{$AuxType_Id}} = $AuxType_Id;
4686        }
4687        foreach (keys(%{$Saved_State->{"IntSubClass"}}))
4688        {
4689            @{$IntSubClass{$_}}{keys(%{$Saved_State->{"IntSubClass"}{$_}})} = values %{$Saved_State->{"IntSubClass"}{$_}};
4690        }
4691        foreach (keys(%{$Saved_State->{"Wrappers"}}))
4692        {
4693            @{$Wrappers{$_}}{keys(%{$Saved_State->{"Wrappers"}{$_}})} = values %{$Saved_State->{"Wrappers"}{$_}};
4694        }
4695        foreach (keys(%{$Saved_State->{"Wrappers_SubClasses"}}))
4696        {
4697            @{$Wrappers_SubClasses{$_}}{keys(%{$Saved_State->{"Wrappers_SubClasses"}{$_}})} = values %{$Saved_State->{"Wrappers_SubClasses"}{$_}};
4698        }
4699        foreach (keys(%{$Saved_State->{"UsedConstructors"}}))
4700        {
4701            @{$UsedConstructors{$_}}{keys(%{$Saved_State->{"UsedConstructors"}{$_}})} = values %{$Saved_State->{"UsedConstructors"}{$_}};
4702        }
4703        foreach (keys(%{$Saved_State->{"UsedProtectedMethods"}}))
4704        {
4705            @{$UsedProtectedMethods{$_}}{keys(%{$Saved_State->{"UsedProtectedMethods"}{$_}})} = values %{$Saved_State->{"UsedProtectedMethods"}{$_}};
4706        }
4707        foreach (keys(%{$Saved_State->{"IntSpecType"}}))
4708        {
4709            @{$IntSpecType{$_}}{keys(%{$Saved_State->{"IntSpecType"}{$_}})} = values %{$Saved_State->{"IntSpecType"}{$_}};
4710        }
4711        foreach (keys(%{$Saved_State->{"RequirementsCatalog"}}))
4712        {
4713            @{$RequirementsCatalog{$_}}{keys(%{$Saved_State->{"RequirementsCatalog"}{$_}})} = values %{$Saved_State->{"RequirementsCatalog"}{$_}};
4714        }
4715        $MaxTypeId = $Saved_State->{"MaxTypeId"};
4716        @AuxType{keys(%{$Saved_State->{"AuxType"}})} = values %{$Saved_State->{"AuxType"}};
4717        @TraceFunc{keys(%{$Saved_State->{"TraceFunc"}})} = values %{$Saved_State->{"TraceFunc"}};
4718        @AuxFunc{keys(%{$Saved_State->{"AuxFunc"}})} = values %{$Saved_State->{"AuxFunc"}};
4719        @Create_SubClass{keys(%{$Saved_State->{"Create_SubClass"}})} = values %{$Saved_State->{"Create_SubClass"}};
4720        @SpecCode{keys(%{$Saved_State->{"SpecCode"}})} = values %{$Saved_State->{"SpecCode"}};
4721        @SpecLibs{keys(%{$Saved_State->{"SpecLibs"}})} = values %{$Saved_State->{"SpecLibs"}};
4722        @UsedInterfaces{keys(%{$Saved_State->{"UsedInterfaces"}})} = values %{$Saved_State->{"UsedInterfaces"}};
4723        @IntSpecType{keys(%{$Saved_State->{"IntSpecType"}})} = values %{$Saved_State->{"IntSpecType"}};
4724    }
4725}
4726
4727sub isAbstractClass($)
4728{
4729    my $ClassId = $_[0];
4730    return (keys(%{$Class_PureVirtFunc{get_TypeName($ClassId)}}) > 0);
4731}
4732
4733sub needToInherit($)
4734{
4735    my $Interface = $_[0];
4736    return ($CompleteSignature{$Interface}{"Class"} and (isAbstractClass($CompleteSignature{$Interface}{"Class"}) or isNotInCharge($Interface) or ($CompleteSignature{$Interface}{"Protected"})));
4737}
4738
4739sub parseCode($$)
4740{
4741    my ($Code, $Mode) = @_;
4742    my $Global_State = save_state();
4743    my %ParsedCode = parseCode_m($Code, $Mode);
4744    if(not $ParsedCode{"IsCorrect"})
4745    {
4746        restore_state($Global_State);
4747        return ();
4748    }
4749    else {
4750        return %ParsedCode;
4751    }
4752}
4753
4754sub get_TypeIdByName($)
4755{
4756    my $TypeName = $_[0];
4757    if(my $ExactId = $TName_Tid{formatName($TypeName, "T")}) {
4758        return $ExactId;
4759    }
4760    else {
4761        return $TName_Tid{remove_quals(formatName($TypeName, "T"))};
4762    }
4763}
4764
4765sub callInterfaceParameters(@)
4766{
4767    my %Init_Desc = @_;
4768    my $Interface = $Init_Desc{"Interface"};
4769    return () if(not $Interface);
4770    return () if($SkipInterfaces{$Interface});
4771    foreach my $SkipPattern (keys(%SkipInterfaces_Pattern)) {
4772        return () if($Interface=~/$SkipPattern/);
4773    }
4774    if(defined $MakeIsolated and $Symbol_Library{$Interface}
4775    and keys(%InterfacesList) and not $InterfacesList{$Interface}) {
4776        return ();
4777    }
4778    my $Global_State = save_state();
4779    return () if(isCyclical(\@RecurInterface, $Interface));
4780    push(@RecurInterface, $Interface);
4781    my $PreviousBlock = $CurrentBlock;
4782    if($CompleteSignature{$Interface}{"Protected"}
4783    and not $CompleteSignature{$Interface}{"Constructor"}) {
4784        $CurrentBlock = $Interface;
4785    }
4786    $NodeInterface = $Interface;
4787    $UsedInterfaces{$NodeInterface} = 1;
4788    my %Params_Init = callInterfaceParameters_m(%Init_Desc);
4789    $CurrentBlock = $PreviousBlock;
4790    if(not $Params_Init{"IsCorrect"})
4791    {
4792        pop(@RecurInterface);
4793        restore_state($Global_State);
4794        if($Debug) {
4795            $DebugInfo{"Init_InterfaceParams"}{$Interface} = 1;
4796        }
4797        return ();
4798    }
4799    pop(@RecurInterface);
4800    if($InterfaceSpecType{$Interface}{"SpecEnv"}) {
4801        $SpecEnv{$InterfaceSpecType{$Interface}{"SpecEnv"}} = 1;
4802    }
4803    $Params_Init{"ReturnTypeId"} = $CompleteSignature{$Interface}{"Return"};
4804    return %Params_Init;
4805}
4806
4807sub detectInLineParams($)
4808{
4809    my $Interface = $_[0];
4810    my ($SpecAttributes, %Param_SpecAttributes, %InLineParam) = ();
4811    foreach my $Param_Pos (keys(%{$InterfaceSpecType{$Interface}{"SpecParam"}}))
4812    {
4813        my $SpecType_Id = $InterfaceSpecType{$Interface}{"SpecParam"}{$Param_Pos};
4814        my %SpecType = %{$SpecType{$SpecType_Id}};
4815        $Param_SpecAttributes{$Param_Pos} = $SpecType{"Value"}.$SpecType{"PreCondition"}.$SpecType{"PostCondition"}.$SpecType{"InitCode"}.$SpecType{"DeclCode"}.$SpecType{"FinalCode"};
4816        $SpecAttributes .= $Param_SpecAttributes{$Param_Pos};
4817    }
4818    foreach my $Param_Pos (sort {int($a)<=>int($b)} keys(%{$CompleteSignature{$Interface}{"Param"}}))
4819    {
4820        my $Param_Num = $Param_Pos + 1;
4821        if($SpecAttributes=~/\$$Param_Num(\W|\Z)/
4822        or $Param_SpecAttributes{$Param_Pos}=~/\$0(\W|\Z)/) {
4823            $InLineParam{$Param_Num} = 0;
4824        }
4825        else {
4826            $InLineParam{$Param_Num} = 1;
4827        }
4828    }
4829    return %InLineParam;
4830}
4831
4832sub detectParamsOrder($)
4833{
4834    my $Interface = $_[0];
4835    my ($SpecAttributes, %OrderParam) = ();
4836    foreach my $Param_Pos (keys(%{$InterfaceSpecType{$Interface}{"SpecParam"}}))
4837    { # detect all dependencies
4838        my $SpecType_Id = $InterfaceSpecType{$Interface}{"SpecParam"}{$Param_Pos};
4839        my %SpecType = %{$SpecType{$SpecType_Id}};
4840        $SpecAttributes .= $SpecType{"Value"}.$SpecType{"PreCondition"}.$SpecType{"PostCondition"}.$SpecType{"InitCode"}.$SpecType{"DeclCode"}.$SpecType{"FinalCode"};
4841    }
4842    my $Orded = 1;
4843    foreach my $Param_Pos (sort {int($a)<=>int($b)} keys(%{$CompleteSignature{$Interface}{"Param"}}))
4844    {
4845        my $Param_Num = $Param_Pos + 1;
4846        if($SpecAttributes=~/\$$Param_Num(\W|\Z)/)
4847        {
4848            $OrderParam{$Param_Num} = $Orded;
4849            $Orded += 1;
4850        }
4851    }
4852    foreach my $Param_Pos (sort {int($a)<=>int($b)} keys(%{$CompleteSignature{$Interface}{"Param"}}))
4853    {
4854        my $Param_Num = $Param_Pos + 1;
4855        if(not defined $OrderParam{$Param_Pos+1})
4856        {
4857            $OrderParam{$Param_Num} = $Orded;
4858            $Orded += 1;
4859        }
4860    }
4861    return %OrderParam;
4862}
4863
4864sub chooseSpecType($$$)
4865{
4866    my ($TypeId, $Kind, $Interface) = @_;
4867    if(my $SpecTypeId_Strong = chooseSpecType_Strong($TypeId, $Kind, $Interface, 1)) {
4868        return $SpecTypeId_Strong;
4869    }
4870    elsif(get_TypeType(get_FoundationTypeId($TypeId))!~/\A(Intrinsic)\Z/) {
4871        return chooseSpecType_Strong($TypeId, $Kind, $Interface, 0);
4872    }
4873    else {
4874        return "";
4875    }
4876}
4877
4878sub chooseSpecType_Strong($$$$)
4879{
4880    my ($TypeId, $Kind, $Interface, $Strong) = @_;
4881    return 0 if(not $TypeId or not $Kind);
4882    foreach my $SpecType_Id (sort {int($a)<=>int($b)} keys(%SpecType))
4883    {
4884        next if($Interface and $Common_SpecType_Exceptions{$Interface}{$SpecType_Id});
4885        if($SpecType{$SpecType_Id}{"Kind"} eq $Kind)
4886        {
4887            if($Strong)
4888            {
4889                if($TypeId==get_TypeIdByName($SpecType{$SpecType_Id}{"DataType"})) {
4890                    return $SpecType_Id;
4891                }
4892            }
4893            else
4894            {
4895                my $FoundationTypeId = get_FoundationTypeId($TypeId);
4896                my $SpecType_FTypeId = get_FoundationTypeId(get_TypeIdByName($SpecType{$SpecType_Id}{"DataType"}));
4897                if($FoundationTypeId==$SpecType_FTypeId) {
4898                    return $SpecType_Id;
4899                }
4900            }
4901        }
4902    }
4903    return 0;
4904}
4905
4906sub getAutoConstraint($)
4907{
4908    my $ReturnType_Id = $_[0];
4909    if(get_PointerLevel($ReturnType_Id) > 0) {
4910        return ("\$0 != ".get_null(), $ReturnType_Id);
4911    }
4912    else {
4913        return ();
4914    }
4915}
4916
4917sub requirementReturn($$$$)
4918{
4919    my ($Interface, $Ireturn, $Ispecreturn, $CallObj) = @_;
4920    return "" if(defined $Template2Code and $Interface ne $TestedInterface);
4921    return "" if(not $Ireturn or not $Interface);
4922    my ($PostCondition, $TargetTypeId, $Requirement_Code) = ();
4923    if($Ispecreturn) {
4924        ($PostCondition, $TargetTypeId) = ($SpecType{$Ispecreturn}{"PostCondition"}, get_TypeIdByName($SpecType{$Ispecreturn}{"DataType"}));
4925    }
4926    elsif(defined $CheckReturn) {
4927        ($PostCondition, $TargetTypeId) = getAutoConstraint($Ireturn);
4928    }
4929    return "" if(not $PostCondition or not $TargetTypeId);
4930    my $PointerLevelReturn = get_PointerLevel($Ireturn);
4931    my ($TargetCallReturn, $TmpPreamble) =
4932    convertTypes((
4933        "InputTypeName"=>get_TypeName($Ireturn),
4934        "InputPointerLevel"=>$PointerLevelReturn,
4935        "OutputTypeId"=>$TargetTypeId,
4936        "Value"=>"\$0",
4937        "Key"=>"\$0",
4938        "Destination"=>"Target",
4939        "MustConvert"=>0));
4940    if($TmpPreamble) {
4941        $Requirement_Code .= $TmpPreamble."\n";
4942    }
4943    if($TargetCallReturn=~/\A\*/
4944    or $TargetCallReturn=~/\A\&/) {
4945        $TargetCallReturn = "(".$TargetCallReturn.")";
4946    }
4947    if($CallObj=~/\A\*/
4948    or $CallObj=~/\A\&/) {
4949        $CallObj = "(".$CallObj.")";
4950    }
4951    $PostCondition=~s/\$0/$TargetCallReturn/g;
4952    if($CallObj ne "no object") {
4953        $PostCondition=~s/\$obj/$CallObj/g;
4954    }
4955    $PostCondition = clearSyntax($PostCondition);
4956    my $NormalResult = $PostCondition;
4957    while($PostCondition=~s/([^\\])"/$1\\\"/g){}
4958    $ConstraintNum{$Interface}+=1;
4959    $RequirementsCatalog{$Interface}{$ConstraintNum{$Interface}} = "constraint for the return value: \'$PostCondition\'";
4960    my $ReqId = get_ShortName($Interface).".".normalize_num($ConstraintNum{$Interface});
4961    if(my $Format = is_printable(get_TypeName($TargetTypeId)))
4962    {
4963        my $Comment = "constraint for the return value failed: \'$PostCondition\', returned value: $Format";
4964        $Requirement_Code .= "REQva(\"$ReqId\",\n$NormalResult,\n\"$Comment\",\n$TargetCallReturn);\n";
4965        $TraceFunc{"REQva"}=1;
4966    }
4967    else
4968    {
4969        my $Comment = "constraint for the return value failed: \'$PostCondition\'";
4970        $Requirement_Code .= "REQ(\"$ReqId\",\n\"$Comment\",\n$NormalResult);\n";
4971        $TraceFunc{"REQ"}=1;
4972    }
4973    return $Requirement_Code;
4974}
4975
4976sub is_printable($)
4977{
4978    my $TypeName = remove_quals(uncover_typedefs($_[0]));
4979    if(isIntegerType($TypeName)) {
4980        return "\%d";
4981    }
4982    elsif($TypeName=~/\A(char|unsigned char|wchar_t|void|short|unsigned short) const\*\Z/) {
4983        return "\%s";
4984    }
4985    elsif(isCharType($TypeName)) {
4986        return "\%c";
4987    }
4988    elsif($TypeName=~/\A(float|double|long double)\Z/) {
4989        return "\%f";
4990    }
4991    else {
4992        return "";
4993    }
4994}
4995
4996sub get_ShortName($)
4997{
4998    my $Symbol = $_[0];
4999    my $Short = $CompleteSignature{$Symbol}{"ShortName"};
5000    if(my $Class = $CompleteSignature{$Symbol}{"Class"}) {
5001        $Short = get_TypeName($Class)."::".$Short;
5002    }
5003    return $Short;
5004}
5005
5006sub normalize_num($)
5007{
5008    my $Num = $_[0];
5009    if(int($Num)<10) {
5010        return "0".$Num;
5011    }
5012    else {
5013        return $Num;
5014    }
5015}
5016
5017sub get_PointerLevel($)
5018{
5019    my $TypeId = $_[0];
5020    return "" if(not $TypeId);
5021    if(defined $Cache{"get_PointerLevel"}{$TypeId}
5022    and not defined $AuxType{$TypeId}) {
5023        return $Cache{"get_PointerLevel"}{$TypeId};
5024    }
5025    return "" if(not $TypeInfo{$TypeId});
5026    my %Type = %{$TypeInfo{$TypeId}};
5027    return 0 if(not $Type{"BaseType"});
5028    return 0 if($Type{"Type"} eq "Array");
5029    my $PointerLevel = 0;
5030    if($Type{"Type"} eq "Pointer") {
5031        $PointerLevel += 1;
5032    }
5033    $PointerLevel += get_PointerLevel($Type{"BaseType"});
5034    $Cache{"get_PointerLevel"}{$TypeId} = $PointerLevel;
5035    return $PointerLevel;
5036}
5037
5038sub select_ValueFromCollection(@)
5039{
5040    my %Init_Desc = @_;
5041    my ($TypeId, $Name, $Interface, $CreateChild, $IsObj) = ($Init_Desc{"TypeId"}, $Init_Desc{"ParamName"}, $Init_Desc{"Interface"}, $Init_Desc{"CreateChild"}, $Init_Desc{"ObjectInit"});
5042    return () if($Init_Desc{"DoNotReuse"});
5043    my $TypeName = get_TypeName($TypeId);
5044    my $FTypeId = get_FoundationTypeId($TypeId);
5045    my $FTypeName = get_TypeName($FTypeId);
5046    my $PointerLevel = get_PointerLevel($TypeId);
5047    my $ShortName = $CompleteSignature{$Interface}{"ShortName"};
5048    return () if(isString($TypeId, $Name, $Interface));
5049    return () if(uncover_typedefs($TypeName)=~/\A(char|unsigned char|wchar_t|void\*)\Z/);
5050    return () if(isCyclical(\@RecurTypeId, get_TypeStackId($TypeId)));
5051    if($CurrentBlock and keys(%{$ValueCollection{$CurrentBlock}}))
5052    {
5053        my (@Name_Type_Coinsidence, @Name_FType_Coinsidence, @Type_Coinsidence, @FType_Coinsidence) = ();
5054        foreach my $Value (sort {$b=~/$Name/i<=>$a=~/$Name/i} sort keys(%{$ValueCollection{$CurrentBlock}}))
5055        {
5056            return () if($Name=~/dest|source/i and $Value=~/source|dest/i and $ShortName=~/copy|move|backup/i);
5057            my $Value_TypeId = $ValueCollection{$CurrentBlock}{$Value};
5058            my $PointerLevel_Value = get_PointerLevel($Value_TypeId);
5059            if($Value!~/\A(argc|argv)\Z/)
5060            {
5061                if(get_TypeName($Value_TypeId)=~/(string|date|time|file)/i and $Name!~/\Ap\d+\Z/)
5062                { # date, time arguments
5063                    unless($Name=~/_elem\Z/ and $PointerLevel_Value==0)
5064                    { # array elements may be reused
5065                        next;
5066                    }
5067                }
5068                next if($CreateChild and not $SubClass_Instance{$Value});
5069                # next if(not $IsObj and $SubClass_Instance{$Value});
5070                next if(($Interface eq $TestedInterface) and ($Name ne $Value)
5071                and not $UseVarEveryWhere{$CurrentBlock}{$Value}); # and $Name!~/\Ap\d+\Z/
5072            }
5073            if($TypeName eq get_TypeName($Value_TypeId))
5074            {
5075                if($Value=~/\A(argc|argv)\Z/) {
5076                    next if($PointerLevel > $PointerLevel_Value);
5077                }
5078                else
5079                {
5080                    if(isNumericType($TypeName)
5081                    and $Name!~/\Q$Value\E/i and $TypeName!~/[A-Z]|_t/)
5082                    { # do not reuse intrinsic values
5083                        next;
5084                    }
5085                }
5086                if($Name=~/\A[_]*$Value(|[_]*[a-zA-Z0-9]|[_]*ptr)\Z/i) {
5087                    push(@Name_Type_Coinsidence, $Value);
5088                }
5089                else
5090                {
5091                    next if($Value=~/\A(argc|argv)\Z/ and $CurrentBlock eq "main");
5092                    push(@Type_Coinsidence, $Value);
5093                }
5094            }
5095            else
5096            {
5097                if($Value=~/\A(argc|argv)\Z/) {
5098                    next if($PointerLevel > $PointerLevel_Value);
5099                }
5100                else
5101                {
5102                    if(isNumericType($FTypeName) and $Name!~/\Q$Value\E/i)
5103                    { # do not reuse intrinsic values
5104                        next;
5105                    }
5106                    if($PointerLevel-$PointerLevel_Value!=1)
5107                    {
5108                        if($PointerLevel > $PointerLevel_Value) {
5109                            next;
5110                        }
5111                        elsif($PointerLevel ne $PointerLevel_Value)
5112                        {
5113                            if(get_TypeType($FTypeId)=~/\A(Intrinsic|Array|Enum)\Z/
5114                            or isArray($Value_TypeId, $Value, $Interface)) {
5115                                next;
5116                            }
5117                        }
5118                    }
5119                    if($PointerLevel<$PointerLevel_Value
5120                    and $Init_Desc{"OuterType_Type"} eq "Array") {
5121                        next;
5122                    }
5123                }
5124                my $Value_FTypeId = get_FoundationTypeId($Value_TypeId);
5125                if($FTypeName eq get_TypeName($Value_FTypeId))
5126                {
5127                    if($Name=~/\A[_]*\Q$Value\E(|[_]*[a-z0-9]|[_]*ptr)\Z/i) {
5128                        push(@Name_FType_Coinsidence, $Value);
5129                    }
5130                    else
5131                    {
5132                        next if($Value=~/\A(argc|argv)\Z/ and $CurrentBlock eq "main");
5133                        push(@FType_Coinsidence, $Value);
5134                    }
5135                }
5136            }
5137        }
5138        my @All_Coinsidence = (@Name_Type_Coinsidence, @Name_FType_Coinsidence, @Type_Coinsidence, @FType_Coinsidence);
5139        if($#All_Coinsidence>-1) {
5140            return ($All_Coinsidence[0], $ValueCollection{$CurrentBlock}{$All_Coinsidence[0]});
5141        }
5142    }
5143    return ();
5144}
5145
5146sub get_interface_param_pos($$)
5147{
5148    my ($Interface, $Name) = @_;
5149    foreach my $Pos (keys(%{$CompleteSignature{$Interface}{"Param"}}))
5150    {
5151        if($CompleteSignature{$Interface}{"Param"}{$Pos}{"name"} eq $Name)
5152        {
5153            return $Pos;
5154        }
5155    }
5156    return "";
5157}
5158
5159sub hasLength($$)
5160{
5161    my ($ParamName, $Interface) = @_;
5162    my $ParamPos = get_interface_param_pos($Interface, $ParamName);
5163    if(defined $CompleteSignature{$Interface}{"Param"}{$ParamPos+1})
5164    {
5165      return (isIntegerType(get_TypeName($CompleteSignature{$Interface}{"Param"}{$ParamPos+1}{"type"}))
5166      and is_array_count($ParamName, $CompleteSignature{$Interface}{"Param"}{$ParamPos+1}{"name"}));
5167    }
5168    return 0;
5169}
5170
5171sub isArrayName($)
5172{
5173    my $Name = $_[0];
5174    if($Name=~/([a-z][a-rt-z]s\Z|matrix|list|set|range|array)/i) {
5175        return 1;
5176    }
5177    return 0;
5178}
5179
5180sub isArray($$$)
5181{ # detect parameter semantic
5182    my ($TypeId, $ParamName, $Interface) = @_;
5183    return 0 if(not $TypeId or not $ParamName);
5184    my $I_ShortName = $CompleteSignature{$Interface}{"ShortName"};
5185    my $FTypeId = get_FoundationTypeId($TypeId);
5186    my $FTypeType = get_TypeType($FTypeId);
5187    my $FTypeName = get_TypeName($FTypeId);
5188    my $TypeName = get_TypeName($TypeId);
5189    my $PLevel = get_PointerLevel($TypeId);
5190    my $ParamPos = get_interface_param_pos($Interface, $ParamName);
5191
5192    return 1 if(get_TypeType($TypeId) eq "Array");
5193
5194    # strong reject
5195    return 0 if($PLevel <= 0);
5196    return 0 if(isString($TypeId, $ParamName, $Interface));
5197    return 0 if($PLevel==1 and (isOpaque($FTypeId) or $FTypeName eq "void"));
5198    return 0 if($ParamName=~/ptr|pointer/i and $FTypeType=~/\A(Struct|Union|Class)\Z/);
5199    return 0 if($Interface_OutParam{$Interface}{$ParamName});
5200
5201    # particular reject
5202    # FILE *fopen(const char *path, const char *__modes)
5203    return 0 if(is_const_type($TypeName) and isCharType($FTypeName)
5204    and $PLevel==1 and $ParamName=~/mode/i);
5205
5206    # returned by function
5207    return 0 if(($FTypeType=~/\A(Struct|Union|Class)\Z/
5208    or ($TypeName ne uncover_typedefs($TypeName) and $TypeName!~/size_t|int/))
5209    and check_type_returned($TypeId, isArrayName($TypeName)));
5210
5211    # array followed by the number
5212    return 1 if(not is_const_type($TypeName) and hasLength($ParamName, $Interface));
5213
5214    return 0 if($PLevel>=2 and isCharType($FTypeName)
5215    and not is_const_type($TypeName));
5216
5217    # allowed configurations
5218    # array of arguments
5219    return 1 if($ParamName=~/argv/i);
5220    # array, list, matrix
5221    if($ParamName!~/out|context|name/i and isArrayName($ParamName)
5222    and (getParamNameByTypeName($TypeName) ne $ParamName or $TypeName!~/\*/)
5223    and $TypeName!~/$ParamName/i)
5224    { #  foo(struct type* list)
5225      #! curl_slist_free_all ( struct curl_slist* p1 )
5226        return 1;
5227    }
5228    # array of function pointers
5229    return 1 if($PLevel==1 and $FTypeType=~/\A(FuncPtr|Array)\Z/);
5230    # QString::vsprintf ( char const* format, va_list ap )
5231    return 1 if($ParamName!~/out|context/i and isArrayName($TypeName) and $TypeName!~/$ParamName/i);
5232    # high pointer level
5233    # xmlSchemaSAXPlug (xmlSchemaValidCtxtPtr ctxt, xmlSAXHandlerPtr* sax, void** user_data)
5234    return 1 if($PLevel>=2);
5235    # symbol array for reading
5236    return 1 if($PLevel==1 and not is_const_type($TypeName) and isCharType($FTypeName)
5237    and not grep(/\A(name|cur|current|out|ret|return|buf|buffer|res|result|rslt)\Z/i, @{get_tokens($ParamName)}));
5238    # array followed by the two numbers
5239    return 1 if(not is_const_type($TypeName) and defined $CompleteSignature{$Interface}{"Param"}{$ParamPos+1}
5240    and defined $CompleteSignature{$Interface}{"Param"}{$ParamPos+2}
5241    and isIntegerType(get_TypeName($CompleteSignature{$Interface}{"Param"}{$ParamPos+1}{"type"}))
5242    and isIntegerType(get_TypeName($CompleteSignature{$Interface}{"Param"}{$ParamPos+2}{"type"}))
5243    and is_array_count($ParamName, $CompleteSignature{$Interface}{"Param"}{$ParamPos+2}{"name"}));
5244    # numeric arrays for reading
5245    return 1 if(is_const_type($TypeName) and isNumericType($FTypeName));
5246    # symbol buffer for reading
5247    return 1 if(is_const_type($TypeName) and $ParamName=~/buf/i and $I_ShortName=~/memory/i
5248    and isCharType($FTypeName));
5249
5250    # isn't array
5251    return 0;
5252}
5253
5254sub check_type_returned($$)
5255{
5256    my ($TypeId, $Strong) = @_;
5257    return 0 if(not $TypeId);
5258    my $BaseTypeId = get_FoundationTypeId($TypeId);
5259    if(get_TypeType($BaseTypeId) ne "Intrinsic")
5260    { # by return value
5261        return 1 if(keys(%{$ReturnTypeId_Interface{$TypeId}}) or keys(%{$ReturnTypeId_Interface{$BaseTypeId}}));
5262        if(not $Strong)
5263        { # base type and plevel match
5264            my $PLevel = get_PointerLevel($TypeId);
5265            foreach (0 .. $PLevel)
5266            {
5267                return 1 if(keys(%{$BaseType_PLevel_OutParam{$BaseTypeId}{$_}})
5268                or keys(%{$BaseType_PLevel_Return{$BaseTypeId}{$_}}));
5269            }
5270        }
5271
5272    }
5273    return 0;
5274}
5275
5276sub isBuffer($$$)
5277{
5278    my ($TypeId, $ParamName, $Interface) = @_;
5279    return 0 if(not $TypeId or not $ParamName);
5280    my $I_ShortName = $CompleteSignature{$Interface}{"ShortName"};
5281    my $FTypeId = get_FoundationTypeId($TypeId);
5282    my $FTypeType = get_TypeType($FTypeId);
5283    my $FTypeName = get_TypeName($FTypeId);
5284    my $TypeName = get_TypeName($TypeId);
5285    my $PLevel = get_PointerLevel($TypeId);
5286
5287    # exceptions
5288    # bmp_read24 (uintptr_t addr)
5289    # bmp_write24 (uintptr_t addr, int c)
5290    return 1 if($PLevel==0 and $ParamName=~/addr/i and isIntegerType($FTypeName));
5291    # cblas_zdotu_sub (int const N, void const* X, int const incX, void const* Y, int const incY, void* dotu)
5292    return 1 if($PLevel==1 and $FTypeName eq "void");
5293    if(get_TypeType($FTypeId) eq "Array" and $Interface)
5294    {
5295        my $ArrayElemType_Id = get_FoundationTypeId(get_OneStep_BaseTypeId($FTypeId));
5296        if(get_TypeType($ArrayElemType_Id)=~/\A(Intrinsic|Enum)\Z/)
5297        {
5298            return 1 if(get_TypeAttr($FTypeId, "Count")>1024);
5299        }
5300        else
5301        {
5302            return 1 if(get_TypeAttr($FTypeId, "Count")>256);
5303        }
5304    }
5305
5306    # strong reject
5307    return 0 if($PLevel <= 0);
5308    return 0 if(is_const_type($TypeName));
5309    return 0 if(isString($TypeId, $ParamName, $Interface));
5310    return 0 if($PLevel==1 and isOpaque($FTypeId));
5311    return 0 if(($FTypeType=~/\A(Struct|Union|Class)\Z/
5312    or ($TypeName ne uncover_typedefs($TypeName) and $TypeName!~/size_t|int/))
5313    and check_type_returned($TypeId, isArrayName($TypeName)));
5314
5315    # allowed configurations
5316    # symbol buffer for writing
5317    return 1 if(isSymbolBuffer($TypeId, $ParamName, $Interface));
5318    if($ParamName=~/\Ap\d+\Z/)
5319    {
5320        # buffer of void* type for writing
5321        return 1 if($PLevel==1 and $FTypeName eq "void");
5322        # buffer of arrays for writing
5323        return 1 if($FTypeType eq "Array");
5324    }
5325    return 1 if(is_out_word($ParamName));
5326    # gsl_fft_real_radix2_transform (double* data, size_t const stride, size_t const n)
5327    return 1 if($PLevel==1 and isNumericType($FTypeName) and $ParamName!~/(len|size)/i);
5328
5329    # isn't array
5330    return 0;
5331}
5332
5333sub is_out_word($)
5334{
5335    my $Word = $_[0];
5336    return grep(/\A(out|output|dest|buf|buff|buffer|ptr|pointer|result|res|ret|return|rtrn)\Z/i, @{get_tokens($Word)});
5337}
5338
5339sub isSymbolBuffer($$$)
5340{
5341    my ($TypeId, $ParamName, $Interface) = @_;
5342    return 0 if(not $TypeId or not $ParamName);
5343    my $FTypeId = get_FoundationTypeId($TypeId);
5344    my $FTypeName = get_TypeName($FTypeId);
5345    my $TypeName = get_TypeName($TypeId);
5346    my $PLevel = get_PointerLevel($TypeId);
5347    return (not is_const_type($TypeName) and $PLevel==1
5348    and isCharType($FTypeName)
5349    and $ParamName!~/data|value|arg|var/i and $TypeName!~/list|va_/
5350    and (grep(/\A(name|cur|current)\Z/i, @{get_tokens($ParamName)}) or is_out_word($ParamName)));
5351}
5352
5353sub isOutParam_NoUsing($$$)
5354{
5355    my ($TypeId, $ParamName, $Interface) = @_;
5356    return 0 if(not $TypeId or not $ParamName);
5357    my $Func_ShortName = $CompleteSignature{$Interface}{"ShortName"};
5358    my $FTypeId = get_FoundationTypeId($TypeId);
5359    my $FTypeName = get_TypeName($FTypeId);
5360    my $TypeName = get_TypeName($TypeId);
5361    my $PLevel = get_PointerLevel($TypeId);
5362    return 0 if($PLevel==1 and isOpaque($FTypeId)); # size of the structure/union is unknown
5363    return 0 if(is_const_type($TypeName) or $PLevel<=0);
5364    return 1 if(grep(/\A(err|error)(_|)(p|ptr|)\Z/i, @{get_tokens($ParamName." ".$TypeName)}) and $Func_ShortName!~/error/i);
5365    return 1 if(grep(/\A(out|ret|return)\Z/i, @{get_tokens($ParamName)}));
5366    return 1 if($PLevel>=2 and isCharType($FTypeName) and not is_const_type($TypeName));
5367    return 0;
5368}
5369
5370sub isString($$$)
5371{
5372    my ($TypeId, $ParamName, $Interface) = @_;
5373    return 0 if(not $TypeId or not $ParamName);
5374    my $TypeName_Trivial = uncover_typedefs(get_TypeName($TypeId));
5375    my $PLevel = get_PointerLevel($TypeId);
5376    my $TypeName = get_TypeName($TypeId);
5377    my $FoundationTypeName = get_TypeName(get_FoundationTypeId($TypeId));
5378    # not a pointer
5379    return 0 if($ParamName=~/ptr|pointer/i);
5380    # standard string (std::string)
5381    return 1 if($PLevel==0 and $FoundationTypeName eq "std::basic_string<char>");
5382    if($FoundationTypeName=~/\A(char|unsigned char|wchar_t|short|unsigned short)\Z/)
5383    {
5384        # char const*, unsigned char const*, wchar_t const*
5385        # void const*, short const*, unsigned short const*
5386        # ChannelGroup::getName ( char* name, int namelen )
5387        return 1 if($PLevel==1 and is_const_type($TypeName_Trivial));
5388        if(not hasLength($ParamName, $Interface))
5389        {
5390            return 1 if($PLevel==1 and $CompleteSignature{$Interface}{"ShortName"}!~/get|encode/i
5391            and $ParamName=~/\A(file|)(_|)path\Z|description|label|name/i);
5392            # direct_trim ( char** s )
5393            return 1 if($PLevel>=1 and $ParamName=~/\A(s|str|string)\Z/i);
5394        }
5395    }
5396
5397    # isn't a string
5398    return 0;
5399}
5400
5401sub isOpaque($)
5402{
5403    my $TypeId = $_[0];
5404    return 0 if(not $TypeId);
5405    my %Type = get_Type($TypeId);
5406    return ($Type{"Type"}=~/\A(Struct|Union)\Z/ and not keys(%{$Type{"Memb"}}) and not $Type{"Memb"}{0}{"name"});
5407}
5408
5409sub isStr_FileName($$$)
5410{ # should be called after the "isString" function
5411    my ($ParamPos, $ParamName, $Interface_ShortName) = @_;
5412    return 0 if(not $ParamName);
5413    if($ParamName=~/ext/i)
5414    { # not an extension
5415        return 0;
5416    }
5417    if($ParamName=~/file|dtd/i
5418    and $ParamName!~/type|opt/i)
5419    { # any files, dtds
5420        return 1;
5421    }
5422    return 1 if(lc($ParamName) eq "fname");
5423    # files as buffers
5424    return 1 if($ParamName=~/buf/i and $Interface_ShortName!~/memory|write/i and $Interface_ShortName=~/file/i);
5425    # name of the file at the first parameter of read/write/open functions
5426    # return 1 if($ParamName=~/\A[_]*name\Z/i and $Interface_ShortName=~/read|write|open/i and $ParamPos=="0");
5427    # file path
5428    return 1 if($ParamName=~/path/i
5429    and $Interface_ShortName=~/open|create|file/i
5430    and $Interface_ShortName!~/(open|_)dir(_|\Z)/i);
5431    # path to the configs
5432    return 1 if($ParamName=~/path|cfgs/i and $Interface_ShortName=~/config/i);
5433    # parameter of the string constructor
5434    return 1 if($ParamName=~/src/i and $Interface_ShortName!~/string/i and $ParamPos=="0");
5435    # uri/url of the local files
5436    return 1 if($ParamName=~/uri|url/i and $Interface_ShortName!~/http|ftp/i);
5437
5438    # isn't a file path
5439    return 0;
5440}
5441
5442sub isStr_Dir($$)
5443{
5444    my ($ParamName, $Interface_ShortName) = @_;
5445    return 0 if(not $ParamName);
5446    return 1 if($ParamName=~/path/i
5447    and $Interface_ShortName=~/(open|_)dir(_|\Z)/i);
5448    return 1 if($ParamName=~/dir/i);
5449
5450    # isn't a directory
5451    return 0;
5452}
5453
5454sub equal_types($$)
5455{
5456    my ($Type1_Id, $Type2_Id) = @_;
5457    return (uncover_typedefs(get_TypeName($Type1_Id)) eq uncover_typedefs(get_TypeName($Type2_Id)));
5458}
5459
5460sub reduce_pointer_level($)
5461{
5462    my $TypeId = $_[0];
5463    my %PureType = get_PureType($TypeId);
5464    my $BaseTypeId = get_OneStep_BaseTypeId($PureType{"Tid"});
5465    return ($BaseTypeId eq $TypeId)?"":$BaseTypeId;
5466}
5467
5468sub reassemble_array($)
5469{
5470    my $TypeId = $_[0];
5471    return () if(not $TypeId);
5472    my $FoundationTypeId = get_FoundationTypeId($TypeId);
5473    if(get_TypeType($FoundationTypeId) eq "Array")
5474    {
5475        my ($BaseName, $Length) = (get_TypeName($FoundationTypeId), 1);
5476        while($BaseName=~s/\[(\d+)\]//) {
5477            $Length*=$1;
5478        }
5479        return ($BaseName, $Length);
5480    }
5481    else {
5482        return ();
5483    }
5484}
5485
5486sub get_call_malloc($)
5487{
5488    my $TypeId = $_[0];
5489    return "" if(not $TypeId);
5490    my $FoundationTypeId = get_FoundationTypeId($TypeId);
5491    my $FoundationTypeName = get_TypeName($FoundationTypeId);
5492    my $PointerLevel = get_PointerLevel($TypeId);
5493    my $Conv = ($FoundationTypeName ne "void")?"(".get_TypeName($TypeId).") ":"";
5494    $Conv=~s/\&//g;
5495    my $BuffSize = 0;
5496    if(get_TypeType($FoundationTypeId) eq "Array")
5497    {
5498        my ($Array_BaseName, $Array_Length) = reassemble_array($TypeId);
5499        $Conv = "($Array_BaseName*)";
5500        $BuffSize = $Array_Length;
5501        $FoundationTypeName = $Array_BaseName;
5502        my %ArrayBase = get_BaseType($TypeId);
5503        $FoundationTypeId = $ArrayBase{"Tid"};
5504    }
5505    else {
5506        $BuffSize = $BUFF_SIZE;
5507    }
5508    my $MallocCall = "malloc";
5509    if($LibraryMallocFunc)
5510    {
5511        $MallocCall = $CompleteSignature{$LibraryMallocFunc}{"ShortName"};
5512        if(my $NS = $CompleteSignature{$LibraryMallocFunc}{"NameSpace"}) {
5513            $MallocCall = $NS."::".$MallocCall;
5514        }
5515    }
5516    if($FoundationTypeName eq "void") {
5517        return $Conv.$MallocCall."($BuffSize)";
5518    }
5519    else
5520    {
5521        if(isOpaque($FoundationTypeId))
5522        { # opaque buffers
5523            if(get_TypeType($FoundationTypeId) eq "Array") {
5524                $BuffSize*=$BUFF_SIZE;
5525            }
5526            else {
5527                $BuffSize*=4;
5528            }
5529            return $Conv.$MallocCall."($BuffSize)";
5530        }
5531        else
5532        {
5533            if($PointerLevel==1)
5534            {
5535                my $ReducedTypeId = reduce_pointer_level($TypeId);
5536                return $Conv.$MallocCall."(sizeof(".get_TypeName($ReducedTypeId).")".($BuffSize>1?"*$BuffSize":"").")";
5537            }
5538            else {
5539                return $Conv.$MallocCall."(sizeof($FoundationTypeName)".($BuffSize>1?"*$BuffSize":"").")";
5540            }
5541        }
5542    }
5543}
5544
5545sub isKnownExt($)
5546{
5547    my $Ext = $_[0];
5548    if($Ext=~/\A(png|tiff|zip|bmp|bitmap|nc)/i)
5549    {
5550        return $1;
5551    }
5552    return "";
5553}
5554
5555sub add_VirtualSpecType(@)
5556{
5557    my %Init_Desc = @_;
5558    my %NewInit_Desc = %Init_Desc;
5559    if($Init_Desc{"Value"} eq "") {
5560        $Init_Desc{"Value"} = "no value";
5561    }
5562    my ($TypeId, $ParamName, $Interface) = ($Init_Desc{"TypeId"}, $Init_Desc{"ParamName"}, $Init_Desc{"Interface"});
5563    my $FoundationTypeId = get_FoundationTypeId($TypeId);
5564    my $FoundationTypeName = get_TypeName($FoundationTypeId);
5565    my $PointerLevel = get_PointerLevel($TypeId);
5566    my $FoundationTypeType = $TypeInfo{$FoundationTypeId}{"Type"};
5567    my $TypeName = get_TypeName($TypeId);
5568    my $TypeType = get_TypeType($TypeId);
5569    my $I_ShortName = $CompleteSignature{$Init_Desc{"Interface"}}{"ShortName"};
5570    my $I_Header = $CompleteSignature{$Init_Desc{"Interface"}}{"Header"};
5571    if($Init_Desc{"Value"} eq "no value"
5572    or (defined $ValueCollection{$CurrentBlock}{$ParamName} and $ValueCollection{$CurrentBlock}{$ParamName}==$TypeId))
5573    { # create value atribute
5574        if($CurrentBlock and keys(%{$ValueCollection{$CurrentBlock}}) and not $Init_Desc{"InLineArray"})
5575        {
5576            ($NewInit_Desc{"Value"}, $NewInit_Desc{"ValueTypeId"}) = select_ValueFromCollection(%Init_Desc);
5577            if($NewInit_Desc{"Value"} and $NewInit_Desc{"ValueTypeId"})
5578            {
5579                my ($Call, $TmpPreamble)=convertTypes((
5580                    "InputTypeName"=>get_TypeName($NewInit_Desc{"ValueTypeId"}),
5581                    "InputPointerLevel"=>get_PointerLevel($NewInit_Desc{"ValueTypeId"}),
5582                    "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$TypeId,
5583                    "Value"=>$NewInit_Desc{"Value"},
5584                    "Key"=>$LongVarNames?$Init_Desc{"Key"}:$ParamName,
5585                    "Destination"=>"Param",
5586                    "MustConvert"=>0));
5587                if($Call and not $TmpPreamble)
5588                { # try to create simple value
5589                    $NewInit_Desc{"ValueTypeId"}=$TypeId;
5590                    $NewInit_Desc{"Value"} = $Call;
5591                }
5592                if($NewInit_Desc{"ValueTypeId"}==$TypeId) {
5593                    $NewInit_Desc{"InLine"} = 1;
5594                }
5595                $NewInit_Desc{"Reuse"} = 1;
5596                return %NewInit_Desc;
5597            }
5598        }
5599        if($TypeName=~/\&/
5600        or not $Init_Desc{"InLine"}) {
5601            $NewInit_Desc{"InLine"} = 0;
5602        }
5603        else {
5604            $NewInit_Desc{"InLine"} = 1;
5605        }
5606        # creating virtual specialized type
5607        if($TypeName eq "...")
5608        {
5609            $NewInit_Desc{"Value"} = get_null();
5610            $NewInit_Desc{"ValueTypeId"} = get_TypeIdByName("int");
5611        }
5612        elsif($I_ShortName eq "time" and $I_Header eq "time.h")
5613        { # spectype for time_t time(time_t *t) from time.h
5614            $NewInit_Desc{"Value"} = get_null();
5615            $NewInit_Desc{"ValueTypeId"} = $TypeId;
5616        }
5617        elsif($ParamName=~/unused/i and $PointerLevel>=1)
5618        { # curl_getdate ( char const* p, time_t const* unused )
5619            $NewInit_Desc{"Value"} = get_null();
5620            $NewInit_Desc{"ValueTypeId"} = $TypeId;
5621        }
5622        elsif($FoundationTypeName eq "int" and $ParamName=~/\Aargc(_|)(p|ptr|)\Z/i
5623        and not $Interface_OutParam{$Interface}{$ParamName} and $PointerLevel>=1
5624        and my $Value_TId = register_new_type(get_TypeIdByName("int"), 1))
5625        { # gtk_init ( int* argc, char*** argv )
5626            $NewInit_Desc{"Value"} = "&argc";
5627            $NewInit_Desc{"ValueTypeId"} = $Value_TId;
5628        }
5629        elsif($FoundationTypeName eq "char" and $ParamName=~/\Aargv(_|)(p|ptr|)\Z/i
5630        and not $Interface_OutParam{$Interface}{$ParamName} and $PointerLevel>=3
5631        and my $Value_TId = register_new_type(get_TypeIdByName("char"), 3))
5632        { # gtk_init ( int* argc, char*** argv )
5633            $NewInit_Desc{"Value"} = "&argv";
5634            $NewInit_Desc{"ValueTypeId"} = $Value_TId;
5635        }
5636        elsif($FoundationTypeName eq "complex float")
5637        {
5638            $NewInit_Desc{"Value"} = getIntrinsicValue("float")." + I*".getIntrinsicValue("float");
5639            $NewInit_Desc{"ValueTypeId"} = $FoundationTypeId;
5640        }
5641        elsif($FoundationTypeName eq "complex double")
5642        {
5643            $NewInit_Desc{"Value"} = getIntrinsicValue("double")." + I*".getIntrinsicValue("double");
5644            $NewInit_Desc{"ValueTypeId"} = $FoundationTypeId;
5645        }
5646        elsif($FoundationTypeName eq "complex long double")
5647        {
5648            $NewInit_Desc{"Value"} = getIntrinsicValue("long double")." + I*".getIntrinsicValue("long double");
5649            $NewInit_Desc{"ValueTypeId"} = $FoundationTypeId;
5650        }
5651        elsif((($Interface_OutParam{$Interface}{$ParamName} and $PointerLevel>=1) or ($Interface_OutParam_NoUsing{$Interface}{$ParamName}
5652        and $PointerLevel>=1)) and not grep(/\A(in|input)\Z/, @{get_tokens($ParamName)}) and not isSymbolBuffer($TypeId, $ParamName, $Interface))
5653        {
5654            $NewInit_Desc{"InLine"} = 0;
5655            $NewInit_Desc{"ValueTypeId"} = reduce_pointer_level($TypeId);
5656            if($PointerLevel>=2) {
5657                $NewInit_Desc{"Value"} = get_null();
5658            }
5659            elsif($PointerLevel==1 and isNumericType(get_TypeName($FoundationTypeId)))
5660            {
5661                $NewInit_Desc{"Value"} = "0";
5662                $NewInit_Desc{"OnlyByValue"} = 1;
5663            }
5664            else {
5665                $NewInit_Desc{"OnlyDecl"} = 1;
5666            }
5667            $NewInit_Desc{"UseableValue"} = 1;
5668        }
5669        elsif($FoundationTypeName eq "void" and $PointerLevel==1
5670        and my $SimilarType_Id = find_similar_type($NewInit_Desc{"TypeId"}, $ParamName)
5671        and $TypeName=~/(\W|\A)void(\W|\Z)/ and not $NewInit_Desc{"TypeId_Changed"})
5672        {
5673            $NewInit_Desc{"TypeId"} = $SimilarType_Id;
5674            $NewInit_Desc{"DenyMalloc"} = 1;
5675            %NewInit_Desc = add_VirtualSpecType(%NewInit_Desc);
5676            $NewInit_Desc{"TypeId_Changed"} = $TypeId;
5677        }
5678        elsif(isArray($TypeId, $ParamName, $Interface)
5679        and not $Init_Desc{"IsString"})
5680        {
5681            $NewInit_Desc{"FoundationType_Type"} = "Array";
5682            if($ParamName=~/matrix/) {
5683                $NewInit_Desc{"ArraySize"} = 16;
5684            }
5685            $NewInit_Desc{"TypeType_Changed"} = 1;
5686        }
5687        elsif($Init_Desc{"FuncPtrName"}=~/realloc/i and $PointerLevel==1
5688        and $Init_Desc{"RetVal"} and $Init_Desc{"FuncPtrTypeId"})
5689        {
5690            my %FuncPtrType = get_Type($Init_Desc{"FuncPtrTypeId"});
5691            my ($IntParam, $IntParam2, $PtrParam, $PtrTypeId) = ("", "", "", 0);
5692            foreach my $ParamPos (sort {int($a) <=> int($b)} keys(%{$FuncPtrType{"Memb"}}))
5693            {
5694                my $ParamTypeId = $FuncPtrType{"Memb"}{$ParamPos}{"type"};
5695                my $ParamName = $FuncPtrType{"Memb"}{$ParamPos}{"name"};
5696                $ParamName = "p".($ParamPos+1) if(not $ParamName);
5697                my $ParamFTypeId = get_FoundationTypeId($ParamTypeId);
5698                if(isIntegerType(get_TypeName($ParamTypeId)))
5699                {
5700                    if(not $IntParam) {
5701                        $IntParam = $ParamName;
5702                    }
5703                    elsif(not $IntParam2) {
5704                        $IntParam2 = $ParamName;
5705                    }
5706                }
5707                elsif(get_PointerLevel($ParamTypeId)==1
5708                and get_TypeType($ParamFTypeId) eq "Intrinsic")
5709                {
5710                    $PtrParam = $ParamName;
5711                    $PtrTypeId = $ParamTypeId;
5712                }
5713            }
5714            if($IntParam and $PtrParam)
5715            { # function has an integer parameter
5716                my $Conv = ($FoundationTypeName ne "void")?"(".get_TypeName($TypeId).") ":"";
5717                $Conv=~s/\&//g;
5718                my $VoidConv = (get_TypeName(get_FoundationTypeId($PtrTypeId)) ne "void")?"(void*)":"";
5719                if($IntParam2) {
5720                    $NewInit_Desc{"Value"} = $Conv."realloc($VoidConv$PtrParam, $IntParam2)";
5721                }
5722                else {
5723                    $NewInit_Desc{"Value"} = $Conv."realloc($VoidConv$PtrParam, $IntParam)";
5724                }
5725            }
5726            else {
5727                $NewInit_Desc{"Value"} = get_call_malloc($TypeId);
5728            }
5729            $NewInit_Desc{"ValueTypeId"} = $TypeId;
5730            $NewInit_Desc{"InLine"} = ($Init_Desc{"RetVal"} or ($Init_Desc{"OuterType_Type"} eq "Array"))?1:0;
5731            if($LibraryMallocFunc and (not $IntParam or not $PtrParam)) {
5732                $NewInit_Desc{"Headers"} = addHeaders([$CompleteSignature{$LibraryMallocFunc}{"Header"}], $NewInit_Desc{"Headers"});
5733            }
5734            else
5735            {
5736                $NewInit_Desc{"Headers"} = addHeaders(["stdlib.h"], $NewInit_Desc{"Headers"});
5737                $AuxHeaders{"stdlib.h"} = 1;
5738            }
5739        }
5740        elsif($Init_Desc{"FuncPtrName"}=~/alloc/i and $PointerLevel==1
5741        and $Init_Desc{"RetVal"} and $Init_Desc{"FuncPtrTypeId"})
5742        {
5743            my %FuncPtrType = get_Type($Init_Desc{"FuncPtrTypeId"});
5744            my $IntParam = "";
5745            foreach my $ParamPos (sort {int($a) <=> int($b)} keys(%{$FuncPtrType{"Memb"}}))
5746            {
5747                my $ParamTypeId = $FuncPtrType{"Memb"}{$ParamPos}{"type"};
5748                my $ParamName = $FuncPtrType{"Memb"}{$ParamPos}{"name"};
5749                $ParamName = "p".($ParamPos+1) if(not $ParamName);
5750                if(isIntegerType(get_TypeName($ParamTypeId)))
5751                {
5752                    $IntParam = $ParamName;
5753                    last;
5754                }
5755            }
5756            if($IntParam)
5757            { # function has an integer parameter
5758                my $Conv = ($FoundationTypeName ne "void")?"(".get_TypeName($TypeId).") ":"";
5759                $Conv=~s/\&//g;
5760                $NewInit_Desc{"Value"} = $Conv."malloc($IntParam)";
5761            }
5762            else {
5763                $NewInit_Desc{"Value"} = get_call_malloc($TypeId);
5764            }
5765            $NewInit_Desc{"ValueTypeId"} = $TypeId;
5766            $NewInit_Desc{"InLine"} = ($Init_Desc{"RetVal"} or ($Init_Desc{"OuterType_Type"} eq "Array"))?1:0;
5767            if($LibraryMallocFunc and not $IntParam) {
5768                $NewInit_Desc{"Headers"} = addHeaders([$CompleteSignature{$LibraryMallocFunc}{"Header"}], $NewInit_Desc{"Headers"});
5769            }
5770            else
5771            {
5772                $NewInit_Desc{"Headers"} = addHeaders(["stdlib.h"], $NewInit_Desc{"Headers"});
5773                $AuxHeaders{"stdlib.h"} = 1;
5774            }
5775        }
5776        elsif((isBuffer($TypeId, $ParamName, $Interface)
5777        or ($PointerLevel==1 and $I_ShortName=~/free/i and $FoundationTypeName=~/\A(void|char|unsigned char|wchar_t)\Z/))
5778        and not $NewInit_Desc{"InLineArray"} and not $Init_Desc{"IsString"} and not $Init_Desc{"DenyMalloc"})
5779        {
5780            if(get_TypeName($TypeId) eq "char const*"
5781            and (my $NewTypeId = get_TypeIdByName("char*"))) {
5782                $TypeId = $NewTypeId;
5783            }
5784            $NewInit_Desc{"Value"} = get_call_malloc($TypeId);
5785            $NewInit_Desc{"ValueTypeId"} = $TypeId;
5786            $NewInit_Desc{"InLine"} = ($Init_Desc{"RetVal"} or ($Init_Desc{"OuterType_Type"} eq "Array"))?1:0;
5787            if($LibraryMallocFunc) {
5788                $NewInit_Desc{"Headers"} = addHeaders([$CompleteSignature{$LibraryMallocFunc}{"Header"}], $NewInit_Desc{"Headers"});
5789            }
5790            else
5791            {
5792                $NewInit_Desc{"Headers"} = addHeaders(["stdlib.h"], $NewInit_Desc{"Headers"});
5793                $AuxHeaders{"stdlib.h"} = 1;
5794            }
5795        }
5796        elsif(isString($TypeId, $ParamName, $Interface)
5797        or $Init_Desc{"IsString"})
5798        {
5799            my @Values = ();
5800            if($ParamName and $ParamName!~/\Ap\d+\Z/)
5801            {
5802                if($I_ShortName=~/Display/ and $ParamName=~/name|display/i)
5803                {
5804                    @Values = ("getenv(\"DISPLAY\")");
5805                    $NewInit_Desc{"Headers"} = addHeaders(["stdlib.h"], $NewInit_Desc{"Headers"});
5806                    $AuxHeaders{"stdlib.h"} = 1;
5807                }
5808                elsif($ParamName=~/uri|url|href/i
5809                and $I_ShortName!~/file/i) {
5810                    @Values = ("\"http://www.w3.org/\"");
5811                }
5812                elsif($ParamName=~/language/i) {
5813                    @Values = ("\"$COMMON_LANGUAGE\"");
5814                }
5815                elsif($ParamName=~/mount/i and $ParamName=~/path/i) {
5816                    @Values = ("\"/dev\"");
5817                }
5818                elsif(isStr_FileName($Init_Desc{"ParamPos"}, $ParamName, $I_ShortName))
5819                {
5820                    if($I_ShortName=~/sqlite/i) {
5821                        @Values = ("TG_TEST_DATA_DB");
5822                    }
5823                    elsif($TestedInterface=~/\A(ov_|vorbis_)/i) {
5824                        @Values = ("TG_TEST_DATA_AUDIO");
5825                    }
5826                    elsif($TestedInterface=~/\A(zip_)/i) {
5827                        @Values = ("TG_TEST_DATA_ZIP_FILE");
5828                    }
5829                    elsif($ParamName=~/dtd/i or $I_ShortName=~/dtd/i) {
5830                        @Values = ("TG_TEST_DATA_DTD_FILE");
5831                    }
5832                    elsif($ParamName=~/xml/i or $I_ShortName=~/xml/i
5833                    or ($Init_Desc{"OuterType_Type"}=~/\A(Struct|Union)\Z/ and get_TypeName($Init_Desc{"OuterType_Id"})=~/xml/i))
5834                    {
5835                        @Values = ("TG_TEST_DATA_XML_FILE");
5836                    }
5837                    elsif($ParamName=~/html/i or $I_ShortName=~/html/i
5838                    or ($Init_Desc{"OuterType_Type"}=~/\A(Struct|Union)\Z/ and get_TypeName($Init_Desc{"OuterType_Id"})=~/html/i))
5839                    {
5840                        @Values = ("TG_TEST_DATA_HTML_FILE");
5841                    }
5842                    elsif($ParamName=~/path/i and $I_ShortName=~/\Asnd_/)
5843                    { # ALSA
5844                        @Values = ("TG_TEST_DATA_ASOUNDRC_FILE");
5845                    }
5846                    else
5847                    {
5848                        my $KnownExt = isKnownExt(getPrefix($I_ShortName));
5849                        $KnownExt = isKnownExt($Init_Desc{"Key"}) if(not $KnownExt);
5850                        $KnownExt = isKnownExt($TestedInterface) if(not $KnownExt);
5851                        $KnownExt = isKnownExt($I_ShortName) if(not $KnownExt);
5852                        if($KnownExt) {
5853                            @Values = ("TG_TEST_DATA_FILE_".uc($KnownExt));
5854                        }
5855                        else {
5856                            @Values = ("TG_TEST_DATA_PLAIN_FILE");
5857                        }
5858                    }
5859                }
5860                elsif(isStr_Dir($ParamName, $I_ShortName)
5861                or ($ParamName=~/path/ and get_TypeName($Init_Desc{"OuterType_Id"})=~/Dir|directory/))
5862                {
5863                    @Values = ("TG_TEST_DATA_DIRECTORY");
5864                }
5865                elsif($ParamName=~/path/i and $I_ShortName=~/\Adbus_/)
5866                { # D-Bus
5867                    @Values = ("TG_TEST_DATA_ABS_FILE");
5868                }
5869                elsif($ParamName=~/path/i) {
5870                    @Values = ("TG_TEST_DATA_PLAIN_FILE");
5871                }
5872                elsif($ParamName=~/\A(ext|extension(s|))\Z/i) {
5873                    @Values = ("\".txt\"", "\".hh\"");
5874                }
5875                elsif($ParamName=~/mode/i and $I_ShortName=~/fopen/i)
5876                { # FILE *fopen(const char *path, const char *mode)
5877                    @Values = ("\"r+\"");
5878                }
5879                elsif($ParamName=~/mode/i and $I_ShortName=~/open/i) {
5880                    @Values = ("\"rw\"");
5881                }
5882                elsif($ParamName=~/date/i) {
5883                    @Values = ("\"Sun, 06 Nov 1994 08:49:37 GMT\"");
5884                }
5885                elsif($ParamName=~/day/i) {
5886                    @Values = ("\"monday\"", "\"tuesday\"");
5887                }
5888                elsif($ParamName=~/month/i) {
5889                    @Values = ("\"november\"", "\"october\"");
5890                }
5891                elsif($ParamName=~/name/i and $I_ShortName=~/font/i)
5892                {
5893                    if($I_ShortName=~/\A[_]*X/) {
5894                        @Values = ("\"10x20\"", "\"fixed\"");
5895                    }
5896                    else {
5897                        @Values = ("\"times\"", "\"arial\"", "\"courier\"");
5898                    }
5899                }
5900                elsif($ParamName=~/version/i) {
5901                    @Values = ("\"1.0\"", "\"2.0\"");
5902                }
5903                elsif($ParamName=~/encoding/i
5904                or $Init_Desc{"Key"}=~/encoding/i) {
5905                    @Values = ("\"utf-8\"", "\"koi-8\"");
5906                }
5907                elsif($ParamName=~/method/i
5908                and $I_ShortName=~/http|ftp|url|uri|request/i) {
5909                    @Values = ("\"GET\"", "\"PUT\"");
5910                }
5911                elsif($I_ShortName=~/cast/i
5912                and $CompleteSignature{$Interface}{"Class"}) {
5913                    @Values = ("\"".get_TypeName($CompleteSignature{$Interface}{"Class"})."\"");
5914                }
5915                elsif($I_ShortName=~/\Asnd_/ and $I_ShortName!~/\Asnd_seq_/ and $ParamName=~/name/i)
5916                { # ALSA
5917                    @Values = ("\"hw:0\"");
5918                }
5919                elsif($ParamName=~/var/i and $I_ShortName=~/env/i) {
5920                    @Values = ("\"HOME\"", "\"PATH\"");
5921                }
5922                elsif($ParamName=~/error_name/i and $I_ShortName=~/\Adbus_/)
5923                { # D-Bus
5924                    if($Constants{"DBUS_ERROR_FAILED"}{"Value"}) {
5925                        @Values = ("DBUS_ERROR_FAILED");
5926                    }
5927                    else {
5928                        @Values = ("\"org.freedesktop.DBus.Error.Failed\"");
5929                    }
5930                }
5931                elsif($ParamName=~/name/i and $I_ShortName=~/\Adbus_/)
5932                { # D-Bus
5933                    @Values = ("\"sample.bus\"");
5934                }
5935                elsif($ParamName=~/interface/i and $I_ShortName=~/\Adbus_/) {
5936                    @Values = ("\"sample.interface\""); # D-Bus
5937                }
5938                elsif($ParamName=~/address/i and $I_ShortName=~/\Adbus_server/) {
5939                    @Values = ("\"unix:tmpdir=/tmp\""); # D-Bus
5940                }
5941                elsif($CompleteSignature{$Interface}{"Constructor"} and not $Init_Desc{"ParamRenamed"})
5942                {
5943                    my $KeyPart = $Init_Desc{"Key"};
5944                    my $IgnoreSiffix = lc($I_ShortName)."_".$ParamName;
5945                    $KeyPart=~s/_\Q$ParamName\E\Z// if($I_ShortName=~/string|char/i and $KeyPart!~/(\A|_)\Q$IgnoreSiffix\E\Z/);
5946                    $KeyPart=~s/_\d+\Z//g;
5947                    $KeyPart=~s/\A.*_([^_]+)\Z/$1/g;
5948                    if($KeyPart!~/(\A|_)p\d+\Z/)
5949                    {
5950                        $NewInit_Desc{"ParamName"} = $KeyPart;
5951                        $NewInit_Desc{"ParamRenamed"} = 1;
5952                        %NewInit_Desc = add_VirtualSpecType(%NewInit_Desc);
5953                    }
5954                    else {
5955                        @Values = ("\"".$ParamName."\"");
5956                    }
5957                }
5958                else {
5959                    @Values = ("\"".$ParamName."\"");
5960                }
5961            }
5962            else
5963            {
5964                if($I_ShortName=~/Display/)
5965                {
5966                    @Values = ("getenv(\"DISPLAY\")");
5967                    $NewInit_Desc{"Headers"} = addHeaders(["stdlib.h"], $NewInit_Desc{"Headers"});
5968                    $AuxHeaders{"stdlib.h"} = 1;
5969                }
5970                elsif($I_ShortName=~/cast/ and $CompleteSignature{$Interface}{"Class"}) {
5971                    @Values = ("\"".get_TypeName($CompleteSignature{$Interface}{"Class"})."\"");
5972                }
5973                else {
5974                    @Values = (getIntrinsicValue("char*"));
5975                }
5976            }
5977            if($FoundationTypeName eq "wchar_t")
5978            {
5979                foreach my $Str (@Values) {
5980                    $Str = "L".$Str if($Str=~/\A\"/);
5981                }
5982                $NewInit_Desc{"ValueTypeId"} = get_TypeIdByName("wchar_t const*");
5983            }
5984            elsif($FoundationTypeType eq "Intrinsic") {
5985                $NewInit_Desc{"ValueTypeId"} = get_TypeIdByName("char const*");
5986            }
5987            else
5988            { # std::string
5989                $NewInit_Desc{"ValueTypeId"} = $FoundationTypeId;
5990            }
5991            $NewInit_Desc{"Value"} = vary_values(\@Values, \%Init_Desc) if($#Values>=0);
5992            if(not is_const_type(uncover_typedefs(get_TypeName($TypeId))) and not $Init_Desc{"IsString"})
5993            { # FIXME: inlining strings
5994                #$NewInit_Desc{"InLine"} = 0;
5995            }
5996        }
5997        elsif(($FoundationTypeName eq "void") and ($PointerLevel==1))
5998        {
5999            $NewInit_Desc{"FoundationType_Type"} = "Array";
6000            $NewInit_Desc{"TypeType_Changed"} = 1;
6001            $NewInit_Desc{"TypeId"} = get_TypeIdByName("char*");
6002            $NewInit_Desc{"TypeId_Changed"} = $TypeId;
6003        }
6004        elsif($FoundationTypeType eq "Intrinsic")
6005        {
6006            if($PointerLevel==1 and $ParamName=~/matrix/i)
6007            {
6008                $NewInit_Desc{"FoundationType_Type"} = "Array";
6009                $NewInit_Desc{"TypeType_Changed"} = 1;
6010                $NewInit_Desc{"ArraySize"} = 16;
6011            }
6012            elsif(isIntegerType($FoundationTypeName))
6013            {
6014                if($PointerLevel==0)
6015                {
6016                    if($Init_Desc{"RetVal"}
6017                    and $CurrentBlock=~/read/i) {
6018                        $NewInit_Desc{"Value"} = "0";
6019                    }
6020                    elsif($Init_Desc{"RetVal"}
6021                    and $TypeName=~/err/i) {
6022                        $NewInit_Desc{"Value"} = "1";
6023                    }
6024                    elsif($ParamName=~/socket|block/i) {
6025                        $NewInit_Desc{"Value"} = vary_values(["0"], \%Init_Desc);
6026                    }
6027                    elsif($ParamName=~/freq/i) {
6028                        $NewInit_Desc{"Value"} = vary_values(["50"], \%Init_Desc);
6029                    }
6030                    elsif(lc($ParamName) eq "id") {
6031                        $NewInit_Desc{"Value"} = "0";
6032                    }
6033                    elsif($ParamName=~/verbose/i) {
6034                        $NewInit_Desc{"Value"} = vary_values(["0", "1"], \%Init_Desc);
6035                    }
6036                    elsif($ParamName=~/year/i
6037                    or ($ParamName eq "y" and $I_ShortName=~/date/i)) {
6038                        $NewInit_Desc{"Value"} = vary_values(["2009", "2010"], \%Init_Desc);
6039                    }
6040                    elsif($ParamName eq "sa_family"
6041                    and get_TypeName($Init_Desc{"OuterType_Id"}) eq "struct sockaddr") {
6042                        $NewInit_Desc{"Value"} = vary_values(["AF_INET", "AF_INET6"], \%Init_Desc);
6043                    }
6044                    elsif($ParamName=~/day/i or ($ParamName eq "d" and $I_ShortName=~/date/i)) {
6045                        $NewInit_Desc{"Value"} = vary_values(["30", "17"], \%Init_Desc);
6046                    }
6047                    elsif($ParamName=~/month/i
6048                    or ($ParamName eq "m" and $I_ShortName=~/date/i)) {
6049                        $NewInit_Desc{"Value"} = vary_values(["11", "10"], \%Init_Desc);
6050                    }
6051                    elsif($ParamName=~/\Ac\Z/i and $I_ShortName=~/char/i) {
6052                        $NewInit_Desc{"Value"} = vary_values([get_CharNum()], \%Init_Desc);
6053                    }
6054                    elsif($ParamName=~/n_param_values/i) {
6055                        $NewInit_Desc{"Value"} = vary_values(["2"], \%Init_Desc);
6056                    }
6057                    elsif($ParamName=~/debug/i) {
6058                        $NewInit_Desc{"Value"} = vary_values(["0", "1"], \%Init_Desc);
6059                    }
6060                    elsif($ParamName=~/hook/i)
6061                    {
6062                        $NewInit_Desc{"Value"} = vary_values(["128"], \%Init_Desc);
6063                    }
6064                    elsif($ParamName=~/size|len|count/i
6065                    and $I_ShortName=~/char|string/i) {
6066                        $NewInit_Desc{"Value"} = vary_values(["7"], \%Init_Desc);
6067                    }
6068                    elsif($ParamName=~/size|len|capacity|count|max|(\A(n|l|s|c)_)/i) {
6069                        $NewInit_Desc{"Value"} = vary_values([$DEFAULT_ARRAY_AMOUNT], \%Init_Desc);
6070                    }
6071                    elsif($ParamName=~/time/i and $ParamName=~/req/i) {
6072                        $NewInit_Desc{"Value"} = vary_values([$HANGED_EXECUTION_TIME], \%Init_Desc);
6073                    }
6074                    elsif($ParamName=~/time/i
6075                    or ($ParamName=~/len/i and $ParamName!~/error/i)) {
6076                        $NewInit_Desc{"Value"} = vary_values(["1", "0"], \%Init_Desc);
6077                    }
6078                    elsif($ParamName=~/depth/i) {
6079                        $NewInit_Desc{"Value"} = vary_values(["1"], \%Init_Desc);
6080                    }
6081                    elsif($ParamName=~/delay/i) {
6082                        $NewInit_Desc{"Value"} = vary_values(["0", "1"], \%Init_Desc);
6083                    }
6084                    elsif($TypeName=~/(count|size)_t/i
6085                    and $ParamName=~/items/) {
6086                        $NewInit_Desc{"Value"} = vary_values([$DEFAULT_ARRAY_AMOUNT], \%Init_Desc);
6087                    }
6088                    elsif($ParamName=~/exists|start/i) {
6089                        $NewInit_Desc{"Value"} = vary_values(["0", "1"], \%Init_Desc);
6090                    }
6091                    elsif($ParamName=~/make/i) {
6092                        $NewInit_Desc{"Value"} = vary_values(["1", "0"], \%Init_Desc);
6093                    }
6094                    elsif($ParamName=~/\A(n|l|s|c)[0-9_]*\Z/i
6095                    # gsl_vector_complex_float_alloc (size_t const n)
6096                    # gsl_matrix_complex_float_alloc (size_t const n1, size_t const n2)
6097                    or (is_alloc_func($I_ShortName) and $ParamName=~/(num|len)[0-9_]*/i))
6098                    {
6099                        if($I_ShortName=~/column/) {
6100                            $NewInit_Desc{"Value"} = vary_values(["0"], \%Init_Desc);
6101                        }
6102                        else {
6103                            $NewInit_Desc{"Value"} = vary_values([$DEFAULT_ARRAY_AMOUNT], \%Init_Desc);
6104                        }
6105                    }
6106                    elsif($Init_Desc{"OuterType_Type"} eq "Array"
6107                    and $Init_Desc{"Index"} ne "") {
6108                        $NewInit_Desc{"Value"} = vary_values([$Init_Desc{"Index"}], \%Init_Desc);
6109                    }
6110                    elsif(($ParamName=~/index|from|pos|field|line|column|row/i and $ParamName!~/[a-z][a-rt-z]s\Z/i)
6111                    or $ParamName=~/\A(i|j|k|icol)\Z/i)
6112                    { # gsl_vector_complex_float_get (gsl_vector_complex_float const* v, size_t const i)
6113                        if($Init_Desc{"OuterType_Type"} eq "Array") {
6114                            $NewInit_Desc{"Value"} = vary_values([$Init_Desc{"Index"}], \%Init_Desc);
6115                        }
6116                        else {
6117                            $NewInit_Desc{"Value"} = vary_values(["0"], \%Init_Desc);
6118                        }
6119                    }
6120                    elsif($TypeName=~/bool/i) {
6121                        $NewInit_Desc{"Value"} = vary_values(["1", "0"], \%Init_Desc);
6122                    }
6123                    elsif($ParamName=~/with/i) {
6124                        $NewInit_Desc{"Value"} = vary_values(["1", "0"], \%Init_Desc);
6125                    }
6126                    elsif($ParamName=~/sign/i) {
6127                        $NewInit_Desc{"Value"} = vary_values(["1", "0"], \%Init_Desc);
6128                    }
6129                    elsif($ParamName=~/endian|order/i) {
6130                        $NewInit_Desc{"Value"} = vary_values(["1", "0"], \%Init_Desc);
6131                    }
6132                    elsif($ParamName=~/\A(w|width)\d*\Z/i
6133                    and $I_ShortName=~/display/i) {
6134                        $NewInit_Desc{"Value"} = vary_values(["640"], \%Init_Desc);
6135                    }
6136                    elsif($ParamName=~/\A(h|height)\d*\Z/i
6137                    and $I_ShortName=~/display/i) {
6138                        $NewInit_Desc{"Value"} = vary_values(["480"], \%Init_Desc);
6139                    }
6140                    elsif($ParamName=~/width|height/i
6141                    or $ParamName=~/\A(x|y|z|w|h)\d*\Z/i) {
6142                        $NewInit_Desc{"Value"} = vary_values([8 * getIntrinsicValue($FoundationTypeName)], \%Init_Desc);
6143                    }
6144                    elsif($ParamName=~/offset/i) {
6145                        $NewInit_Desc{"Value"} = vary_values(["8", "16"], \%Init_Desc);
6146                    }
6147                    elsif($ParamName=~/stride|step|spacing|iter|interval|move/i
6148                    or $ParamName=~/\A(to)\Z/) {
6149                        $NewInit_Desc{"Value"} = vary_values(["1"], \%Init_Desc);
6150                    }
6151                    elsif($ParamName=~/channels|frames/i and $I_ShortName=~/\Asnd_/i)
6152                    { # ALSA
6153                        $NewInit_Desc{"Value"} = vary_values([$DEFAULT_ARRAY_AMOUNT], \%Init_Desc);
6154                    }
6155                    elsif($ParamName=~/first/i and ($Init_Desc{"OuterType_Type"} eq "Struct" and get_TypeName($Init_Desc{"OuterType_Id"})=~/_snd_/i))
6156                    { # ALSA
6157                        $NewInit_Desc{"Value"} = vary_values([8 * getIntrinsicValue($FoundationTypeName)], \%Init_Desc);
6158                    }
6159                    elsif(isFD($TypeId, $ParamName))
6160                    {
6161                        $NewInit_Desc{"Value"} = vary_values(["open(TG_TEST_DATA_PLAIN_FILE, O_RDWR)"], \%Init_Desc);
6162                        $NewInit_Desc{"Headers"} = addHeaders(["sys/stat.h", "fcntl.h"], $NewInit_Desc{"Headers"});
6163                        $AuxHeaders{"sys/stat.h"}=1;
6164                        $NewInit_Desc{"InLine"}=0;
6165                        $AuxHeaders{"fcntl.h"}=1;
6166                        $FuncNames{"open"} = 1;
6167                    }
6168                    elsif(($TypeName=~/enum/i or $ParamName=~/message_type/i)
6169                    and my $EnumConstant = selectConstant($TypeName, $ParamName, $Interface))
6170                    { # or ($TypeName eq "int" and $ParamName=~/\Amode|type\Z/i and $I_ShortName=~/\Asnd_/i) or $ParamName=~/mask/
6171                        $NewInit_Desc{"Value"} = vary_values([$EnumConstant], \%Init_Desc);
6172                        $NewInit_Desc{"Headers"} = addHeaders([$Constants{$EnumConstant}{"Header"}], $NewInit_Desc{"Headers"});
6173                    }
6174                    elsif($TypeName=~/enum/i
6175                    or $ParamName=~/mode|type|flag|option/i) {
6176                        $NewInit_Desc{"Value"} = vary_values(["0"], \%Init_Desc);
6177                    }
6178                    elsif($ParamName=~/mask|alloc/i) {
6179                        $NewInit_Desc{"Value"} = vary_values(["0"], \%Init_Desc);
6180                    }
6181                    elsif($ParamName=~/screen|format/i) {
6182                        $NewInit_Desc{"Value"} = vary_values(["1"], \%Init_Desc);
6183                    }
6184                    elsif($ParamName=~/ed\Z/i) {
6185                        $NewInit_Desc{"Value"} = vary_values(["0"], \%Init_Desc);
6186                    }
6187                    elsif($ParamName=~/key/i
6188                    and $I_ShortName=~/\A[_]*X/)
6189                    { #X11
6190                        $NewInit_Desc{"Value"} = vary_values(["9"], \%Init_Desc);
6191                    }
6192                    elsif($ParamName=~/\Ap\d+\Z/
6193                    and $Init_Desc{"ParamPos"}==$Init_Desc{"MaxParamPos"}
6194                    and $I_ShortName=~/create|intern|privat/i) {
6195                        $NewInit_Desc{"Value"} = vary_values(["0"], \%Init_Desc);
6196                    }
6197                    elsif($TypeName=~/size/i) {
6198                        $NewInit_Desc{"Value"} = vary_values([$DEFAULT_ARRAY_AMOUNT], \%Init_Desc);
6199                    }
6200                    else {
6201                        $NewInit_Desc{"Value"} = vary_values([getIntrinsicValue($FoundationTypeName)], \%Init_Desc);
6202                    }
6203                }
6204                else {
6205                    $NewInit_Desc{"Value"} = "0";
6206                }
6207            }
6208            elsif(isCharType($FoundationTypeName)
6209            and $TypeName=~/bool/i) {
6210                $NewInit_Desc{"Value"} = vary_values([1, 0], \%Init_Desc);
6211            }
6212            else {
6213                $NewInit_Desc{"Value"} = vary_values([getIntrinsicValue($FoundationTypeName)], \%Init_Desc);
6214            }
6215            $NewInit_Desc{"ValueTypeId"} = ($PointerLevel==0)?$TypeId:$FoundationTypeId;
6216        }
6217        elsif($FoundationTypeType eq "Enum")
6218        {
6219            if(my $EnumMember = getSomeEnumMember($FoundationTypeId))
6220            {
6221                if(defined $Template2Code and $PointerLevel==0)
6222                {
6223                    my $Members = [];
6224                    foreach my $Member (@{getEnumMembers($FoundationTypeId)})
6225                    {
6226                        if(is_valid_constant($Member)) {
6227                            push(@{$Members}, $Member);
6228                        }
6229                    }
6230                    if($#{$Members}>=0) {
6231                        $NewInit_Desc{"Value"} = vary_values($Members, \%Init_Desc);
6232                    }
6233                    else {
6234                        $NewInit_Desc{"Value"} = vary_values(getEnumMembers($FoundationTypeId), \%Init_Desc);
6235                    }
6236                }
6237                else {
6238                    $NewInit_Desc{"Value"} = $EnumMember;
6239                }
6240            }
6241            else {
6242                $NewInit_Desc{"Value"} = "0";
6243            }
6244            $NewInit_Desc{"ValueTypeId"} = $FoundationTypeId;
6245        }
6246    }
6247    else
6248    {
6249        if(not $NewInit_Desc{"ValueTypeId"})
6250        { # for union spectypes
6251            $NewInit_Desc{"ValueTypeId"} = $TypeId;
6252        }
6253    }
6254    if($NewInit_Desc{"Value"} eq "")
6255    {
6256        $NewInit_Desc{"Value"} = "no value";
6257    }
6258    return %NewInit_Desc;
6259}
6260
6261sub is_valid_constant($)
6262{
6263    my $Constant = $_[0];
6264    return $Constant!~/(unknown|invalid|null|err|none|(_|\A)(ms|win\d*|no)(_|\Z))/i;
6265}
6266
6267sub get_CharNum()
6268{
6269    $IntrinsicNum{"Char"}=64 if($IntrinsicNum{"Char"} > 89 or $IntrinsicNum{"Char"} < 64);
6270    if($RandomCode) {
6271        $IntrinsicNum{"Char"} = 64+int(rand(25));
6272    }
6273    $IntrinsicNum{"Char"}+=1;
6274    return $IntrinsicNum{"Char"};
6275}
6276
6277sub vary_values($$)
6278{
6279    my ($ValuesArrayRef, $Init_Desc) = @_;
6280    my @ValuesArray = @{$ValuesArrayRef};
6281    return "" if($#ValuesArray==-1);
6282    if(defined $Template2Code and ($Init_Desc->{"Interface"} eq $TestedInterface) and not $Init_Desc->{"OuterType_Type"} and length($Init_Desc->{"ParamName"})>=2 and $Init_Desc->{"ParamName"}!~/\Ap\d+\Z/i)
6283    {
6284        my $Define = uc($Init_Desc->{"ParamName"});
6285        if(defined $Constants{$Define}) {
6286            $Define = "_".$Define;
6287        }
6288        $Define = select_var_name($Define, "");
6289        $Block_Variable{$CurrentBlock}{$Define} = 1;
6290        my $DefineWithNum = keys(%Template2Code_Defines).":".$Define;
6291        if($#ValuesArray>=1) {
6292            $Template2Code_Defines{$DefineWithNum} = "SET(".$ValuesArray[0]."; ".$ValuesArray[1].")";
6293        }
6294        else {
6295            $Template2Code_Defines{$DefineWithNum} = $ValuesArray[0];
6296        }
6297        return $Define;
6298    }
6299    else
6300    { # standalone
6301        return $ValuesArray[0];
6302    }
6303}
6304
6305sub selectConstant($$$)
6306{
6307    my ($TypeName, $ParamName, $Interface) = @_;
6308    return $Cache{"selectConstant"}{$TypeName}{$ParamName}{$Interface} if(defined $Cache{"selectConstant"}{$TypeName}{$ParamName}{$Interface});
6309    my @Csts = ();
6310    foreach (keys(%Constants))
6311    {
6312        if($Constants{$_}{"Value"}=~/\A\d/) {
6313            push(@Csts, $_);
6314        }
6315    }
6316    @Csts = sort @Csts;
6317    @Csts = sort {length($a)<=>length($b)} @Csts;
6318    @Csts = sort {$CompleteSignature{$Interface}{"Header"} cmp $Constants{$a}{"HeaderName"}} @Csts;
6319    my (@Valid, @Invalid) = ();
6320    foreach (@Csts)
6321    {
6322        if(is_valid_constant($_)) {
6323            push(@Valid, $_);
6324        }
6325        else {
6326            push(@Invalid, $_);
6327        }
6328    }
6329    @Csts = (@Valid, @Invalid);
6330    sort_byName(\@Csts, $ParamName." ".$CompleteSignature{$Interface}{"ShortName"}." ".$TypeName, "Constants");
6331    if($#Csts>=0)
6332    {
6333        $Cache{"selectConstant"}{$TypeName}{$ParamName}{$Interface} = $Csts[0];
6334        return $Csts[0];
6335    }
6336    else
6337    {
6338        $Cache{"selectConstant"}{$TypeName}{$ParamName}{$Interface} = "";
6339        return "";
6340    }
6341}
6342
6343sub isFD($$)
6344{
6345    my ($TypeId, $ParamName) = @_;
6346    my $FoundationTypeId = get_FoundationTypeId($TypeId);
6347    my $FoundationTypeName = get_TypeName($FoundationTypeId);
6348    if($ParamName=~/(\A|[_]+)fd(s|)\Z/i
6349    and isIntegerType($FoundationTypeName)) {
6350        return (-f "/usr/include/sys/stat.h" and -f "/usr/include/fcntl.h");
6351    }
6352    else {
6353        return "";
6354    }
6355}
6356
6357sub find_similar_type($$)
6358{
6359    my ($TypeId, $ParamName) = @_;
6360    return 0 if(not $TypeId or not $ParamName);
6361    return 0 if($ParamName=~/\A(p\d+|data|object)\Z/i or length($ParamName)<=2 or is_out_word($ParamName));
6362    return $Cache{"find_similar_type"}{$TypeId}{$ParamName} if(defined $Cache{"find_similar_type"}{$TypeId}{$ParamName} and not defined $AuxType{$TypeId});
6363    my $PointerLevel = get_PointerLevel($TypeId);
6364    $ParamName=~s/([a-z][a-df-rt-z])s\Z/$1/i;
6365    my @TypeNames = ();
6366    foreach my $TypeName (keys(%StructUnionPName_Tid))
6367    {
6368        if($TypeName=~/\Q$ParamName\E/i)
6369        {
6370            my $Tid = $StructUnionPName_Tid{$TypeName};
6371            next if(not $Tid);
6372            my $FTid = get_FoundationTypeId($Tid);
6373            next if(get_TypeType($FTid)!~/\A(Struct|Union)\Z/);
6374            next if(isOpaque($FTid) and not keys(%{$ReturnTypeId_Interface{$Tid}}));
6375            next if(get_PointerLevel($Tid)!=$PointerLevel);
6376            push(@TypeNames, $TypeName);
6377        }
6378    }
6379    @TypeNames = sort {lc($a) cmp lc($b)} @TypeNames;
6380    @TypeNames = sort {length($a)<=>length($b)} @TypeNames;
6381    @TypeNames = sort {$a=~/\*/<=>$b=~/\*/} @TypeNames;
6382    # @TypeNames = sort {keys(%{$ReturnTypeId_Interface{$TName_Tid{$b}}})<=>keys(%{$ReturnTypeId_Interface{$TName_Tid{$a}}})} @TypeNames;
6383    if($#TypeNames>=0)
6384    {
6385        $Cache{"find_similar_type"}{$TypeId}{$ParamName} = $TName_Tid{$TypeNames[0]};
6386        return $StructUnionPName_Tid{$TypeNames[0]};
6387    }
6388    else
6389    {
6390        $Cache{"find_similar_type"}{$TypeId}{$ParamName} = 0;
6391        return 0;
6392    }
6393}
6394
6395sub isCyclical($$)
6396{
6397    return (grep {$_ eq $_[1]} @{$_[0]});
6398}
6399
6400sub convertTypes(@)
6401{
6402    my %Conv = @_;
6403    return () if(not $Conv{"OutputTypeId"} or not $Conv{"InputTypeName"} or not $Conv{"Value"} or not $Conv{"Key"});
6404    my $OutputType_PointerLevel = get_PointerLevel($Conv{"OutputTypeId"});
6405    my $OutputType_Name = get_TypeName($Conv{"OutputTypeId"});
6406    my $OutputFType_Id = get_FoundationTypeId($Conv{"OutputTypeId"});
6407    my $OutputType_BaseTypeType = get_TypeType($OutputFType_Id);
6408    my $PLevelDelta = $OutputType_PointerLevel - $Conv{"InputPointerLevel"};
6409    return ($Conv{"Value"}, "") if($OutputType_Name eq "...");
6410    my $Tmp_Var = $Conv{"Key"};
6411    $Tmp_Var .= ($Conv{"Destination"} eq "Target")?"_tp":"_p";
6412    my $NeedTypeConvertion = 0;
6413    my ($Preamble, $ToCall) = ();
6414    # pointer convertion
6415    if($PLevelDelta==0) {
6416        $ToCall = $Conv{"Value"};
6417    }
6418    elsif($PLevelDelta==1)
6419    {
6420        if($Conv{"Value"}=~/\A\&/)
6421        {
6422            $Preamble .= $Conv{"InputTypeName"}." $Tmp_Var = (".$Conv{"InputTypeName"}.")".$Conv{"Value"}.";\n";
6423            $Block_Variable{$CurrentBlock}{$Tmp_Var} = 1;
6424            $ToCall = "&".$Tmp_Var;
6425        }
6426        else {
6427            $ToCall = "&".$Conv{"Value"};
6428        }
6429    }
6430    elsif($PLevelDelta<0)
6431    {
6432        foreach (0 .. - 1 - $PLevelDelta) {
6433            $ToCall = $ToCall."*";
6434        }
6435        $ToCall = $ToCall.$Conv{"Value"};
6436    }
6437    else
6438    { # this section must be deprecated in future
6439        my $Stars = "**";
6440        if($Conv{"Value"}=~/\A\&/)
6441        {
6442            $Preamble .= $Conv{"InputTypeName"}." $Tmp_Var = (".$Conv{"InputTypeName"}.")".$Conv{"Value"}.";\n";
6443            $Block_Variable{$CurrentBlock}{$Tmp_Var} = 1;
6444            $Conv{"Value"} = $Tmp_Var;
6445            $Tmp_Var .= "p";
6446        }
6447        $Preamble .= $Conv{"InputTypeName"}." *$Tmp_Var = (".$Conv{"InputTypeName"}." *)&".$Conv{"Value"}.";\n";
6448        $Block_Variable{$CurrentBlock}{$Tmp_Var} = 1;
6449        my $Tmp_Var_Pre = $Tmp_Var;
6450        foreach my $Itr (1 .. $PLevelDelta - 1)
6451        {
6452            $Tmp_Var .= "p";
6453            $Block_Variable{$CurrentBlock}{$Tmp_Var} = 1;
6454            $Preamble .= $Conv{"InputTypeName"}." $Stars$Tmp_Var = &$Tmp_Var_Pre;\n";
6455            $Stars .= "*";
6456            $NeedTypeConvertion = 1;
6457            $Tmp_Var_Pre = $Tmp_Var;
6458            $ToCall = $Tmp_Var;
6459        }
6460    }
6461    $Preamble .= "\n" if($Preamble);
6462
6463    $NeedTypeConvertion = 1 if(get_base_type_name($OutputType_Name) ne get_base_type_name($Conv{"InputTypeName"}));
6464    $NeedTypeConvertion = 1 if(not is_equal_types($OutputType_Name,$Conv{"InputTypeName"}) and $PLevelDelta==0);
6465    $NeedTypeConvertion = 1 if(not is_const_type($OutputType_Name) and is_const_type($Conv{"InputTypeName"}));
6466    $NeedTypeConvertion = 0 if(($OutputType_PointerLevel eq 0) and (($OutputType_BaseTypeType eq "Class") or ($OutputType_BaseTypeType eq "Struct")));
6467    $NeedTypeConvertion = 1 if((($OutputType_Name=~/\&/) or $Conv{"MustConvert"}) and ($OutputType_PointerLevel > 0) and (($OutputType_BaseTypeType eq "Class") or ($OutputType_BaseTypeType eq "Struct")));
6468    $NeedTypeConvertion = 1 if($OutputType_PointerLevel eq 2);
6469    $NeedTypeConvertion = 0 if($OutputType_Name eq $Conv{"InputTypeName"});
6470    $NeedTypeConvertion = 0 if(uncover_typedefs($OutputType_Name)=~/\[(\d+|)\]/); # arrays
6471    $NeedTypeConvertion = 0 if(isAnon($OutputType_Name));
6472
6473    # type convertion
6474    if($NeedTypeConvertion and ($Conv{"Destination"} eq "Param"))
6475    {
6476        if($ToCall=~/\-\>/) {
6477            $ToCall = "(".$OutputType_Name.")"."(".$ToCall.")";
6478        }
6479        else {
6480            $ToCall = "(".$OutputType_Name.")".$ToCall;
6481        }
6482    }
6483    return ($ToCall, $Preamble);
6484}
6485
6486sub sortTypes_ByPLevel($$)
6487{
6488    my ($Types, $PLevel) = @_;
6489    my (@Eq, @Lt, @Gt) = ();
6490    foreach my $TypeId (@{$Types})
6491    {
6492        my $Type_PLevel = get_PointerLevel($TypeId);
6493        if($Type_PLevel==$PLevel) {
6494            push(@Eq, $TypeId);
6495        }
6496        elsif($Type_PLevel<$PLevel) {
6497            push(@Lt, $TypeId);
6498        }
6499        elsif($Type_PLevel>$PLevel) {
6500            push(@Gt, $TypeId);
6501        }
6502    }
6503    @{$Types} = (@Eq, @Lt, @Gt);
6504}
6505
6506sub familyTypes($)
6507{
6508    my $TypeId = $_[0];
6509    return [] if(not $TypeId);
6510    my $FoundationTypeId = get_FoundationTypeId($TypeId);
6511    return $Cache{"familyTypes"}{$TypeId} if($Cache{"familyTypes"}{$TypeId} and not defined $AuxType{$TypeId});
6512    my (@FamilyTypes_Const, @FamilyTypes_NotConst) = ();
6513    foreach my $Tid (sort {int($a)<=>int($b)} keys(%TypeInfo))
6514    {
6515        if((get_FoundationTypeId($Tid) eq $FoundationTypeId) and ($Tid ne $TypeId))
6516        {
6517            if(is_const_type(get_TypeName($Tid))) {
6518                @FamilyTypes_Const = (@FamilyTypes_Const, $Tid);
6519            }
6520            else {
6521                @FamilyTypes_NotConst = (@FamilyTypes_NotConst, $Tid);
6522            }
6523        }
6524    }
6525    sortTypes_ByPLevel(\@FamilyTypes_Const, get_PointerLevel($TypeId));
6526    sortTypes_ByPLevel(\@FamilyTypes_NotConst, get_PointerLevel($TypeId));
6527    my @FamilyTypes = ((is_const_type(get_TypeName($TypeId)))?(@FamilyTypes_NotConst, $TypeId, @FamilyTypes_Const):($TypeId, @FamilyTypes_NotConst, @FamilyTypes_Const));
6528    $Cache{"familyTypes"}{$TypeId} = \@FamilyTypes;
6529    return \@FamilyTypes;
6530}
6531
6532sub register_ExtType($$$)
6533{
6534    my ($Type_Name, $Type_Type, $BaseTypeId) = @_;
6535    return "" if(not $Type_Name or not $Type_Type or not $BaseTypeId);
6536    return $TName_Tid{$Type_Name} if($TName_Tid{$Type_Name});
6537    $MaxTypeId += 1;
6538    $TName_Tid{$Type_Name} = $MaxTypeId;
6539    %{$TypeInfo{$MaxTypeId}}=(
6540        "Name" => $Type_Name,
6541        "Type" => $Type_Type,
6542        "BaseType" => $BaseTypeId,
6543        "Tid" => $MaxTypeId,
6544        "Headers"=>getTypeHeaders($BaseTypeId)
6545    );
6546    $AuxType{$MaxTypeId} = $Type_Name;
6547    return $MaxTypeId;
6548}
6549
6550
6551sub get_ExtTypeId($$)
6552{
6553    my ($Key, $TypeId) = @_;
6554    return () if(not $TypeId);
6555    my ($Declarations, $Headers) = ("", []);
6556    if(get_TypeType($TypeId) eq "Typedef") {
6557        return ($TypeId, "", "");
6558    }
6559    my $FTypeId = get_FoundationTypeId($TypeId);
6560    my %BaseType = goToFirst($TypeId, "Typedef");
6561    my $BaseTypeId = $BaseType{"Tid"};
6562    if(not $BaseTypeId)
6563    {
6564        $BaseTypeId = $FTypeId;
6565        if(get_TypeName($BaseTypeId)=~/\Astd::/)
6566        {
6567            if(my $CxxTypedefId = get_type_typedef($BaseTypeId)) {
6568                $BaseTypeId = $CxxTypedefId;
6569            }
6570        }
6571    }
6572    my $PointerLevel = get_PointerLevel($TypeId) - get_PointerLevel($BaseTypeId);
6573    if(get_TypeType($FTypeId) eq "Array")
6574    {
6575        my ($Array_BaseName, $Array_Length) = reassemble_array($FTypeId);
6576        $BaseTypeId = get_TypeIdByName($Array_BaseName);
6577        $PointerLevel+=1;
6578    }
6579    my $BaseTypeName = get_TypeName($BaseTypeId);
6580    my $BaseTypeType = get_TypeType($BaseTypeId);
6581    if($BaseTypeType eq "FuncPtr") {
6582        $Declarations .= declare_funcptr_typedef($Key, $BaseTypeId);
6583    }
6584    if(isAnon($BaseTypeName))
6585    {
6586        if($BaseTypeType eq "Struct")
6587        {
6588            my ($AnonStruct_Declarations, $AnonStruct_Headers) = declare_anon_struct($Key, $BaseTypeId);
6589            $Declarations .= $AnonStruct_Declarations;
6590            $Headers = addHeaders($AnonStruct_Headers, $Headers);
6591        }
6592        elsif($BaseTypeType eq "Union")
6593        {
6594            my ($AnonUnion_Declarations, $AnonUnion_Headers) = declare_anon_union($Key, $BaseTypeId);
6595            $Declarations .= $AnonUnion_Declarations;
6596            $Headers = addHeaders($AnonUnion_Headers, $Headers);
6597        }
6598    }
6599    if($PointerLevel>=1)
6600    {
6601#         if(get_TypeType(get_FoundationTypeId($TypeId)) eq "FuncPtr" and get_TypeName($TypeId)=~/\A[^*]+const\W/)
6602#         {
6603#             $BaseTypeId = register_ExtType(get_TypeName($BaseTypeId)." const", "Const", $BaseTypeId);
6604#         }
6605
6606        my $ExtTypeId = register_new_type($BaseTypeId, $PointerLevel);
6607        return ($ExtTypeId, $Declarations, $Headers);
6608    }
6609    else {
6610        return ($BaseTypeId, $Declarations, $Headers);
6611    }
6612}
6613
6614sub register_new_type($$)
6615{
6616    my ($BaseTypeId, $PLevel) = @_;
6617    my $ExtTypeName = get_TypeName($BaseTypeId);
6618    my $ExtTypeId = $BaseTypeId;
6619    foreach (1 .. $PLevel)
6620    {
6621        $ExtTypeName .= "*";
6622        $ExtTypeName = formatName($ExtTypeName, "T");
6623        if(not $TName_Tid{$ExtTypeName}) {
6624            register_ExtType($ExtTypeName, "Pointer", $ExtTypeId);
6625        }
6626        $ExtTypeId = $TName_Tid{$ExtTypeName};
6627    }
6628    return $ExtTypeId;
6629}
6630
6631sub correct_init_stmt($$$)
6632{
6633    my ($String, $TypeName, $ParamName) = @_;
6634    my $Stmt = $TypeName." ".$ParamName." = ".$TypeName;
6635    if($String=~/\Q$Stmt\E\:\:/) {
6636        return $String;
6637    }
6638    else
6639    {
6640        $String=~s/(\W|\A)\Q$Stmt\E\(\)(\W|\Z)/$1$TypeName $ParamName$2/g;
6641        $String=~s/(\W|\A)\Q$Stmt\E(\W|\Z)/$1$TypeName $ParamName$2/g;
6642        return $String;
6643    }
6644}
6645
6646sub isValidConv($)
6647{
6648    return ($_[0]!~/\A(__va_list_tag|...)\Z/);
6649}
6650
6651sub emptyDeclaration(@)
6652{
6653    my %Init_Desc = @_;
6654    my %Type_Init = ();
6655    $Init_Desc{"Var"} = select_var_name($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $Init_Desc{"ParamNameExt"});
6656    my $Var = $Init_Desc{"Var"};
6657    my $InitTypeId = $Init_Desc{"ValueTypeId"};
6658    if(not $InitTypeId) {
6659        $InitTypeId = $Init_Desc{"TypeId"};
6660    }
6661    my $InitializedType_PLevel = get_PointerLevel($InitTypeId);
6662    my ($ETypeId, $Declarations, $Headers) = get_ExtTypeId($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $InitTypeId);
6663    my $InitializedType_Name = get_TypeName($ETypeId);
6664    if($InitializedType_Name eq "void") {
6665        $InitializedType_Name = "int";
6666    }
6667    $Type_Init{"Code"} .= $Declarations;
6668    $Type_Init{"Headers"} = addHeaders($Headers, $Type_Init{"Headers"});
6669    $Type_Init{"Headers"} = addHeaders($Headers, getTypeHeaders($ETypeId));
6670    $Type_Init{"Headers"} = addHeaders($Headers, getTypeHeaders(get_FoundationTypeId($ETypeId))) if($InitializedType_PLevel==0);
6671    $Type_Init{"Init"} = $InitializedType_Name." ".$Var.";\n";
6672    $Block_Variable{$CurrentBlock}{$Var} = 1;
6673    # create call
6674    my ($Call, $Preamble) = convertTypes((
6675        "InputTypeName"=>$InitializedType_Name,
6676        "InputPointerLevel"=>$InitializedType_PLevel,
6677        "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
6678        "Value"=>$Var,
6679        "Key"=>$Var,
6680        "Destination"=>"Param",
6681        "MustConvert"=>0));
6682    $Type_Init{"Init"} .= $Preamble;
6683    $Type_Init{"Call"} = $Call;
6684    # call to constraint
6685    if($Init_Desc{"TargetTypeId"}==$Init_Desc{"TypeId"}) {
6686        $Type_Init{"TargetCall"} = $Type_Init{"Call"};
6687    }
6688    else
6689    {
6690        my ($TargetCall, $TargetPreamble) =
6691        convertTypes((
6692            "InputTypeName"=>$InitializedType_Name,
6693            "InputPointerLevel"=>$InitializedType_PLevel,
6694            "OutputTypeId"=>$Init_Desc{"TargetTypeId"},
6695            "Value"=>$Var,
6696            "Key"=>$Var,
6697            "Destination"=>"Target",
6698            "MustConvert"=>0));
6699        $Type_Init{"TargetCall"} = $TargetCall;
6700        $Type_Init{"Init"} .= $TargetPreamble;
6701    }
6702    $Type_Init{"IsCorrect"} = 1;
6703    return %Type_Init;
6704}
6705
6706sub initializeByValue(@)
6707{
6708    my %Init_Desc = @_;
6709    return () if($Init_Desc{"DoNotAssembly"} and $Init_Desc{"ByNull"});
6710    my %Type_Init = ();
6711    $Init_Desc{"InLine"} = 1 if($Init_Desc{"Value"}=~/\$\d+/);
6712    my $TName_Trivial = get_TypeName($Init_Desc{"TypeId"});
6713    $TName_Trivial=~s/&//g;
6714    my $FoundationType_Id = get_FoundationTypeId($Init_Desc{"TypeId"});
6715    # $Type_Init{"Headers"} = addHeaders(getTypeHeaders($FoundationType_Id), $Type_Init{"Headers"});
6716    $Type_Init{"Headers"} = addHeaders(getTypeHeaders($Init_Desc{"TypeId"}), $Type_Init{"Headers"});
6717    if(uncover_typedefs(get_TypeName($Init_Desc{"TypeId"}))=~/\&/
6718    and $Init_Desc{"OuterType_Type"}=~/\A(Struct|Union|Array)\Z/) {
6719        $Init_Desc{"InLine"} = 0;
6720    }
6721    my $FoundationType_Name = get_TypeName($FoundationType_Id);
6722    my $FoundationType_Type = get_TypeType($FoundationType_Id);
6723    my $PointerLevel = get_PointerLevel($Init_Desc{"TypeId"});
6724    my $Target_PointerLevel = get_PointerLevel($Init_Desc{"TargetTypeId"});
6725    if($FoundationType_Name eq "...")
6726    {
6727        $PointerLevel = get_PointerLevel($Init_Desc{"ValueTypeId"});
6728        $Target_PointerLevel = $PointerLevel;
6729    }
6730    my $Value_PointerLevel = get_PointerLevel($Init_Desc{"ValueTypeId"});
6731    return () if(not $Init_Desc{"ValueTypeId"} or $Init_Desc{"Value"} eq "");
6732    $Init_Desc{"Var"} = select_var_name($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $Init_Desc{"ParamNameExt"});
6733    my $Var = $Init_Desc{"Var"};
6734    my ($Value_ETypeId, $Declarations, $Headers) = get_ExtTypeId($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $Init_Desc{"ValueTypeId"});
6735    my $Value_ETypeName = get_TypeName($Value_ETypeId);
6736    $Type_Init{"Code"} .= $Declarations;
6737    $Type_Init{"Headers"} = addHeaders($Headers, $Type_Init{"Headers"});
6738    if($FoundationType_Type eq "Class")
6739    { # classes
6740        my ($ChildCreated, $CallDestructor) = (0, 1);
6741        if(my $ValueClass = getValueClass($Init_Desc{"Value"}) and $Target_PointerLevel eq 0)
6742        { # class object construction by constructor in value
6743            if($FoundationType_Name eq $ValueClass)
6744            {
6745                if(isAbstractClass($FoundationType_Id) or $Init_Desc{"CreateChild"})
6746                { # when don't know constructor in value, so declaring all in the child
6747                    my $ChildClassName = getSubClassName($FoundationType_Name);
6748                    my $FoundationChildName = getSubClassName($FoundationType_Name);
6749                    $ChildCreated = 1;
6750                    if($Init_Desc{"Value"}=~/\Q$FoundationType_Name\E/
6751                    and $Init_Desc{"Value"}!~/\Q$ChildClassName\E/) {
6752                        substr($Init_Desc{"Value"}, index($Init_Desc{"Value"}, $FoundationType_Name), pos($FoundationType_Name) + length($FoundationType_Name)) = $FoundationChildName;
6753                    }
6754                    $IntSubClass{$TestedInterface}{$FoundationType_Id} = 1;
6755                    $Create_SubClass{$FoundationType_Id} = 1;
6756                    foreach my $ClassConstructor (getClassConstructors($FoundationType_Id)) {
6757                        $UsedConstructors{$FoundationType_Id}{$ClassConstructor} = 1;
6758                    }
6759                    $FoundationType_Name = $ChildClassName;
6760                }
6761            }
6762            else
6763            { # new class
6764                $FoundationType_Name = $ValueClass;
6765            }
6766            if($Init_Desc{"InLine"} and ($PointerLevel eq 0))
6767            {
6768                $Type_Init{"Call"} = $Init_Desc{"Value"};
6769                $CallDestructor = 0;
6770            }
6771            else
6772            {
6773                $Block_Variable{$CurrentBlock}{$Var} = 1;
6774                if(not defined $DisableReuse) {
6775                    $ValueCollection{$CurrentBlock}{$Var} = $FoundationType_Id;
6776                }
6777                $Type_Init{"Init"} .= $FoundationType_Name." $Var = ".$Init_Desc{"Value"}.";".($Init_Desc{"ByNull"}?" //can't initialize":"")."\n";
6778                $Type_Init{"Headers"} = addHeaders(getTypeHeaders($FoundationType_Id), $Type_Init{"Headers"});
6779                $Type_Init{"Init"} = correct_init_stmt($Type_Init{"Init"}, $FoundationType_Name, $Var);
6780                my ($Call, $TmpPreamble) =
6781                convertTypes((
6782                    "InputTypeName"=>$FoundationType_Name,
6783                    "InputPointerLevel"=>$Value_PointerLevel,
6784                    "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
6785                    "Value"=>$Var,
6786                    "Key"=>$Var,
6787                    "Destination"=>"Param",
6788                    "MustConvert"=>0));
6789                $Type_Init{"Init"} .= $TmpPreamble;
6790                $Type_Init{"Call"} = $Call;
6791            }
6792        }
6793        else
6794        { # class object returned by some interface in value
6795            if($Init_Desc{"CreateChild"})
6796            {
6797                $ChildCreated = 1;
6798                my $FoundationChildName = getSubClassName($FoundationType_Name);
6799                my $TNameChild = $TName_Trivial;
6800                substr($Value_ETypeName, index($Value_ETypeName, $FoundationType_Name), pos($FoundationType_Name) + length($FoundationType_Name)) = $FoundationChildName;
6801                substr($TNameChild, index($TNameChild, $FoundationType_Name), pos($FoundationType_Name) + length($FoundationType_Name)) = $FoundationChildName;
6802                $IntSubClass{$TestedInterface}{$FoundationType_Id} = 1;
6803                $Create_SubClass{$FoundationType_Id} = 1;
6804                if($Value_PointerLevel==0
6805                and my $SomeConstructor = getSomeConstructor($FoundationType_Id)) {
6806                    $UsedConstructors{$FoundationType_Id}{$SomeConstructor} = 1;
6807                }
6808                if($Init_Desc{"InLine"} and ($PointerLevel eq $Value_PointerLevel))
6809                {
6810                    if($Init_Desc{"Value"} eq "NULL"
6811                    or $Init_Desc{"Value"} eq "0") {
6812                        $Type_Init{"Call"} = "($TNameChild) ".$Init_Desc{"Value"};
6813                    }
6814                    else
6815                    {
6816                        my ($Call, $TmpPreamble) =
6817                        convertTypes((
6818                            "InputTypeName"=>get_TypeName($Init_Desc{"ValueTypeId"}),
6819                            "InputPointerLevel"=>$Value_PointerLevel,
6820                            "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
6821                            "Value"=>$Init_Desc{"Value"},
6822                            "Key"=>$LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"},
6823                            "Destination"=>"Param",
6824                            "MustConvert"=>1));
6825                        $Type_Init{"Call"} = $Call;
6826                        $Type_Init{"Init"} .= $TmpPreamble;
6827                    }
6828                    $CallDestructor = 0;
6829                }
6830                else
6831                {
6832                    $Block_Variable{$CurrentBlock}{$Var} = 1;
6833                    if((not defined $DisableReuse and ($Init_Desc{"Value"} ne "NULL") and ($Init_Desc{"Value"} ne "0"))
6834                    or $Init_Desc{"ByNull"} or $Init_Desc{"UseableValue"}) {
6835                        $ValueCollection{$CurrentBlock}{$Var} = $Value_ETypeId;
6836                    }
6837                    $Type_Init{"Init"} .= $Value_ETypeName." $Var = ($Value_ETypeName)".$Init_Desc{"Value"}.";".($Init_Desc{"ByNull"}?" //can't initialize":"")."\n";
6838                    $Type_Init{"Headers"} = addHeaders(getTypeHeaders($Value_ETypeId), $Type_Init{"Headers"});
6839                    my ($Call, $TmpPreamble) =
6840                    convertTypes((
6841                        "InputTypeName"=>$Value_ETypeName,
6842                        "InputPointerLevel"=>$Value_PointerLevel,
6843                        "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
6844                        "Value"=>$Var,
6845                        "Key"=>$Var,
6846                        "Destination"=>"Param",
6847                        "MustConvert"=>0));
6848                    $Type_Init{"Init"} .= $TmpPreamble;
6849                    $Type_Init{"Call"} = $Call;
6850                }
6851            }
6852            else
6853            {
6854                if($Init_Desc{"InLine"} and $PointerLevel eq $Value_PointerLevel)
6855                {
6856                    if($Init_Desc{"Value"} eq "NULL"
6857                    or $Init_Desc{"Value"} eq "0") {
6858                        $Type_Init{"Call"} = "($TName_Trivial) ".$Init_Desc{"Value"};
6859                        $CallDestructor = 0;
6860                    }
6861                    else
6862                    {
6863                        $CallDestructor = 0;
6864                        my ($Call, $TmpPreamble) =
6865                        convertTypes((
6866                            "InputTypeName"=>get_TypeName($Init_Desc{"ValueTypeId"}),
6867                            "InputPointerLevel"=>$Value_PointerLevel,
6868                            "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
6869                            "Value"=>$Init_Desc{"Value"},
6870                            "Key"=>$LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"},
6871                            "Destination"=>"Param",
6872                            "MustConvert"=>1));
6873                        $Type_Init{"Call"} = $Call;
6874                        $Type_Init{"Init"} .= $TmpPreamble;
6875                    }
6876                }
6877                else
6878                {
6879                    $Block_Variable{$CurrentBlock}{$Var} = 1;
6880                    if((not defined $DisableReuse and $Init_Desc{"Value"} ne "NULL" and $Init_Desc{"Value"} ne "0")
6881                    or $Init_Desc{"ByNull"} or $Init_Desc{"UseableValue"}) {
6882                        $ValueCollection{$CurrentBlock}{$Var} = $Value_ETypeId;
6883                    }
6884                    $Type_Init{"Init"} .= $Value_ETypeName." $Var = ".$Init_Desc{"Value"}.";".($Init_Desc{"ByNull"}?" //can't initialize":"")."\n";
6885                    $Type_Init{"Headers"} = addHeaders(getTypeHeaders($Value_ETypeId), $Type_Init{"Headers"});
6886                    my ($Call, $TmpPreamble) =
6887                    convertTypes((
6888                        "InputTypeName"=>$Value_ETypeName,
6889                        "InputPointerLevel"=>$Value_PointerLevel,
6890                        "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
6891                        "Value"=>$Var,
6892                        "Key"=>$Var,
6893                        "Destination"=>"Param",
6894                        "MustConvert"=>0));
6895                    $Type_Init{"Init"} .= $TmpPreamble;
6896                    $Type_Init{"Call"} = $Call;
6897                }
6898            }
6899        }
6900
6901        # create destructor call for class object
6902        if($CallDestructor and
6903        ((has_public_destructor($FoundationType_Id, "D2") and $ChildCreated) or
6904        (has_public_destructor($FoundationType_Id, "D0") and not $ChildCreated)) )
6905        {
6906            if($Value_PointerLevel > 0)
6907            {
6908                if($Value_PointerLevel eq 1) {
6909                    $Type_Init{"Destructors"} .= "delete($Var);\n";
6910                }
6911                else
6912                {
6913                    $Type_Init{"Destructors"} .= "delete(";
6914                    foreach (0 .. $Value_PointerLevel - 2) {
6915                        $Type_Init{"Destructors"} .= "*";
6916                    }
6917                    $Type_Init{"Destructors"} .= $Var.");\n";
6918                }
6919            }
6920        }
6921    }
6922    else
6923    { # intrinsics, structs
6924        if($Init_Desc{"InLine"} and ($PointerLevel eq $Value_PointerLevel))
6925        {
6926            if(($Init_Desc{"Value"} eq "NULL") or ($Init_Desc{"Value"} eq "0"))
6927            {
6928                if((getSymLang($TestedInterface) eq "C++" or $Init_Desc{"StrongConvert"})
6929                and isValidConv($TName_Trivial) and ($Init_Desc{"OuterType_Type"} ne "Array"))
6930                {
6931                    $Type_Init{"Call"} = "($TName_Trivial) ".$Init_Desc{"Value"};
6932                }
6933                else
6934                {
6935                    $Type_Init{"Call"} = $Init_Desc{"Value"};
6936                }
6937            }
6938            else
6939            {
6940                if((not is_equal_types(get_TypeName($Init_Desc{"TypeId"}), get_TypeName($Init_Desc{"ValueTypeId"})) or $Init_Desc{"StrongConvert"}) and isValidConv($TName_Trivial))
6941                {
6942                    $Type_Init{"Call"} = "($TName_Trivial) ".$Init_Desc{"Value"};
6943                }
6944                else
6945                {
6946                    $Type_Init{"Call"} = $Init_Desc{"Value"};
6947                }
6948            }
6949        }
6950        else
6951        {
6952            $Block_Variable{$CurrentBlock}{$Var} = 1;
6953            if((not defined $DisableReuse and ($Init_Desc{"Value"} ne "NULL") and ($Init_Desc{"Value"} ne "0"))
6954            or $Init_Desc{"ByNull"} or $Init_Desc{"UseableValue"})
6955            {
6956                $ValueCollection{$CurrentBlock}{$Var} = $Value_ETypeId;
6957            }
6958            $Type_Init{"Init"} .= $Value_ETypeName." $Var = ".$Init_Desc{"Value"}.";".($Init_Desc{"ByNull"}?" //can't initialize":"")."\n";
6959            $Type_Init{"Headers"} = addHeaders(getTypeHeaders($Value_ETypeId), $Type_Init{"Headers"});
6960            my ($Call, $TmpPreamble) =
6961            convertTypes((
6962                "InputTypeName"=>$Value_ETypeName,
6963                "InputPointerLevel"=>$Value_PointerLevel,
6964                "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
6965                "Value"=>$Var,
6966                "Key"=>$Var,
6967                "Destination"=>"Param",
6968                "MustConvert"=>$Init_Desc{"StrongConvert"}));
6969            $Type_Init{"Init"} .= $TmpPreamble;
6970            $Type_Init{"Call"} = $Call;
6971        }
6972    }
6973    # call to constraint
6974    if($Init_Desc{"TargetTypeId"}==$Init_Desc{"TypeId"})
6975    {
6976        $Type_Init{"TargetCall"} = $Type_Init{"Call"};
6977    }
6978    else
6979    {
6980        my ($TargetCall, $TargetPreamble) =
6981        convertTypes((
6982            "InputTypeName"=>$Value_ETypeName,
6983            "InputPointerLevel"=>$Value_PointerLevel,
6984            "OutputTypeId"=>$Init_Desc{"TargetTypeId"},
6985            "Value"=>$Var,
6986            "Key"=>$Var,
6987            "Destination"=>"Target",
6988            "MustConvert"=>0));
6989        $Type_Init{"TargetCall"} = $TargetCall;
6990        $Type_Init{"Init"} .= $TargetPreamble;
6991    }
6992    if(get_TypeType($Init_Desc{"TypeId"}) eq "Ref")
6993    { # ref handler
6994        my $BaseRefId = get_OneStep_BaseTypeId($Init_Desc{"TypeId"});
6995        my $BaseRefName = get_TypeName($BaseRefId);
6996        if(get_PointerLevel($BaseRefId) > $Value_PointerLevel)
6997        {
6998            $Type_Init{"Init"} .= $BaseRefName." ".$Var."_ref = ".$Type_Init{"Call"}.";\n";
6999            $Type_Init{"Call"} = $Var."_ref";
7000            $Block_Variable{$CurrentBlock}{$Var."_ref"} = 1;
7001            if(not defined $DisableReuse and ($Init_Desc{"Value"} ne "NULL") and ($Init_Desc{"Value"} ne "0"))
7002            {
7003                $ValueCollection{$CurrentBlock}{$Var."_ref"} = $Init_Desc{"TypeId"};
7004            }
7005        }
7006    }
7007    $Type_Init{"Code"} = $Type_Init{"Code"};
7008    $Type_Init{"IsCorrect"} = 1;
7009    $Type_Init{"ByNull"} = 1 if($Init_Desc{"ByNull"});
7010    return %Type_Init;
7011}
7012
7013sub remove_quals($)
7014{
7015    my $Type_Name = $_[0];
7016    $Type_Name=~s/ (const|volatile|restrict)\Z//g;
7017    $Type_Name=~s/\A(const|volatile|restrict) //g;
7018    while($Type_Name=~s/(\W|\A|>)(const|volatile|restrict)(\W([^<>()]+|)|)\Z/$1$3/g){};
7019    return formatName($Type_Name, "T");
7020}
7021
7022sub is_equal_types($$)
7023{
7024    my ($Type1_Name, $Type2_Name) = @_;
7025    return (remove_quals(uncover_typedefs($Type1_Name)) eq
7026            remove_quals(uncover_typedefs($Type2_Name)));
7027}
7028
7029sub get_base_type_name($)
7030{
7031    my $Type_Name = $_[0];
7032    while($Type_Name=~s/(\*|\&)([^<>()]+|)\Z/$2/g){};
7033    my $Type_Name = remove_quals(uncover_typedefs($Type_Name));
7034    while($Type_Name=~s/(\*|\&)([^<>()]+|)\Z/$2/g){};
7035    return $Type_Name;
7036}
7037
7038sub isIntegerType($)
7039{
7040    my $TName = remove_quals(uncover_typedefs($_[0]));
7041    return 0 if($TName=~/[(<*]/);
7042    if($TName eq "bool")
7043    {
7044        return (getSymLang($TestedInterface) ne "C++");
7045    }
7046    return ($TName=~/(\W|\A| )(int)(\W|\Z| )/
7047    or $TName=~/\A(short|size_t|unsigned|long|long long|unsigned long|unsigned long long|unsigned short)\Z/);
7048}
7049
7050sub isCharType($)
7051{
7052    my $TName = remove_quals(uncover_typedefs($_[0]));
7053    return 0 if($TName=~/[(<*]/);
7054    return ($TName=~/\A(char|unsigned char|signed char|wchar_t)\Z/);
7055}
7056
7057sub isNumericType($)
7058{
7059    my $TName = uncover_typedefs($_[0]);
7060    return 0 if($TName=~/[(<*]/);
7061    if(isIntegerType($TName))
7062    {
7063        return 1;
7064    }
7065    else
7066    {
7067        return ($TName=~/\A(float|double|long double|float const|double const|long double const)\Z/);
7068    }
7069}
7070
7071sub getIntrinsicValue($)
7072{
7073    my $TypeName = $_[0];
7074    $IntrinsicNum{"Char"}=64 if($IntrinsicNum{"Char"}>89 or $IntrinsicNum{"Char"}<64);
7075    $IntrinsicNum{"Int"}=0 if($IntrinsicNum{"Int"} >= 10);
7076    if($RandomCode)
7077    {
7078        $IntrinsicNum{"Char"} = 64+int(rand(25));
7079        $IntrinsicNum{"Int"} = int(rand(5));
7080    }
7081    if($TypeName eq "char*")
7082    {
7083        $IntrinsicNum{"Str"}+=1;
7084        if($IntrinsicNum{"Str"}==1)
7085        {
7086            return "\"str\"";
7087        }
7088        else
7089        {
7090            return "\"str".$IntrinsicNum{"Str"}."\"";
7091        }
7092    }
7093    elsif($TypeName=~/(\A| )char(\Z| )/)
7094    {
7095        $IntrinsicNum{"Char"} += 1;
7096        return "'".chr($IntrinsicNum{"Char"})."'";
7097    }
7098    elsif($TypeName eq "wchar_t")
7099    {
7100        $IntrinsicNum{"Char"}+=1;
7101        return "L'".chr($IntrinsicNum{"Char"})."'";
7102    }
7103    elsif($TypeName eq "wchar_t*")
7104    {
7105        $IntrinsicNum{"Str"}+=1;
7106        if($IntrinsicNum{"Str"}==1)
7107        {
7108            return "L\"str\"";
7109        }
7110        else
7111        {
7112            return "L\"str".$IntrinsicNum{"Str"}."\"";
7113        }
7114    }
7115    elsif($TypeName eq "wint_t")
7116    {
7117        $IntrinsicNum{"Int"}+=1;
7118        return "L".$IntrinsicNum{"Int"};
7119    }
7120    elsif($TypeName=~/\A(long|long int)\Z/)
7121    {
7122        $IntrinsicNum{"Int"} += 1;
7123        return $IntrinsicNum{"Int"}."L";
7124    }
7125    elsif($TypeName=~/\A(long long|long long int)\Z/)
7126    {
7127        $IntrinsicNum{"Int"} += 1;
7128        return $IntrinsicNum{"Int"}."LL";
7129    }
7130    elsif(isIntegerType($TypeName))
7131    {
7132        $IntrinsicNum{"Int"} += 1;
7133        return $IntrinsicNum{"Int"};
7134    }
7135    elsif($TypeName eq "float")
7136    {
7137        $IntrinsicNum{"Float"} += 1;
7138        return $IntrinsicNum{"Float"}.".5f";
7139    }
7140    elsif($TypeName eq "double")
7141    {
7142        $IntrinsicNum{"Float"} += 1;
7143        return $IntrinsicNum{"Float"}.".5";
7144    }
7145    elsif($TypeName eq "long double")
7146    {
7147        $IntrinsicNum{"Float"} += 1;
7148        return $IntrinsicNum{"Float"}.".5L";
7149    }
7150    elsif($TypeName eq "bool")
7151    {
7152        if(getSymLang($TestedInterface) eq "C++") {
7153            return "true";
7154        }
7155        else {
7156            return "1";
7157        }
7158    }
7159    else
7160    { # void, "..." and other
7161        return "";
7162    }
7163}
7164
7165sub findInterface_OutParam($$$$$$)
7166{
7167    my ($TypeId, $Key, $StrongTypeCompliance, $Var, $ParamName, $Strong) = @_;
7168    return () if(not $TypeId);
7169    foreach my $FamilyTypeId (get_OutParamFamily($TypeId, 1))
7170    {
7171        foreach my $Interface (get_CompatibleInterfaces($FamilyTypeId, "OutParam", $ParamName))
7172        { # find interface to create some type in the family as output parameter
7173            if($Strong)
7174            {
7175                foreach my $PPos (keys(%{$CompleteSignature{$Interface}{"Param"}}))
7176                { # only one possible structural out parameter
7177                    my $PTypeId = $CompleteSignature{$Interface}{"Param"}{$PPos}{"type"};
7178                    my $P_FTypeId = get_FoundationTypeId($PTypeId);
7179                    return () if(get_TypeType($P_FTypeId)!~/\A(Intrinsic|Enum)\Z/
7180                    and $P_FTypeId ne get_FoundationTypeId($FamilyTypeId)
7181                    and not is_const_type(get_TypeName($PTypeId)));
7182                }
7183            }
7184            my $OutParam_Pos = $OutParam_Interface{$FamilyTypeId}{$Interface};
7185            my %Interface_Init = callInterface((
7186                "Interface"=>$Interface,
7187                "Key"=>$Key,
7188                "OutParam"=>$OutParam_Pos,
7189                "OutVar"=>$Var));
7190            if($Interface_Init{"IsCorrect"})
7191            {
7192                $Interface_Init{"Interface"} = $Interface;
7193                $Interface_Init{"OutParamPos"} = $OutParam_Pos;
7194                return %Interface_Init;
7195            }
7196        }
7197    }
7198    return ();
7199}
7200
7201sub findInterface(@)
7202{
7203    my %Init_Desc = @_;
7204    my ($TypeId, $Key, $StrongTypeCompliance, $ParamName) = ($Init_Desc{"TypeId"}, $Init_Desc{"Key"}, $Init_Desc{"StrongTypeCompliance"}, $Init_Desc{"ParamName"});
7205    return () if(not $TypeId);
7206    my @FamilyTypes = ();
7207    if($StrongTypeCompliance)
7208    {
7209        @FamilyTypes = ($TypeId);
7210        # try to initialize basic typedef
7211        my $BaseTypeId = $TypeId;
7212        $BaseTypeId = get_OneStep_BaseTypeId($TypeId) if(get_TypeType($BaseTypeId) eq "Const");
7213        $BaseTypeId = get_OneStep_BaseTypeId($TypeId) if(get_TypeType($BaseTypeId) eq "Pointer");
7214        if($BaseTypeId ne $TypeId)
7215        {
7216            if(get_TypeType($BaseTypeId) eq "Typedef") {
7217                push(@FamilyTypes, $BaseTypeId);
7218            }
7219        }
7220    }
7221    else {
7222        @FamilyTypes = @{familyTypes($TypeId)};
7223    }
7224    my @Ints = ();
7225    foreach my $FamilyTypeId (@FamilyTypes)
7226    {
7227        next if((get_PointerLevel($TypeId)<get_PointerLevel($FamilyTypeId)) and $Init_Desc{"OuterType_Type"} eq "Array");
7228        next if(get_TypeType($TypeId) eq "Class" and get_PointerLevel($FamilyTypeId)==0);
7229        if($Init_Desc{"OnlyData"}) {
7230            @Ints = (@Ints, get_CompatibleInterfaces($FamilyTypeId, "OnlyData",
7231                              $Init_Desc{"Interface"}." ".$ParamName." ".$Init_Desc{"KeyWords"}));
7232        }
7233        elsif($Init_Desc{"OnlyReturn"}) {
7234            @Ints = (@Ints, get_CompatibleInterfaces($FamilyTypeId, "OnlyReturn",
7235                              $Init_Desc{"Interface"}." ".$ParamName." ".$Init_Desc{"KeyWords"}));
7236        }
7237        else {
7238            @Ints = (@Ints, get_CompatibleInterfaces($FamilyTypeId, "Return",
7239                              $Init_Desc{"Interface"}." ".$ParamName." ".$Init_Desc{"KeyWords"}));
7240        }
7241    }
7242    sort_byCriteria(\@Ints, "DeleteSmth");
7243    foreach my $Interface (@Ints)
7244    { # find interface for returning some type in the family
7245        my %Interface_Init = callInterface((
7246            "Interface"=>$Interface,
7247            "Key"=>$Key,
7248            "RetParam"=>$ParamName));
7249        if($Interface_Init{"IsCorrect"}) {
7250            $Interface_Init{"Interface"} = $Interface;
7251            return %Interface_Init;
7252        }
7253    }
7254    return ();
7255}
7256
7257sub initializeByInterface_OutParam(@)
7258{
7259    my %Init_Desc = @_;
7260    return () if(not $Init_Desc{"TypeId"});
7261    my $Global_State = save_state();
7262    my %Type_Init = ();
7263    my $FTypeId = get_FoundationTypeId($Init_Desc{"TypeId"});
7264    my $PointerLevel = get_PointerLevel($Init_Desc{"TypeId"});
7265    $Init_Desc{"Var"} = select_var_name($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $Init_Desc{"ParamNameExt"});
7266    my $Var = $Init_Desc{"Var"};
7267    $Block_Variable{$CurrentBlock}{$Var} = 1;
7268    my %Interface_Init = findInterface_OutParam($Init_Desc{"TypeId"}, $Init_Desc{"Key"}, $Init_Desc{"StrongTypeCompliance"}, "\@OUT_PARAM\@", $Init_Desc{"ParamName"}, $Init_Desc{"Strong"});
7269    if(not $Interface_Init{"IsCorrect"})
7270    {
7271        restore_state($Global_State);
7272        return ();
7273    }
7274    $Type_Init{"Init"} = $Interface_Init{"Init"};
7275    $Type_Init{"Destructors"} = $Interface_Init{"Destructors"};
7276    $Type_Init{"Code"} .= $Interface_Init{"Code"};
7277    $Type_Init{"Headers"} = addHeaders($Interface_Init{"Headers"}, $Type_Init{"Headers"});
7278
7279    # initialization
7280    my $OutParam_Pos = $Interface_Init{"OutParamPos"};
7281    my $OutParam_TypeId = $CompleteSignature{$Interface_Init{"Interface"}}{"Param"}{$OutParam_Pos}{"type"};
7282    my $PLevel_Out = get_PointerLevel($OutParam_TypeId);
7283    my ($InitializedEType_Id, $Declarations, $Headers) = get_ExtTypeId($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $OutParam_TypeId);
7284    my $InitializedType_Name = get_TypeName($InitializedEType_Id);
7285    $Type_Init{"Code"} .= $Declarations;
7286    $Type_Init{"Headers"} = addHeaders($Headers, $Type_Init{"Headers"});
7287    my $InitializedFType_Id = get_FoundationTypeId($OutParam_TypeId);
7288#     my $InitializedFType_Type = get_TypeType($InitializedFType_Id);
7289    my $InitializedType_PointerLevel = get_PointerLevel($OutParam_TypeId);
7290    my $VarNameForReplace = $Var;
7291    if($PLevel_Out>1 or ($PLevel_Out==1 and not isOpaque($InitializedFType_Id)))
7292    {
7293        $OutParam_TypeId = reduce_pointer_level($InitializedEType_Id);
7294        $InitializedType_Name=get_TypeName($OutParam_TypeId);
7295        $VarNameForReplace="&".$Var;
7296        $InitializedType_PointerLevel-=1;
7297    }
7298    foreach (keys(%Interface_Init))
7299    {
7300        $Interface_Init{$_}=~s/\@OUT_PARAM\@/$VarNameForReplace/g;
7301        $Interface_Init{$_} = clearSyntax($Interface_Init{$_});
7302    }
7303    if(uncover_typedefs($InitializedType_Name)=~/&|\[/ or $PLevel_Out==1)
7304    {
7305#         if($InitializedFType_Type eq "Struct")
7306#         {
7307#             my %Struct_Desc = %Init_Desc;
7308#             $Struct_Desc{"TypeId"} = $OutParam_TypeId;
7309#             $Struct_Desc{"InLine"} = 0;
7310#             my $Key = $Struct_Desc{"Key"};
7311#             delete($Block_Variable{$CurrentBlock}{$Var});
7312#             my %Assembly = assembleStruct(%Struct_Desc);
7313#             $Block_Variable{$CurrentBlock}{$Var} = 1;
7314#             $Type_Init{"Init"} .= $Assembly{"Init"};
7315#             $Type_Init{"Code"} .= $Assembly{"Code"};
7316#             $Type_Init{"Headers"} = addHeaders($Assembly{"Headers"}, $Type_Init{"Headers"});
7317#         }
7318#         else
7319#         {
7320        $Type_Init{"Init"} .= $InitializedType_Name." $Var;\n";
7321        if(get_TypeType($InitializedFType_Id) eq "Struct")
7322        {
7323            my %Type = get_Type($InitializedFType_Id);
7324            foreach my $MemPos (keys(%{$Type{"Memb"}}))
7325            {
7326                if($Type{"Memb"}{$MemPos}{"name"}=~/initialized/i
7327                and isNumericType(get_TypeName($Type{"Memb"}{$MemPos}{"type"})))
7328                {
7329                    $Type_Init{"Init"} .= "$Var.initialized = 0;\n";
7330                    last;
7331                }
7332            }
7333        }
7334    }
7335    else
7336    {
7337        $Type_Init{"Init"} .= $InitializedType_Name." $Var = ".get_null().";\n";
7338    }
7339    if(not defined $DisableReuse)
7340    {
7341        $ValueCollection{$CurrentBlock}{$Var} = $OutParam_TypeId;
7342    }
7343    $Type_Init{"Init"} .= $Interface_Init{"PreCondition"} if($Interface_Init{"PreCondition"});
7344    $Type_Init{"Init"} .= $Interface_Init{"Call"}.";\n";
7345    $Type_Init{"Headers"} = addHeaders(getTypeHeaders($Init_Desc{"TypeId"}), $Type_Init{"Headers"});
7346    $Type_Init{"Init"} .= $Interface_Init{"PostCondition"} if($Interface_Init{"PostCondition"});
7347    if($Interface_Init{"FinalCode"})
7348    {
7349        $Type_Init{"Init"} .= "//final code\n";
7350        $Type_Init{"Init"} .= $Interface_Init{"FinalCode"}."\n";
7351    }
7352    # create call
7353    my ($Call, $Preamble) = convertTypes((
7354        "InputTypeName"=>$InitializedType_Name,
7355        "InputPointerLevel"=>$InitializedType_PointerLevel,
7356        "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
7357        "Value"=>$Var,
7358        "Key"=>$Var,
7359        "Destination"=>"Param",
7360        "MustConvert"=>0));
7361    $Type_Init{"Init"} .= $Preamble;
7362    $Type_Init{"Call"} = $Call;
7363    # create call to constraint
7364    if($Init_Desc{"TargetTypeId"}==$Init_Desc{"TypeId"})
7365    {
7366        $Type_Init{"TargetCall"} = $Type_Init{"Call"};
7367    }
7368    else
7369    {
7370        my ($TargetCall, $TargetPreamble) = convertTypes((
7371            "InputTypeName"=>$InitializedType_Name,
7372            "InputPointerLevel"=>$InitializedType_PointerLevel,
7373            "OutputTypeId"=>$Init_Desc{"TargetTypeId"},
7374            "Value"=>$Var,
7375            "Key"=>$Var,
7376            "Destination"=>"Target",
7377            "MustConvert"=>0));
7378        $Type_Init{"TargetCall"} = $TargetCall;
7379        $Type_Init{"Init"} .= $TargetPreamble;
7380    }
7381    if(get_TypeType($Init_Desc{"TypeId"}) eq "Ref")
7382    { # ref handler
7383        my $BaseRefTypeId = get_OneStep_BaseTypeId($Init_Desc{"TypeId"});
7384        if(get_PointerLevel($BaseRefTypeId) > $InitializedType_PointerLevel)
7385        {
7386            my $BaseRefTypeName = get_TypeName($BaseRefTypeId);
7387            $Type_Init{"Init"} .= $BaseRefTypeName." ".$Var."_ref = ".$Type_Init{"Call"}.";\n";
7388            $Type_Init{"Call"} = $Var."_ref";
7389            $Block_Variable{$CurrentBlock}{$Var."_ref"} = 1;
7390            if(not defined $DisableReuse)
7391            {
7392                $ValueCollection{$CurrentBlock}{$Var."_ref"} = $Init_Desc{"TypeId"};
7393            }
7394        }
7395    }
7396    $Type_Init{"Init"} .= "\n";
7397    $Type_Init{"IsCorrect"} = 1;
7398    return %Type_Init;
7399}
7400
7401sub declare_funcptr_typedef($$)
7402{
7403    my ($Key, $TypeId) = @_;
7404    return "" if($AuxType{$TypeId} or not $TypeId or not $Key);
7405    my $TypedefTo = $Key."_type";
7406    my $Typedef = "typedef ".get_TypeName($TypeId).";\n";
7407    $Typedef=~s/[ ]*\(\*\)[ ]*/ \(\*$TypedefTo\) /;
7408    $AuxType{$TypeId} = $TypedefTo;
7409    $TypeInfo{$TypeId}{"Name_Old"} = get_TypeName($TypeId);
7410    $TypeInfo{$TypeId}{"Name"} = $AuxType{$TypeId};
7411    $TName_Tid{$TypedefTo} = $TypeId;
7412    return $Typedef;
7413}
7414
7415sub have_copying_constructor($)
7416{
7417    my $ClassId = $_[0];
7418    return 0 if(not $ClassId);
7419    foreach my $Constructor (keys(%{$Class_Constructors{$ClassId}}))
7420    {
7421        if(keys(%{$CompleteSignature{$Constructor}{"Param"}})==1
7422        and not $CompleteSignature{$Constructor}{"Protected"})
7423        {
7424            my $FirstParamTypeId = $CompleteSignature{$Constructor}{"Param"}{0}{"type"};
7425            if(get_FoundationTypeId($FirstParamTypeId) eq $ClassId
7426            and get_PointerLevel($FirstParamTypeId)==0) {
7427                return 1;
7428            }
7429        }
7430    }
7431    return 0;
7432}
7433
7434sub initializeByInterface(@)
7435{
7436    my %Init_Desc = @_;
7437    return () if(not $Init_Desc{"TypeId"});
7438    my $Global_State = save_state();
7439    my %Type_Init = ();
7440    my $PointerLevel = get_PointerLevel($Init_Desc{"TypeId"});
7441    my $FTypeId = get_FoundationTypeId($Init_Desc{"TypeId"});
7442    if(get_TypeType($FTypeId) eq "Class" and $PointerLevel==0
7443    and not have_copying_constructor($FTypeId)) {
7444        return ();
7445    }
7446    my %Interface_Init = ();
7447    if($Init_Desc{"ByInterface"})
7448    {
7449        %Interface_Init = callInterface((
7450          "Interface"=>$Init_Desc{"ByInterface"},
7451          "Key"=>$Init_Desc{"Key"},
7452          "RetParam"=>$Init_Desc{"ParamName"},
7453          "OnlyReturn"=>1));
7454    }
7455    else {
7456        %Interface_Init = findInterface(%Init_Desc);
7457    }
7458    if(not $Interface_Init{"IsCorrect"})
7459    {
7460        restore_state($Global_State);
7461        return ();
7462    }
7463    $Init_Desc{"Var"} = select_var_name($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $Init_Desc{"ParamNameExt"});
7464    $Type_Init{"Init"} = $Interface_Init{"Init"};
7465    $Type_Init{"Destructors"} = $Interface_Init{"Destructors"};
7466    $Type_Init{"Code"} = $Interface_Init{"Code"};
7467    $Type_Init{"Headers"} = addHeaders($Interface_Init{"Headers"}, $Type_Init{"Headers"});
7468    if(keys(%{$CompleteSignature{$Interface_Init{"Interface"}}{"Param"}})>$MAX_PARAMS_INLINE) {
7469        $Init_Desc{"InLine"} = 0;
7470    }
7471    # initialization
7472    my $ReturnType_PointerLevel = get_PointerLevel($Interface_Init{"ReturnTypeId"});
7473    if($ReturnType_PointerLevel==$PointerLevel and $Init_Desc{"InLine"}
7474    and not $Interface_Init{"PreCondition"} and not $Interface_Init{"PostCondition"}
7475    and not $Interface_Init{"ReturnFinalCode"})
7476    {
7477        my ($Call, $Preamble) = convertTypes((
7478            "InputTypeName"=>get_TypeName($Interface_Init{"ReturnTypeId"}),
7479            "InputPointerLevel"=>$ReturnType_PointerLevel,
7480            "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
7481            "Value"=>$Interface_Init{"Call"},
7482            "Key"=>$Init_Desc{"Var"},
7483            "Destination"=>"Param",
7484            "MustConvert"=>0));
7485        $Type_Init{"Init"} .= $Preamble;
7486        $Type_Init{"Call"} = $Call;
7487        $Type_Init{"TypeName"} = get_TypeName($Interface_Init{"ReturnTypeId"});
7488    }
7489    else
7490    {
7491        my $Var = $Init_Desc{"Var"};
7492        $Block_Variable{$CurrentBlock}{$Var} = 1;
7493        my ($InitializedEType_Id, $Declarations, $Headers) = get_ExtTypeId($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $Interface_Init{"ReturnTypeId"});
7494        my $InitializedType_Name = get_TypeName($InitializedEType_Id);
7495        $Type_Init{"TypeName"} = $InitializedType_Name;
7496        $Type_Init{"Code"} .= $Declarations;
7497        $Type_Init{"Headers"} = addHeaders($Headers, $Type_Init{"Headers"});
7498        my %ReturnType = get_Type($Interface_Init{"ReturnTypeId"});
7499        if(not defined $DisableReuse) {
7500            $ValueCollection{$CurrentBlock}{$Var} = $Interface_Init{"ReturnTypeId"};
7501        }
7502        $Type_Init{"Init"} .= $Interface_Init{"PreCondition"} if($Interface_Init{"PreCondition"});
7503        if(($InitializedType_Name eq $ReturnType{"Name"})) {
7504            $Type_Init{"Init"} .= $InitializedType_Name." $Var = ".$Interface_Init{"Call"}.";\n";
7505        }
7506        else {
7507            $Type_Init{"Init"} .= $InitializedType_Name." $Var = "."(".$InitializedType_Name.")".$Interface_Init{"Call"}.";\n";
7508        }
7509        if($Interface_Init{"Interface"} eq "fopen") {
7510            $OpenStreams{$CurrentBlock}{$Var} = 1;
7511        }
7512        # create call
7513        my ($Call, $Preamble) = convertTypes((
7514            "InputTypeName"=>$InitializedType_Name,
7515            "InputPointerLevel"=>$ReturnType_PointerLevel,
7516            "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
7517            "Value"=>$Var,
7518            "Key"=>$Var,
7519            "Destination"=>"Param",
7520            "MustConvert"=>0));
7521        $Type_Init{"Init"} .= $Preamble;
7522        $Type_Init{"Call"} = $Call;
7523        # create call to constraint
7524        if($Init_Desc{"TargetTypeId"}==$Init_Desc{"TypeId"}) {
7525            $Type_Init{"TargetCall"} = $Type_Init{"Call"};
7526        }
7527        else
7528        {
7529            my ($TargetCall, $TargetPreamble) = convertTypes((
7530                "InputTypeName"=>$InitializedType_Name,
7531                "InputPointerLevel"=>$ReturnType_PointerLevel,
7532                "OutputTypeId"=>$Init_Desc{"TargetTypeId"},
7533                "Value"=>$Var,
7534                "Key"=>$Var,
7535                "Destination"=>"Target",
7536                "MustConvert"=>0));
7537            $Type_Init{"TargetCall"} = $TargetCall;
7538            $Type_Init{"Init"} .= $TargetPreamble;
7539        }
7540        if(get_TypeType($Init_Desc{"TypeId"}) eq "Ref")
7541        { # ref handler
7542            my $BaseRefTypeId = get_OneStep_BaseTypeId($Init_Desc{"TypeId"});
7543            if(get_PointerLevel($BaseRefTypeId) > $ReturnType_PointerLevel)
7544            {
7545                my $BaseRefTypeName = get_TypeName($BaseRefTypeId);
7546                $Type_Init{"Init"} .= $BaseRefTypeName." ".$Var."_ref = ".$Type_Init{"Call"}.";\n";
7547                $Type_Init{"Call"} = $Var."_ref";
7548                $Block_Variable{$CurrentBlock}{$Var."_ref"} = 1;
7549                if(not defined $DisableReuse)
7550                {
7551                    $ValueCollection{$CurrentBlock}{$Var."_ref"} = $Init_Desc{"TypeId"};
7552                }
7553            }
7554        }
7555        if($Interface_Init{"ReturnRequirement"})
7556        {
7557            $Interface_Init{"ReturnRequirement"}=~s/(\$0|\$retval)/$Var/gi;
7558            $Type_Init{"Init"} .= $Interface_Init{"ReturnRequirement"};
7559        }
7560        if($Interface_Init{"ReturnFinalCode"})
7561        {
7562            $Interface_Init{"ReturnFinalCode"}=~s/(\$0|\$retval)/$Var/gi;
7563            $Type_Init{"Init"} .= "//final code\n";
7564            $Type_Init{"Init"} .= $Interface_Init{"ReturnFinalCode"}."\n";
7565        }
7566    }
7567    $Type_Init{"Init"} .= $Interface_Init{"PostCondition"} if($Interface_Init{"PostCondition"});
7568    if($Interface_Init{"FinalCode"})
7569    {
7570        $Type_Init{"Init"} .= "//final code\n";
7571        $Type_Init{"Init"} .= $Interface_Init{"FinalCode"}."\n";
7572    }
7573
7574    $Type_Init{"IsCorrect"} = 1;
7575    return %Type_Init;
7576}
7577
7578sub initializeFuncPtr(@)
7579{
7580    my %Init_Desc = @_;
7581    my %Type_Init = initializeByInterface(%Init_Desc);
7582    if($Type_Init{"IsCorrect"}) {
7583        return %Type_Init;
7584    }
7585    else {
7586        return assembleFuncPtr(%Init_Desc);
7587    }
7588}
7589
7590sub get_OneStep_BaseTypeId($)
7591{
7592    my $TypeId = $_[0];
7593    my %Type = %{$TypeInfo{$TypeId}};
7594    if(defined $Type{"BaseType"}
7595    and $Type{"BaseType"}) {
7596        return $Type{"BaseType"};
7597    }
7598    else {
7599        return $Type{"Tid"};
7600    }
7601}
7602
7603sub initializeArray(@)
7604{
7605    my %Init_Desc = @_;
7606    if($Init_Desc{"TypeType_Changed"})
7607    {
7608        my %Type_Init = assembleArray(%Init_Desc);
7609        if($Type_Init{"IsCorrect"}) {
7610            return %Type_Init;
7611        }
7612        else
7613        { # failed to initialize as "array"
7614            if(my $FTId = get_FoundationTypeId($Init_Desc{"TypeId"}))
7615            {
7616                my $FType = get_TypeType($FTId);
7617                if($FType ne "Array")
7618                {
7619                    $Init_Desc{"FoundationType_Type"} = $FType;
7620                    return selectInitializingWay(%Init_Desc);
7621                }
7622            }
7623            return ();
7624        }
7625    }
7626    else
7627    {
7628        $Init_Desc{"StrongTypeCompliance"} = 1;
7629        my %Type_Init = initializeByInterface(%Init_Desc);
7630        if($Type_Init{"IsCorrect"}) {
7631            return %Type_Init;
7632        }
7633        else
7634        {
7635            %Type_Init = initializeByInterface_OutParam(%Init_Desc);
7636            if($Type_Init{"IsCorrect"}) {
7637                return %Type_Init;
7638            }
7639            else
7640            {
7641                $Init_Desc{"StrongTypeCompliance"} = 0;
7642                return assembleArray(%Init_Desc);
7643            }
7644        }
7645    }
7646}
7647
7648sub get_PureType($)
7649{
7650    my $TypeId = $_[0];
7651    return () if(not $TypeId);
7652    if(defined $Cache{"get_PureType"}{$TypeId}
7653    and not defined $AuxType{$TypeId}) {
7654        return %{$Cache{"get_PureType"}{$TypeId}};
7655    }
7656    return () if(not $TypeInfo{$TypeId});
7657    my %Type = %{$TypeInfo{$TypeId}};
7658    return %Type if(not $Type{"BaseType"});
7659    if($Type{"Type"}=~/\A(Ref|Const|Volatile|Restrict|Typedef)\Z/) {
7660        %Type = get_PureType($Type{"BaseType"});
7661    }
7662    $Cache{"get_PureType"}{$TypeId} = \%Type;
7663    return %Type;
7664}
7665
7666sub delete_quals($)
7667{
7668    my $TypeId = $_[0];
7669    return () if(not $TypeId);
7670    if(defined $Cache{"delete_quals"}{$TypeId}
7671    and not defined $AuxType{$TypeId}) {
7672        return %{$Cache{"delete_quals"}{$TypeId}};
7673    }
7674    return () if(not $TypeInfo{$TypeId});
7675    my %Type = %{$TypeInfo{$TypeId}};
7676    return %Type if(not $Type{"BaseType"});
7677    if($Type{"Type"}=~/\A(Ref|Const|Volatile|Restrict)\Z/) {
7678        %Type = delete_quals($Type{"BaseType"});
7679    }
7680    $Cache{"delete_quals"}{$TypeId} = \%Type;
7681    return %Type;
7682}
7683
7684sub goToFirst($$)
7685{
7686    my ($TypeId, $Type_Type) = @_;
7687    if(defined $Cache{"goToFirst"}{$TypeId}{$Type_Type}
7688    and not defined $AuxType{$TypeId}) {
7689        return %{$Cache{"goToFirst"}{$TypeId}{$Type_Type}};
7690    }
7691    return () if(not $TypeInfo{$TypeId});
7692    my %Type = %{$TypeInfo{$TypeId}};
7693    return () if(not $Type{"Type"});
7694    if($Type{"Type"} ne $Type_Type)
7695    {
7696        return () if(not $Type{"BaseType"});
7697        %Type = goToFirst($Type{"BaseType"}, $Type_Type);
7698    }
7699    $Cache{"goToFirst"}{$TypeId}{$Type_Type} = \%Type;
7700    return %Type;
7701}
7702
7703sub detectArrayTypeId($)
7704{
7705    my $TypeId = $_[0];
7706    my $ArrayType_Id = get_FoundationTypeId($TypeId);
7707    my $PointerLevel = get_PointerLevel($TypeId);
7708    if(get_TypeType($ArrayType_Id) eq "Array")# and $PointerLevel==0
7709    {
7710        return $ArrayType_Id;
7711    }
7712    else
7713    { # this branch for types like arrays (char* like char[])
7714        my %Type = get_PureType($TypeId);
7715        return $Type{"Tid"};
7716    }
7717}
7718
7719sub assembleArray(@)
7720{
7721    my %Init_Desc = @_;
7722    my %Type_Init = ();
7723    my $Global_State = save_state();
7724    my $PointerLevel = get_PointerLevel($Init_Desc{"TypeId"});
7725    my %Type = get_Type($Init_Desc{"TypeId"});
7726    # determine array base
7727    my $ArrayType_Id = detectArrayTypeId($Init_Desc{"TypeId"});
7728    my %ArrayType = get_Type($ArrayType_Id);
7729    my $AmountArray = ($ArrayType{"Type"} eq "Array")?$ArrayType{"Count"}:(($Init_Desc{"ArraySize"})?$Init_Desc{"ArraySize"}:$DEFAULT_ARRAY_AMOUNT);
7730    if($AmountArray>1024)
7731    { # such too long arrays should be initialized by other methods
7732        restore_state($Global_State);
7733        return ();
7734    }
7735    # array base type attributes
7736    my $ArrayElemType_Id = get_OneStep_BaseTypeId($ArrayType_Id);
7737    my $ArrayElemType_Name = remove_quals(get_TypeName($ArrayElemType_Id));
7738    my $ArrayElemType_PLevel = get_PointerLevel($ArrayElemType_Id);
7739    my $ArrayElemFType_Id = get_FoundationTypeId($ArrayElemType_Id);
7740    my $IsInlineDef = (($ArrayType{"Type"} eq "Array") and $PointerLevel==0 and ($Type{"Type"} ne "Ref") and $Init_Desc{"InLine"} or $Init_Desc{"InLineArray"});
7741    $Init_Desc{"Var"} = select_var_name($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $Init_Desc{"ParamNameExt"});
7742    my $Var = $Init_Desc{"Var"};
7743    if(not $IsInlineDef) {
7744        $Block_Variable{$CurrentBlock}{$Var} = 1;
7745    }
7746    if(not isCharType(get_TypeName($ArrayElemFType_Id)) and not $IsInlineDef)
7747    {
7748        my ($ExtTypeId, $Declarations, $Headers) = get_ExtTypeId($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $ArrayElemType_Id);
7749        $ArrayElemType_Id = $ExtTypeId;
7750        $Type_Init{"Code"} .= $Declarations;
7751        $Type_Init{"Headers"} = addHeaders($Headers, $Type_Init{"Headers"});
7752    }
7753    my @ElemStr = ();
7754    foreach my $Elem_Pos (1 .. $AmountArray)
7755    { # initialize array members
7756        my $ElemName = "";
7757        if(isCharType(get_TypeName($ArrayElemFType_Id))
7758        and $ArrayElemType_PLevel==1) {
7759            $ElemName = $Init_Desc{"ParamName"}."_".$Elem_Pos;
7760        }
7761        elsif(my $EName = getParamNameByTypeName($ArrayElemType_Name)) {
7762            $ElemName = $EName;
7763        }
7764        else {
7765            $ElemName = $Init_Desc{"ParamName"}.((not defined $DisableReuse)?"_elem":"");
7766            $ElemName=~s/es_elem\Z/e/g;
7767        }
7768        my %Elem_Init = initializeParameter((
7769            "TypeId" => $ArrayElemType_Id,
7770            "Key" => $Init_Desc{"Key"}."_".$Elem_Pos,
7771            "InLine" => 1,
7772            "Value" => "no value",
7773            "ValueTypeId" => 0,
7774            "TargetTypeId" => 0,
7775            "CreateChild" => 0,
7776            "Usage" => "Common",
7777            "ParamName" => $ElemName,
7778            "OuterType_Type" => "Array",
7779            "Index" => $Elem_Pos-1,
7780            "InLineArray" => ($ArrayElemType_PLevel==1 and isCharType(get_TypeName($ArrayElemFType_Id)) and $Init_Desc{"ParamName"}=~/text|txt|doc/i)?1:0,
7781            "IsString" => ($ArrayElemType_PLevel==1 and isCharType(get_TypeName($ArrayElemFType_Id)) and $Init_Desc{"ParamName"}=~/prefixes/i)?1:0 ));
7782        if(not $Elem_Init{"IsCorrect"} or $Elem_Init{"ByNull"}) {
7783            restore_state($Global_State);
7784            return ();
7785        }
7786        if($Elem_Pos eq 1) {
7787            $Type_Init{"Headers"} = addHeaders($Elem_Init{"Headers"}, $Type_Init{"Headers"});
7788        }
7789        @ElemStr = (@ElemStr, $Elem_Init{"Call"});
7790        $Type_Init{"Init"} .= $Elem_Init{"Init"};
7791        $Type_Init{"Destructors"} .= $Elem_Init{"Destructors"};
7792        $Type_Init{"Code"} .= $Elem_Init{"Code"};
7793    }
7794    if(($ArrayType{"Type"} ne "Array") and not isNumericType($ArrayElemType_Name))
7795    { # the last array element
7796        if($ArrayElemType_PLevel==0
7797        and get_TypeName($ArrayElemFType_Id)=~/\A(char|unsigned char)\Z/) {
7798            @ElemStr = (@ElemStr, "\'\\0\'");
7799        }
7800        elsif($ArrayElemType_PLevel==0
7801        and is_equal_types($ArrayElemType_Name, "wchar_t")) {
7802            @ElemStr = (@ElemStr, "L\'\\0\'");
7803        }
7804        elsif($ArrayElemType_PLevel>=1) {
7805            @ElemStr = (@ElemStr, get_null());
7806        }
7807        elsif($ArrayElemType_PLevel==0
7808        and get_TypeType($ArrayElemFType_Id)=~/\A(Struct|Union)\Z/) {
7809            @ElemStr = (@ElemStr, "($ArrayElemType_Name) "."{0}");
7810        }
7811    }
7812    # initialization
7813    if($IsInlineDef) {
7814        $Type_Init{"Call"} = "{".create_matrix(\@ElemStr, "    ")."}";
7815    }
7816    else
7817    {
7818        if(not defined $DisableReuse) {
7819            $ValueCollection{$CurrentBlock}{$Var} = $ArrayType_Id;
7820        }
7821        # $Type_Init{"Init"} .= "//parameter initialization\n";
7822        $Type_Init{"Init"} .= $ArrayElemType_Name." $Var [".(($ArrayType{"Type"} eq "Array")?$AmountArray:"")."] = {".create_matrix(\@ElemStr, "    ")."};\n";
7823        #create call
7824        my ($Call, $TmpPreamble) =
7825        convertTypes((
7826            "InputTypeName"=>formatName($ArrayElemType_Name."*", "T"),
7827            "InputPointerLevel"=>get_PointerLevel($ArrayType_Id),
7828            "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
7829            "Value"=>$Var,
7830            "Key"=>$Var,
7831            "Destination"=>"Param",
7832            "MustConvert"=>0));
7833        $Type_Init{"Init"} .= $TmpPreamble;
7834        $Type_Init{"Call"} = $Call;
7835        # create type
7836
7837        # create call to constraint
7838        if($Init_Desc{"TargetTypeId"}==$Init_Desc{"TypeId"}) {
7839            $Type_Init{"TargetCall"} = $Type_Init{"Call"};
7840        }
7841        else
7842        {
7843            my ($TargetCall, $Target_TmpPreamble) =
7844            convertTypes((
7845                "InputTypeName"=>formatName($ArrayElemType_Name."*", "T"),
7846                "InputPointerLevel"=>get_PointerLevel($ArrayType_Id),
7847                "OutputTypeId"=>$Init_Desc{"TargetTypeId"},
7848                "Value"=>$Var,
7849                "Key"=>$Var,
7850                "Destination"=>"Target",
7851                "MustConvert"=>0));
7852            $Type_Init{"TargetCall"} = $TargetCall;
7853            $Type_Init{"Init"} .= $Target_TmpPreamble;
7854        }
7855        # ref handler
7856        if($Type{"Type"} eq "Ref")
7857        {
7858            my $BaseRefId = get_OneStep_BaseTypeId($Init_Desc{"TypeId"});
7859            if($ArrayType{"Type"} eq "Pointer" or (get_PointerLevel($BaseRefId) > 0))
7860            {
7861                my $BaseRefName = get_TypeName($BaseRefId);
7862                $Type_Init{"Init"} .= $BaseRefName." ".$Var."_ref = ".$Type_Init{"Call"}.";\n";
7863                $Type_Init{"Call"} = $Var."_ref";
7864                $Block_Variable{$CurrentBlock}{$Var."_ref"} = 1;
7865                if(not defined $DisableReuse) {
7866                    $ValueCollection{$CurrentBlock}{$Var."_ref"} = $Init_Desc{"TypeId"};
7867                }
7868            }
7869        }
7870    }
7871    $Type_Init{"TypeName"} = $ArrayElemType_Name." [".(($ArrayType{"Type"} eq "Array")?$AmountArray:"")."]";
7872    $Type_Init{"IsCorrect"} = 1;
7873    return %Type_Init;
7874}
7875
7876sub get_null()
7877{
7878    if(getSymLang($TestedInterface) eq "C++"
7879    and $Constants{"NULL"}) {
7880        return "NULL";
7881    }
7882    else {
7883        return "0";
7884    }
7885}
7886
7887sub create_list($$)
7888{
7889    my ($Array, $Spaces) = @_;
7890    my @Elems = @{$Array};
7891    my ($MaxLength, $SumLength);
7892    foreach my $Elem (@Elems)
7893    {
7894        $SumLength += length($Elem);
7895        if(not defined $MaxLength
7896        or $MaxLength<length($Elem)) {
7897            $MaxLength = length($Elem);
7898        }
7899    }
7900    if(($#Elems+1>$MAX_PARAMS_INLINE)
7901    or ($SumLength>$MAX_PARAMS_LENGTH_INLINE and $#Elems>0)
7902    or join("", @Elems)=~/\n/) {
7903        return "\n$Spaces".join(",\n$Spaces", @Elems);
7904    }
7905    else {
7906        return join(", ", @Elems);
7907    }
7908}
7909
7910sub create_matrix($$)
7911{
7912    my ($Array, $Spaces) = @_;
7913    my @Elems = @{$Array};
7914    my $MaxLength;
7915    foreach my $Elem (@Elems)
7916    {
7917        if(length($Elem) > $MATRIX_MAX_ELEM_LENGTH) {
7918            return create_list($Array, $Spaces);
7919        }
7920        if(not defined $MaxLength
7921        or $MaxLength<length($Elem)) {
7922            $MaxLength = length($Elem);
7923        }
7924    }
7925    if($#Elems+1 >= $MIN_PARAMS_MATRIX)
7926    {
7927        my (@Rows, @Row) = ();
7928        foreach my $Num (0 .. $#Elems)
7929        {
7930            my $Elem = $Elems[$Num];
7931            if($Num%$MATRIX_WIDTH==0 and $Num!=0)
7932            {
7933                push(@Rows, join(", ", @Row));
7934                @Row = ();
7935            }
7936            push(@Row, aligh_str($Elem, $MaxLength));
7937        }
7938        push(@Rows, join(", ", @Row)) if($#Row>=0);
7939        return "\n$Spaces".join(",\n$Spaces", @Rows);
7940    }
7941    else {
7942        return create_list($Array, $Spaces);
7943    }
7944}
7945
7946sub aligh_str($$)
7947{
7948    my ($Str, $Length) = @_;
7949    if(length($Str)<$Length)
7950    {
7951        foreach (1 .. $Length - length($Str)) {
7952            $Str = " ".$Str;
7953        }
7954    }
7955    return $Str;
7956}
7957
7958sub findFuncPtr_RealFunc($$)
7959{
7960    my ($FuncTypeId, $ParamName) = @_;
7961    my @AvailableRealFuncs = ();
7962    foreach my $Interface (sort {length($a)<=>length($b)} sort {$a cmp $b} keys(%{$Func_TypeId{$FuncTypeId}}))
7963    {
7964        next if(isCyclical(\@RecurInterface, $Interface));
7965        if($Symbol_Library{$Interface}
7966        or $DepSymbol_Library{$Interface}) {
7967            push(@AvailableRealFuncs, $Interface);
7968        }
7969    }
7970    sort_byCriteria(\@AvailableRealFuncs, "Internal");
7971    @AvailableRealFuncs = sort {($b=~/\Q$ParamName\E/i)<=>($a=~/\Q$ParamName\E/i)} @AvailableRealFuncs if($ParamName!~/\Ap\d+\Z/);
7972    sort_byName(\@AvailableRealFuncs, $ParamName, "Interfaces");
7973    if($#AvailableRealFuncs>=0) {
7974        return $AvailableRealFuncs[0];
7975    }
7976    else {
7977        return "";
7978    }
7979}
7980
7981sub get_base_typedef($)
7982{
7983    my $TypeId = $_[0];
7984    my %TypeDef = goToFirst($TypeId, "Typedef");
7985    return 0 if(not $TypeDef{"Type"});
7986    if(get_PointerLevel($TypeDef{"Tid"})==0) {
7987        return $TypeDef{"Tid"};
7988    }
7989    my $BaseTypeId = get_OneStep_BaseTypeId($TypeDef{"Tid"});
7990    return get_base_typedef($BaseTypeId);
7991}
7992
7993sub assembleFuncPtr(@)
7994{
7995    my %Init_Desc = @_;
7996    my %Type_Init = ();
7997    my $Global_State = save_state();
7998    my %Type = get_Type($Init_Desc{"TypeId"});
7999    my $FuncPtr_TypeId = get_FoundationTypeId($Init_Desc{"TypeId"});
8000    my %FuncPtrType = get_Type($FuncPtr_TypeId);
8001    my ($TypeName, $AuxFuncName) = ($FuncPtrType{"Name"}, "");
8002    if(get_PointerLevel($Init_Desc{"TypeId"})>0)
8003    {
8004        if(my $Typedef_Id = get_base_typedef($Init_Desc{"TypeId"})) {
8005            $TypeName = get_TypeName($Typedef_Id);
8006        }
8007        elsif(my $Typedef_Id = get_type_typedef($FuncPtr_TypeId))
8008        {
8009            $Type_Init{"Headers"} = addHeaders(getTypeHeaders($Typedef_Id), $Type_Init{"Headers"});
8010            $TypeName = get_TypeName($Typedef_Id);
8011        }
8012        else
8013        {
8014            $Type_Init{"Code"} .= declare_funcptr_typedef($Init_Desc{"Key"}, $FuncPtr_TypeId);
8015            $TypeName = get_TypeName($FuncPtr_TypeId);
8016        }
8017    }
8018    if($FuncPtrType{"Name"} eq "void*(*)(size_t)")
8019    {
8020        $Type_Init{"Headers"} = addHeaders(["stdlib.h"], $Type_Init{"Headers"});
8021        $AuxHeaders{"stdlib.h"} = 1;
8022        $AuxFuncName = "malloc";
8023    }
8024    elsif(my $Interface_FuncPtr = findFuncPtr_RealFunc($FuncPtrType{"FuncTypeId"}, $Init_Desc{"ParamName"}))
8025    {
8026        $UsedInterfaces{$Interface_FuncPtr} = 1;
8027        $Type_Init{"Headers"} = addHeaders([$CompleteSignature{$Interface_FuncPtr}{"Header"}], $Type_Init{"Headers"});
8028        $AuxFuncName = $CompleteSignature{$Interface_FuncPtr}{"ShortName"};
8029        if($CompleteSignature{$Interface_FuncPtr}{"NameSpace"}) {
8030            $AuxFuncName = $CompleteSignature{$Interface_FuncPtr}{"NameSpace"}."::".$AuxFuncName;
8031        }
8032    }
8033    else
8034    {
8035        if($AuxFunc{$FuncPtr_TypeId}) {
8036            $AuxFuncName = $AuxFunc{$FuncPtr_TypeId};
8037        }
8038        else
8039        {
8040            my @FuncParams = ();
8041            $AuxFuncName = select_func_name($LongVarNames?$Init_Desc{"Key"}:(($Init_Desc{"ParamName"}=~/\Ap\d+\Z/)?"aux_func":$Init_Desc{"ParamName"}));
8042            # global
8043            $AuxFunc{$FuncPtr_TypeId} = $AuxFuncName;
8044            my $PreviousBlock = $CurrentBlock;
8045            $CurrentBlock = $AuxFuncName;
8046            # function declaration
8047            my $FuncReturnType_Id = $FuncPtrType{"Return"};
8048            foreach my $ParamPos (sort {int($a)<=>int($b)} keys(%{$FuncPtrType{"Param"}}))
8049            {
8050                my $ParamTypeId = $FuncPtrType{"Param"}{$ParamPos}{"type"};
8051                $Type_Init{"Headers"} = addHeaders(getTypeHeaders($ParamTypeId), $Type_Init{"Headers"});
8052                my $ParamName = $FuncPtrType{"Param"}{$ParamPos}{"name"};
8053                $ParamName = "p".($ParamPos+1) if(not $ParamName);
8054                # my ($ParamEType_Id, $Param_Declarations, $Param_Headers) = get_ExtTypeId($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $ParamTypeId);
8055                my $ParamTypeName = get_TypeName($ParamTypeId);#get_TypeName($ParamEType_Id);
8056                # $Type_Init{"Header"} = addHeaders($Param_Headers, $Type_Init{"Header"});
8057                # $Type_Init{"Code"} .= $Param_Declarations;
8058                if($ParamTypeName and ($ParamTypeName ne "..."))
8059                {
8060                    my $Field = create_member_decl($ParamTypeName, $ParamName);
8061                    @FuncParams = (@FuncParams, $Field);
8062                }
8063                $ValueCollection{$AuxFuncName}{$ParamName} = $ParamTypeId;
8064                $Block_Param{$AuxFuncName}{$ParamName} = $ParamTypeId;
8065                $Block_Variable{$CurrentBlock}{$ParamName} = 1;
8066            }
8067            # definition of function
8068            if(get_TypeName($FuncReturnType_Id) eq "void")
8069            {
8070                my $FuncDef = "//auxiliary function\n";
8071                $FuncDef .= "void\n".$AuxFuncName."(".create_list(\@FuncParams, "    ").")";
8072                if($AuxFuncName=~/free/i)
8073                {
8074                    my $PtrParam = "";
8075                    foreach my $ParamPos (sort {int($a)<=>int($b)} keys(%{$FuncPtrType{"Param"}}))
8076                    {
8077                        my $ParamTypeId = $FuncPtrType{"Param"}{$ParamPos}{"type"};
8078                        my $ParamName = $FuncPtrType{"Param"}{$ParamPos}{"name"};
8079                        $ParamName = "p".($ParamPos+1) if(not $ParamName);
8080                        my $ParamFTypeId = get_FoundationTypeId($ParamTypeId);
8081                        if(get_PointerLevel($ParamTypeId)==1
8082                        and get_TypeType($ParamFTypeId) eq "Intrinsic")
8083                        {
8084                            $PtrParam = $ParamName;
8085                            last;
8086                        }
8087                    }
8088                    if($PtrParam)
8089                    {
8090                        $FuncDef .= "{\n";
8091                        $FuncDef .= "    free($PtrParam);\n";
8092                        $FuncDef .= "}\n\n";
8093                    }
8094                    else {
8095                        $FuncDef .= "{}\n\n";
8096                    }
8097                }
8098                else {
8099                    $FuncDef .= "{}\n\n";
8100                }
8101                $Type_Init{"Code"} .= "\n".$FuncDef;
8102            }
8103            else
8104            {
8105                my %ReturnType_Init = initializeParameter((
8106                    "TypeId" => $FuncReturnType_Id,
8107                    "Key" => "retval",
8108                    "InLine" => 1,
8109                    "Value" => "no value",
8110                    "ValueTypeId" => 0,
8111                    "TargetTypeId" => 0,
8112                    "CreateChild" => 0,
8113                    "Usage" => "Common",
8114                    "RetVal" => 1,
8115                    "ParamName" => "retval",
8116                    "FuncPtrTypeId" => $FuncPtr_TypeId),
8117                    "FuncPtrName" => $AuxFuncName);
8118                if(not $ReturnType_Init{"IsCorrect"})
8119                {
8120                    restore_state($Global_State);
8121                    $CurrentBlock = $PreviousBlock;
8122                    return ();
8123                }
8124                $ReturnType_Init{"Init"} = alignCode($ReturnType_Init{"Init"}, "    ", 0);
8125                $ReturnType_Init{"Call"} = alignCode($ReturnType_Init{"Call"}, "    ", 1);
8126                $Type_Init{"Code"} .= $ReturnType_Init{"Code"};
8127                $Type_Init{"Headers"} = addHeaders($ReturnType_Init{"Headers"}, $Type_Init{"Headers"});
8128                my ($FuncReturnEType_Id, $Declarations, $Headers) = get_ExtTypeId($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $FuncReturnType_Id);
8129                my $FuncReturnType_Name = get_TypeName($FuncReturnEType_Id);
8130                $Type_Init{"Code"} .= $Declarations;
8131                $Type_Init{"Headers"} = addHeaders($Headers, $Type_Init{"Headers"});
8132                my $FuncDef = "//auxiliary function\n";
8133                $FuncDef .= $FuncReturnType_Name."\n".$AuxFuncName."(".create_list(\@FuncParams, "    ").")";
8134                $FuncDef .= "{\n";
8135                $FuncDef .= $ReturnType_Init{"Init"};
8136                $FuncDef .= "    return ".$ReturnType_Init{"Call"}.";\n}\n\n";
8137                $Type_Init{"Code"} .= "\n".$FuncDef;
8138            }
8139            $CurrentBlock = $PreviousBlock;
8140        }
8141    }
8142
8143    $Init_Desc{"Var"} = select_var_name($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $Init_Desc{"ParamNameExt"});
8144    my $Var = $Init_Desc{"Var"};
8145
8146    # create call
8147    my ($Call, $TmpPreamble) =
8148    convertTypes((
8149        "InputTypeName"=>$TypeName,
8150        "InputPointerLevel"=>0,
8151        "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
8152        "Value"=>"&".$AuxFuncName,
8153        "Key"=>$LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"},
8154        "Destination"=>"Param",
8155        "MustConvert"=>0));
8156    $Type_Init{"Init"} .= $TmpPreamble;
8157    $Type_Init{"Call"} = $Call;
8158    # create type
8159    $Type_Init{"TypeName"} = get_TypeName($Init_Desc{"TypeId"});
8160    # create call to constraint
8161    if($Init_Desc{"TargetTypeId"}==$Init_Desc{"TypeId"}) {
8162        $Type_Init{"TargetCall"} = $Type_Init{"Call"};
8163    }
8164    else
8165    {
8166        my ($TargetCall, $Target_TmpPreamble) =
8167        convertTypes((
8168            "InputTypeName"=>$TypeName,
8169            "InputPointerLevel"=>0,
8170            "OutputTypeId"=>$Init_Desc{"TargetTypeId"},
8171            "Value"=>"&".$AuxFuncName,
8172            "Key"=>$LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"},
8173            "Destination"=>"Target",
8174            "MustConvert"=>0));
8175        $Type_Init{"TargetCall"} = $TargetCall;
8176        $Type_Init{"Init"} .= $Target_TmpPreamble;
8177    }
8178
8179    # ref handler
8180    if($Type{"Type"} eq "Ref")
8181    {
8182        my $BaseRefId = get_OneStep_BaseTypeId($Init_Desc{"TypeId"});
8183        if(get_PointerLevel($BaseRefId) > 0)
8184        {
8185            my $BaseRefName = get_TypeName($BaseRefId);
8186            $Type_Init{"Init"} .= $BaseRefName." ".$Var."_ref = ".$Type_Init{"Call"}.";\n";
8187            $Type_Init{"Call"} = $Var."_ref";
8188            $Block_Variable{$CurrentBlock}{$Var."_ref"} = 1;
8189        }
8190    }
8191    $Type_Init{"IsCorrect"} = 1;
8192    return %Type_Init;
8193}
8194
8195sub declare_anon_union($$)
8196{
8197    my ($Key, $UnionId) = @_;
8198    return "" if($AuxType{$UnionId} or not $UnionId or not $Key);
8199    my %Union = get_Type($UnionId);
8200    my @MembStr = ();
8201    my ($Headers, $Declarations) = ([], "");
8202    foreach my $Member_Pos (sort {int($a)<=>int($b)} keys(%{$Union{"Memb"}}))
8203    { # create member types string
8204        my $Member_Name = $Union{"Memb"}{$Member_Pos}{"name"};
8205        my $MemberType_Id = $Union{"Memb"}{$Member_Pos}{"type"};
8206        my $MemberFType_Id = get_FoundationTypeId($MemberType_Id);
8207        my $MemberType_Name = "";
8208        if(isAnon(get_TypeName($MemberFType_Id)))
8209        {
8210            my ($FieldEType_Id, $Field_Declarations, $Field_Headers) = get_ExtTypeId($Key, $MemberType_Id);
8211            $Headers = addHeaders($Field_Headers, $Headers);
8212            $Declarations .= $Field_Declarations;
8213            $MemberType_Name = get_TypeName($FieldEType_Id);
8214        }
8215        else {
8216            $MemberType_Name = get_TypeName($MemberFType_Id);
8217        }
8218        my $MembDecl = create_member_decl($MemberType_Name, $Member_Name);
8219        @MembStr = (@MembStr, $MembDecl);
8220    }
8221    my $Type_Name = select_type_name("union_type_".$Key);
8222    $Declarations .= "//auxiliary union type\nunion ".$Type_Name;
8223    $Declarations .= "{\n    ".join(";\n    ", @MembStr).";};\n\n";
8224    $AuxType{$UnionId} = "union ".$Type_Name;
8225    $TName_Tid{$AuxType{$UnionId}} = $UnionId;
8226    $TypeInfo{$UnionId}{"Name_Old"} = $Union{"Name"};
8227    $TypeInfo{$UnionId}{"Name"} = $AuxType{$UnionId};
8228    return ($Declarations, $Headers);
8229}
8230
8231sub declare_anon_struct($$)
8232{
8233    my ($Key, $StructId) = @_;
8234    return () if($AuxType{$StructId} or not $StructId or not $Key);
8235    my %Struct = get_Type($StructId);
8236    my @MembStr = ();
8237    my ($Headers, $Declarations) = ([], "");
8238    foreach my $Member_Pos (sort {int($a)<=>int($b)} keys(%{$Struct{"Memb"}}))
8239    {
8240        my $Member_Name = $Struct{"Memb"}{$Member_Pos}{"name"};
8241        my $MemberType_Id = $Struct{"Memb"}{$Member_Pos}{"type"};
8242        my $MemberFType_Id = get_FoundationTypeId($MemberType_Id);
8243        my $MemberType_Name = "";
8244        if(isAnon(get_TypeName($MemberFType_Id)))
8245        {
8246            my ($FieldEType_Id, $Field_Declarations, $Field_Headers) = get_ExtTypeId($Key, $MemberType_Id);
8247            $Headers = addHeaders($Field_Headers, $Headers);
8248            $Declarations .= $Field_Declarations;
8249            $MemberType_Name = get_TypeName($FieldEType_Id);
8250        }
8251        else {
8252            $MemberType_Name = get_TypeName($MemberFType_Id);
8253        }
8254        my $MembDecl = create_member_decl($MemberType_Name, $Member_Name);
8255        @MembStr = (@MembStr, $MembDecl);
8256    }
8257    my $Type_Name = select_type_name("struct_type_".$Key);
8258    $Declarations .= "//auxiliary struct type\nstruct ".$Type_Name;
8259    $Declarations .= "{\n    ".join(";\n    ", @MembStr).";};\n\n";
8260    $AuxType{$StructId} = "struct ".$Type_Name;
8261    $TName_Tid{$AuxType{$StructId}} = $StructId;
8262    $TypeInfo{$StructId}{"Name_Old"} = $Struct{"Name"};
8263    $TypeInfo{$StructId}{"Name"} = $AuxType{$StructId};
8264    return ($Declarations, $Headers);
8265}
8266
8267sub create_member_decl($$)
8268{
8269    my ($TName, $Member) = @_;
8270    if($TName=~/\([\*]+\)/)
8271    {
8272        $TName=~s/\(([\*]+)\)/\($1$Member\)/;
8273        return $TName;
8274    }
8275    else
8276    {
8277        my @ArraySizes = ();
8278        while($TName=~s/(\[[^\[\]]*\])\Z//) {
8279            push(@ArraySizes, $1);
8280        }
8281        return $TName." ".$Member.join("", @ArraySizes);
8282    }
8283}
8284
8285sub assembleStruct(@)
8286{
8287    my %Init_Desc = @_;
8288    my %Type_Init = ();
8289    my %Type = get_Type($Init_Desc{"TypeId"});
8290    my $Type_PointerLevel = get_PointerLevel($Init_Desc{"TypeId"});
8291    my $StructId = get_FoundationTypeId($Init_Desc{"TypeId"});
8292    my $StructName = get_TypeName($StructId);
8293    return () if($OpaqueTypes{$StructName});
8294    my %Struct = get_Type($StructId);
8295    return () if(not keys(%{$Struct{"Memb"}}));
8296    my $Global_State = save_state();
8297    $Init_Desc{"Var"} = select_var_name($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $Init_Desc{"ParamNameExt"});
8298    my $Var = $Init_Desc{"Var"};
8299    if($Type_PointerLevel>0 or $Type{"Type"} eq "Ref"
8300    or not $Init_Desc{"InLine"}) {
8301        $Block_Variable{$CurrentBlock}{$Var} = 1;
8302    }
8303    $Type_Init{"Headers"} = addHeaders([$Struct{"Header"}], $Type_Init{"Headers"});
8304    my @ParamStr = ();
8305    my $Static = "";
8306    foreach my $Member_Pos (sort {int($a)<=>int($b)} keys(%{$Struct{"Memb"}}))
8307    { # initialize members
8308        my $Member_Name = $Struct{"Memb"}{$Member_Pos}{"name"};
8309        if(getSymLang($TestedInterface) eq "C")
8310        {
8311            if($Member_Name eq "c_class"
8312            and $StructName=~/\A(struct |)(XWindowAttributes|Visual|XVisualInfo)\Z/)
8313            { # for X11
8314                $Member_Name = "class";
8315            }
8316            elsif($Member_Name eq "c_explicit"
8317            and $StructName=~/\A(struct |)(_XkbServerMapRec)\Z/)
8318            { # for X11
8319                $Member_Name = "explicit";
8320            }
8321            elsif($Member_Name=~/\A(__|)fds_bits\Z/ and $StructName eq "fd_set")
8322            { # for libc
8323                if(defined $Constants{"__USE_XOPEN"}) {
8324                    $Member_Name = "fds_bits";
8325                }
8326                else {
8327                    $Member_Name = "__fds_bits";
8328                }
8329            }
8330        }
8331        my $MemberType_Id = $Struct{"Memb"}{$Member_Pos}{"type"};
8332        my $MemberFType_Id = get_FoundationTypeId($MemberType_Id);
8333
8334        if(not $Static)
8335        {
8336            if($Member_Pos+1==keys(%{$Struct{"Memb"}}))
8337            {
8338                if(get_TypeName($MemberFType_Id)=~/\[\]/)
8339                { # flexible arrays
8340                    $Static = "static ";
8341                }
8342            }
8343        }
8344
8345        if(get_TypeType($MemberFType_Id) eq "Array")
8346        {
8347            my $ArrayElemType_Id = get_FoundationTypeId(get_OneStep_BaseTypeId($MemberFType_Id));
8348            if(get_TypeType($ArrayElemType_Id)=~/\A(Intrinsic|Enum)\Z/)
8349            {
8350                if(get_TypeAttr($MemberFType_Id, "Count")>1024) {
8351                    next;
8352                }
8353            }
8354            else
8355            {
8356                if(get_TypeAttr($MemberFType_Id, "Count")>256) {
8357                    next;
8358                }
8359            }
8360        }
8361#         my $Member_Access = $Struct{"Memb"}{$Member_Pos}{"access"};
8362#         return () if($Member_Access eq "private" or $Member_Access eq "protected");
8363        my $Memb_Key = "";
8364        if($Member_Name) {
8365            $Memb_Key = ($Init_Desc{"Key"})?$Init_Desc{"Key"}."_".$Member_Name:$Member_Name;
8366        }
8367        else {
8368            $Memb_Key = ($Init_Desc{"Key"})?$Init_Desc{"Key"}."_".($Member_Pos+1):"m".($Member_Pos+1);
8369        }
8370        my %Memb_Init = initializeParameter((
8371            "TypeId" => $MemberType_Id,
8372            "Key" => $Memb_Key,
8373            "InLine" => 1,
8374            "Value" => "no value",
8375            "ValueTypeId" => 0,
8376            "TargetTypeId" => 0,
8377            "CreateChild" => 0,
8378            "Usage" => "Common",
8379            "ParamName" => $Member_Name,
8380            "OuterType_Type" => "Struct",
8381            "OuterType_Id" => $StructId));
8382        if(not $Memb_Init{"IsCorrect"}) {
8383            restore_state($Global_State);
8384            return ();
8385        }
8386        $Type_Init{"Code"} .= $Memb_Init{"Code"};
8387        $Type_Init{"Headers"} = addHeaders($Memb_Init{"Headers"}, $Type_Init{"Headers"});
8388        $Memb_Init{"Call"} = alignCode($Memb_Init{"Call"}, get_paragraph($Memb_Init{"Call"}, 1)."    ", 1);
8389        if(getSymLang($TestedInterface) eq "C"
8390        and $OSgroup ne "windows") {
8391            @ParamStr = (@ParamStr, "\.$Member_Name = ".$Memb_Init{"Call"});
8392        }
8393        else {
8394            @ParamStr = (@ParamStr, $Memb_Init{"Call"});
8395        }
8396        $Type_Init{"Init"} .= $Memb_Init{"Init"};
8397        $Type_Init{"Destructors"} .= $Memb_Init{"Destructors"};
8398    }
8399    if(my $Typedef_Id = get_type_typedef($StructId)) {
8400        $StructName = get_TypeName($Typedef_Id);
8401    }
8402
8403    # initialization
8404    if($Type_PointerLevel==0 and ($Type{"Type"} ne "Ref") and $Init_Desc{"InLine"} and not $Static)
8405    {
8406        my $Conversion = (not isAnon($StructName) and not isAnon($Struct{"Name_Old"}))?"(".$Type{"Name"}.") ":"";
8407        $Type_Init{"Call"} = $Conversion."{".create_list(\@ParamStr, "    ")."}";
8408        $Type_Init{"TypeName"} = $Type{"Name"};
8409    }
8410    else
8411    {
8412        if(not defined $DisableReuse) {
8413            $ValueCollection{$CurrentBlock}{$Var} = $StructId;
8414        }
8415        if(isAnon($StructName))
8416        {
8417            my ($AnonStruct_Declarations, $AnonStruct_Headers) = declare_anon_struct($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $StructId);
8418            $Type_Init{"Code"} .= $AnonStruct_Declarations;
8419            $Type_Init{"Headers"} = addHeaders($AnonStruct_Headers, $Type_Init{"Headers"});
8420            $Type_Init{"Init"} .= $Static.get_TypeName($StructId)." $Var = {".create_list(\@ParamStr, "    ")."};\n";
8421            $Type_Init{"TypeName"} = get_TypeName($StructId);
8422            foreach (1 .. $Type_PointerLevel) {
8423                $Type_Init{"TypeName"} .= "*";
8424            }
8425        }
8426        else
8427        {
8428            $Type_Init{"Init"} .= $Static.$StructName." $Var = {".create_list(\@ParamStr, "    ")."};\n";
8429            $Type_Init{"TypeName"} = $Type{"Name"};
8430        }
8431        # create call
8432        my ($Call, $TmpPreamble) =
8433        convertTypes((
8434            "InputTypeName"=>get_TypeName($StructId),
8435            "InputPointerLevel"=>0,
8436            "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
8437            "Value"=>$Var,
8438            "Key"=>$Var,
8439            "Destination"=>"Param",
8440            "MustConvert"=>0));
8441        $Type_Init{"Init"} .= $TmpPreamble;
8442        $Type_Init{"Call"} = $Call;
8443        # create call for constraint
8444        if($Init_Desc{"TargetTypeId"}==$Init_Desc{"TypeId"}) {
8445            $Type_Init{"TargetCall"} = $Type_Init{"Call"};
8446        }
8447        else
8448        {
8449            my ($TargetCall, $Target_TmpPreamble) =
8450            convertTypes((
8451                "InputTypeName"=>get_TypeName($StructId),
8452                "InputPointerLevel"=>0,
8453                "OutputTypeId"=>$Init_Desc{"TargetTypeId"},
8454                "Value"=>$Var,
8455                "Key"=>$Var,
8456                "Destination"=>"Target",
8457                "MustConvert"=>0));
8458            $Type_Init{"TargetCall"} = $TargetCall;
8459            $Type_Init{"Init"} .= $Target_TmpPreamble;
8460        }
8461        #ref handler
8462        if($Type{"Type"} eq "Ref")
8463        {
8464            my $BaseRefId = get_OneStep_BaseTypeId($Init_Desc{"TypeId"});
8465            if(get_PointerLevel($BaseRefId) > 0)
8466            {
8467                my $BaseRefName = get_TypeName($BaseRefId);
8468                $Type_Init{"Init"} .= $BaseRefName." ".$Var."_ref = ".$Type_Init{"Call"}.";\n";
8469                $Type_Init{"Call"} = $Var."_ref";
8470                $Block_Variable{$CurrentBlock}{$Var."_ref"} = 1;
8471                if(not defined $DisableReuse) {
8472                    $ValueCollection{$CurrentBlock}{$Var."_ref"} = $Init_Desc{"TypeId"};
8473                }
8474            }
8475        }
8476    }
8477    $Type_Init{"IsCorrect"} = 1;
8478    return %Type_Init;
8479}
8480
8481sub getSomeEnumMember($)
8482{
8483    my $EnumId = $_[0];
8484    my %Enum = get_Type($EnumId);
8485    return "" if(not keys(%{$Enum{"Memb"}}));
8486    my @Members = ();
8487    foreach my $MembPos (sort{int($a)<=>int($b)} keys(%{$Enum{"Memb"}})) {
8488        push(@Members, $Enum{"Memb"}{$MembPos}{"name"});
8489    }
8490    if($RandomCode) {
8491        @Members = mix_array(@Members);
8492    }
8493    my @ValidMembers = ();
8494    foreach my $Member (@Members)
8495    {
8496        if(is_valid_constant($Member)) {
8497            push(@ValidMembers, $Member);
8498        }
8499    }
8500    my $MemberName = $Members[0];
8501    if($#ValidMembers>=0) {
8502        $MemberName = $ValidMembers[0];
8503    }
8504    if($Enum{"NameSpace"} and $MemberName
8505    and getSymLang($TestedInterface) eq "C++") {
8506        $MemberName = $Enum{"NameSpace"}."::".$MemberName;
8507    }
8508    return $MemberName;
8509}
8510
8511sub getEnumMembers($)
8512{
8513    my $EnumId = $_[0];
8514    my %Enum = get_Type($EnumId);
8515    return () if(not keys(%{$Enum{"Memb"}}));
8516    my @Members = ();
8517    foreach my $MembPos (sort{int($a)<=>int($b)} keys(%{$Enum{"Memb"}})) {
8518        push(@Members, $Enum{"Memb"}{$MembPos}{"name"});
8519    }
8520    return \@Members;
8521}
8522
8523sub add_NullSpecType(@)
8524{
8525    my %Init_Desc = @_;
8526    my %NewInit_Desc = %Init_Desc;
8527    my $PointerLevel = get_PointerLevel($Init_Desc{"TypeId"});
8528    my $TypeName = get_TypeName($Init_Desc{"TypeId"});
8529    if($TypeName=~/\&/ or not $Init_Desc{"InLine"}) {
8530        $NewInit_Desc{"InLine"} = 0;
8531    }
8532    else {
8533        $NewInit_Desc{"InLine"} = 1;
8534    }
8535    if($PointerLevel>=1)
8536    {
8537        if($Init_Desc{"OuterType_Type"}!~/\A(Struct|Union|Array)\Z/
8538        and (isOutParam_NoUsing($Init_Desc{"TypeId"}, $Init_Desc{"ParamName"}, $Init_Desc{"Interface"})
8539        or $Interface_OutParam{$Init_Desc{"Interface"}}{$Init_Desc{"ParamName"}}
8540        or $Interface_OutParam_NoUsing{$Init_Desc{"Interface"}}{$Init_Desc{"ParamName"}} or $PointerLevel>=2))
8541        {
8542            $NewInit_Desc{"InLine"} = 0;
8543            $NewInit_Desc{"ValueTypeId"} = reduce_pointer_level($Init_Desc{"TypeId"});
8544            if($PointerLevel>=2) {
8545                $NewInit_Desc{"Value"} = get_null();
8546            }
8547            else {
8548                $NewInit_Desc{"OnlyDecl"} = 1;
8549            }
8550        }
8551        else
8552        {
8553            $NewInit_Desc{"Value"} = get_null();
8554            $NewInit_Desc{"ValueTypeId"} = $Init_Desc{"TypeId"};
8555            $NewInit_Desc{"ByNull"}=1;
8556        }
8557    }
8558    else {
8559        $NewInit_Desc{"Value"} = "no value";
8560    }
8561    return %NewInit_Desc;
8562}
8563
8564sub initializeIntrinsic(@)
8565{
8566    my %Init_Desc = @_;
8567    $Init_Desc{"StrongTypeCompliance"} = 1;
8568    my %Type_Init = initializeByInterface(%Init_Desc);
8569    if($Type_Init{"IsCorrect"}) {
8570        return %Type_Init;
8571    }
8572    else {
8573        return initializeByInterface_OutParam(%Init_Desc);
8574    }
8575}
8576
8577sub initializeRetVal(@)
8578{
8579    my %Init_Desc = @_;
8580    return () if(get_TypeName($Init_Desc{"TypeId"}) eq "void*");
8581    my %Type_Init = initializeByInterface(%Init_Desc);
8582    if($Type_Init{"IsCorrect"}) {
8583        return %Type_Init;
8584    }
8585    else {
8586        return initializeByInterface_OutParam(%Init_Desc);
8587    }
8588}
8589
8590sub initializeEnum(@)
8591{
8592    my %Init_Desc = @_;
8593    return initializeByInterface(%Init_Desc);
8594}
8595
8596sub is_geometry_body($)
8597{
8598    my $TypeId = $_[0];
8599    return 0 if(not $TypeId);
8600    my $StructId = get_FoundationTypeId($TypeId);
8601    my %Struct = get_Type($StructId);
8602    return 0 if($Struct{"Name"}!~/rectangle|line/i);
8603    return 0 if($Struct{"Type"} ne "Struct");
8604    foreach my $Member_Pos (sort {int($a)<=>int($b)} keys(%{$Struct{"Memb"}}))
8605    {
8606        if(get_TypeType(get_FoundationTypeId($Struct{"Memb"}{$Member_Pos}{"type"}))!~/\A(Intrinsic|Enum)\Z/) {
8607            return 0;
8608        }
8609    }
8610    return 1;
8611}
8612
8613sub initializeUnion(@)
8614{
8615    my %Init_Desc = @_;
8616    $Init_Desc{"Strong"}=1;
8617    my %Type_Init = initializeByInterface_OutParam(%Init_Desc);
8618    if($Type_Init{"IsCorrect"}) {
8619        return %Type_Init;
8620    }
8621    else
8622    {
8623        delete($Init_Desc{"Strong"});
8624        %Type_Init = initializeByInterface(%Init_Desc);
8625        if($Type_Init{"IsCorrect"}) {
8626            return %Type_Init;
8627        }
8628        else
8629        {
8630            %Type_Init = assembleUnion(%Init_Desc);
8631            if($Type_Init{"IsCorrect"}) {
8632                return %Type_Init;
8633            }
8634            else {
8635                return initializeByInterface_OutParam(%Init_Desc);
8636            }
8637        }
8638    }
8639}
8640
8641sub initializeStruct(@)
8642{
8643    my %Init_Desc = @_;
8644    if(is_geometry_body($Init_Desc{"TypeId"}))
8645    { # GdkRectangle
8646        return assembleStruct(%Init_Desc);
8647    }
8648#     $Init_Desc{"Strong"}=1;
8649#     my %Type_Init = initializeByInterface_OutParam(%Init_Desc);
8650#     if($Type_Init{"IsCorrect"})
8651#     {
8652#         return %Type_Init;
8653#     }
8654#     else
8655#     {
8656#         delete($Init_Desc{"Strong"});
8657    $Init_Desc{"OnlyReturn"}=1;
8658    my %Type_Init = initializeByInterface(%Init_Desc);
8659    if($Type_Init{"IsCorrect"}) {
8660        return %Type_Init;
8661    }
8662    else
8663    {
8664        return () if($Init_Desc{"OnlyByInterface"});
8665        delete($Init_Desc{"OnlyReturn"});
8666        %Type_Init = initializeByInterface_OutParam(%Init_Desc);
8667        if($Type_Init{"IsCorrect"}) {
8668            return %Type_Init;
8669        }
8670        else
8671        {
8672            $Init_Desc{"OnlyData"}=1;
8673            %Type_Init = initializeByInterface(%Init_Desc);
8674            if($Type_Init{"IsCorrect"}) {
8675                return %Type_Init;
8676            }
8677            else
8678            {
8679                delete($Init_Desc{"OnlyData"});
8680                %Type_Init = initializeByAlienInterface(%Init_Desc);
8681                if($Type_Init{"IsCorrect"}) {
8682                    return %Type_Init;
8683                }
8684                else
8685                {
8686                    %Type_Init = initializeSubClass_Struct(%Init_Desc);
8687                    if($Type_Init{"IsCorrect"}) {
8688                        return %Type_Init;
8689                    }
8690                    else
8691                    {
8692                        if($Init_Desc{"DoNotAssembly"}) {
8693                            return initializeByField(%Init_Desc);
8694                        }
8695                        else
8696                        {
8697                            %Type_Init = assembleStruct(%Init_Desc);
8698                            if($Type_Init{"IsCorrect"}) {
8699                                return %Type_Init;
8700                            }
8701                            else
8702                            {
8703                                %Type_Init = assembleClass(%Init_Desc);
8704                                if($Type_Init{"IsCorrect"}) {
8705                                    return %Type_Init;
8706                                }
8707                                else {
8708                                    return initializeByField(%Init_Desc);
8709                                }
8710                            }
8711                        }
8712                    }
8713                }
8714            }
8715        }
8716    }
8717}
8718
8719sub initializeByAlienInterface(@)
8720{ # GtkWidget*  gtk_plug_new (GdkNativeWindow socket_id)
8721  # return GtkPlug*
8722    my %Init_Desc = @_;
8723    if($Init_Desc{"ByInterface"} = find_alien_interface($Init_Desc{"TypeId"}))
8724    {
8725        my %Type_Init = initializeByInterface(%Init_Desc);
8726        if(not $Type_Init{"ByNull"}) {
8727            return %Type_Init;
8728        }
8729    }
8730    return ();
8731}
8732
8733sub find_alien_interface($)
8734{
8735    my $TypeId = $_[0];
8736    return "" if(not $TypeId);
8737    return "" if(get_PointerLevel($TypeId)!=1);
8738    my $StructId = get_FoundationTypeId($TypeId);
8739    return "" if(get_TypeType($StructId) ne "Struct");
8740    my $Desirable = get_TypeName($StructId);
8741    $Desirable=~s/\Astruct //g;
8742    $Desirable=~s/\A[_]+//g;
8743    while($Desirable=~s/([a-z]+)([A-Z][a-z]+)/$1_$2/g){};
8744    $Desirable = lc($Desirable);
8745    my @Cnadidates = ($Desirable."_new", $Desirable."_create");
8746    foreach my $Candiate (@Cnadidates)
8747    {
8748        if(defined $CompleteSignature{$Candiate}
8749        and $CompleteSignature{$Candiate}{"Header"}
8750        and get_PointerLevel($CompleteSignature{$Candiate}{"Return"})==1)  {
8751            return $Candiate;
8752        }
8753    }
8754    return "";
8755}
8756
8757sub initializeByField(@)
8758{ # FIXME: write body of this function
8759    my %Init_Desc = @_;
8760    return ();
8761}
8762
8763sub initializeSubClass_Struct(@)
8764{
8765    my %Init_Desc = @_;
8766    $Init_Desc{"TypeId_Changed"} = $Init_Desc{"TypeId"} if(not $Init_Desc{"TypeId_Changed"});
8767    my $StructId = get_FoundationTypeId($Init_Desc{"TypeId"});
8768    my $StructName = get_TypeName($StructId);
8769    my $PLevel = get_PointerLevel($Init_Desc{"TypeId"});
8770    return () if(get_TypeType($StructId) ne "Struct" or $PLevel==0);
8771    foreach my $SubClassId (keys(%{$Struct_SubClasses{$StructId}}))
8772    {
8773        $Init_Desc{"TypeId"} = get_TypeId($SubClassId, $PLevel);
8774        next if(not $Init_Desc{"TypeId"});
8775        $Init_Desc{"DoNotAssembly"} = 1;
8776        my %Type_Init = initializeType(%Init_Desc);
8777        if($Type_Init{"IsCorrect"}) {
8778            return %Type_Init;
8779        }
8780    }
8781    if(my $ParentId = get_TypeId($Struct_Parent{$StructId}, $PLevel))
8782    {
8783        $Init_Desc{"TypeId"} = $ParentId;
8784        $Init_Desc{"DoNotAssembly"} = 1;
8785        $Init_Desc{"OnlyByInterface"} = 1;
8786        $Init_Desc{"KeyWords"} = $StructName;
8787        $Init_Desc{"KeyWords"}=~s/\Astruct //;
8788        my %Type_Init = initializeType(%Init_Desc);
8789        if($Type_Init{"IsCorrect"}
8790        and (not $Type_Init{"Interface"} or get_word_coinsidence($Type_Init{"Interface"}, $Init_Desc{"KeyWords"})>0)) {
8791            return %Type_Init;
8792        }
8793    }
8794}
8795
8796sub get_TypeId($$)
8797{
8798    my ($BaseTypeId, $PLevel) = @_;
8799    return 0 if(not $BaseTypeId);
8800    if(my @DerivedTypes = sort {length($a)<=>length($b)}
8801    keys(%{$BaseType_PLevel_Type{$BaseTypeId}{$PLevel}})) {
8802        return $DerivedTypes[0];
8803    }
8804    elsif(my $NewTypeId = register_new_type($BaseTypeId, $PLevel)) {
8805        return $NewTypeId;
8806    }
8807    else {
8808        return 0;
8809    }
8810}
8811
8812sub assembleUnion(@)
8813{
8814    my %Init_Desc = @_;
8815    my %Type_Init = ();
8816    my %Type = get_Type($Init_Desc{"TypeId"});
8817    my $Type_PointerLevel = get_PointerLevel($Init_Desc{"TypeId"});
8818    my $UnionId = get_FoundationTypeId($Init_Desc{"TypeId"});
8819    my %UnionType = get_Type($UnionId);
8820    my $UnionName = $UnionType{"Name"};
8821    return () if($OpaqueTypes{$UnionName});
8822    return () if(not keys(%{$UnionType{"Memb"}}));
8823    my $Global_State = save_state();
8824    $Init_Desc{"Var"} = select_var_name($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $Init_Desc{"ParamNameExt"});
8825    my $Var = $Init_Desc{"Var"};
8826    if($Type_PointerLevel>0 or $Type{"Type"} eq "Ref"
8827    or not $Init_Desc{"InLine"}) {
8828        $Block_Variable{$CurrentBlock}{$Var} = 1;
8829    }
8830    $Type_Init{"Headers"} = addHeaders([$UnionType{"Header"}], $Type_Init{"Headers"});
8831    my (%Memb_Init, $SelectedMember_Name) = ();
8832    foreach my $Member_Pos (sort {int($a)<=>int($b)} keys(%{$UnionType{"Memb"}}))
8833    { # initialize members
8834        my $Member_Name = $UnionType{"Memb"}{$Member_Pos}{"name"};
8835        my $MemberType_Id = $UnionType{"Memb"}{$Member_Pos}{"type"};
8836        my $Memb_Key = "";
8837        if($Member_Name) {
8838            $Memb_Key = ($Init_Desc{"Key"})?$Init_Desc{"Key"}."_".$Member_Name:$Member_Name;
8839        }
8840        else {
8841            $Memb_Key = ($Init_Desc{"Key"})?$Init_Desc{"Key"}."_".($Member_Pos+1):"m".($Member_Pos+1);
8842        }
8843        %Memb_Init = initializeParameter((
8844            "TypeId" => $MemberType_Id,
8845            "Key" => $Memb_Key,
8846            "InLine" => 1,
8847            "Value" => "no value",
8848            "ValueTypeId" => 0,
8849            "TargetTypeId" => 0,
8850            "CreateChild" => 0,
8851            "Usage" => "Common",
8852            "ParamName" => $Member_Name,
8853            "OuterType_Type" => "Union",
8854            "OuterType_Id" => $UnionId));
8855        next if(not $Memb_Init{"IsCorrect"});
8856        $SelectedMember_Name = $Member_Name;
8857        last;
8858    }
8859    if(not $Memb_Init{"IsCorrect"})
8860    {
8861        restore_state($Global_State);
8862        return ();
8863    }
8864    $Type_Init{"Code"} .= $Memb_Init{"Code"};
8865    $Type_Init{"Headers"} = addHeaders($Memb_Init{"Headers"}, $Type_Init{"Headers"});
8866    $Type_Init{"Init"} .= $Memb_Init{"Init"};
8867    $Type_Init{"Destructors"} .= $Memb_Init{"Destructors"};
8868    $Memb_Init{"Call"} = alignCode($Memb_Init{"Call"}, get_paragraph($Memb_Init{"Call"}, 1)."    ", 1);
8869    if(my $Typedef_Id = get_type_typedef($UnionId)) {
8870        $UnionName = get_TypeName($Typedef_Id);
8871    }
8872    # initialization
8873    if($Type_PointerLevel==0 and ($Type{"Type"} ne "Ref") and $Init_Desc{"InLine"})
8874    {
8875        my $Conversion = (not isAnon($UnionName) and not isAnon($UnionType{"Name_Old"}))?"(".$Type{"Name"}.") ":"";
8876        if($TestedInterface=~/\A(_Z|\?)/) { # C++
8877            $Type_Init{"Call"} = $Conversion."{".$Memb_Init{"Call"}."}";
8878        }
8879        else {
8880            $Type_Init{"Call"} = $Conversion."{\.$SelectedMember_Name = ".$Memb_Init{"Call"}."}";
8881        }
8882        $Type_Init{"TypeName"} = $Type{"Name"};
8883    }
8884    else
8885    {
8886        if(not defined $DisableReuse) {
8887            $ValueCollection{$CurrentBlock}{$Var} = $UnionId;
8888        }
8889        if(isAnon($UnionName))
8890        {
8891            my ($AnonUnion_Declarations, $AnonUnion_Headers) = declare_anon_union($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $UnionId);
8892            $Type_Init{"Code"} .= $AnonUnion_Declarations;
8893            $Type_Init{"Headers"} = addHeaders($AnonUnion_Headers, $Type_Init{"Headers"});
8894            if($TestedInterface=~/\A(_Z|\?)/) { # C++
8895                $Type_Init{"Init"} .= get_TypeName($UnionId)." $Var = {".$Memb_Init{"Call"}."};\n";
8896            }
8897            else {
8898                $Type_Init{"Init"} .= get_TypeName($UnionId)." $Var = {\.$SelectedMember_Name = ".$Memb_Init{"Call"}."};\n";
8899            }
8900            $Type_Init{"TypeName"} = "union ".get_TypeName($UnionId);
8901            foreach (1 .. $Type_PointerLevel) {
8902                $Type_Init{"TypeName"} .= "*";
8903            }
8904        }
8905        else
8906        {
8907            if($TestedInterface=~/\A(_Z|\?)/) { # C++
8908                $Type_Init{"Init"} .= $UnionName." $Var = {".$Memb_Init{"Call"}."};\n";
8909            }
8910            else {
8911                $Type_Init{"Init"} .= $UnionName." $Var = {\.$SelectedMember_Name = ".$Memb_Init{"Call"}."};\n";
8912            }
8913            $Type_Init{"TypeName"} = $Type{"Name"};
8914        }
8915        #create call
8916        my ($Call, $TmpPreamble) =
8917        convertTypes((
8918            "InputTypeName"=>get_TypeName($UnionId),
8919            "InputPointerLevel"=>0,
8920            "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
8921            "Value"=>$Var,
8922            "Key"=>$Var,
8923            "Destination"=>"Param",
8924            "MustConvert"=>0));
8925        $Type_Init{"Init"} .= $TmpPreamble;
8926        $Type_Init{"Call"} = $Call;
8927        #create call in constraint
8928        if($Init_Desc{"TargetTypeId"}==$Init_Desc{"TypeId"}) {
8929            $Type_Init{"TargetCall"} = $Type_Init{"Call"};
8930        }
8931        else
8932        {
8933            my ($TargetCall, $Target_TmpPreamble) =
8934            convertTypes((
8935                "InputTypeName"=>get_TypeName($UnionId),
8936                "InputPointerLevel"=>0,
8937                "OutputTypeId"=>$Init_Desc{"TargetTypeId"},
8938                "Value"=>$Var,
8939                "Key"=>$Var,
8940                "Destination"=>"Target",
8941                "MustConvert"=>0));
8942            $Type_Init{"TargetCall"} = $TargetCall;
8943            $Type_Init{"Init"} .= $Target_TmpPreamble;
8944        }
8945        #ref handler
8946        if($Type{"Type"} eq "Ref")
8947        {
8948            my $BaseRefId = get_OneStep_BaseTypeId($Init_Desc{"TypeId"});
8949            if(get_PointerLevel($BaseRefId) > 0)
8950            {
8951                my $BaseRefName = get_TypeName($BaseRefId);
8952                $Type_Init{"Init"} .= $BaseRefName." ".$Var."_ref = ".$Type_Init{"Call"}.";\n";
8953                $Type_Init{"Call"} = $Var."_ref";
8954                $Block_Variable{$CurrentBlock}{$Var."_ref"} = 1;
8955                if(not defined $DisableReuse) {
8956                    $ValueCollection{$CurrentBlock}{$Var."_ref"} = $Init_Desc{"TypeId"};
8957                }
8958            }
8959        }
8960    }
8961    $Type_Init{"IsCorrect"} = 1;
8962    return %Type_Init;
8963}
8964
8965sub initializeClass(@)
8966{
8967    my %Init_Desc = @_;
8968    my %Type_Init = ();
8969    if($Init_Desc{"CreateChild"})
8970    {
8971        $Init_Desc{"InheritingPriority"} = "High";
8972        return assembleClass(%Init_Desc);
8973    }
8974    else
8975    {
8976        if((get_TypeType($Init_Desc{"TypeId"}) eq "Typedef"))
8977        { # try to initialize typedefs by interface return value
8978            %Type_Init = initializeByInterface(%Init_Desc);
8979            if($Type_Init{"IsCorrect"}) {
8980                return %Type_Init;
8981            }
8982        }
8983        $Init_Desc{"InheritingPriority"} = "Low";
8984        %Type_Init = assembleClass(%Init_Desc);
8985        if($Type_Init{"IsCorrect"}) {
8986            return %Type_Init;
8987        }
8988        else
8989        {
8990            if(isAbstractClass(get_FoundationTypeId($Init_Desc{"TypeId"})))
8991            {
8992                $Init_Desc{"InheritingPriority"} = "High";
8993                %Type_Init = assembleClass(%Init_Desc);
8994                if($Type_Init{"IsCorrect"}) {
8995                    return %Type_Init;
8996                }
8997                else {
8998                    return initializeByInterface(%Init_Desc);
8999                }
9000            }
9001            else
9002            {
9003                %Type_Init = initializeByInterface(%Init_Desc);
9004                if($Type_Init{"IsCorrect"}) {
9005                    return %Type_Init;
9006                }
9007                else
9008                {
9009                    $Init_Desc{"InheritingPriority"} = "High";
9010                    %Type_Init = assembleClass(%Init_Desc);
9011                    if($Type_Init{"IsCorrect"}) {
9012                        return %Type_Init;
9013                    }
9014                    else {
9015                        return initializeByInterface_OutParam(%Init_Desc);
9016                    }
9017                }
9018            }
9019        }
9020    }
9021}
9022
9023sub has_public_destructor($$)
9024{
9025    my ($ClassId, $DestrType) = @_;
9026    my $ClassName = get_TypeName($ClassId);
9027    return $Cache{"has_public_destructor"}{$ClassId}{$DestrType} if($Cache{"has_public_destructor"}{$ClassId}{$DestrType});
9028    foreach my $Destructor (sort keys(%{$Class_Destructors{$ClassId}}))
9029    {
9030        if($Destructor=~/\Q$DestrType\E/)
9031        {
9032            if(not $CompleteSignature{$Destructor}{"Protected"})
9033            {
9034                $Cache{"has_public_destructor"}{$ClassId}{$DestrType} = $Destructor;
9035                return $Destructor;
9036            }
9037            else {
9038                return "";
9039            }
9040        }
9041    }
9042    $Cache{"has_public_destructor"}{$ClassId}{$DestrType} = "Default";
9043    return "Default";
9044}
9045
9046sub findConstructor($$)
9047{
9048    my ($ClassId, $Key) = @_;
9049    return () if(not $ClassId);
9050    foreach my $Constructor (get_CompatibleInterfaces($ClassId, "Construct", ""))
9051    {
9052        my %Interface_Init = callInterfaceParameters((
9053            "Interface"=>$Constructor,
9054            "Key"=>$Key,
9055            "ObjectCall"=>"no object"));
9056        if($Interface_Init{"IsCorrect"})
9057        {
9058            $Interface_Init{"Interface"} = $Constructor;
9059            return %Interface_Init;
9060        }
9061    }
9062    return ();
9063}
9064
9065sub assembleClass(@)
9066{
9067    my %Init_Desc = @_;
9068    my %Type_Init = ();
9069    my $Global_State = save_state();
9070    my $CreateDestructor = 1;
9071    $Type_Init{"TypeName"} = get_TypeName($Init_Desc{"TypeId"});
9072    my $ClassId = get_FoundationTypeId($Init_Desc{"TypeId"});
9073    my $ClassName = get_TypeName($ClassId);
9074    my $PointerLevel = get_PointerLevel($Init_Desc{"TypeId"});
9075    $Init_Desc{"Var"} = select_var_name($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $Init_Desc{"ParamNameExt"});
9076    my $Var = $Init_Desc{"Var"};
9077    $Block_Variable{$CurrentBlock}{$Var} = 1;
9078    my %Obj_Init = findConstructor($ClassId, $Init_Desc{"Key"});
9079    if(not $Obj_Init{"IsCorrect"}) {
9080        restore_state($Global_State);
9081        return ();
9082    }
9083    $Type_Init{"Init"} = $Obj_Init{"Init"};
9084    $Type_Init{"Destructors"} = $Obj_Init{"Destructors"};
9085    $Type_Init{"Code"} = $Obj_Init{"Code"};
9086    $Type_Init{"Headers"} = addHeaders($Obj_Init{"Headers"}, $Type_Init{"Headers"});
9087    my $NeedToInheriting = (isAbstractClass($ClassId) or $Init_Desc{"CreateChild"} or isNotInCharge($Obj_Init{"Interface"}) or $CompleteSignature{$Obj_Init{"Interface"}}{"Protected"});
9088    if($Init_Desc{"InheritingPriority"} eq "Low"
9089    and $NeedToInheriting) {
9090        restore_state($Global_State);
9091        return ();
9092    }
9093    my $HeapStack = (($PointerLevel eq 0) and has_public_destructor($ClassId, "D1") and not $Init_Desc{"ObjectInit"} and (not $Init_Desc{"RetVal"} or get_TypeType($Init_Desc{"TypeId"}) ne "Ref"))?"Stack":"Heap";
9094    my $ChildName = getSubClassName($ClassName);
9095    if($NeedToInheriting)
9096    {
9097        if($Obj_Init{"Call"}=~/\A(\Q$ClassName\E([\n]*)\()/) {
9098            substr($Obj_Init{"Call"}, index($Obj_Init{"Call"}, $1), pos($1) + length($1)) = $ChildName.$2."(";
9099        }
9100        $UsedConstructors{$ClassId}{$Obj_Init{"Interface"}} = 1;
9101        $IntSubClass{$TestedInterface}{$ClassId} = 1;
9102        $Create_SubClass{$ClassId} = 1;
9103        $SubClass_Instance{$Var} = 1;
9104        $SubClass_ObjInstance{$Var} = 1 if($Init_Desc{"ObjectInit"});
9105    }
9106    my %AutoFinalCode_Init = ();
9107    my $Typedef_Id = detect_typedef($Init_Desc{"TypeId"});
9108    if(get_TypeName($ClassId)=~/list/i or get_TypeName($Typedef_Id)=~/list/i)
9109    { # auto final code
9110        %AutoFinalCode_Init = get_AutoFinalCode($Obj_Init{"Interface"}, ($HeapStack eq "Stack")?$Var:"*".$Var);
9111        if($AutoFinalCode_Init{"IsCorrect"}) {
9112            $Init_Desc{"InLine"} = 0;
9113        }
9114    }
9115    if($Obj_Init{"PreCondition"}
9116    or $Obj_Init{"PostCondition"}) {
9117        $Init_Desc{"InLine"} = 0;
9118    }
9119    # check precondition
9120    if($Obj_Init{"PreCondition"}) {
9121        $Type_Init{"Init"} .= $Obj_Init{"PreCondition"}."\n";
9122    }
9123    if($HeapStack eq "Stack")
9124    {
9125        $CreateDestructor = 0;
9126        if($Init_Desc{"InLine"} and ($PointerLevel eq 0))
9127        {
9128            $Type_Init{"Call"} = $Obj_Init{"Call"};
9129            $Type_Init{"TargetCall"} = $Type_Init{"Call"};
9130            delete($Block_Variable{$CurrentBlock}{$Var});
9131        }
9132        else
9133        {
9134            if(not defined $DisableReuse) {
9135                $ValueCollection{$CurrentBlock}{$Var} = $ClassId;
9136            }
9137            # $Type_Init{"Init"} .= "//parameter initialization\n";
9138            my $ConstructedName = ($NeedToInheriting)?$ChildName:$ClassName;
9139            $Type_Init{"Init"} .= correct_init_stmt($ConstructedName." $Var = ".$Obj_Init{"Call"}.";\n", $ConstructedName, $Var);
9140            # create call
9141            my ($Call, $TmpPreamble) =
9142            convertTypes((
9143                "InputTypeName"=>$ConstructedName,
9144                "InputPointerLevel"=>0,
9145                "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
9146                "Value"=>$Var,
9147                "Key"=>$Var,
9148                "Destination"=>"Param",
9149                "MustConvert"=>0));
9150            $Type_Init{"Init"} .= $TmpPreamble;
9151            $Type_Init{"Call"} = $Call;
9152            #call to constraint
9153            if($Init_Desc{"TargetTypeId"}==$Init_Desc{"TypeId"}) {
9154                $Type_Init{"TargetCall"} = $Type_Init{"Call"};
9155            }
9156            else
9157            {
9158                my ($TargetCall, $Target_TmpPreamble) =
9159                convertTypes((
9160                    "InputTypeName"=>$ConstructedName,
9161                    "InputPointerLevel"=>0,
9162                    "OutputTypeId"=>$Init_Desc{"TargetTypeId"},
9163                    "Value"=>$Var,
9164                    "Key"=>$Var,
9165                    "Destination"=>"Target",
9166                    "MustConvert"=>0));
9167                $Type_Init{"TargetCall"} = $TargetCall;
9168                $Type_Init{"Init"} .= $Target_TmpPreamble;
9169            }
9170        }
9171    }
9172    elsif($HeapStack eq "Heap")
9173    {
9174        if($Init_Desc{"InLine"} and ($PointerLevel eq 1))
9175        {
9176            $Type_Init{"Call"} = "new ".$Obj_Init{"Call"};
9177            $Type_Init{"TargetCall"} = $Type_Init{"Call"};
9178            $CreateDestructor = 0;
9179            delete($Block_Variable{$CurrentBlock}{$Var});
9180        }
9181        else
9182        {
9183            if(not defined $DisableReuse) {
9184                $ValueCollection{$CurrentBlock}{$Var} = get_TypeIdByName("$ClassName*");
9185            }
9186            #$Type_Init{"Init"} .= "//parameter initialization\n";
9187            if($NeedToInheriting)
9188            {
9189                if($Init_Desc{"ConvertToBase"}) {
9190                    $Type_Init{"Init"} .= $ClassName."* $Var = ($ClassName*)new ".$Obj_Init{"Call"}.";\n";
9191                }
9192                else {
9193                    $Type_Init{"Init"} .= $ChildName."* $Var = new ".$Obj_Init{"Call"}.";\n";
9194                }
9195            }
9196            else {
9197                $Type_Init{"Init"} .= $ClassName."* $Var = new ".$Obj_Init{"Call"}.";\n";
9198            }
9199            #create call
9200            my ($Call, $TmpPreamble) =
9201            convertTypes((
9202                "InputTypeName"=>"$ClassName*",
9203                "InputPointerLevel"=>1,
9204                "OutputTypeId"=>($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"},
9205                "Value"=>$Var,
9206                "Key"=>$Var,
9207                "Destination"=>"Param",
9208                "MustConvert"=>0));
9209            $Type_Init{"Init"} .= $TmpPreamble;
9210            $Type_Init{"Call"} = $Call;
9211            #call to constraint
9212            if($Init_Desc{"TargetTypeId"}==$Init_Desc{"TypeId"}) {
9213                $Type_Init{"TargetCall"} = $Type_Init{"Call"};
9214            }
9215            else
9216            {
9217                my ($TargetCall, $Target_TmpPreamble) =
9218                convertTypes((
9219                    "InputTypeName"=>"$ClassName*",
9220                    "InputPointerLevel"=>1,
9221                    "OutputTypeId"=>$Init_Desc{"TargetTypeId"},
9222                    "Value"=>$Var,
9223                    "Key"=>$Var,
9224                    "Destination"=>"Target",
9225                    "MustConvert"=>0));
9226                $Type_Init{"TargetCall"} = $TargetCall;
9227                $Type_Init{"Init"} .= $Target_TmpPreamble;
9228            }
9229        }
9230        # destructor for object
9231        if($CreateDestructor) # mayCallDestructors($ClassId)
9232        {
9233            if($HeapStack eq "Heap")
9234            {
9235                if($NeedToInheriting)
9236                {
9237                    if(has_public_destructor($ClassId, "D2")) {
9238                        $Type_Init{"Destructors"} .= "delete($Var);\n";
9239                    }
9240                }
9241                else
9242                {
9243                    if(has_public_destructor($ClassId, "D0")) {
9244                        $Type_Init{"Destructors"} .= "delete($Var);\n";
9245                    }
9246                }
9247            }
9248        }
9249    }
9250    # check postcondition
9251    if($Obj_Init{"PostCondition"}) {
9252        $Type_Init{"Init"} .= $Obj_Init{"PostCondition"}."\n";
9253    }
9254    if($Obj_Init{"ReturnRequirement"})
9255    {
9256        if($HeapStack eq "Stack") {
9257            $Obj_Init{"ReturnRequirement"}=~s/(\$0|\$obj)/$Var/gi;
9258        }
9259        else {
9260            $Obj_Init{"ReturnRequirement"}=~s/(\$0|\$obj)/*$Var/gi;
9261        }
9262        $Type_Init{"Init"} .= $Obj_Init{"ReturnRequirement"}."\n";
9263    }
9264    if($Obj_Init{"FinalCode"})
9265    {
9266        $Type_Init{"Init"} .= "//final code\n";
9267        $Type_Init{"Init"} .= $Obj_Init{"FinalCode"}."\n";
9268    }
9269    if(get_TypeType($Init_Desc{"TypeId"}) eq "Ref")
9270    { # obsolete
9271        my $BaseRefId = get_OneStep_BaseTypeId($Init_Desc{"TypeId"});
9272        if($HeapStack eq "Heap")
9273        {
9274            if(get_PointerLevel($BaseRefId)>1)
9275            {
9276                my $BaseRefName = get_TypeName($BaseRefId);
9277                $Type_Init{"Init"} .= $BaseRefName." ".$Var."_ref = ".$Type_Init{"Call"}.";\n";
9278                $Type_Init{"Call"} = $Var."_ref";
9279                $Block_Variable{$CurrentBlock}{$Var."_ref"} = 1;
9280                if(not defined $DisableReuse) {
9281                    $ValueCollection{$CurrentBlock}{$Var."_ref"} = $Init_Desc{"TypeId"};
9282                }
9283            }
9284        }
9285        else
9286        {
9287            if(get_PointerLevel($BaseRefId)>0)
9288            {
9289                my $BaseRefName = get_TypeName($BaseRefId);
9290                $Type_Init{"Init"} .= $BaseRefName." ".$Var."_ref = ".$Type_Init{"Call"}.";\n";
9291                $Type_Init{"Call"} = $Var."_ref";
9292                $Block_Variable{$CurrentBlock}{$Var."_ref"} = 1;
9293                if(not defined $DisableReuse) {
9294                    $ValueCollection{$CurrentBlock}{$Var."_ref"} = $Init_Desc{"TypeId"};
9295                }
9296            }
9297        }
9298    }
9299    $Type_Init{"IsCorrect"} = 1;
9300    if($Typedef_Id)
9301    {
9302        $Type_Init{"Headers"} = addHeaders(getTypeHeaders($Typedef_Id), $Type_Init{"Headers"});
9303        foreach my $Elem ("Call", "Init") {
9304            $Type_Init{$Elem} = cover_by_typedef($Type_Init{$Elem}, $ClassId, $Typedef_Id);
9305        }
9306    }
9307    else {
9308        $Type_Init{"Headers"} = addHeaders(getTypeHeaders($ClassId), $Type_Init{"Headers"});
9309    }
9310    if($AutoFinalCode_Init{"IsCorrect"})
9311    {
9312        $Type_Init{"Init"} = $AutoFinalCode_Init{"Init"}.$Type_Init{"Init"}.$AutoFinalCode_Init{"PreCondition"}.$AutoFinalCode_Init{"Call"}.";\n".$AutoFinalCode_Init{"FinalCode"}.$AutoFinalCode_Init{"PostCondition"};
9313        $Type_Init{"Code"} .= $AutoFinalCode_Init{"Code"};
9314        $Type_Init{"Destructors"} .= $AutoFinalCode_Init{"Destructors"};
9315        $Type_Init{"Headers"} = addHeaders($AutoFinalCode_Init{"Headers"}, $Type_Init{"Headers"});
9316    }
9317    return %Type_Init;
9318}
9319
9320sub cover_by_typedef($$$)
9321{
9322    my ($Code, $Type_Id, $Typedef_Id) = @_;
9323    if($Class_SubClassTypedef{$Type_Id}) {
9324        $Typedef_Id = $Class_SubClassTypedef{$Type_Id};
9325    }
9326    return $Code if(not $Code or not $Type_Id or not $Typedef_Id);
9327    return $Code if(not $Type_Id or not $Typedef_Id);
9328    return $Code if(get_TypeType($Type_Id)!~/\A(Class|Struct)\Z/);
9329    my $Type_Name = get_TypeName($Type_Id);
9330    my $Typedef_Name = get_TypeName($Typedef_Id);
9331    if(length($Typedef_Name)>=length($Type_Name)) {
9332        return $Code;
9333    }
9334    my $Child_Name_Old = getSubClassName($Type_Name);
9335    my $Child_Name_New = getSubClassName($Typedef_Name);
9336    $Class_SubClassTypedef{$Type_Id}=$Typedef_Id;
9337    $Code=~s/(\W|\A)\Q$Child_Name_Old\E(\W|\Z)/$1$Child_Name_New$2/g;
9338    if($Type_Name=~/\W\Z/)
9339    {
9340        $Code=~s/(\W|\A)\Q$Type_Name\E(\W|\Z)/$1$Typedef_Name$2/g;
9341        $Code=~s/(\W|\A)\Q$Type_Name\E(\w|\Z)/$1$Typedef_Name $2/g;
9342    }
9343    else {
9344        $Code=~s/(\W|\A)\Q$Type_Name\E(\W|\Z)/$1$Typedef_Name$2/g;
9345    }
9346    return $Code;
9347}
9348
9349sub get_type_typedef($)
9350{
9351    my $ClassId = $_[0];
9352    if($Class_SubClassTypedef{$ClassId}) {
9353        return $Class_SubClassTypedef{$ClassId};
9354    }
9355    my @Types = (keys(%{$Type_Typedef{$ClassId}}));
9356    @Types = sort {lc(get_TypeName($a)) cmp lc(get_TypeName($b))} @Types;
9357    @Types = sort {length(get_TypeName($a)) <=> length(get_TypeName($b))} @Types;
9358    if($#Types==0) {
9359        return $Types[0];
9360    }
9361    else {
9362        return 0;
9363    }
9364}
9365
9366sub is_used_var($$)
9367{
9368    my ($Block, $Var) = @_;
9369    return ($Block_Variable{$Block}{$Var} or $ValueCollection{$Block}{$Var}
9370    or not is_allowed_var_name($Var));
9371}
9372
9373sub select_var_name($$)
9374{
9375    my ($Var_Name, $SuffixCandidate) = @_;
9376    my $OtherVarPrefix = 1;
9377    my $Candidate = $Var_Name;
9378    if($Var_Name=~/\Ap\d+\Z/)
9379    {
9380        $Var_Name = "p";
9381        while(is_used_var($CurrentBlock, $Candidate))
9382        {
9383            $Candidate = $Var_Name.$OtherVarPrefix;
9384            $OtherVarPrefix += 1;
9385        }
9386    }
9387    else
9388    {
9389        if($SuffixCandidate)
9390        {
9391            $Candidate = $Var_Name."_".$SuffixCandidate;
9392            if(not is_used_var($CurrentBlock, $Candidate)) {
9393                return $Candidate;
9394            }
9395        }
9396        if($Var_Name eq "description" and is_used_var($CurrentBlock, $Var_Name)
9397        and not is_used_var($CurrentBlock, "desc")) {
9398            return "desc";
9399        }
9400        elsif($Var_Name eq "system" and is_used_var($CurrentBlock, $Var_Name)
9401        and not is_used_var($CurrentBlock, "sys")) {
9402            return "sys";
9403        }
9404        while(is_used_var($CurrentBlock, $Candidate))
9405        {
9406            $Candidate = $Var_Name."_".$OtherVarPrefix;
9407            $OtherVarPrefix += 1;
9408        }
9409    }
9410    return $Candidate;
9411}
9412
9413sub select_type_name($)
9414{
9415    my $Type_Name = $_[0];
9416    my $OtherPrefix = 1;
9417    my $NameCandidate = $Type_Name;
9418    while($TName_Tid{$NameCandidate}
9419    or $TName_Tid{"struct ".$NameCandidate}
9420    or $TName_Tid{"union ".$NameCandidate})
9421    {
9422        $NameCandidate = $Type_Name."_".$OtherPrefix;
9423        $OtherPrefix += 1;
9424    }
9425    return $NameCandidate;
9426}
9427
9428sub select_func_name($)
9429{
9430    my $FuncName = $_[0];
9431    my $OtherFuncPrefix = 1;
9432    my $Candidate = $FuncName;
9433    while(is_used_func_name($Candidate))
9434    {
9435        $Candidate = $FuncName."_".$OtherFuncPrefix;
9436        $OtherFuncPrefix += 1;
9437    }
9438    return $Candidate;
9439}
9440
9441sub is_used_func_name($)
9442{
9443    my $FuncName = $_[0];
9444    return 1 if($FuncNames{$FuncName});
9445    foreach my $FuncTypeId (keys(%AuxFunc))
9446    {
9447        if($AuxFunc{$FuncTypeId} eq $FuncName) {
9448            return 1;
9449        }
9450    }
9451    return 0;
9452}
9453
9454sub get_TypeStackId($)
9455{
9456    my $TypeId = $_[0];
9457    my $FoundationId = get_FoundationTypeId($TypeId);
9458    if(get_TypeType($FoundationId) eq "Intrinsic")
9459    {
9460        my %BaseTypedef = goToFirst($TypeId, "Typedef");
9461        if(get_TypeType($BaseTypedef{"Tid"}) eq "Typedef") {
9462            return $BaseTypedef{"Tid"};
9463        }
9464        else {
9465            return $FoundationId;
9466        }
9467    }
9468    else {
9469        return $FoundationId;
9470    }
9471}
9472
9473sub initializeType(@)
9474{
9475    my %Init_Desc = @_;
9476    return () if(not $Init_Desc{"TypeId"});
9477    my %Type_Init = ();
9478    my $Global_State = save_state();
9479    my $TypeName = get_TypeName($Init_Desc{"TypeId"});
9480    my $SpecValue = $Init_Desc{"Value"};
9481    %Init_Desc = add_VirtualSpecType(%Init_Desc);
9482    $Init_Desc{"Var"} = select_var_name($LongVarNames?$Init_Desc{"Key"}:$Init_Desc{"ParamName"}, $Init_Desc{"ParamNameExt"});
9483    if(($TypeName eq "...") and (($Init_Desc{"Value"} eq "no value") or ($Init_Desc{"Value"} eq "")))
9484    {
9485        $Type_Init{"IsCorrect"} = 1;
9486        $Type_Init{"Call"} = "";
9487        return %Type_Init;
9488    }
9489    if($TypeName eq "struct __va_list_tag*")
9490    { # initialize va_list
9491        if(my $VaList_Tid = $TName_Tid{"va_list"}) {
9492            $Init_Desc{"TypeId"} = $VaList_Tid;
9493        }
9494        %Type_Init = emptyDeclaration(%Init_Desc);
9495        $Type_Init{"Headers"} = addHeaders($Init_Desc{"Headers"}, $Type_Init{"Headers"});
9496        return %Type_Init;
9497    }
9498    my $FoundationId = get_FoundationTypeId($Init_Desc{"TypeId"});
9499    if(not $Init_Desc{"FoundationType_Type"}) {
9500        $Init_Desc{"FoundationType_Type"} = get_TypeType($FoundationId);
9501    }
9502    my $TypeStackId = get_TypeStackId($Init_Desc{"TypeId"});
9503    if(isCyclical(\@RecurTypeId, $TypeStackId))
9504    { # initialize by null for cyclical types
9505        if($Init_Desc{"Value"} ne "no value" and $Init_Desc{"Value"} ne "")
9506        {
9507            return () if(get_TypeType($TypeStackId) eq "Typedef" and $TypeName!~/_t/);
9508            %Type_Init = initializeByValue(%Init_Desc);
9509            $Type_Init{"Headers"} = addHeaders($Init_Desc{"Headers"}, $Type_Init{"Headers"});
9510            return %Type_Init;
9511        }
9512        else
9513        {
9514            %Init_Desc = add_NullSpecType(%Init_Desc);
9515            if($Init_Desc{"OnlyDecl"})
9516            {
9517                %Type_Init = emptyDeclaration(%Init_Desc);
9518                $Type_Init{"Headers"} = addHeaders($Init_Desc{"Headers"}, $Type_Init{"Headers"});
9519                return %Type_Init;
9520            }
9521            elsif(($Init_Desc{"Value"} ne "no value") and ($Init_Desc{"Value"} ne ""))
9522            {
9523                %Type_Init = initializeByValue(%Init_Desc);
9524                $Type_Init{"Headers"} = addHeaders($Init_Desc{"Headers"}, $Type_Init{"Headers"});
9525                return %Type_Init;
9526            }
9527            else {
9528                return ();
9529            }
9530        }
9531    }
9532    else
9533    {
9534        if($Init_Desc{"FoundationType_Type"} ne "Array") {
9535            push(@RecurTypeId, $TypeStackId);
9536        }
9537    }
9538    if(not $Init_Desc{"TargetTypeId"})
9539    { # repair target type
9540        $Init_Desc{"TargetTypeId"} = $Init_Desc{"TypeId"};
9541    }
9542    if($Init_Desc{"RetVal"} and get_PointerLevel($Init_Desc{"TypeId"})>=1
9543    and not $Init_Desc{"TypeType_Changed"} and $TypeName!~/(\W|\Z)const(\W|\Z)/)
9544    { # return value
9545        if(($Init_Desc{"Value"} ne "no value") and ($Init_Desc{"Value"} ne ""))
9546        { # try to initialize type by value
9547            %Type_Init = initializeByValue(%Init_Desc);
9548            if($Type_Init{"IsCorrect"})
9549            {
9550                if($Init_Desc{"FoundationType_Type"} ne "Array") {
9551                    pop(@RecurTypeId);
9552                }
9553                $Type_Init{"Headers"} = addHeaders($Init_Desc{"Headers"}, $Type_Init{"Headers"});
9554                return %Type_Init;
9555            }
9556        }
9557        else
9558        {
9559            %Type_Init = initializeRetVal(%Init_Desc);
9560            if($Type_Init{"IsCorrect"})
9561            {
9562                if($Init_Desc{"FoundationType_Type"} ne "Array") {
9563                    pop(@RecurTypeId);
9564                }
9565                $Type_Init{"Headers"} = addHeaders($Init_Desc{"Headers"}, $Type_Init{"Headers"});
9566                return %Type_Init;
9567            }
9568        }
9569    }
9570    if($Init_Desc{"OnlyDecl"})
9571    {
9572        %Type_Init = emptyDeclaration(%Init_Desc);
9573        $Type_Init{"Headers"} = addHeaders($Init_Desc{"Headers"}, $Type_Init{"Headers"});
9574        if($Init_Desc{"FoundationType_Type"} ne "Array") {
9575            pop(@RecurTypeId);
9576        }
9577        return %Type_Init;
9578    }
9579    my $RealTypeId = ($Init_Desc{"TypeId_Changed"})?$Init_Desc{"TypeId_Changed"}:$Init_Desc{"TypeId"};
9580    my $RealFTypeType = get_TypeType(get_FoundationTypeId($RealTypeId));
9581    if(($RealFTypeType eq "Intrinsic") and not $SpecValue and not $Init_Desc{"Reuse"} and not $Init_Desc{"OnlyByValue"} and $Init_Desc{"ParamName"}!~/num|width|height/i)
9582    { # initializing intrinsics by the interface
9583        my %BaseTypedef = goToFirst($RealTypeId, "Typedef");
9584        if(get_TypeType($BaseTypedef{"Tid"}) eq "Typedef"
9585        and $BaseTypedef{"Name"}!~/(int|short|long|error|real|float|double|bool|boolean|pointer|count|byte|len)\d*(_t|)\Z/i
9586        and $BaseTypedef{"Name"}!~/char|str|size|enum/i
9587        and $BaseTypedef{"Name"}!~/(\A|::)u(32|64)/i)
9588        { # try to initialize typedefs to intrinsic types
9589            my $Global_State1 = save_state();
9590            my %Init_Desc_Copy = %Init_Desc;
9591            $Init_Desc_Copy{"InLine"} = 0 if($Init_Desc{"ParamName"}!~/\Ap\d+\Z/);
9592            $Init_Desc_Copy{"TypeId"} = $RealTypeId;
9593            restore_state($Global_State);
9594            %Type_Init = initializeIntrinsic(%Init_Desc_Copy);
9595            if($Type_Init{"IsCorrect"})
9596            {
9597                if($Init_Desc{"FoundationType_Type"} ne "Array") {
9598                    pop(@RecurTypeId);
9599                }
9600                return %Type_Init;
9601            }
9602            else {
9603                restore_state($Global_State1);
9604            }
9605        }
9606    }
9607    if(($Init_Desc{"Value"} ne "no value") and ($Init_Desc{"Value"} ne ""))
9608    { # try to initialize type by value
9609        %Type_Init = initializeByValue(%Init_Desc);
9610        $Type_Init{"Headers"} = addHeaders($Init_Desc{"Headers"}, $Type_Init{"Headers"});
9611        if($Init_Desc{"FoundationType_Type"} ne "Array") {
9612            pop(@RecurTypeId);
9613        }
9614        return %Type_Init;
9615    }
9616    else {
9617        %Type_Init = selectInitializingWay(%Init_Desc);
9618    }
9619    if($Type_Init{"IsCorrect"})
9620    {
9621        $Type_Init{"Headers"} = addHeaders($Init_Desc{"Headers"}, $Type_Init{"Headers"});
9622        if($Init_Desc{"FoundationType_Type"} ne "Array") {
9623            pop(@RecurTypeId);
9624        }
9625        return %Type_Init;
9626    }
9627    else {
9628        restore_state($Global_State);
9629    }
9630    if($Init_Desc{"TypeId_Changed"})
9631    {
9632        $Init_Desc{"TypeId"} = $Init_Desc{"TypeId_Changed"};
9633        %Init_Desc = add_VirtualSpecType(%Init_Desc);
9634        if(($Init_Desc{"Value"} ne "no value") and ($Init_Desc{"Value"} ne ""))
9635        { # try to initialize type by value
9636            %Type_Init = initializeByValue(%Init_Desc);
9637            $Type_Init{"Headers"} = addHeaders($Init_Desc{"Headers"}, $Type_Init{"Headers"});
9638            if($Init_Desc{"FoundationType_Type"} ne "Array") {
9639                pop(@RecurTypeId);
9640            }
9641            return %Type_Init;
9642        }
9643    }
9644    # finally initializing by null (0)
9645    %Init_Desc = add_NullSpecType(%Init_Desc);
9646    if($Init_Desc{"OnlyDecl"})
9647    {
9648        %Type_Init = emptyDeclaration(%Init_Desc);
9649        $Type_Init{"Headers"} = addHeaders($Init_Desc{"Headers"}, $Type_Init{"Headers"});
9650        if($Init_Desc{"FoundationType_Type"} ne "Array") {
9651            pop(@RecurTypeId);
9652        }
9653        return %Type_Init;
9654    }
9655    elsif(($Init_Desc{"Value"} ne "no value") and ($Init_Desc{"Value"} ne ""))
9656    {
9657        %Type_Init = initializeByValue(%Init_Desc);
9658        $Type_Init{"Headers"} = addHeaders($Init_Desc{"Headers"}, $Type_Init{"Headers"});
9659        if($Init_Desc{"FoundationType_Type"} ne "Array") {
9660            pop(@RecurTypeId);
9661        }
9662        return %Type_Init;
9663    }
9664    else
9665    {
9666        if($Init_Desc{"FoundationType_Type"} ne "Array") {
9667            pop(@RecurTypeId);
9668        }
9669        return ();
9670    }
9671}
9672
9673sub selectInitializingWay(@)
9674{
9675    my %Init_Desc = @_;
9676    if($Init_Desc{"FoundationType_Type"} eq "Class") {
9677        return initializeClass(%Init_Desc);
9678    }
9679    elsif($Init_Desc{"FoundationType_Type"} eq "Intrinsic") {
9680        return initializeIntrinsic(%Init_Desc);
9681    }
9682    elsif($Init_Desc{"FoundationType_Type"} eq "Struct") {
9683        return initializeStruct(%Init_Desc);
9684    }
9685    elsif($Init_Desc{"FoundationType_Type"} eq "Union") {
9686        return initializeUnion(%Init_Desc);
9687    }
9688    elsif($Init_Desc{"FoundationType_Type"} eq "Enum") {
9689        return initializeEnum(%Init_Desc);
9690    }
9691    elsif($Init_Desc{"FoundationType_Type"} eq "Array") {
9692        return initializeArray(%Init_Desc);
9693    }
9694    elsif($Init_Desc{"FoundationType_Type"} eq "FuncPtr") {
9695        return initializeFuncPtr(%Init_Desc);
9696    }
9697    else {
9698        return ();
9699    }
9700}
9701
9702sub is_const_type($)
9703{ # char const*
9704  #! char*const
9705    my $TypeName = uncover_typedefs($_[0]);
9706    return ($TypeName=~/(\W|\A)const(\W)/);
9707}
9708
9709sub clearSyntax($)
9710{
9711    my $Expression = $_[0];
9712    $Expression=~s/\*\&//g;
9713    $Expression=~s/\&\*//g;
9714    $Expression=~s/\(\*(\w+)\)\./$1\-\>/ig;
9715    $Expression=~s/\(\&(\w+)\)\-\>/$1\./ig;
9716    $Expression=~s/\*\(\&(\w+)\)/$1/ig;
9717    $Expression=~s/\*\(\(\&(\w+)\)\)/$1/ig;
9718    $Expression=~s/\&\(\*(\w+)\)/$1/ig;
9719    $Expression=~s/\&\(\(\*(\w+)\)\)/$1/ig;
9720    $Expression=~s/(?<=[\s()])\(([a-z_]\w*)\)[ ]*,/$1,/ig;
9721    $Expression=~s/,(\s*)\(([a-z_]\w*)\)[ ]*(\)|,)/,$1$2/ig;
9722    $Expression=~s/(?<=[^\$])\(\(([a-z_]\w*)\)\)/\($1\)/ig;
9723    return $Expression;
9724}
9725
9726sub apply_default_value($$)
9727{
9728    my ($Interface, $ParamPos) = @_;
9729    return 0 if(defined $DisableDefaultValues);
9730    return 0 if(not defined $CompleteSignature{$Interface}{"Param"}{$ParamPos});
9731    return 0 if(not $CompleteSignature{$Interface}{"Param"}{$ParamPos}{"default"});
9732    if($Interface eq $TestedInterface
9733    or replace_c2c1($Interface) eq replace_c2c1($TestedInterface))
9734    { # do not use defaults for target symbol
9735        return 0;
9736    }
9737    return 1;
9738}
9739
9740sub sort_AppendInsert(@)
9741{
9742    my @Interfaces = @_;
9743    my (@Add, @Append, @Push, @Init, @Insert) = ();
9744    foreach my $Interface (@Interfaces)
9745    {
9746        if($CompleteSignature{$Interface}{"ShortName"}=~/add/i) {
9747            push(@Add, $Interface);
9748        }
9749        elsif($CompleteSignature{$Interface}{"ShortName"}=~/append/i) {
9750            push(@Append, $Interface);
9751        }
9752        elsif($CompleteSignature{$Interface}{"ShortName"}=~/push/i) {
9753            push(@Push, $Interface);
9754        }
9755        elsif($CompleteSignature{$Interface}{"ShortName"}=~/init/i) {
9756            push(@Init, $Interface);
9757        }
9758        elsif($CompleteSignature{$Interface}{"ShortName"}=~/insert/) {
9759            push(@Insert, $Interface);
9760        }
9761    }
9762    return (@Add, @Append, @Push, @Init, @Insert);
9763}
9764
9765sub get_AutoFinalCode($$)
9766{
9767    my ($Interface, $ObjectCall) = @_;
9768    my (@AddMethods, @AppendMethods, @PushMethods, @InitMethods, @InsertMethods) = ();
9769    if($CompleteSignature{$Interface}{"Constructor"})
9770    {
9771        my $ClassId = $CompleteSignature{$Interface}{"Class"};
9772        my @Methods = sort_AppendInsert(keys(%{$Class_Method{$ClassId}}));
9773        return () if($#Methods<0);
9774        foreach my $Method (@Methods)
9775        {
9776            my %Method_Init = callInterface((
9777            "Interface"=>$Method,
9778            "ObjectCall"=>$ObjectCall,
9779            "DoNotReuse"=>1,
9780            "InsertCall"));
9781            if($Method_Init{"IsCorrect"}) {
9782                return %Method_Init;
9783            }
9784        }
9785        return ();
9786    }
9787    else {
9788        return ();
9789    }
9790}
9791
9792sub initializeParameter(@)
9793{
9794    my %ParamDesc = @_;
9795    my $ParamPos = $ParamDesc{"ParamPos"};
9796    my ($TypeOfSpecType, $SpectypeCode, $SpectypeValue);
9797    my (%Param_Init, $PreCondition, $PostCondition, $InitCode, $DeclCode);
9798    my $ObjectCall = $ParamDesc{"AccessToParam"}->{"obj"};
9799    my $FoundationType_Id = get_FoundationTypeId($ParamDesc{"TypeId"});
9800    if((not $ParamDesc{"SpecType"}) and ($ObjectCall ne "create object")
9801    and not $Interface_OutParam_NoUsing{$ParamDesc{"Interface"}}{$ParamDesc{"ParamName"}}
9802    and not $Interface_OutParam{$ParamDesc{"Interface"}}{$ParamDesc{"ParamName"}}) {
9803        $ParamDesc{"SpecType"} = chooseSpecType($ParamDesc{"TypeId"}, "common_param", $ParamDesc{"Interface"});
9804    }
9805    if($ParamDesc{"SpecType"} and not isCyclical(\@RecurSpecType, $ParamDesc{"SpecType"}))
9806    {
9807        $IntSpecType{$TestedInterface}{$ParamDesc{"SpecType"}} = 1;
9808        $SpectypeCode = $SpecType{$ParamDesc{"SpecType"}}{"GlobalCode"} if(not $SpecCode{$ParamDesc{"SpecType"}});
9809        $SpecCode{$ParamDesc{"SpecType"}} = 1;
9810        push(@RecurSpecType, $ParamDesc{"SpecType"});
9811        $TypeOfSpecType = get_TypeIdByName($SpecType{$ParamDesc{"SpecType"}}{"DataType"});
9812        $SpectypeValue = $SpecType{$ParamDesc{"SpecType"}}{"Value"};
9813        if($SpectypeValue=~/\A[A-Z_0-9]+\Z/
9814        and get_TypeType($FoundationType_Id)=~/\A(Struct|Union)\Z/i) {
9815            $ParamDesc{"InLine"} = 1;
9816        }
9817        $DeclCode = $SpecType{$ParamDesc{"SpecType"}}{"DeclCode"};
9818        if($DeclCode)
9819        {
9820            $DeclCode .= "\n";
9821            if($DeclCode=~/\$0/ or $DeclCode=~/\$$ParamPos(\Z|\D)/) {
9822                $ParamDesc{"InLine"} = 0;
9823            }
9824        }
9825        $InitCode = $SpecType{$ParamDesc{"SpecType"}}{"InitCode"};
9826        if($InitCode)
9827        {
9828            $InitCode .= "\n";
9829            if($InitCode=~/\$0/ or $InitCode=~/\$$ParamPos(\Z|\D)/) {
9830                $ParamDesc{"InLine"} = 0;
9831            }
9832        }
9833        $Param_Init{"FinalCode"} = $SpecType{$ParamDesc{"SpecType"}}{"FinalCode"};
9834        if($Param_Init{"FinalCode"})
9835        {
9836            $Param_Init{"FinalCode"} .= "\n";
9837            if($Param_Init{"FinalCode"}=~/\$0/
9838            or $Param_Init{"FinalCode"}=~/\$$ParamPos(\Z|\D)/) {
9839                $ParamDesc{"InLine"} = 0;
9840            }
9841        }
9842        $PreCondition = $SpecType{$ParamDesc{"SpecType"}}{"PreCondition"};
9843        if($PreCondition=~/\$0/ or $PreCondition=~/\$$ParamPos(\Z|\D)/) {
9844            $ParamDesc{"InLine"} = 0;
9845        }
9846        $PostCondition = $SpecType{$ParamDesc{"SpecType"}}{"PostCondition"};
9847        if($PostCondition=~/\$0/ or $PostCondition=~/\$$ParamPos(\Z|\D)/) {
9848            $ParamDesc{"InLine"} = 0;
9849        }
9850        foreach my $Lib (keys(%{$SpecType{$ParamDesc{"SpecType"}}{"Libs"}})) {
9851            $SpecLibs{$Lib} = 1;
9852        }
9853
9854    }
9855    elsif(apply_default_value($ParamDesc{"Interface"}, $ParamDesc{"ParamPos"}))
9856    {
9857        $Param_Init{"IsCorrect"} = 1;
9858        $Param_Init{"Call"} = "";
9859        return %Param_Init;
9860    }
9861    if(($ObjectCall ne "no object") and ($ObjectCall ne "create object"))
9862    {
9863        if(($ObjectCall=~/\A\*/) or ($ObjectCall=~/\A\&/)) {
9864            $ObjectCall = "(".$ObjectCall.")";
9865        }
9866        $SpectypeValue=~s/\$obj/$ObjectCall/g;
9867        $SpectypeValue = clearSyntax($SpectypeValue);
9868    }
9869    if($ParamDesc{"Value"} ne ""
9870    and $ParamDesc{"Value"} ne "no value") {
9871        $SpectypeValue = $ParamDesc{"Value"};
9872    }
9873    if($SpectypeValue=~/\$[^\(\[]/)
9874    { # access to other parameters
9875        foreach my $ParamKey (keys(%{$ParamDesc{"AccessToParam"}}))
9876        {
9877            my $AccessToParam_Value = $ParamDesc{"AccessToParam"}->{$ParamKey};
9878            $SpectypeValue=~s/\$\Q$ParamKey\E([^0-9]|\Z)/$AccessToParam_Value$1/g;
9879        }
9880    }
9881    if($SpectypeValue)
9882    {
9883        my %ParsedValueCode = parseCode($SpectypeValue, "Value");
9884        if(not $ParsedValueCode{"IsCorrect"})
9885        {
9886            pop(@RecurSpecType);
9887            return ();
9888        }
9889        $Param_Init{"Init"} .= $ParsedValueCode{"CodeBefore"};
9890        $Param_Init{"FinalCode"} .= $ParsedValueCode{"CodeAfter"};
9891        $SpectypeValue = $ParsedValueCode{"Code"};
9892        $Param_Init{"Headers"} = addHeaders($ParsedValueCode{"Headers"}, $ParsedValueCode{"Headers"});
9893        $Param_Init{"Code"} .= $ParsedValueCode{"NewGlobalCode"};
9894    }
9895    if(get_TypeType($FoundationType_Id)=~/\A(Struct|Class|Union)\Z/i
9896    and $CompleteSignature{$ParamDesc{"Interface"}}{"Constructor"}
9897    and get_PointerLevel($ParamDesc{"TypeId"})==0) {
9898        $ParamDesc{"InLine"} = 0;
9899    }
9900    if($DeclCode)
9901    {
9902        $Param_Init{"Headers"} = addHeaders(getTypeHeaders($ParamDesc{"TypeId"}), $Param_Init{"Headers"});
9903        $Param_Init{"Call"} = select_var_name($ParamDesc{"ParamName"}, "");
9904        $Param_Init{"TargetCall"} = $Param_Init{"Value"}?$Param_Init{"Value"}:$Param_Init{"Call"};
9905    }
9906    elsif($ParamDesc{"Usage"} eq "Common")
9907    {
9908        my %Type_Init = initializeType((
9909            "Interface" => $ParamDesc{"Interface"},
9910            "TypeId" => $ParamDesc{"TypeId"},
9911            "Key" => $ParamDesc{"Key"},
9912            "InLine" => $ParamDesc{"InLine"},
9913            "Value" => $SpectypeValue,
9914            "ValueTypeId" => $TypeOfSpecType,
9915            "TargetTypeId" => $TypeOfSpecType,
9916            "CreateChild" => $ParamDesc{"CreateChild"},
9917            "ParamName" => $ParamDesc{"ParamName"},
9918            "ParamPos" => $ParamDesc{"ParamPos"},
9919            "ConvertToBase" => $ParamDesc{"ConvertToBase"},
9920            "StrongConvert" => $ParamDesc{"StrongConvert"},
9921            "ObjectInit" => $ParamDesc{"ObjectInit"},
9922            "DoNotReuse" => $ParamDesc{"DoNotReuse"},
9923            "RetVal" => $ParamDesc{"RetVal"},
9924            "ParamNameExt" => $ParamDesc{"ParamNameExt"},
9925            "MaxParamPos" => $ParamDesc{"MaxParamPos"},
9926            "OuterType_Id" => $ParamDesc{"OuterType_Id"},
9927            "OuterType_Type" => $ParamDesc{"OuterType_Type"},
9928            "Index" => $ParamDesc{"Index"},
9929            "InLineArray" => $ParamDesc{"InLineArray"},
9930            "IsString" => $ParamDesc{"IsString"},
9931            "FuncPtrName" => $ParamDesc{"FuncPtrName"},
9932            "FuncPtrTypeId" => $ParamDesc{"FuncPtrTypeId"}));
9933        if(not $Type_Init{"IsCorrect"})
9934        {
9935            pop(@RecurSpecType);
9936            return ();
9937        }
9938        $Param_Init{"Init"} .= $Type_Init{"Init"};
9939        $Param_Init{"Call"} .= $Type_Init{"Call"};
9940        $Param_Init{"TargetCall"} = $Type_Init{"TargetCall"};
9941        $Param_Init{"Code"} .= $Type_Init{"Code"};
9942        $Param_Init{"Destructors"} .= $Type_Init{"Destructors"};
9943        $Param_Init{"FinalCode"} .= $Type_Init{"FinalCode"};
9944        $Param_Init{"PreCondition"} .= $Type_Init{"PreCondition"};
9945        $Param_Init{"PostCondition"} .= $Type_Init{"PostCondition"};
9946        $Param_Init{"Headers"} = addHeaders($Type_Init{"Headers"}, $Param_Init{"Headers"});
9947        $Param_Init{"ByNull"} = $Type_Init{"ByNull"};
9948    }
9949    else
9950    {
9951        $Param_Init{"Headers"} = addHeaders(getTypeHeaders($ParamDesc{"TypeId"}), $Param_Init{"Headers"});
9952        if(my $Target = $ParamDesc{"AccessToParam"}->{"0"}) {
9953            $Param_Init{"TargetCall"} = $Target;
9954        }
9955    }
9956    my $TargetCall = $Param_Init{"TargetCall"};
9957    if($TargetCall=~/\A(\*|\&)/) {
9958        $TargetCall = "(".$TargetCall.")";
9959    }
9960    if($SpectypeCode)
9961    {
9962        my $PreviousBlock = $CurrentBlock;
9963        $CurrentBlock = $CurrentBlock."_code_".$ParamDesc{"SpecType"};
9964        my %ParsedCode = parseCode($SpectypeCode, "Code");
9965        $CurrentBlock = $PreviousBlock;
9966        if(not $ParsedCode{"IsCorrect"})
9967        {
9968            pop(@RecurSpecType);
9969            return ();
9970        }
9971        foreach my $Header (@{$ParsedCode{"Headers"}}) {
9972            $SpecTypeHeaders{get_filename($Header)}=1;
9973        }
9974        $Param_Init{"Headers"} = addHeaders($ParsedCode{"Headers"}, $Param_Init{"Headers"});
9975        $Param_Init{"Code"} .= $ParsedCode{"NewGlobalCode"}.$ParsedCode{"Code"};
9976    }
9977    if($ObjectCall eq "create object")
9978    {
9979        $ObjectCall = $Param_Init{"Call"};
9980        if($ObjectCall=~/\A\*/ or $ObjectCall=~/\A\&/) {
9981            $ObjectCall = "(".$ObjectCall.")";
9982        }
9983    }
9984    if($DeclCode)
9985    {
9986        if($ObjectCall ne "no object") {
9987            $DeclCode=~s/\$obj/$ObjectCall/g;
9988        }
9989        $DeclCode=~s/\$0/$TargetCall/g;
9990        my %ParsedCode = parseCode($DeclCode, "Code");
9991        if(not $ParsedCode{"IsCorrect"})
9992        {
9993            pop(@RecurSpecType);
9994            return ();
9995        }
9996        $DeclCode = clearSyntax($DeclCode);
9997        $Param_Init{"Headers"} = addHeaders($ParsedCode{"Headers"}, $Param_Init{"Headers"});
9998        $Param_Init{"Code"} .= $ParsedCode{"NewGlobalCode"};
9999        $DeclCode = $ParsedCode{"Code"};
10000        $Param_Init{"Init"} .= "//decl code\n".$DeclCode."\n";
10001    }
10002    if($InitCode)
10003    {
10004        if($ObjectCall ne "no object") {
10005            $InitCode=~s/\$obj/$ObjectCall/g;
10006        }
10007        $InitCode=~s/\$0/$TargetCall/g;
10008        my %ParsedCode = parseCode($InitCode, "Code");
10009        if(not $ParsedCode{"IsCorrect"})
10010        {
10011            pop(@RecurSpecType);
10012            return ();
10013        }
10014        $InitCode = clearSyntax($InitCode);
10015        $Param_Init{"Headers"} = addHeaders($ParsedCode{"Headers"}, $Param_Init{"Headers"});
10016        $Param_Init{"Code"} .= $ParsedCode{"NewGlobalCode"};
10017        $InitCode = $ParsedCode{"Code"};
10018        $Param_Init{"Init"} .= "//init code\n".$InitCode."\n";
10019    }
10020    if($Param_Init{"FinalCode"})
10021    {
10022        if($ObjectCall ne "no object") {
10023            $Param_Init{"FinalCode"}=~s/\$obj/$ObjectCall/g;
10024        }
10025        $Param_Init{"FinalCode"}=~s/\$0/$TargetCall/g;
10026        my %ParsedCode = parseCode($Param_Init{"FinalCode"}, "Code");
10027        if(not $ParsedCode{"IsCorrect"})
10028        {
10029            pop(@RecurSpecType);
10030            return ();
10031        }
10032        $Param_Init{"FinalCode"} = clearSyntax($Param_Init{"FinalCode"});
10033        $Param_Init{"Headers"} = addHeaders($ParsedCode{"Headers"}, $Param_Init{"Headers"});
10034        $Param_Init{"Code"} .= $ParsedCode{"NewGlobalCode"};
10035        $Param_Init{"FinalCode"} = $ParsedCode{"Code"};
10036    }
10037    if(not defined $Template2Code or $ParamDesc{"Interface"} eq $TestedInterface)
10038    {
10039        $Param_Init{"PreCondition"} .= constraint_for_parameter($ParamDesc{"Interface"}, $SpecType{$ParamDesc{"SpecType"}}{"DataType"}, "precondition", $PreCondition, $ObjectCall, $TargetCall);
10040        $Param_Init{"PostCondition"} .= constraint_for_parameter($ParamDesc{"Interface"}, $SpecType{$ParamDesc{"SpecType"}}{"DataType"}, "postcondition", $PostCondition, $ObjectCall, $TargetCall);
10041    }
10042    pop(@RecurSpecType);
10043    $Param_Init{"IsCorrect"} = 1;
10044    return %Param_Init;
10045}
10046
10047sub constraint_for_parameter($$$$$$)
10048{
10049    my ($Interface, $DataType, $ConditionType, $Condition, $ObjectCall, $TargetCall) = @_;
10050    return "" if(not $Interface or not $ConditionType or not $Condition);
10051    my $Condition_Comment = $Condition;
10052    $Condition_Comment=~s/\$obj/$ObjectCall/g if($ObjectCall ne "no object" and $ObjectCall ne "");
10053    $Condition_Comment=~s/\$0/$TargetCall/g if($TargetCall ne "");
10054    $Condition_Comment = clearSyntax($Condition_Comment);
10055    $Condition = $Condition_Comment;
10056    while($Condition_Comment=~s/([^\\])"/$1\\\"/g){}
10057    $ConstraintNum{$Interface}+=1;
10058    my $ParameterObject = ($ObjectCall eq "create object")?"object":"parameter";
10059    $RequirementsCatalog{$Interface}{$ConstraintNum{$Interface}} = "$ConditionType for the $ParameterObject: \'$Condition_Comment\'";
10060    my $ReqId = get_ShortName($Interface).".".normalize_num($ConstraintNum{$Interface});
10061    if(my $Format = is_printable($DataType))
10062    {
10063        my $Comment = "$ConditionType for the $ParameterObject failed: \'$Condition_Comment\', parameter value: $Format";
10064        $TraceFunc{"REQva"}=1;
10065        return "REQva(\"$ReqId\",\n$Condition,\n\"$Comment\",\n$TargetCall);\n";
10066    }
10067    else
10068    {
10069        my $Comment = "$ConditionType for the $ParameterObject failed: \'$Condition_Comment\'";
10070        $TraceFunc{"REQ"}=1;
10071        return "REQ(\"$ReqId\",\n\"$Comment\",\n$Condition);\n";
10072    }
10073}
10074
10075sub is_array_count($$)
10076{
10077    my ($ParamName_Prev, $ParamName_Next) = @_;
10078    return ($ParamName_Next=~/\A(\Q$ParamName_Prev\E|)[_]*(n|l|c|s)[_]*(\Q$ParamName_Prev\E|)\Z/i
10079    or $ParamName_Next=~/len|size|amount|count|num|number/i);
10080}
10081
10082sub add_VirtualProxy($$$$)
10083{
10084    my ($Interface, $OutParamPos, $Order, $Step) = @_;
10085    return if(keys(%{$CompleteSignature{$Interface}{"Param"}})<$Step+1);
10086    foreach my $Param_Pos (sort {($Order eq "forward")?int($a)<=>int($b):int($b)<=>int($a)} keys(%{$CompleteSignature{$Interface}{"Param"}}))
10087    {
10088        if(apply_default_value($Interface, $Param_Pos)) {
10089            next;
10090        }
10091        my $Prev_Pos = ($Order eq "forward")?$Param_Pos-$Step:$Param_Pos+$Step;
10092        next if(($Order eq "forward")?$Prev_Pos<0:$Prev_Pos>keys(%{$CompleteSignature{$Interface}{"Param"}})-1);
10093        my $ParamName = $CompleteSignature{$Interface}{"Param"}{$Param_Pos}{"name"};
10094        my $ParamTypeId = $CompleteSignature{$Interface}{"Param"}{$Param_Pos}{"type"};
10095        my $ParamTypeName = get_TypeName($ParamTypeId);
10096        my $ParamName_Prev = $CompleteSignature{$Interface}{"Param"}{$Prev_Pos}{"name"};
10097        my $ParamTypeId_Prev = $CompleteSignature{$Interface}{"Param"}{$Prev_Pos}{"type"};
10098        if(not $InterfaceSpecType{$Interface}{"SpecParam"}{$Param_Pos})
10099        {
10100            next if($OutParamPos ne "" and $OutParamPos==$Prev_Pos);
10101            my $ParamFTypeId = get_FoundationTypeId($ParamTypeId);
10102            if(isIntegerType(get_TypeName($ParamFTypeId)) and get_PointerLevel($ParamTypeId)==0
10103            and get_PointerLevel($ParamTypeId_Prev)>=1 and $ParamName_Prev
10104            and is_array_count($ParamName_Prev, $ParamName) and not isOutParam_NoUsing($ParamTypeId_Prev, $ParamName_Prev, $Interface)
10105            and not $OutParamInterface_Pos{$Interface}{$Prev_Pos} and not $OutParamInterface_Pos_NoUsing{$Interface}{$Prev_Pos})
10106            {
10107                if(isArray($ParamTypeId_Prev, $ParamName_Prev, $Interface)) {
10108                    $ProxyValue{$Interface}{$Param_Pos} = $DEFAULT_ARRAY_AMOUNT;
10109                }
10110                elsif(isBuffer($ParamTypeId_Prev, $ParamName_Prev, $Interface)) {
10111                    $ProxyValue{$Interface}{$Param_Pos} = $BUFF_SIZE;
10112                }
10113                elsif(isString($ParamTypeId_Prev, $ParamName_Prev, $Interface))
10114                {
10115                    if($ParamName_Prev=~/file|src|uri|buf|dir|url/i) {
10116                        $ProxyValue{$Interface}{$Param_Pos} = "1";
10117                    }
10118                    elsif($ParamName_Prev!~/\Ap\d+\Z/i) {
10119                        $ProxyValue{$Interface}{$Param_Pos} = length($ParamName_Prev);
10120                    }
10121                }
10122                elsif($ParamName_Prev=~/buf/i) {
10123                    $ProxyValue{$Interface}{$Param_Pos} = "1";
10124                }
10125            }
10126            elsif($Order eq "forward" and isString($ParamTypeId_Prev, $ParamName_Prev, $Interface)
10127            and ($ParamName_Prev=~/\A[_0-9]*(format|fmt)[_0-9]*\Z/i) and ($ParamTypeName eq "..."))
10128            {
10129                $ProxyValue{$Interface}{$Param_Pos-1} = "\"\%d\"";
10130                $ProxyValue{$Interface}{$Param_Pos} = "1";
10131            }
10132        }
10133    }
10134}
10135
10136sub isExactValueAble($)
10137{
10138    my $TypeName = $_[0];
10139    return $TypeName=~/\A(char const\*|wchar_t const\*|wint_t|int|bool|double|float|long double|char|long|long long|long long int|long int)\Z/;
10140}
10141
10142sub select_obj_name($$)
10143{
10144    my ($Key, $ClassId) = @_;
10145    my $ClassName = get_TypeName($ClassId);
10146    if(my $NewName = getParamNameByTypeName($ClassName)) {
10147        return $NewName;
10148    }
10149    else {
10150        return (($Key)?"src":"obj");
10151    }
10152}
10153
10154sub getParamNameByTypeName($)
10155{
10156    my $TypeName = get_type_short_name(remove_quals($_[0]));
10157    return "" if(not $TypeName or $TypeName=~/\(|\)|<|>/);
10158    while($TypeName=~s/\A\w+\:\://g){ };
10159    while($TypeName=~s/(\*|\&|\[|\])//g){ };
10160    $TypeName=~s/(\A\s+|\s+\Z)//g;
10161    return "Db" if($TypeName eq "sqlite3");
10162    return "tif" if($TypeName eq "TIFF");
10163    my $ShortTypeName = cut_NamePrefix($TypeName);
10164    if($ShortTypeName ne $TypeName
10165    and is_allowed_var_name(lc($ShortTypeName)))
10166    {
10167        $TypeName = $ShortTypeName;
10168        return lc($ShortTypeName);
10169    }
10170    if($TypeName=~/[A-Z]+/)
10171    {
10172        if(is_allowed_var_name(lc($TypeName))) {
10173            return lc($TypeName);
10174        }
10175    }
10176    return "";
10177}
10178
10179sub is_allowed_var_name($)
10180{
10181    my $Candidate = $_[0];
10182    return (not $IsKeyword{$Candidate} and not $TName_Tid{$Candidate}
10183    and not $NameSpaces{$Candidate} and not $EnumMembers{$Candidate}
10184    and not $GlobalDataNames{$Candidate} and not $FuncNames{$Candidate});
10185}
10186
10187sub callInterfaceParameters_m(@)
10188{
10189    my %Init_Desc = @_;
10190    my (@ParamList, %ParametersOrdered, %Params_Init, $IsWrapperCall);
10191    my ($Interface, $Key, $ObjectCall) = ($Init_Desc{"Interface"}, $Init_Desc{"Key"}, $Init_Desc{"ObjectCall"});
10192    add_VirtualProxy($Interface, $Init_Desc{"OutParam"},  "forward", 1);
10193    add_VirtualProxy($Interface, $Init_Desc{"OutParam"},  "forward", 2);
10194    add_VirtualProxy($Interface, $Init_Desc{"OutParam"}, "backward", 1);
10195    add_VirtualProxy($Interface, $Init_Desc{"OutParam"}, "backward", 2);
10196    my (%KeyTable, %AccessToParam, %TargetAccessToParam, %InvOrder, %Interface_Init, $SubClasses_Before) = ();
10197    $AccessToParam{"obj"} = $ObjectCall;
10198    $TargetAccessToParam{"obj"} = $ObjectCall;
10199    return () if(needToInherit($Interface) and isInCharge($Interface));
10200    $Interface_Init{"Headers"} = addHeaders([$CompleteSignature{$Interface}{"Header"}], $Interface_Init{"Headers"});
10201    if(not $CompleteSignature{$Interface}{"Constructor"}
10202    and not $CompleteSignature{$Interface}{"Destructor"}) {
10203        $Interface_Init{"Headers"} = addHeaders(getTypeHeaders($CompleteSignature{$Interface}{"Return"}), $Interface_Init{"Headers"});
10204    }
10205    my $ShortName = $CompleteSignature{$Interface}{"ShortName"};
10206    if($CompleteSignature{$Interface}{"Constructor"}) {
10207        $Interface_Init{"Call"} .= get_TypeName($CompleteSignature{$Interface}{"Class"});
10208    }
10209    else {
10210        $Interface_Init{"Call"} .= $ShortName;
10211    }
10212    my $IsWrapperCall = (($CompleteSignature{$Interface}{"Protected"}) and (not $CompleteSignature{$Interface}{"Constructor"}));
10213    if($IsWrapperCall)
10214    {
10215        $Interface_Init{"Call"} .= "_Wrapper";
10216        $Interface_Init{"Call"} = cleanName($Interface_Init{"Call"});
10217        @{$SubClasses_Before}{keys %Create_SubClass} = values %Create_SubClass;
10218        %Create_SubClass = ();
10219    }
10220    my $NumOfParams = getNumOfParams($Interface);
10221    # detecting inline parameters
10222    my %InLineParam = detectInLineParams($Interface);
10223    my %Order = detectParamsOrder($Interface);
10224    @InvOrder{values %Order} = keys %Order;
10225    foreach my $Param_Pos (sort {int($a)<=>int($b)} keys(%{$CompleteSignature{$Interface}{"Param"}}))
10226    {
10227        $ParametersOrdered{$Order{$Param_Pos + 1} - 1}{"type"} = $CompleteSignature{$Interface}{"Param"}{$Param_Pos}{"type"};
10228        $ParametersOrdered{$Order{$Param_Pos + 1} - 1}{"name"} = $CompleteSignature{$Interface}{"Param"}{$Param_Pos}{"name"};
10229    }
10230    # initializing parameters
10231    if(keys(%{$CompleteSignature{$Interface}{"Param"}})>0
10232    and defined $CompleteSignature{$Interface}{"Param"}{0})
10233    {
10234        my $MaxParamPos = keys(%{$CompleteSignature{$Interface}{"Param"}}) - 1;
10235        foreach my $Param_Pos (sort {int($a)<=>int($b)} keys(%{$CompleteSignature{$Interface}{"Param"}}))
10236        {
10237            next if($Param_Pos eq "");
10238            my $TruePos = $InvOrder{$Param_Pos + 1} - 1;
10239            my $TypeId = $ParametersOrdered{$Param_Pos}{"type"};
10240            my $TypeName = get_TypeName($TypeId);
10241
10242            my $FTypeId = get_FoundationTypeId($TypeId);
10243
10244            my $Param_Name = $ParametersOrdered{$Param_Pos}{"name"};
10245            if($Param_Name=~/\Ap\d+\Z/
10246            and (my $NewParamName = getParamNameByTypeName($TypeName))) {
10247                $Param_Name = $NewParamName;
10248            }
10249            my $Param_Name_Ext = "";
10250            if(is_used_var($CurrentBlock, $Param_Name) and not $LongVarNames
10251            and ($Key=~/(_|\A)\Q$Param_Name\E(_|\Z)/))
10252            {
10253                if($TypeName=~/string/i) {
10254                    $Param_Name_Ext="str";
10255                }
10256                elsif($TypeName=~/char/i) {
10257                    $Param_Name_Ext="ch";
10258                }
10259            }
10260            $Param_Name = "p".($TruePos+1) if(not $Param_Name);
10261            my $TypeType = get_TypeType($TypeId);
10262            my $TypeName_Uncovered = uncover_typedefs($TypeName);
10263            my $InLine = $InLineParam{$TruePos+1};
10264            my $StrongConvert = 0;
10265            if($OverloadedInterface{$Interface})
10266            {
10267                if(not isExactValueAble($TypeName_Uncovered)
10268                and $TypeType ne "Enum")
10269                {
10270                    # $InLine = 0;
10271                    $StrongConvert = 1;
10272                }
10273            }
10274            $InLine = 0 if(uncover_typedefs($TypeName)=~/\&/);
10275            $InLine = 0 if(get_TypeType($FTypeId)!~/\A(Intrinsic|Enum)\Z/ and $Param_Name!~/\Ap\d+\Z/
10276                and not isCyclical(\@RecurTypeId, get_TypeStackId($TypeId)));
10277            my $NewKey = ($Param_Name)? (($Key)?$Key."_".$Param_Name:$Param_Name) : ($Key)?$Key."_".($TruePos+1):"p".$InvOrder{$Param_Pos+1};
10278            my $SpecTypeId = $InterfaceSpecType{$Interface}{"SpecParam"}{$TruePos};
10279            my $ParamValue = "no value";
10280            if(defined $ProxyValue{$Interface}
10281            and my $PValue = $ProxyValue{$Interface}{$TruePos}) {
10282                $ParamValue = $PValue;
10283            }
10284            # initialize parameter
10285            if(($Init_Desc{"OutParam"} ne "") and $Param_Pos==$Init_Desc{"OutParam"})
10286            { # initializing out-parameter
10287                $AccessToParam{$TruePos+1} = $Init_Desc{"OutVar"};
10288                $TargetAccessToParam{$TruePos+1} = $Init_Desc{"OutVar"};
10289                if($SpecTypeId and ($SpecType{$SpecTypeId}{"InitCode"}.$SpecType{$SpecTypeId}{"FinalCode"}.$SpecType{$SpecTypeId}{"PreCondition"}.$SpecType{$SpecTypeId}{"PostCondition"})=~/\$0/)
10290                {
10291                    if(is_equal_types(get_TypeName($TypeId), $SpecType{$SpecTypeId}{"DataType"}))
10292                    {
10293                        $AccessToParam{"0"} = $Init_Desc{"OutVar"};
10294                        $TargetAccessToParam{"0"} = $Init_Desc{"OutVar"};
10295                    }
10296                    else
10297                    {
10298                        my ($TargetCall, $Preamble)=
10299                        convertTypes((
10300                            "InputTypeName"=>get_TypeName($TypeId),
10301                            "InputPointerLevel"=>get_PointerLevel($TypeId),
10302                            "OutputTypeId"=>get_TypeIdByName($SpecType{$SpecTypeId}{"DataType"}),
10303                            "Value"=>$Init_Desc{"OutVar"},
10304                            "Key"=>$NewKey,
10305                            "Destination"=>"Target",
10306                            "MustConvert"=>0));
10307                        $Params_Init{"Init"} .= $Preamble;
10308                        $AccessToParam{"0"} = $TargetCall;
10309                        $TargetAccessToParam{"0"} = $TargetCall;
10310                    }
10311                }
10312                my %Param_Init = initializeParameter((
10313                    "Interface" => $Interface,
10314                    "AccessToParam" => \%TargetAccessToParam,
10315                    "TypeId" => $TypeId,
10316                    "Key" => $NewKey,
10317                    "SpecType" => $SpecTypeId,
10318                    "Usage" => "OnlySpecType",
10319                    "ParamName" => $Param_Name,
10320                    "ParamPos" => $TruePos));
10321                $Params_Init{"Init"} .= $Param_Init{"Init"};
10322                $Params_Init{"Code"} .= $Param_Init{"Code"};
10323                $Params_Init{"FinalCode"} .= $Param_Init{"FinalCode"};
10324                $Params_Init{"PreCondition"} .= $Param_Init{"PreCondition"};
10325                $Params_Init{"PostCondition"} .= $Param_Init{"PostCondition"};
10326                $Interface_Init{"Headers"} = addHeaders($Param_Init{"Headers"}, $Interface_Init{"Headers"});
10327            }
10328            else
10329            {
10330                my $CreateChild = ($ShortName eq "operator=" and get_TypeName($FTypeId) eq get_TypeName($CompleteSignature{$Interface}{"Class"}) and $CompleteSignature{$Interface}{"Protected"});
10331                if($IsWrapperCall
10332                and $CompleteSignature{$Interface}{"Class"}) {
10333                    # push(@RecurTypeId, $CompleteSignature{$Interface}{"Class"});
10334                }
10335                my %Param_Init = initializeParameter((
10336                    "Interface" => $Interface,
10337                    "AccessToParam" => \%TargetAccessToParam,
10338                    "TypeId" => $TypeId,
10339                    "Key" => $NewKey,
10340                    "InLine" => $InLine,
10341                    "Value" => $ParamValue,
10342                    "CreateChild" => $CreateChild,
10343                    "SpecType" => $SpecTypeId,
10344                    "Usage" => "Common",
10345                    "ParamName" => $Param_Name,
10346                    "ParamPos" => $TruePos,
10347                    "StrongConvert" => $StrongConvert,
10348                    "DoNotReuse" => $Init_Desc{"DoNotReuse"},
10349                    "ParamNameExt" => $Param_Name_Ext,
10350                    "MaxParamPos" => $MaxParamPos));
10351                if($IsWrapperCall
10352                and $CompleteSignature{$Interface}{"Class"}) {
10353                    # pop(@RecurTypeId);
10354                }
10355                if(not $Param_Init{"IsCorrect"})
10356                {
10357                    foreach my $ClassId (keys(%{$SubClasses_Before})) {
10358                        $Create_SubClass{$ClassId} = 1;
10359                    }
10360                    return ();
10361                }
10362                my $RetParam = $Init_Desc{"RetParam"};
10363                if($Param_Init{"ByNull"} and ($Interface ne $TestedInterface)
10364                and (($ShortName=~/(\A|_)\Q$RetParam\E(\Z|_)/i and $ShortName!~/(\A|_)init(\Z|_)/i and $Param_Name!~/out|error/i)
10365                or is_transit_function($CompleteSignature{$Interface}{"ShortName"}))) {
10366                    return ();
10367                }
10368                if($Param_Init{"ByNull"}
10369                and $Param_Init{"InsertCall"}) {
10370                    return ();
10371                }
10372                $Params_Init{"Init"} .= $Param_Init{"Init"};
10373                $Params_Init{"Code"} .= $Param_Init{"Code"};
10374                $Params_Init{"Destructors"} .= $Param_Init{"Destructors"};
10375                $Params_Init{"FinalCode"} .= $Param_Init{"FinalCode"};
10376                $Params_Init{"PreCondition"} .= $Param_Init{"PreCondition"};
10377                $Params_Init{"PostCondition"} .= $Param_Init{"PostCondition"};
10378                $Interface_Init{"Headers"} = addHeaders($Param_Init{"Headers"}, $Interface_Init{"Headers"});
10379                $AccessToParam{$TruePos+1} = $Param_Init{"Call"};
10380                $TargetAccessToParam{$TruePos+1} = $Param_Init{"TargetCall"};
10381            }
10382        }
10383        foreach my $Param_Pos (sort {int($a)<=>int($b)} keys(%{$CompleteSignature{$Interface}{"Param"}}))
10384        {
10385            next if($Param_Pos eq "");
10386            my $Param_Call = $AccessToParam{$Param_Pos + 1};
10387            my $ParamType_Id = $CompleteSignature{$Interface}{"Param"}{$Param_Pos}{"type"};
10388            if((get_TypeName($ParamType_Id) ne "..." and not $CompleteSignature{$Interface}{"Param"}{$Param_Pos}{"default"})
10389            or $Param_Call ne "") {
10390                push(@ParamList, $Param_Call);
10391            }
10392        }
10393        my $LastParamPos = keys(%{$CompleteSignature{$Interface}{"Param"}})-1;
10394        my $LastTypeId = $CompleteSignature{$Interface}{"Param"}{$LastParamPos}{"type"};
10395        my $LastParamCall = $AccessToParam{$LastParamPos+1};
10396        if(get_TypeName($LastTypeId) eq "..." and $LastParamCall ne "0" and $LastParamCall ne "NULL")
10397        { # add sentinel to function call
10398          # http://www.linuxonly.nl/docs/2/2_GCC_4_warnings_about_sentinels.html
10399            push(@ParamList, "(char*)0");
10400        }
10401        my $Parameters_Call = "(".create_list(\@ParamList, "    ").")";
10402        if($IsWrapperCall)
10403        {
10404            $Interface_Init{"Call"} .= "()";
10405            $Wrappers{$Interface}{"Init"} = $Params_Init{"Init"};
10406            $Wrappers{$Interface}{"Code"} = $Params_Init{"Code"};
10407            $Wrappers{$Interface}{"Destructors"} = $Params_Init{"Destructors"};
10408            $Wrappers{$Interface}{"FinalCode"} = $Params_Init{"FinalCode"};
10409            $Wrappers{$Interface}{"PreCondition"} = $Params_Init{"PreCondition"};
10410            $Wrappers{$Interface}{"PostCondition"} = $Params_Init{"PostCondition"};
10411            $Wrappers{$Interface}{"Parameters_Call"} = $Parameters_Call;
10412            foreach my $ClassId (keys(%Create_SubClass)) {
10413                $Wrappers_SubClasses{$Interface}{$ClassId} = 1;
10414            }
10415        }
10416        else
10417        {
10418            $Interface_Init{"Call"} .= $Parameters_Call;
10419            $Interface_Init{"Init"} .= $Params_Init{"Init"};
10420            $Interface_Init{"Code"} .= $Params_Init{"Code"};
10421            $Interface_Init{"Destructors"} .= $Params_Init{"Destructors"};
10422            $Interface_Init{"FinalCode"} .= $Params_Init{"FinalCode"};
10423            $Interface_Init{"PreCondition"} .= $Params_Init{"PreCondition"};
10424            $Interface_Init{"PostCondition"} .= $Params_Init{"PostCondition"};
10425        }
10426    }
10427    elsif($CompleteSignature{$Interface}{"Data"})
10428    {
10429        if($IsWrapperCall) {
10430            $Interface_Init{"Call"} .= "()";
10431        }
10432    }
10433    else
10434    {
10435        $Interface_Init{"Call"} .= "()";
10436        $Wrappers{$Interface}{"Parameters_Call"} = "()";
10437    }
10438    if($IsWrapperCall)
10439    {
10440        foreach my $ClassId (keys(%{$SubClasses_Before})) {
10441            $Create_SubClass{$ClassId} = 1;
10442        }
10443    }
10444    # check requirement for return value
10445    my $SpecReturnType = $InterfaceSpecType{$Interface}{"SpecReturn"};
10446    if(not $SpecReturnType) {
10447        $SpecReturnType = chooseSpecType($CompleteSignature{$Interface}{"Return"}, "common_retval", $Interface);
10448    }
10449    $Interface_Init{"ReturnRequirement"} = requirementReturn($Interface, $CompleteSignature{$Interface}{"Return"}, $SpecReturnType, $ObjectCall);
10450    if($SpecReturnType)
10451    {
10452        if(my $ReturnInitCode = $SpecType{$SpecReturnType}{"InitCode"})
10453        {
10454            my %ParsedCode = parseCode($ReturnInitCode, "Code");
10455            if($ParsedCode{"IsCorrect"})
10456            {
10457                $Interface_Init{"Headers"} = addHeaders($ParsedCode{"Headers"}, $Interface_Init{"Headers"});
10458                $Interface_Init{"Code"} .= $ParsedCode{"NewGlobalCode"};
10459                $Interface_Init{"Init"} .= $ParsedCode{"Code"};
10460            }
10461        }
10462        if(my $ReturnFinalCode = $SpecType{$SpecReturnType}{"FinalCode"})
10463        {
10464            my %ParsedCode = ();
10465            if($Init_Desc{"RetParam"})
10466            {
10467                my $LastId = pop(@RecurTypeId);
10468                # add temp $retval
10469                $ValueCollection{$CurrentBlock}{"\$retval"} = $CompleteSignature{$Interface}{"Return"};
10470                # parse code using temp $retval
10471                %ParsedCode = parseCode($ReturnFinalCode, "Code");
10472                # remove temp $retval
10473                delete($ValueCollection{$CurrentBlock}{"\$retval"});
10474                push(@RecurTypeId, $LastId);
10475            }
10476            else {
10477                %ParsedCode = parseCode($ReturnFinalCode, "Code");
10478            }
10479            if($ParsedCode{"IsCorrect"})
10480            {
10481                $Interface_Init{"Headers"} = addHeaders($ParsedCode{"Headers"}, $Interface_Init{"Headers"});
10482                $Interface_Init{"Code"} .= $ParsedCode{"NewGlobalCode"};
10483                $Interface_Init{"ReturnFinalCode"} = $ParsedCode{"Code"};
10484            }
10485            else {
10486                $Interface_Init{"ReturnFinalCode"} = "";
10487            }
10488        }
10489    }
10490    foreach my $ParamId (keys %AccessToParam)
10491    {
10492        if($TargetAccessToParam{$ParamId} and ($TargetAccessToParam{$ParamId} ne "no object"))
10493        {
10494            my $AccessValue = $TargetAccessToParam{$ParamId};
10495            foreach my $Attr (keys(%Interface_Init)) {
10496                $Interface_Init{$Attr}=~s/\$\Q$ParamId\E([^0-9]|\Z)/$AccessValue$1/g;
10497            }
10498        }
10499    }
10500    $Interface_Init{"IsCorrect"} = 1;
10501    return %Interface_Init;
10502}
10503
10504sub parse_param_name($$)
10505{
10506    my ($String, $Place) = @_;
10507    if($String=~/(([a-z_]\w+)[ ]*\(.+\))/i)
10508    {
10509        my ($Call, $Interface_ShortName) = ($1, $2);
10510        my $Pos = 0;
10511        foreach my $Part (get_Signature_Parts($Call, 0))
10512        {
10513            $Part=~s/(\A\s+|\s+\Z)//g;
10514            if($Part eq $Place)
10515            {
10516                if($CompleteSignature{$Interface_ShortName}) {
10517                    return ($CompleteSignature{$Interface_ShortName}{"Param"}{$Pos}{"name"}, $Pos, $Interface_ShortName);
10518                }
10519                else {
10520                    return (0, 0, "");
10521                }
10522            }
10523            $Pos+=1;
10524        }
10525    }
10526    return (0, 0, "");
10527}
10528
10529sub parseCode_m($$)
10530{
10531    my ($Code, $Mode) = @_;
10532    return ("IsCorrect"=>1) if(not $Code or not $Mode);
10533    my ($Bracket_Num, $Code_Inlined, $NotEnded) = (0, "", 0);
10534    foreach my $Line (split(/\n/, $Code))
10535    {
10536        foreach my $Pos (0 .. length($Line) - 1)
10537        {
10538            my $Symbol = substr($Line, $Pos, 1);
10539            $Bracket_Num += 1 if($Symbol eq "(");
10540            $Bracket_Num -= 1 if($Symbol eq ")");
10541        }
10542        if($NotEnded and $Bracket_Num!=0) {
10543            $Line=~s/\A\s+/ /g;
10544        }
10545        $Code_Inlined .= $Line;
10546        if($Bracket_Num==0) {
10547            $Code_Inlined .= "\n";
10548        }
10549        else {
10550            $NotEnded = 1;
10551        }
10552    }
10553    $Code = $Code_Inlined;
10554    my ($AllSubCode, $ParsedCode, $Headers) = ();
10555    $Block_InsNum{$CurrentBlock} = 1 if(not defined $Block_InsNum{$CurrentBlock});
10556    if($Mode eq "Value") {
10557        $Code=~s/\n//g;
10558    }
10559    foreach my $String (split(/\n/, $Code))
10560    {
10561        if($String=~/\#[ \t]*include[ \t]*\<[ \t]*([^ \t]+)[ \t]*\>/)
10562        {
10563            $Headers = addHeaders($Headers, [$1]);
10564            next;
10565        }
10566        my ($CodeBefore, $CodeAfter) = ();
10567        while($String=~/(\$\(([^\$\(\)]+)\))/)
10568        { # parsing $(Type) constructions
10569            my $Replace = $1;
10570            my $TypeName = $2;
10571            my $TypeId = get_TypeIdByName($TypeName);
10572            my $FTypeId = get_FoundationTypeId($TypeId);
10573            my $NewKey = "_var".$Block_InsNum{$CurrentBlock};
10574            my ($FuncParamName, $FuncParamPos, $InterfaceShortName) = parse_param_name($String, $Replace);
10575            if($FuncParamName) {
10576                $NewKey = $FuncParamName;
10577            }
10578            my $InLine = 1;
10579            $InLine = 0 if(uncover_typedefs($TypeName)=~/\&/);
10580            $InLine = 0 if(get_TypeType($FTypeId)!~/\A(Intrinsic|Enum)\Z/ and $FuncParamName and $FuncParamName!~/\Ap\d+\Z/
10581                and not isCyclical(\@RecurTypeId, get_TypeStackId($TypeId)));
10582            my %Param_Init = initializeParameter((
10583                "AccessToParam" => {"obj"=>"no object"},
10584                "TypeId" => $TypeId,
10585                "Key" => $NewKey,
10586                "InLine" => $InLine,
10587                "Value" => "no value",
10588                "CreateChild" => 0,
10589                "SpecType" => ($FuncParamName and $InterfaceShortName)?$InterfaceSpecType{$InterfaceShortName}{"SpecParam"}{$FuncParamPos}:0,
10590                "Usage" => "Common",
10591                "ParamName" => $NewKey,
10592                "Interface" => $InterfaceShortName));
10593            return () if(not $Param_Init{"IsCorrect"} or $Param_Init{"ByNull"});
10594            $Block_InsNum{$CurrentBlock} += 1 if(($Param_Init{"Init"}.$Param_Init{"FinalCode"}.$Param_Init{"Code"})=~/\Q$NewKey\E/);
10595            $Param_Init{"Init"} = alignCode($Param_Init{"Init"}, $String, 0);
10596            $Param_Init{"PreCondition"} = alignCode($Param_Init{"PreCondition"}, $String, 0);
10597            $Param_Init{"PostCondition"} = alignCode($Param_Init{"PostCondition"}, $String, 0);
10598            $Param_Init{"Call"} = alignCode($Param_Init{"Call"}, $String, 1);
10599            substr($String, index($String, $Replace), pos($Replace) + length($Replace)) = $Param_Init{"Call"};
10600            $String = clearSyntax($String);
10601            $AllSubCode .= $Param_Init{"Code"};
10602            $Headers = addHeaders($Param_Init{"Headers"}, $Headers);
10603            $CodeBefore .= $Param_Init{"Init"}.$Param_Init{"PreCondition"};
10604            $CodeAfter .= $Param_Init{"PostCondition"}.$Param_Init{"FinalCode"};
10605        }
10606        while($String=~/(\$\[([^\$\[\]]+)\])/)
10607        { # parsing $[Interface] constructions
10608            my $Replace = $1;
10609            my $InterfaceName = $2;
10610            my $RetvalName = "";
10611            if($InterfaceName=~/\A(.+):(\w+?)\Z/)
10612            { # $[al_create_display:allegro_display]
10613                ($InterfaceName, $RetvalName) = ($1, $2);
10614            }
10615            my $NewKey = "_var".$Block_InsNum{$CurrentBlock};
10616            my %Interface_Init = ();
10617            return () if(not $InterfaceName or not $CompleteSignature{$InterfaceName});
10618            if($InterfaceName eq $TestedInterface)
10619            { # recursive call of the target interface
10620                substr($String, index($String, $Replace), pos($Replace) + length($Replace)) = "";
10621                $String = "" if($String eq ";");
10622                next;
10623            }
10624            if($CompleteSignature{$InterfaceName}{"Constructor"})
10625            {
10626                push(@RecurTypeId, $CompleteSignature{$InterfaceName}{"Class"});
10627                %Interface_Init = callInterface((
10628                    "Interface"=>$InterfaceName,
10629                    "Key"=>$NewKey));
10630                pop(@RecurTypeId);
10631            }
10632            else
10633            {
10634                if($RetvalName) {
10635                    push(@RecurTypeId, get_TypeStackId($CompleteSignature{$InterfaceName}{"Return"}));
10636                }
10637                %Interface_Init = callInterface((
10638                    "Interface"=>$InterfaceName,
10639                    "Key"=>$NewKey,
10640                    "RetParam"=>$RetvalName));
10641                if($RetvalName)
10642                {
10643                    pop(@RecurTypeId);
10644                    $Interface_Init{"ReturnFinalCode"}=~s/\$retval/$RetvalName/;
10645                }
10646            }
10647            return () if(not $Interface_Init{"IsCorrect"});
10648            $Block_InsNum{$CurrentBlock} += 1 if(($Interface_Init{"Init"}.$Interface_Init{"FinalCode"}.$Interface_Init{"ReturnFinalCode"}.$Interface_Init{"Code"})=~/\Q$NewKey\E/);
10649            if(($CompleteSignature{$InterfaceName}{"Constructor"}) and (needToInherit($InterfaceName)))
10650            { # for constructors in abstract classes
10651                    my $ClassName = get_TypeName($CompleteSignature{$InterfaceName}{"Class"});
10652                    my $ClassNameChild = getSubClassName($ClassName);
10653                    if($Interface_Init{"Call"}=~/\A(\Q$ClassName\E([\n]*)\()/) {
10654                        substr($Interface_Init{"Call"}, index($Interface_Init{"Call"}, $1), pos($1) + length($1)) = $ClassNameChild.$2."(";
10655                    }
10656                    $UsedConstructors{$CompleteSignature{$InterfaceName}{"Class"}}{$InterfaceName} = 1;
10657                    $IntSubClass{$TestedInterface}{$CompleteSignature{$InterfaceName}{"Class"}} = 1;
10658                    $Create_SubClass{$CompleteSignature{$InterfaceName}{"Class"}} = 1;
10659            }
10660            $Interface_Init{"Init"} = alignCode($Interface_Init{"Init"}, $String, 0);
10661            $Interface_Init{"PreCondition"} = alignCode($Interface_Init{"PreCondition"}, $String, 0);
10662            $Interface_Init{"PostCondition"} = alignCode($Interface_Init{"PostCondition"}, $String, 0);
10663            $Interface_Init{"FinalCode"} = alignCode($Interface_Init{"FinalCode"}, $String, 0);
10664            $Interface_Init{"ReturnFinalCode"} = alignCode($Interface_Init{"ReturnFinalCode"}, $String, 0);
10665            $Interface_Init{"Call"} = alignCode($Interface_Init{"Call"}, $String, 1);
10666            if($RetvalName)
10667            {
10668                $Block_Variable{$CurrentBlock}{$RetvalName} = 1;
10669                $ValueCollection{$CurrentBlock}{$RetvalName} = $CompleteSignature{$InterfaceName}{"Return"};
10670                $UseVarEveryWhere{$CurrentBlock}{$RetvalName} = 1;
10671                $Interface_Init{"Call"} = get_TypeName($CompleteSignature{$InterfaceName}{"Return"})." $RetvalName = ".$Interface_Init{"Call"};
10672            }
10673            substr($String, index($String, $Replace), pos($Replace) + length($Replace)) = $Interface_Init{"Call"};
10674            $AllSubCode .= $Interface_Init{"Code"};
10675            $Headers = addHeaders($Interface_Init{"Headers"}, $Headers);
10676            $CodeBefore .= $Interface_Init{"Init"}.$Interface_Init{"PreCondition"};
10677            $CodeAfter .= $Interface_Init{"PostCondition"}.$Interface_Init{"FinalCode"}.$Interface_Init{"ReturnFinalCode"};
10678        }
10679        $ParsedCode .= $CodeBefore.$String."\n".$CodeAfter;
10680        if($Mode eq "Value")
10681        {
10682            return ("NewGlobalCode" => $AllSubCode,
10683            "Code" => $String,
10684            "CodeBefore" => $CodeBefore,
10685            "CodeAfter" => $CodeAfter,
10686            "Headers" => $Headers,
10687            "IsCorrect" => 1);
10688        }
10689    }
10690    return ("NewGlobalCode" => $AllSubCode, "Code" => clearSyntax($ParsedCode), "Headers" => $Headers, "IsCorrect" => 1);
10691}
10692
10693sub callInterface_m(@)
10694{
10695    my %Init_Desc = @_;
10696    my ($Interface, $Key) = ($Init_Desc{"Interface"}, $Init_Desc{"Key"});
10697    my $SpecObjectType = $InterfaceSpecType{$Interface}{"SpecObject"};
10698    my $SpecReturnType = $InterfaceSpecType{$Interface}{"SpecReturn"};
10699    my %Interface_Init = ();
10700    my $ClassName = get_TypeName($CompleteSignature{$Interface}{"Class"});
10701    my ($CreateChild, $CallAsGlobalData, $MethodToInitObj) = (0, 0, "Common");
10702
10703    if(needToInherit($Interface) and isInCharge($Interface))
10704    { # impossible testing
10705        return ();
10706    }
10707    if($CompleteSignature{$Interface}{"Protected"})
10708    {
10709        if(not $CompleteSignature{$Interface}{"Constructor"}) {
10710            $UsedProtectedMethods{$CompleteSignature{$Interface}{"Class"}}{$Interface} = 1;
10711        }
10712        $IntSubClass{$TestedInterface}{$CompleteSignature{$Interface}{"Class"}} = 1;
10713        $Create_SubClass{$CompleteSignature{$Interface}{"Class"}} = 1;
10714        $CreateChild = 1;
10715    }
10716    if(($CompleteSignature{$Interface}{"Static"}) and (not $CompleteSignature{$Interface}{"Protected"}))
10717    {
10718        $MethodToInitObj = "OnlySpecType";
10719        $CallAsGlobalData = 1;
10720    }
10721    if($SpecReturnType and not isCyclical(\@RecurSpecType, $SpecReturnType))
10722    {
10723        my $SpecReturnCode = $SpecType{$SpecReturnType}{"Code"};
10724        if($SpecReturnCode) {
10725            push(@RecurSpecType, $SpecReturnType);
10726        }
10727        my $PreviousBlock = $CurrentBlock;
10728        $CurrentBlock = $CurrentBlock."_code_".$SpecReturnType;
10729        my %ParsedCode = parseCode($SpecType{$SpecReturnType}{"Code"}, "Code");
10730        $CurrentBlock = $PreviousBlock;
10731        if(not $ParsedCode{"IsCorrect"})
10732        {
10733            if($SpecReturnCode) {
10734                pop(@RecurSpecType);
10735            }
10736            return ();
10737        }
10738        $SpecCode{$SpecReturnType} = 1 if($ParsedCode{"Code"});
10739        $Interface_Init{"Code"} .= $ParsedCode{"NewGlobalCode"}.$ParsedCode{"Code"};
10740        $Interface_Init{"Headers"} = addHeaders($ParsedCode{"Headers"}, $Interface_Init{"Headers"});
10741        if($SpecReturnCode) {
10742            pop(@RecurSpecType);
10743        }
10744    }
10745    if($CompleteSignature{$Interface}{"Class"}
10746    and not $CompleteSignature{$Interface}{"Constructor"})
10747    {
10748        # initialize object
10749        my $ParamName = select_obj_name($Key, $CompleteSignature{$Interface}{"Class"});
10750        my $NewKey = ($Key)?$Key."_".$ParamName:$ParamName;
10751        if(not $SpecObjectType) {
10752            $SpecObjectType = chooseSpecType($CompleteSignature{$Interface}{"Class"}, "common_param", $Init_Desc{"Interface"});
10753        }
10754        my %Obj_Init = (not $Init_Desc{"ObjectCall"})?initializeParameter((
10755            "ParamName" => $ParamName,
10756            "Interface" => $Interface,
10757            "AccessToParam" => {"obj"=>"create object"},
10758            "TypeId" => $CompleteSignature{$Interface}{"Class"},
10759            "Key" => $NewKey,
10760            "InLine" => 0,
10761            "Value" => "no value",
10762            "CreateChild" => $CreateChild,
10763            "SpecType" => $SpecObjectType,
10764            "Usage" => $MethodToInitObj,
10765            "ConvertToBase" => (not $CompleteSignature{$Interface}{"Protected"}),
10766            "ObjectInit" =>1 )):("IsCorrect"=>1, "Call"=>$Init_Desc{"ObjectCall"});
10767        if(not $Obj_Init{"IsCorrect"})
10768        {
10769            if($Debug) {
10770                $DebugInfo{"Init_Class"}{get_TypeName($CompleteSignature{$Interface}{"Class"})} = 1;
10771            }
10772            return ();
10773        }
10774        $Obj_Init{"Call"} = "no object" if($CallAsGlobalData);
10775        # initialize parameters
10776        pop(@RecurInterface);
10777        $Init_Desc{"ObjectCall"} = $Obj_Init{"Call"} if(not $Init_Desc{"ObjectCall"});
10778        my %Params_Init = callInterfaceParameters(%Init_Desc);
10779        push(@RecurInterface, $Interface);
10780        return () if(not $Params_Init{"IsCorrect"});
10781        $Interface_Init{"ReturnRequirement"} .= $Params_Init{"ReturnRequirement"};
10782        $Interface_Init{"ReturnFinalCode"} .= $Params_Init{"ReturnFinalCode"};
10783        $Interface_Init{"Init"} .= $Obj_Init{"Init"}.$Params_Init{"Init"};
10784        $Interface_Init{"Destructors"} .= $Params_Init{"Destructors"}.$Obj_Init{"Destructors"};
10785        $Interface_Init{"Headers"} = addHeaders($Params_Init{"Headers"}, $Interface_Init{"Headers"});
10786        $Interface_Init{"Headers"} = addHeaders($Obj_Init{"Headers"}, $Interface_Init{"Headers"});
10787        $Interface_Init{"Code"} .= $Obj_Init{"Code"}.$Params_Init{"Code"};
10788        $Interface_Init{"PreCondition"} .= $Obj_Init{"PreCondition"}.$Params_Init{"PreCondition"};
10789        $Interface_Init{"PostCondition"} .= $Obj_Init{"PostCondition"}.$Params_Init{"PostCondition"};
10790        $Interface_Init{"FinalCode"} .= $Obj_Init{"FinalCode"}.$Params_Init{"FinalCode"};
10791        # target call
10792        if($CallAsGlobalData) {
10793            $Interface_Init{"Call"} = $ClassName."::".$Params_Init{"Call"};
10794        }
10795        else
10796        {
10797            if(($Obj_Init{"Call"}=~/\A\*/) or ($Obj_Init{"Call"}=~/\A\&/)) {
10798                $Obj_Init{"Call"} = "(".$Obj_Init{"Call"}.")";
10799            }
10800            $Interface_Init{"Call"} = $Obj_Init{"Call"}.".".$Params_Init{"Call"};
10801            $Interface_Init{"Call"}=~s/\(\*(\w+)\)\./$1\-\>/;
10802            $Interface_Init{"Call"}=~s/\(\&(\w+)\)\-\>/$1\./;
10803        }
10804        #simplify operators
10805        $Interface_Init{"Call"} = simplifyOperator($Interface_Init{"Call"});
10806        $Interface_Init{"IsCorrect"} = 1;
10807        return %Interface_Init;
10808    }
10809    else
10810    {
10811        pop(@RecurInterface);
10812        $Init_Desc{"ObjectCall"} = "no object";
10813        my %Params_Init = callInterfaceParameters(%Init_Desc);
10814        push(@RecurInterface, $Interface);
10815        return () if(not $Params_Init{"IsCorrect"});
10816        $Interface_Init{"ReturnRequirement"} .= $Params_Init{"ReturnRequirement"};
10817        $Interface_Init{"ReturnFinalCode"} .= $Params_Init{"ReturnFinalCode"};
10818        $Interface_Init{"Init"} .= $Params_Init{"Init"};
10819        $Interface_Init{"Destructors"} .= $Params_Init{"Destructors"};
10820        $Interface_Init{"Headers"} = addHeaders($Params_Init{"Headers"}, $Interface_Init{"Headers"});
10821        $Interface_Init{"Code"} .= $Params_Init{"Code"};
10822        $Interface_Init{"PreCondition"} .= $Params_Init{"PreCondition"};
10823        $Interface_Init{"PostCondition"} .= $Params_Init{"PostCondition"};
10824        $Interface_Init{"FinalCode"} .= $Params_Init{"FinalCode"};
10825        $Interface_Init{"Call"} = $Params_Init{"Call"};
10826        if($CompleteSignature{$Interface}{"NameSpace"}
10827        and not $CompleteSignature{$Interface}{"Class"}) {
10828            $Interface_Init{"Call"} = $CompleteSignature{$Interface}{"NameSpace"}."::".$Interface_Init{"Call"};
10829        }
10830        $Interface_Init{"IsCorrect"} = 1;
10831        return %Interface_Init;
10832    }
10833}
10834
10835sub simplifyOperator($)
10836{
10837    my $String = $_[0];
10838    if($String!~/\.operator/) {
10839        return $String;
10840    }
10841    return $String if($String!~/(.*)\.operator[ ]*([^()]+)\((.*)\)/);
10842    my $Target = $1;
10843    my $Operator = $2;
10844    my $Params = $3;
10845    if($Params eq "")
10846    {
10847        #prefix operator
10848        if($Operator=~/[a-z]/i) {
10849            return $String;
10850        }
10851        else {
10852            return $Operator.$Target;
10853        }
10854    }
10855    else
10856    {
10857        #postfix operator
10858        if($Params!~/\,/)
10859        {
10860            $Params = "" if(($Operator eq "++") or ($Operator eq "--"));
10861            if($Operator eq "[]") {
10862                return $Target."[$Params]";
10863            }
10864            else {
10865                return $Target.$Operator."$Params";
10866            }
10867        }
10868        else {
10869            return $Target.$Operator."($Params)";
10870        }
10871    }
10872}
10873
10874sub callInterface(@)
10875{
10876    my %Init_Desc = @_;
10877    my $Interface = $Init_Desc{"Interface"};
10878    return () if(not $Interface);
10879    return () if($SkipInterfaces{$Interface});
10880    foreach my $SkipPattern (keys(%SkipInterfaces_Pattern)) {
10881        return () if($Interface=~/$SkipPattern/);
10882    }
10883    if(defined $MakeIsolated and $Symbol_Library{$Interface}
10884    and keys(%InterfacesList) and not $InterfacesList{$Interface}) {
10885        return ();
10886    }
10887    my $Global_State = save_state();
10888    return () if(isCyclical(\@RecurInterface, $Interface));
10889    push(@RecurInterface, $Interface);
10890    $UsedInterfaces{$Interface} = 1;
10891    my %Interface_Init = callInterface_m(%Init_Desc);
10892    if(not $Interface_Init{"IsCorrect"})
10893    {
10894        pop(@RecurInterface);
10895        restore_state($Global_State);
10896        return ();
10897    }
10898    pop(@RecurInterface);
10899    $Interface_Init{"ReturnTypeId"} = $CompleteSignature{$Interface}{"Return"};
10900    return %Interface_Init;
10901}
10902
10903sub get_REQ_define($)
10904{
10905    my $Interface = $_[0];
10906    my $Code = "#define REQ(id, failure_comment, constraint) { \\\n";
10907    $Code .= "    if(!(constraint)) { \\\n";
10908    $Code .= "        printf(\"\%s: \%s\\n\", id, failure_comment); \\\n    } \\\n";
10909    $Code .= "}\n";
10910    $FuncNames{"REQ"} = 1;
10911    $Block_Variable{"REQ"}{"id"} = 1;
10912    $Block_Variable{"REQ"}{"failure_comment"} = 1;
10913    $Block_Variable{"REQ"}{"constraint"} = 1;
10914    return $Code;
10915}
10916
10917sub get_REQva_define($)
10918{
10919    my $Interface = $_[0];
10920    my $Code = "#define REQva(id, constraint, failure_comment_fmt, ...) { \\\n";
10921    $Code .= "    if(!(constraint)) { \\\n";
10922    $Code .= "        printf(\"\%s: \"failure_comment_fmt\"\\n\", id, __VA_ARGS__); \\\n    } \\\n";
10923    $Code .= "}\n";
10924    $FuncNames{"REQva"} = 1;
10925    $Block_Variable{"REQva"}{"id"} = 1;
10926    $Block_Variable{"REQva"}{"failure_comment"} = 1;
10927    $Block_Variable{"REQva"}{"constraint"} = 1;
10928    return $Code;
10929}
10930
10931sub add_lines($$)
10932{
10933    my ($Code, $AdditionalLines) = @_;
10934    my @Lines = split(/\n/, $Code);
10935    my $NewCode_LineNumbers = "\@LT\@table\@SP\@class='l_num'\@SP\@border='0'\@SP\@cellpadding='0'\@SP\@cellspacing='0'\@GT\@\@NL\@";
10936    my $NewCode_Lines = "\@LT\@table\@SP\@class='code_lines'\@SP\@border='0'\@SP\@cellpadding='0'\@SP\@cellspacing='0'\@GT\@\@NL\@";
10937    my $NewCode = "\@LT\@table\@SP\@border='0'\@SP\@cellpadding='0'\@SP\@cellspacing='0'\@GT\@\@NL\@";
10938    my $MaxLineNum = 0;
10939    foreach my $LineNum (0 .. $#Lines)
10940    {
10941        my $Line = $Lines[$LineNum];
10942        $Line = "    " if(not $Line);
10943        my $Color = "";
10944        #if(index($Line, "'targ'")!=-1) {
10945            # $Color = "\@SP\@class='targ'";
10946        #}
10947        $NewCode_LineNumbers .= "\@LT\@tr\@GT\@\@LT\@td\@GT\@".($LineNum+1)."\@LT\@/td\@GT\@\@LT\@/tr\@GT\@\@NL\@";
10948        $NewCode_Lines .= "\@LT\@tr\@GT\@\@LT\@td$Color\@GT\@$Line\@LT\@/td\@GT\@\@LT\@/tr\@GT\@\@NL\@";
10949        $MaxLineNum = $LineNum;
10950    }
10951    foreach my $LineNum (1 .. $AdditionalLines) {
10952        $NewCode_LineNumbers .= "\@LT\@tr\@GT\@\@LT\@td\@GT\@".($MaxLineNum+$LineNum+1)."\@LT\@/td\@GT\@\@LT\@/tr\@GT\@\@NL\@";
10953    }
10954    $NewCode_LineNumbers .= "\@LT\@/table\@GT\@\@NL\@";
10955    $NewCode_Lines .= "\@LT\@/table\@GT\@\@NL\@";
10956    $NewCode .= "\@LT\@tr\@GT\@\@LT\@td\@SP\@valign='top'\@GT\@$NewCode_LineNumbers\@LT\@/td\@GT\@\@LT\@td\@SP\@valign='top'\@GT\@$NewCode_Lines\@LT\@/td\@GT\@\@LT\@/tr\@GT\@\@LT\@/table\@GT\@\@NL\@";
10957    return $NewCode;
10958}
10959
10960sub parse_variables($)
10961{
10962    my $Code = $_[0];
10963    return () if(not $Code);
10964    my $Code_Copy = $Code;
10965    my (%Variables, %LocalFuncNames, %LocalMethodNames) = ();
10966    while($Code=~s/([a-z_]\w*)[ ]*\([^;{}]*\)[ \n]*\{//io) {
10967        $LocalFuncNames{$1} = 1;
10968    }
10969    $Code = $Code_Copy;
10970    while($Code=~s/\:\:([a-z_]\w*)[ ]*\([^;{}]*\)[ \n]*\{//io) {
10971        $LocalMethodNames{$1} = 1;
10972    }
10973    foreach my $Block (sort keys(%Block_Variable))
10974    {
10975        foreach my $Variable (sort {length($b)<=>length($a)} keys(%{$Block_Variable{$Block}}))
10976        {
10977            next if(not $Variable);
10978            if($Code_Copy=~/\W$Variable[ ]*(,|(\n[ ]*|)\))/) {
10979                $Variables{$Variable}=1;
10980            }
10981            else
10982            {
10983                next if(is_not_variable($Variable, $Code_Copy));
10984                next if($LocalFuncNames{$Variable} and ($Code_Copy=~/\W\Q$Variable\E[ ]*\(/ or $Code_Copy=~/\&\Q$Variable\E\W/));
10985                next if($LocalMethodNames{$Variable} and $Code_Copy=~/\W\Q$Variable\E[ ]*\(/);
10986                $Variables{$Variable}=1;
10987            }
10988        }
10989    }
10990    while($Code=~s/[ ]+([a-z_]\w*)([ ]*=|;)//io)
10991    {
10992        my $Variable = $1;
10993        next if(is_not_variable($Variable, $Code_Copy));
10994        next if($LocalFuncNames{$Variable} and ($Code_Copy=~/\W\Q$Variable\E[ ]*\(/ or $Code_Copy=~/\&\Q$Variable\E\W/));
10995        next if($LocalMethodNames{$Variable} and $Code_Copy=~/\W\Q$Variable\E[ ]*\(/);
10996        $Variables{$Variable}=1;
10997    }
10998    while($Code=~s/(\(|,)[ ]*([a-z_]\w*)[ ]*(\)|,)//io)
10999    {
11000        my $Variable = $2;
11001        next if(is_not_variable($Variable, $Code_Copy));
11002        next if($LocalFuncNames{$Variable} and ($Code_Copy=~/\W\Q$Variable\E[ ]*\(/ or $Code_Copy=~/\&\Q$Variable\E\W/));
11003        next if($LocalMethodNames{$Variable} and $Code_Copy=~/\W\Q$Variable\E[ ]*\(/);
11004        $Variables{$Variable}=1;
11005    }
11006    my @Variables = keys(%Variables);
11007    return @Variables;
11008}
11009
11010sub is_not_variable($$)
11011{
11012    my ($Variable, $Code) = @_;
11013    return 1 if($Variable=~/\A[A-Z_]+\Z/);
11014    # FIXME: more appropriate constants check
11015    return 1 if($TName_Tid{$Variable});
11016    return 1 if($EnumMembers{$Variable});
11017    return 1 if($NameSpaces{$Variable}
11018    and ($Code=~/\W\Q$Variable\E\:\:/ or $Code=~/\s+namespace\s+\Q$Variable\E\s*;/));
11019    return 1 if($IsKeyword{$Variable} or $Variable=~/\A(\d+)\Z|_SubClass/);
11020    return 1 if($Constants{$Variable});
11021    return 1 if($GlobalDataNames{$Variable});
11022    return 1 if($FuncNames{$Variable} and ($Code=~/\W\Q$Variable\E[ ]*\(/ or $Code=~/\&\Q$Variable\E\W/));
11023    return 1 if($MethodNames{$Variable} and $Code=~/\W\Q$Variable\E[ ]*\(/);
11024    return 1 if($Code=~/(\-\>|\.|\:\:)\Q$Variable\E[ ]*\(/);
11025    return 0;
11026}
11027
11028sub highlight_code($$)
11029{
11030    my ($Code, $Interface) = @_;
11031    my $Signature = get_Signature($Interface);
11032    my %Preprocessor = ();
11033    my $PreprocessorNum = 1;
11034    my @Lines = split(/\n/, $Code);
11035    foreach my $LineNum (0 .. $#Lines)
11036    {
11037        my $Line = $Lines[$LineNum];
11038        if($Line=~/\A[ \t]*(#.+)\Z/)
11039        {
11040            my $LineNum_Define = $LineNum;
11041            my $Define = $1;
11042            while($Define=~/\\[ \t]*\Z/)
11043            {
11044                $LineNum_Define+=1;
11045                $Define .= "\n".$Lines[$LineNum_Define];
11046            }
11047            if($Code=~s/\Q$Define\E/\@PREPROC_$PreprocessorNum\@/)
11048            {
11049                $Preprocessor{$PreprocessorNum} = $Define;
11050                $PreprocessorNum+=1;
11051            }
11052        }
11053    }
11054    my %Strings_DQ = ();
11055    my $StrNum_DQ = 1;
11056    while($Code=~s/((L|)"[^"]*")/\@STR_DQ_$StrNum_DQ\@/)
11057    {
11058        $Strings_DQ{$StrNum_DQ} = $1;
11059        $StrNum_DQ += 1;
11060    }
11061    my %Strings = ();
11062    my $StrNum = 1;
11063    while($Code=~s/((?<=\W)(L|)'[^']*')/\@STR_$StrNum\@/)
11064    {
11065        $Strings{$StrNum} = $1;
11066        $StrNum += 1;
11067    }
11068    my %Comments = ();
11069    my $CommentNum = 1;
11070    while($Code=~s/([^:]|\A)(\/\/[^\n]*)\n/$1\@COMMENT_$CommentNum\@\n/)
11071    {
11072        $Comments{$CommentNum} = $2;
11073        $CommentNum += 1;
11074    }
11075    if(my $ShortName = ($CompleteSignature{$Interface}{"Constructor"})?get_TypeName($CompleteSignature{$Interface}{"Class"}):$CompleteSignature{$Interface}{"ShortName"})
11076    { # target interface
11077        if($CompleteSignature{$Interface}{"Class"})
11078        {
11079            while($ShortName=~s/\A\w+\:\://g){ };
11080            if($CompleteSignature{$Interface}{"Constructor"}) {
11081                $Code=~s!(\:| new |\n    )(\Q$ShortName\E)([ \n]*\()!$1\@LT\@span\@SP\@class='targ'\@GT\@$2\@LT\@/span\@GT\@$3!g;
11082            }
11083            elsif($CompleteSignature{$Interface}{"Destructor"}) {
11084                $Code=~s!(\n    )(delete)([ \n]*\()!$1\@LT\@span\@SP\@class='targ'\@GT\@$2\@LT\@/span\@GT\@$3!g;
11085            }
11086            else {
11087                $Code=~s!(\-\>|\.|\:\:| new )(\Q$ShortName\E)([ \n]*\()!$1\@LT\@span\@SP\@class='targ'\@GT\@$2\@LT\@/span\@GT\@$3!g;
11088            }
11089        }
11090        else {
11091            $Code=~s!( )(\Q$ShortName\E)([ \n]*\()!$1\@LT\@span\@SP\@class='targ'\@GT\@$2\@LT\@/span\@GT\@$3!g;
11092        }
11093    }
11094    my %Variables = ();
11095    foreach my $Variable (parse_variables($Code))
11096    {
11097        if($Code=~s#(?<=[^\w\n.:>])($Variable)(?=\W)#\@LT\@span\@SP\@class='var'\@GT\@$1\@LT\@/span\@GT\@#g) {
11098            $Variables{$Variable}=1;
11099        }
11100    }
11101    $Code=~s!(?<=[^.\w])(bool|_Bool|_Complex|complex|void|const|int|long|short|float|double|volatile|restrict|char|unsigned|signed)(?=[^\w\=])!\@LT\@span\@SP\@class='type'\@GT\@$1\@LT\@/span\@GT\@!g;
11102    $Code=~s!(?<=[^.\w])(false|true|namespace|return|struct|static|enum|union|public|protected|private|delete|typedef)(?=[^\w\=])!\@LT\@span\@SP\@class='keyw'\@GT\@$1\@LT\@/span\@GT\@!g;
11103    if(not $Variables{"class"}) {
11104        $Code=~s!(?<=[^.\w])(class)(?=[^\w\=])!\@LT\@span\@SP\@class='keyw'\@GT\@$1\@LT\@/span\@GT\@!g;
11105    }
11106    if(not $Variables{"new"}) {
11107        $Code=~s!(?<=[^.\w])(new)(?=[^\w\=])!\@LT\@span\@SP\@class='keyw'\@GT\@$1\@LT\@/span\@GT\@!g;
11108    }
11109    $Code=~s!(?<=[^.\w])(for|if|else if)([ \n]*\()(?=[^\w\=])!\@LT\@span\@SP\@class='keyw'\@GT\@$1\@LT\@/span\@GT\@$2!g;
11110    $Code=~s!(?<=[^.\w])else([ \n\{]+)(?=[^\w\=])!\@LT\@span\@SP\@class='keyw'\@GT\@else\@LT\@/span\@GT\@$1!g;
11111    $Code=~s!(?<=[^\w\@\$])(\d+(f|L|LL|)|NULL)(?=[^\w\@\$])!\@LT\@span\@SP\@class='num'\@GT\@$1\@LT\@/span\@GT\@!g;
11112    $Code=~s!(?<=[^\w\@\$])(0x[a-fA-F\d]{4})(?=[^\w\@\$])!\@LT\@span\@SP\@class='num'\@GT\@$1\@LT\@/span\@GT\@!g;
11113    foreach my $Num (keys(%Comments))
11114    {
11115        my $String = $Comments{$Num};
11116        $Code=~s!\@COMMENT_$Num\@!\@LT\@span\@SP\@class='comm'\@GT\@$String\@LT\@/span\@GT\@!g;
11117    }
11118    my $AdditionalLines = 0;
11119    foreach my $Num (keys(%Preprocessor))
11120    {
11121        my $Define = $Preprocessor{$Num};
11122        while($Define=~s/\n//) {
11123            $AdditionalLines+=1;
11124        }
11125    }
11126    $Code = add_lines($Code, $AdditionalLines);
11127    # $Code=~s/\n/\@LT\@br\/\@GT\@\n/g;
11128    foreach my $Num (keys(%Preprocessor))
11129    {
11130        my $Define = $Preprocessor{$Num};
11131        $Code=~s!\@PREPROC_$Num\@!\@LT\@span\@SP\@class='prepr'\@GT\@$Define\@LT\@/span\@GT\@!g;
11132    }
11133    foreach my $Num (keys(%Strings_DQ))
11134    {
11135        my $String = $Strings_DQ{$Num};
11136        $Code=~s!\@STR_DQ_$Num\@!\@LT\@span\@SP\@class='str'\@GT\@$String\@LT\@/span\@GT\@!g;
11137    }
11138    foreach my $Num (keys(%Strings))
11139    {
11140        my $String = $Strings{$Num};
11141        $Code=~s!\@STR_$Num\@!\@LT\@span\@SP\@class='str'\@GT\@$String\@LT\@/span\@GT\@!g;
11142    }
11143    $Code =~ s!\[\]![\@LT\@span\@SP\@style='padding-left:2px;'\@GT\@]\@LT\@/span\@GT\@!g;
11144    $Code =~ s!\(\)!(\@LT\@span\@SP\@style='padding-left:2px;'\@GT\@)\@LT\@/span\@GT\@!g;
11145    return $Code;
11146}
11147
11148sub is_process_running($)
11149{
11150    my ($PID, $procname) = @_;
11151    if (!-e "/proc/$PID") {
11152        return 0;
11153    }
11154    open(FILE, "/proc/$PID/stat") or return 0;
11155    my $info = <FILE>;
11156    close(FILE);
11157    if ($info=~/^\d+\s+\((.*)\)\s+(\S)\s+[^\(\)]+$/) {
11158        return ($2 ne 'Z');
11159    }
11160    else {
11161        return 0;
11162    }
11163}
11164
11165sub kill_all_childs($)
11166{
11167    my $root_pid = $_[0];
11168    return if(not $root_pid);
11169    # Build the list of processes to be killed.
11170    # Sub-tree of this particular process is excluded so that it could finish its work.
11171    my %children = ();
11172    my %parent = ();
11173    # Read list of all currently running processes
11174    if(!opendir(PROC_DIR, "/proc"))
11175    {
11176        kill(9, $root_pid);
11177        return;
11178    }
11179    my @all_pids = grep(/^\d+$/, readdir(PROC_DIR));
11180    closedir(PROC_DIR);
11181    # Build the parent-child tree and get command lines
11182    foreach my $pid (@all_pids)
11183    {
11184        if (open(PID_FILE, "/proc/$pid/stat"))
11185        {
11186            my $info = <PID_FILE>;
11187            close(PID_FILE);
11188            if ($info=~/^\d+\s+\((.*)\)\s+\S\s+(\d+)\s+[^\(\)]+$/)
11189            {
11190                my $ppid = $2;
11191                $parent{$pid} = $ppid;
11192                if (!defined($children{$ppid})) {
11193                    $children{$ppid} = [];
11194                }
11195                push @{$children{$ppid}}, $pid;
11196            }
11197        }
11198    }
11199    # Get the plain list of processes to kill (breadth-first tree-walk)
11200    my @kill_list = ($root_pid);
11201    for (my $i = 0; $i < scalar(@kill_list); ++$i)
11202    {
11203        my $pid = $kill_list[$i];
11204        if ($children{$pid})
11205        {
11206            foreach (@{$children{$pid}}) {
11207                push @kill_list, $_;
11208            }
11209        }
11210    }
11211    # Send TERM signal to all processes
11212    foreach (@kill_list) {
11213        kill("SIGTERM", $_);
11214    }
11215    # Try 20 times, waiting 0.3 seconds each time, for all the processes to be really dead.
11216    my %death_check = map { $_ => 1 } @kill_list;
11217    for (my $i = 0; $i < 20; ++$i)
11218    {
11219        foreach (keys %death_check)
11220        {
11221            if (!is_process_running($_)) {
11222                delete $death_check{$_};
11223            }
11224        }
11225        if (scalar(keys %death_check) == 0) {
11226            last;
11227        }
11228        else {
11229            select(undef, undef, undef, 0.3);
11230        }
11231    }
11232}
11233
11234sub filt_output($)
11235{
11236    my $Output = $_[0];
11237    return $Output if(not keys(%SkipWarnings) and not keys(%SkipWarnings_Pattern));
11238    my @NewOutput = ();
11239    foreach my $Line (split(/\n/, $Output))
11240    {
11241        my $IsMatched = 0;
11242        foreach my $Warning (keys(%SkipWarnings))
11243        {
11244            if($Line=~/\Q$Warning\E/) {
11245                $IsMatched = 1;
11246            }
11247        }
11248        foreach my $Warning (keys(%SkipWarnings_Pattern))
11249        {
11250            if($Line=~/$Warning/) {
11251                $IsMatched = 1;
11252            }
11253        }
11254        if(not $IsMatched) {
11255            push(@NewOutput, $Line);
11256        }
11257    }
11258    my $FinalOut = join("\n", @NewOutput);
11259    $FinalOut=~s/\A[\n]+//g;
11260    return $FinalOut;
11261}
11262
11263sub createTestRunner()
11264{ # C-utility to run tests under Windows
11265
11266    # remove old stuff
11267    rmtree("test_runner/");
11268
11269    writeFile("test_runner/test_runner.cpp","
11270    #include <windows.h>
11271    #include <stdio.h>
11272    int main(int argc, char *argv[])
11273    {
11274        char* cmd = argv[1];
11275        char* directory = argv[2];
11276        char* res = argv[3];
11277        STARTUPINFO si;
11278        PROCESS_INFORMATION pi;
11279        ZeroMemory( &si, sizeof(STARTUPINFO));
11280        si.cb = sizeof(STARTUPINFO);
11281        ZeroMemory( &pi, sizeof(PROCESS_INFORMATION));
11282        if(CreateProcess(NULL, cmd, NULL, NULL, FALSE, DEBUG_PROCESS,
11283        NULL, directory, &si, &pi) == 0) {
11284            return 1;
11285        }
11286        FILE * result = fopen(res, \"w+\");
11287        if(result==NULL) {
11288            return 1;
11289        }
11290        DEBUG_EVENT de;
11291        DWORD ecode;
11292        int done = 0;
11293        for(;;)
11294        {
11295            if(WaitForDebugEvent(&de, INFINITE)==0)
11296                break;
11297            switch (de.dwDebugEventCode)
11298            {
11299                case EXCEPTION_DEBUG_EVENT:
11300                    ecode = de.u.Exception.ExceptionRecord.ExceptionCode;
11301                    if (ecode!=EXCEPTION_BREAKPOINT &&
11302                    ecode!=EXCEPTION_SINGLE_STEP)
11303                    {
11304                        fprintf(result, \"\%x;0\", ecode);
11305                        printf(\"\%x\\n\", ecode);
11306                        TerminateProcess(pi.hProcess, 0);
11307                        done = 1;
11308                    }
11309                    break;
11310                case EXIT_PROCESS_DEBUG_EVENT:
11311                    done = 1;
11312            }
11313            if(done==1)
11314                break;
11315            ContinueDebugEvent(de.dwProcessId, de.dwThreadId, DBG_CONTINUE);
11316        }
11317        fclose(result);
11318        return 0;
11319    }
11320    ");
11321    chdir("test_runner");
11322    system("cl test_runner.cpp >build_log 2>&1");
11323    chdir($ORIG_DIR);
11324    if($?) {
11325        exitStatus("Error", "can't compile test runner\n");
11326    }
11327}
11328
11329my %WindowsExceptions=(
11330    "c0000005" => "ACCESS_VIOLATION",
11331    "c00002c5" => "DATATYPE_MISALIGNMENT",
11332    "c000008c" => "ARRAY_BOUNDS_EXCEEDED",
11333    "c000008d" => "FLOAT_DENORMAL_OPERAND",
11334    "c000008e" => "FLOAT_DIVIDE_BY_ZERO",
11335    "c000008f" => "FLOAT_INEXACT_RESULT",
11336    "c0000090" => "FLOAT_INVALID_OPERATION",
11337    "c0000091" => "FLOAT_OVERFLOW",
11338    "c0000092" => "FLOAT_STACK_CHECK",
11339    "c0000093" => "FLOAT_UNDERFLOW",
11340    "c0000094" => "INTEGER_DIVIDE_BY_ZERO",
11341    "c0000095" => "INTEGER_OVERFLOW",
11342    "c0000096" => "PRIVILEGED_INSTRUCTION",
11343    "c0000006" => "IN_PAGE_ERROR",
11344    "c000001d" => "ILLEGAL_INSTRUCTION",
11345    "c0000025" => "NONCONTINUABLE_EXCEPTION",
11346    "c00000fd" => "STACK_OVERFLOW",
11347    "c0000026" => "INVALID_DISPOSITION",
11348    "80000001" => "GUARD_PAGE_VIOLATION",
11349    "c0000008" => "INVALID_HANDLE",
11350    "c0000135" => "DLL_NOT_FOUND"
11351);
11352
11353sub run_sanity_test($)
11354{
11355    my $Interface = $_[0];
11356    my $TestDir = $Interface_TestDir{$Interface};
11357    if(not $TestDir)
11358    {
11359        $ResultCounter{"Run"}{"Fail"} += 1;
11360        $RunResult{$Interface}{"IsCorrect"} = 0;
11361        $RunResult{$Interface}{"TestNotExists"} = 1;
11362        if($TargetInterfaceName)
11363        {
11364            printMsg("INFO", "fail");
11365            exitStatus("Error", "test is not generated yet");
11366        }
11367        return 1;
11368    }
11369    elsif(not -f $TestDir."/test" and not -f $TestDir."/test.exe")
11370    {
11371        $ResultCounter{"Run"}{"Fail"} += 1;
11372        $RunResult{$Interface}{"IsCorrect"} = 0;
11373        $RunResult{$Interface}{"TestNotExists"} = 1;
11374        if($TargetInterfaceName)
11375        {
11376            printMsg("INFO", "fail");
11377            exitStatus("Error", "test is not built yet");
11378        }
11379        return 1;
11380    }
11381    unlink($TestDir."/result");
11382    my $pid = fork();
11383    unless($pid)
11384    {
11385        if($OSgroup eq "windows")
11386        {
11387            my $ProcCmd = "test_runner/test_runner.exe \"".abs_path($TestDir)."/run_test.bat\" \"$TestDir\" \"".abs_path($TestDir)."/result\" >nul 2>&1";
11388            $ProcCmd=~s/[\/\\]/\\/g;
11389            system($ProcCmd);
11390        }
11391        else
11392        {
11393            open(STDIN,"$TMP_DIR/null");
11394            open(STDOUT,"$TMP_DIR/null");
11395            open(STDERR,"$TMP_DIR/null");
11396            setsid(); # to remove signals printing on the terminal screen
11397            chdir($TestDir);
11398            system("sh run_test.sh 2>stderr");
11399            chdir($ORIG_DIR);
11400            writeFile("$TestDir/result", $?.";".$!);
11401        }
11402        exit(0);
11403    }
11404    my $Hang = 0;
11405    $SIG{ALRM} = sub {
11406        $Hang=1;
11407        if($OSgroup eq "windows") {
11408            kill(9, $pid);
11409        }
11410        else {
11411            kill_all_childs($pid);
11412        }
11413    };
11414    alarm $HANGED_EXECUTION_TIME;
11415    waitpid($pid, 0);
11416    alarm 0;
11417    my $Result = readFile("$TestDir/result");
11418    unlink($TestDir."/result");
11419    unlink("$TestDir/output") if(not readFile("$TestDir/output"));
11420    unlink("$TestDir/stderr") if(not readFile("$TestDir/stderr"));
11421    my ($R_1, $R_2) = split(";", $Result);
11422    my $ErrorOut = readFile("$TestDir/output");#checking test output
11423    $ErrorOut = filt_output($ErrorOut);
11424    if($ErrorOut)
11425    { # reduce length of the test output
11426        if(length($ErrorOut)>1200) {
11427            $ErrorOut = substr($ErrorOut, 0, 1200)." ...";
11428        }
11429    }
11430    if($Hang)
11431    {
11432        $ResultCounter{"Run"}{"Fail"} += 1;
11433        $RunResult{$Interface}{"IsCorrect"} = 0;
11434        $RunResult{$Interface}{"Type"} = "Hanged_Execution";
11435        $RunResult{$Interface}{"Info"} = "hanged execution (more than $HANGED_EXECUTION_TIME seconds)";
11436        $RunResult{$Interface}{"Info"} .= "\n".$ErrorOut if($ErrorOut);
11437    }
11438    elsif($R_1)
11439    {
11440        if($OSgroup eq "windows")
11441        {
11442            my $ExceptionName = $WindowsExceptions{$R_1};
11443            $RunResult{$Interface}{"Info"} = "received exception $ExceptionName\n";
11444            $RunResult{$Interface}{"Type"} = "Received_Exception";
11445            $RunResult{$Interface}{"Value"} = $ExceptionName;
11446        }
11447        else
11448        {
11449            if ($R_1 == -1)
11450            {
11451                $RunResult{$Interface}{"Info"} = "failed to execute: $R_2\n";
11452                $RunResult{$Interface}{"Type"} = "Other_Problems";
11453            }
11454            elsif (my $Signal_Num = ($R_1 & 127))
11455            {
11456                my $Signal_Name = $SigName{$Signal_Num};
11457                $RunResult{$Interface}{"Info"} = "received signal $Signal_Name, ".(($R_1 & 128)?"with":"without")." coredump\n";
11458                $RunResult{$Interface}{"Type"} = "Received_Signal";
11459                $RunResult{$Interface}{"Value"} = ($R_1 & 127);
11460            }
11461            else
11462            {
11463                my $Signal_Num = ($R_1 >> 8)-128;
11464                my $Signal_Name = $SigName{$Signal_Num};
11465                if($Signal_Name)
11466                {
11467                    $RunResult{$Interface}{"Info"} = "received signal $Signal_Name\n";
11468                    $RunResult{$Interface}{"Type"} = "Received_Signal";
11469                    $RunResult{$Interface}{"Value"} = $Signal_Name;
11470                }
11471                else
11472                {
11473                    $RunResult{$Interface}{"Info"} = "exited with value ".($R_1 >> 8)."\n";
11474                    $RunResult{$Interface}{"Type"} = "Exited_With_Value";
11475                    $RunResult{$Interface}{"Value"} = ($R_1 >> 8);
11476                }
11477            }
11478        }
11479        $ResultCounter{"Run"}{"Fail"} += 1;
11480        $RunResult{$Interface}{"IsCorrect"} = 0;
11481        $RunResult{$Interface}{"Info"} .= "\n".$ErrorOut if($ErrorOut);
11482    }
11483    elsif(readFile($TestDir."/output")=~/(constraint|postcondition|precondition) for the (return value|object|environment|parameter) failed/i)
11484    {
11485        $ResultCounter{"Run"}{"Fail"} += 1;
11486        $RunResult{$Interface}{"IsCorrect"} = 0;
11487        $RunResult{$Interface}{"Type"} = "Requirement_Failed";
11488        $RunResult{$Interface}{"Info"} .= "\n".$ErrorOut if($ErrorOut);
11489    }
11490    elsif($ErrorOut)
11491    {
11492        $ResultCounter{"Run"}{"Fail"} += 1;
11493        $RunResult{$Interface}{"Unexpected_Output"} = $ErrorOut;
11494        $RunResult{$Interface}{"Type"} = "Unexpected_Output";
11495        $RunResult{$Interface}{"Info"} = $ErrorOut;
11496    }
11497    else
11498    {
11499        $ResultCounter{"Run"}{"Success"} += 1;
11500        $RunResult{$Interface}{"IsCorrect"} = 1;
11501    }
11502    if(not $RunResult{$Interface}{"IsCorrect"})
11503    {
11504        return 0 if(not -e $TestDir."/test.c" and not -e $TestDir."/test.cpp");
11505        my $ReadingStarted = 0;
11506        foreach my $Line (split(/\n/, readFile($TestDir."/view.html")))
11507        {
11508            if($ReadingStarted) {
11509                $RunResult{$Interface}{"Test"} .= $Line."\n";
11510            }
11511            if($Line eq "<!--Test-->") {
11512                $ReadingStarted = 1;
11513            }
11514            if($Line eq "<!--Test_End-->") {
11515                last;
11516            }
11517        }
11518        my $Test_Info = readFile($TestDir."/info");
11519        foreach my $Str (split(/\n/, $Test_Info))
11520        {
11521            if($Str=~/\A[ ]*([^:]*?)[ ]*\:[ ]*(.*)[ ]*\Z/i)
11522            {
11523                my ($Attr, $Value) = ($1, $2);
11524                if(lc($Attr) eq "header") {
11525                    $RunResult{$Interface}{"Header"} = $Value;
11526                }
11527                elsif(lc($Attr) eq "shared object") {
11528                    $RunResult{$Interface}{"SharedObject"} = $Value;
11529                }
11530                elsif(lc($Attr) eq "interface") {
11531                    $RunResult{$Interface}{"Signature"} = $Value;
11532                }
11533                elsif(lc($Attr) eq "short name") {
11534                    $RunResult{$Interface}{"ShortName"} = $Value;
11535                }
11536                elsif(lc($Attr) eq "namespace") {
11537                    $RunResult{$Interface}{"NameSpace"} = $Value;
11538                }
11539            }
11540        }
11541        $RunResult{$Interface}{"ShortName"} = $Interface if(not $RunResult{$Interface}{"ShortName"});
11542        # filtering problems
11543        if($RunResult{$Interface}{"Type"} eq "Exited_With_Value")
11544        {
11545            if($RunResult{$Interface}{"ShortName"}=~/exit|die|assert/i) {
11546                skip_problem($Interface);
11547            }
11548            else {
11549                mark_as_warning($Interface);
11550            }
11551        }
11552        elsif($RunResult{$Interface}{"Type"} eq "Hanged_Execution")
11553        {
11554            if($RunResult{$Interface}{"ShortName"}=~/call|exec|acquire|start|run|loop|blocking|startblock|wait|time|show|suspend|pause/i
11555            or ($Interface=~/internal|private/ and $RunResult{$Interface}{"ShortName"}!~/private(.*)key/i)) {
11556                mark_as_warning($Interface);
11557            }
11558        }
11559        elsif($RunResult{$Interface}{"Type"} eq "Received_Signal")
11560        {
11561            if($RunResult{$Interface}{"ShortName"}=~/badalloc|bad_alloc|fatal|assert/i) {
11562                skip_problem($Interface);
11563            }
11564            elsif($Interface=~/internal|private/ and $RunResult{$Interface}{"ShortName"}!~/private(.*)key/i) {
11565                mark_as_warning($Interface);
11566            }
11567            elsif($RunResult{$Interface}{"Value"}!~/\A(SEGV|FPE|BUS|ILL|PIPE|SYS|XCPU|XFSZ)\Z/) {
11568                mark_as_warning($Interface);
11569            }
11570        }
11571        elsif($RunResult{$Interface}{"Type"} eq "Unexpected_Output")
11572        {
11573            if($Interface=~/print|debug|warn|message|error|fatal/i) {
11574                skip_problem($Interface);
11575            }
11576            else {
11577                mark_as_warning($Interface);
11578            }
11579        }
11580        elsif($RunResult{$Interface}{"Type"} eq "Other_Problems") {
11581            mark_as_warning($Interface);
11582        }
11583    }
11584    return 0;
11585}
11586
11587sub mark_as_warning($)
11588{
11589    my $Interface = $_[0];
11590    $RunResult{$Interface}{"Warnings"} = 1;
11591    $ResultCounter{"Run"}{"Warnings"} += 1;
11592    $ResultCounter{"Run"}{"Fail"} -= 1;
11593    $ResultCounter{"Run"}{"Success"} += 1;
11594    $RunResult{$Interface}{"IsCorrect"} = 1;
11595}
11596
11597sub skip_problem($)
11598{
11599    my $Interface = $_[0];
11600    $ResultCounter{"Run"}{"Fail"} -= 1;
11601    $ResultCounter{"Run"}{"Success"} += 1;
11602    delete($RunResult{$Interface});
11603    $RunResult{$Interface}{"IsCorrect"} = 1;
11604}
11605
11606sub readScenario()
11607{
11608    foreach my $TestCase (split(/\n/, readFile($TEST_SUITE_PATH."/scenario")))
11609    {
11610        if($TestCase=~/\A(.*);(.*)\Z/) {
11611            $Interface_TestDir{$1} = $2;
11612        }
11613    }
11614}
11615
11616sub write_scenario()
11617{
11618    my $TestCases = "";
11619    foreach my $Interface (sort {lc($a) cmp lc($b)} keys(%Interface_TestDir)) {
11620        $TestCases .= $Interface.";".$Interface_TestDir{$Interface}."\n";
11621    }
11622    writeFile("$TEST_SUITE_PATH/scenario", $TestCases);
11623}
11624
11625sub buildTest($)
11626{
11627    my $Interface = $_[0];
11628    my $TestDir = $Interface_TestDir{$Interface};
11629    if(not $TestDir or not -f "$TestDir/Makefile")
11630    {
11631        $BuildResult{$Interface}{"TestNotExists"} = 1;
11632        if($TargetInterfaceName)
11633        {
11634            printMsg("INFO", "fail");
11635            exitStatus("Error", "test is not generated yet");
11636        }
11637        return 0;
11638    }
11639    my $MakeCmd = ($OSgroup eq "windows")?"nmake":"make";
11640    chdir($TestDir);
11641    system("$MakeCmd clean -f Makefile 2>build_log >$TMP_DIR/null && $MakeCmd -f Makefile 2>build_log >$TMP_DIR/null");
11642    chdir($ORIG_DIR);
11643    if($?)
11644    {
11645        $ResultCounter{"Build"}{"Fail"} += 1;
11646        $BuildResult{$Interface}{"IsCorrect"} = 0;
11647    }
11648    else
11649    {
11650        $ResultCounter{"Build"}{"Success"} += 1;
11651        $BuildResult{$Interface}{"IsCorrect"} = 1;
11652    }
11653    unlink("$TestDir/test.o");
11654    unlink("$TestDir/test.obj");
11655    if(not readFile("$TestDir/build_log")) {
11656        unlink("$TestDir/build_log");
11657    }
11658    elsif($BuildResult{$Interface}{"IsCorrect"}) {
11659        $BuildResult{$Interface}{"Warnings"} = 1;
11660    }
11661}
11662
11663sub cleanTest($)
11664{
11665    my $Interface = $_[0];
11666    my $TestDir = $Interface_TestDir{$Interface};
11667    if(not $TestDir or not -f "$TestDir/Makefile")
11668    {
11669        $BuildResult{$Interface}{"TestNotExists"} = 1;
11670        if($TargetInterfaceName)
11671        {
11672            printMsg("INFO", "fail");
11673            exitStatus("Error", "test is not generated yet");
11674        }
11675        return 0;
11676    }
11677    unlink("$TestDir/test.o");
11678    unlink("$TestDir/test.obj");
11679    unlink("$TestDir/test");
11680    unlink("$TestDir/test.exe");
11681    unlink("$TestDir/build_log");
11682    unlink("$TestDir/output");
11683    unlink("$TestDir/stderr");
11684    rmtree("$TestDir/testdata");
11685    if($CleanSources)
11686    {
11687        foreach my $Path (cmd_find($TestDir,"f","",""))
11688        {
11689            if(get_filename($Path) ne "view.html") {
11690                unlink($Path);
11691            }
11692        }
11693    }
11694    return 1;
11695}
11696
11697sub testForDestructor($)
11698{
11699    my $Interface = $_[0];
11700    my $ClassId = $CompleteSignature{$Interface}{"Class"};
11701    my $ClassName = get_TypeName($ClassId);
11702    my %Interface_Init = ();
11703    my $Var = select_obj_name("", $ClassId);
11704    $Block_Variable{$CurrentBlock}{$Var} = 1;
11705    if($Interface=~/D2/)
11706    {
11707        # push(@RecurTypeId, $ClassId);
11708        my %Obj_Init = findConstructor($ClassId, "");
11709        # pop(@RecurTypeId);
11710        return () if(not $Obj_Init{"IsCorrect"});
11711        my $ClassNameChild = getSubClassName($ClassName);
11712        if($Obj_Init{"Call"}=~/\A(\Q$ClassName\E([\n]*)\()/) {
11713            substr($Obj_Init{"Call"}, index($Obj_Init{"Call"}, $1), pos($1) + length($1)) = $ClassNameChild.$2."(";
11714        }
11715        $ClassName = $ClassNameChild;
11716        $UsedConstructors{$ClassId}{$Obj_Init{"Interface"}} = 1;
11717        $IntSubClass{$TestedInterface}{$ClassId} = 1;
11718        $Create_SubClass{$ClassId} = 1;
11719        $Interface_Init{"Init"} .= $Obj_Init{"Init"};
11720        # $Interface_Init{"Init"} .= "//parameter initialization\n";
11721        if($Obj_Init{"PreCondition"}) {
11722            $Interface_Init{"Init"} .= $Obj_Init{"PreCondition"};
11723        }
11724        $Interface_Init{"Init"} .= "$ClassName *$Var = new ".$Obj_Init{"Call"}.";\n";
11725        if($Obj_Init{"PostCondition"}) {
11726            $Interface_Init{"Init"} .= $Obj_Init{"PostCondition"};
11727        }
11728        if($Obj_Init{"ReturnRequirement"})
11729        {
11730            $Obj_Init{"ReturnRequirement"}=~s/(\$0|\$obj)/*$Var/gi;
11731            $Interface_Init{"Init"} .= $Obj_Init{"ReturnRequirement"};
11732        }
11733        if($Obj_Init{"FinalCode"})
11734        {
11735            $Interface_Init{"Init"} .= "//final code\n";
11736            $Interface_Init{"Init"} .= $Obj_Init{"FinalCode"}."\n";
11737        }
11738        $Interface_Init{"Headers"} = addHeaders($Obj_Init{"Headers"}, $Interface_Init{"Headers"});
11739        $Interface_Init{"Code"} .= $Obj_Init{"Code"};
11740        $Interface_Init{"Call"} = "delete($Var)";
11741        $UsedInterfaces{$Interface} = 1;
11742    }
11743    elsif($Interface=~/D0/)
11744    {
11745        if(isAbstractClass($ClassId))
11746        { # Impossible to call in-charge-deleting (D0) destructor in abstract class
11747            return ();
11748        }
11749        if($CompleteSignature{$Interface}{"Protected"})
11750        { # Impossible to call protected in-charge-deleting (D0) destructor
11751            return ();
11752        }
11753        # push(@RecurTypeId, $ClassId);
11754        my %Obj_Init = findConstructor($ClassId, "");
11755        # pop(@RecurTypeId);
11756        return () if(not $Obj_Init{"IsCorrect"});
11757        if($CompleteSignature{$Obj_Init{"Interface"}}{"Protected"})
11758        { # Impossible to call in-charge-deleting (D0) destructor in class with protected constructor
11759            return ();
11760        }
11761        $Interface_Init{"Init"} .= $Obj_Init{"Init"};
11762        if($Obj_Init{"PreCondition"}) {
11763            $Interface_Init{"Init"} .= $Obj_Init{"PreCondition"};
11764        }
11765        # $Interface_Init{"Init"} .= "//parameter initialization\n";
11766        $Interface_Init{"Init"} .= $ClassName." *$Var = new ".$Obj_Init{"Call"}.";\n";
11767        if($Obj_Init{"PostCondition"}) {
11768            $Interface_Init{"Init"} .= $Obj_Init{"PostCondition"};
11769        }
11770        if($Obj_Init{"ReturnRequirement"})
11771        {
11772            $Obj_Init{"ReturnRequirement"}=~s/(\$0|\$obj)/*$Var/gi;
11773            $Interface_Init{"Init"} .= $Obj_Init{"ReturnRequirement"}
11774        }
11775        if($Obj_Init{"FinalCode"})
11776        {
11777            $Interface_Init{"Init"} .= "//final code\n";
11778            $Interface_Init{"Init"} .= $Obj_Init{"FinalCode"}."\n";
11779        }
11780        $Interface_Init{"Headers"} = addHeaders($Obj_Init{"Headers"}, $Interface_Init{"Headers"});
11781        $Interface_Init{"Code"} .= $Obj_Init{"Code"};
11782        $Interface_Init{"Call"} = "delete($Var)";
11783        $UsedInterfaces{$Interface} = 1;
11784    }
11785    elsif($Interface=~/D1/)
11786    {
11787        if(isAbstractClass($ClassId))
11788        { # Impossible to call in-charge (D1) destructor in abstract class
11789            return ();
11790        }
11791        if($CompleteSignature{$Interface}{"Protected"})
11792        { # Impossible to call protected in-charge (D1) destructor
11793            return ();
11794        }
11795        # push(@RecurTypeId, $ClassId);
11796        my %Obj_Init = findConstructor($ClassId, "");
11797        # pop(@RecurTypeId);
11798        return () if(not $Obj_Init{"IsCorrect"});
11799        if($CompleteSignature{$Obj_Init{"Interface"}}{"Protected"})
11800        { # Impossible to call in-charge (D1) destructor in class with protected constructor
11801            return ();
11802        }
11803        $Interface_Init{"Init"} .= $Obj_Init{"Init"};
11804        # $Interface_Init{"Init"} .= "//parameter initialization\n";
11805        if($Obj_Init{"PreCondition"}) {
11806            $Interface_Init{"Init"} .= $Obj_Init{"PreCondition"};
11807        }
11808        $Interface_Init{"Init"} .= correct_init_stmt("$ClassName $Var = ".$Obj_Init{"Call"}.";\n", $ClassName, $Var);
11809        if($Obj_Init{"PostCondition"}) {
11810            $Interface_Init{"Init"} .= $Obj_Init{"PostCondition"};
11811        }
11812        if($Obj_Init{"ReturnRequirement"})
11813        {
11814            $Obj_Init{"ReturnRequirement"}=~s/(\$0|\$obj)/$Var/gi;
11815            $Interface_Init{"Init"} .= $Obj_Init{"ReturnRequirement"}
11816        }
11817        if($Obj_Init{"FinalCode"})
11818        {
11819            $Interface_Init{"Init"} .= "//final code\n";
11820            $Interface_Init{"Init"} .= $Obj_Init{"FinalCode"}."\n";
11821        }
11822        $Interface_Init{"Headers"} = addHeaders($Obj_Init{"Headers"}, $Interface_Init{"Headers"});
11823        $Interface_Init{"Code"} .= $Obj_Init{"Code"};
11824        $Interface_Init{"Call"} = ""; # auto call after construction
11825        $UsedInterfaces{$Interface} = 1;
11826    }
11827    $Interface_Init{"Headers"} = addHeaders([$CompleteSignature{$Interface}{"Header"}], $Interface_Init{"Headers"});
11828    $Interface_Init{"IsCorrect"} = 1;
11829    if(my $Typedef_Id = get_type_typedef($ClassId))
11830    {
11831        $Interface_Init{"Headers"} = addHeaders(getTypeHeaders($Typedef_Id), $Interface_Init{"Headers"});
11832        foreach my $Elem ("Call", "Init") {
11833            $Interface_Init{$Elem} = cover_by_typedef($Interface_Init{$Elem}, $ClassId, $Typedef_Id);
11834        }
11835    }
11836    else {
11837        $Interface_Init{"Headers"} = addHeaders(getTypeHeaders($ClassId), $Interface_Init{"Headers"});
11838    }
11839    return %Interface_Init;
11840}
11841
11842sub testForConstructor($)
11843{
11844    my $Interface = $_[0];
11845    my $Ispecobjecttype = $InterfaceSpecType{$Interface}{"SpecObject"};
11846    my $PointerLevelTarget = get_PointerLevel($SpecType{$Ispecobjecttype}{"TypeId"});
11847    my $ClassId = $CompleteSignature{$Interface}{"Class"};
11848    my $ClassName = get_TypeName($ClassId);
11849    my $Var = select_obj_name("", $ClassId);
11850    $Block_Variable{$CurrentBlock}{$Var} = 1;
11851    if(isInCharge($Interface))
11852    {
11853        if(isAbstractClass($ClassId))
11854        { # Impossible to call in-charge constructor in abstract class
11855            return ();
11856        }
11857        if($CompleteSignature{$Interface}{"Protected"})
11858        { # Impossible to call in-charge protected constructor
11859            return ();
11860        }
11861    }
11862    my $HeapStack = ($SpecType{$Ispecobjecttype}{"TypeId"} and ($PointerLevelTarget eq 0))?"Stack":"Heap";
11863    my $ObjectCall = ($HeapStack eq "Stack")?$Var:"(*$Var)";
11864    my %Interface_Init = callInterfaceParameters((
11865            "Interface"=>$Interface,
11866            "Key"=>"",
11867            "ObjectCall"=>$ObjectCall));
11868    return () if(not $Interface_Init{"IsCorrect"});
11869    my $PreviousBlock = $CurrentBlock;
11870    $CurrentBlock = $CurrentBlock."_code_".$Ispecobjecttype;
11871    my %ParsedCode = parseCode($SpecType{$Ispecobjecttype}{"Code"}, "Code");
11872    $CurrentBlock = $PreviousBlock;
11873    return () if(not $ParsedCode{"IsCorrect"});
11874    $SpecCode{$Ispecobjecttype} = 1 if($ParsedCode{"Code"});
11875    $Interface_Init{"Code"} .= $ParsedCode{"NewGlobalCode"}.$ParsedCode{"Code"};
11876    $Interface_Init{"Headers"} = addHeaders($ParsedCode{"Headers"}, $Interface_Init{"Headers"});
11877    if(isAbstractClass($ClassId) or isNotInCharge($Interface) or ($CompleteSignature{$Interface}{"Protected"}))
11878    {
11879        my $ClassNameChild = getSubClassName($ClassName);
11880        if($Interface_Init{"Call"}=~/\A($ClassName([\n]*)\()/)
11881        {
11882            substr($Interface_Init{"Call"}, index($Interface_Init{"Call"}, $1), pos($1) + length($1)) = $ClassNameChild.$2."(";
11883        }
11884        $ClassName = $ClassNameChild;
11885        $UsedConstructors{$ClassId}{$Interface} = 1;
11886        $IntSubClass{$TestedInterface}{$ClassId} = 1;
11887        $Create_SubClass{$ClassId} = 1;
11888    }
11889    if($HeapStack eq "Stack") {
11890        $Interface_Init{"Call"} = correct_init_stmt($ClassName." $Var = ".$Interface_Init{"Call"}, $ClassName, $Var);
11891    }
11892    elsif($HeapStack eq "Heap") {
11893        $Interface_Init{"Call"} = $ClassName."* $Var = new ".$Interface_Init{"Call"};
11894    }
11895    if(my $Typedef_Id = get_type_typedef($ClassId))
11896    {
11897        $Interface_Init{"Headers"} = addHeaders(getTypeHeaders($Typedef_Id), $Interface_Init{"Headers"});
11898        foreach my $Elem ("Call", "Init") {
11899            $Interface_Init{$Elem} = cover_by_typedef($Interface_Init{$Elem}, $ClassId, $Typedef_Id);
11900        }
11901    }
11902    else {
11903        $Interface_Init{"Headers"} = addHeaders(getTypeHeaders($ClassId), $Interface_Init{"Headers"});
11904    }
11905    if($Ispecobjecttype and my $PostCondition = $SpecType{$Ispecobjecttype}{"PostCondition"}
11906    and $ObjectCall ne "" and (not defined $Template2Code or $Interface eq $TestedInterface))
11907    { # postcondition
11908        $PostCondition=~s/(\$0|\$obj)/$ObjectCall/gi;
11909        $PostCondition = clearSyntax($PostCondition);
11910        my $NormalResult = $PostCondition;
11911        while($PostCondition=~s/([^\\])"/$1\\\"/g){}
11912        $ConstraintNum{$Interface}+=1;
11913        my $ReqId = get_ShortName($Interface).".".normalize_num($ConstraintNum{$Interface});
11914        $RequirementsCatalog{$Interface}{$ConstraintNum{$Interface}} = "postcondition for the object: \'$PostCondition\'";
11915        my $Comment = "postcondition for the object failed: \'$PostCondition\'";
11916        $Interface_Init{"ReturnRequirement"} .= "REQ(\"$ReqId\",\n\"$Comment\",\n$NormalResult);\n";
11917        $TraceFunc{"REQ"}=1;
11918    }
11919    # init code
11920    my $InitCode = $SpecType{$Ispecobjecttype}{"InitCode"};
11921    $Interface_Init{"Init"} .= clearSyntax($InitCode);
11922    # final code
11923    my $ObjFinalCode = $SpecType{$Ispecobjecttype}{"FinalCode"};
11924    $ObjFinalCode=~s/(\$0|\$obj)/$ObjectCall/gi;
11925    $Interface_Init{"FinalCode"} .= clearSyntax($ObjFinalCode);
11926    return %Interface_Init;
11927}
11928
11929sub add_VirtualTestData($$)
11930{
11931    my ($Code, $Path) = @_;
11932    my $RelPath = test_data_relpath("sample.txt");
11933    if($Code=~s/TG_TEST_DATA_(PLAIN|TEXT)_FILE/$RelPath/g)
11934    { # plain text files
11935        mkpath($Path);
11936        writeFile($Path."/sample.txt", "Where there's a will there's a way.");
11937    }
11938    $RelPath = test_data_abspath("sample", $Path);
11939    if($Code=~s/TG_TEST_DATA_ABS_FILE/$RelPath/g)
11940    {
11941        mkpath($Path);
11942        writeFile($Path."/sample", "Where there's a will there's a way.");
11943    }
11944    $RelPath = test_data_relpath("sample.xml");
11945    if($Code=~s/TG_TEST_DATA_XML_FILE/$RelPath/g)
11946    {
11947        mkpath($Path);
11948        writeFile($Path."/sample.xml", getXMLSample());
11949    }
11950    $RelPath = test_data_relpath("sample.html");
11951    if($Code=~s/TG_TEST_DATA_HTML_FILE/$RelPath/g)
11952    {
11953        mkpath($Path);
11954        writeFile($Path."/sample.html", getHTMLSample());
11955    }
11956    $RelPath = test_data_relpath("sample.dtd");
11957    if($Code=~s/TG_TEST_DATA_DTD_FILE/$RelPath/g)
11958    {
11959        mkpath($Path);
11960        writeFile($Path."/sample.dtd", getDTDSample());
11961    }
11962    $RelPath = test_data_relpath("sample.db");
11963    if($Code=~s/TG_TEST_DATA_DB/$RelPath/g)
11964    {
11965        mkpath($Path);
11966        writeFile($Path."/sample.db", "");
11967    }
11968    $RelPath = test_data_relpath("sample.audio");
11969    if($Code=~s/TG_TEST_DATA_AUDIO/$RelPath/g)
11970    {
11971        mkpath($Path);
11972        writeFile($Path."/sample.audio", "");
11973    }
11974    $RelPath = test_data_relpath("sample.asoundrc");
11975    if($Code=~s/TG_TEST_DATA_ASOUNDRC_FILE/$RelPath/g)
11976    {
11977        mkpath($Path);
11978        writeFile($Path."/sample.asoundrc", getASoundRCSample());
11979    }
11980    $RelPath = test_data_relpath("");
11981    if($Code=~s/TG_TEST_DATA_DIRECTORY/$RelPath/g)
11982    {
11983        mkpath($Path);
11984        writeFile($Path."/sample.txt", "Where there's a will there's a way.");
11985    }
11986    while($Code=~/TG_TEST_DATA_FILE_([A-Z]+)/)
11987    {
11988        my ($Type, $Ext) = ($1, lc($1));
11989        $RelPath = test_data_relpath("sample.$Ext");
11990        $Code=~s/TG_TEST_DATA_FILE_$Type/$RelPath/g;
11991        mkpath($Path);
11992        writeFile($Path."/sample.$Ext", "");
11993    }
11994    return $Code;
11995}
11996
11997sub test_data_relpath($)
11998{
11999    my $File = $_[0];
12000    if(defined $Template2Code) {
12001        return "T2C_GET_DATA_PATH(\"$File\")";
12002    }
12003    else {
12004        return "\"testdata/$File\"";
12005    }
12006}
12007
12008sub test_data_abspath($$)
12009{
12010    my ($File, $Path) = @_;
12011    if(defined $Template2Code) {
12012        return "T2C_GET_DATA_PATH(\"$File\")";
12013    }
12014    else {
12015        return "\"".abs_path("./")."/".$Path.$File."\"";
12016    }
12017}
12018
12019sub getXMLSample()
12020{
12021    return "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
12022<note>
12023    <to>Tove</to>
12024    <from>Jani</from>
12025    <heading>Reminder</heading>
12026    <body>Don't forget me this weekend!</body>
12027</note>";
12028}
12029
12030sub getHTMLSample()
12031{
12032    return "<html>
12033<body>
12034Where there's a will there's a way.
12035</body>
12036</html>";
12037}
12038
12039sub getDTDSample()
12040{
12041    return "<!ELEMENT note (to,from,heading,body)>
12042<!ELEMENT to (#PCDATA)>
12043<!ELEMENT from (#PCDATA)>
12044<!ELEMENT heading (#PCDATA)>
12045<!ELEMENT body (#PCDATA)>";
12046}
12047
12048sub getASoundRCSample()
12049{
12050    if(my $Sample = readFile("/usr/share/alsa/alsa.conf"))
12051    {
12052        return $Sample;
12053    }
12054    elsif(my $Sample = readFile("/etc/asound-pulse.conf"))
12055    {
12056        return $Sample;
12057    }
12058    elsif(my $Sample = readFile("/etc/asound.conf"))
12059    {
12060        return $Sample;
12061    }
12062    else
12063    {
12064        return "pcm.card0 {
12065    type hw
12066    card 0
12067}
12068ctl.card0 {
12069    type hw
12070    card 0
12071}";
12072    }
12073}
12074
12075sub add_TestData($$)
12076{
12077    my ($Code, $Path) = @_;
12078    my %CopiedFiles = ();
12079    if($Code=~/TEST_DATA_PATH/)
12080    {
12081        if(not $TestDataPath)
12082        {
12083            printMsg("ERROR", "test data directory is not specified");
12084            return $Code;
12085        }
12086    }
12087    while($Code=~s/TEST_DATA_PATH[ ]*\([ ]*"([^\(\)]+)"[ ]*\)/test_data_relpath($1)/ge)
12088    {
12089        my $FileName = $1;
12090        next if($CopiedFiles{$FileName});
12091        mkpath($Path);
12092        next if(not -e $TestDataPath."/".$FileName);
12093        copy($TestDataPath."/".$FileName, $Path);
12094        $CopiedFiles{$FileName} = 1;
12095    }
12096    return $Code;
12097}
12098
12099sub constraint_for_environment($$$)
12100{
12101    my ($Interface, $ConditionType, $Condition) = @_;
12102    $ConstraintNum{$Interface}+=1;
12103    my $ReqId = get_ShortName($Interface).".".normalize_num($ConstraintNum{$Interface});
12104    $RequirementsCatalog{$Interface}{$ConstraintNum{$Interface}} = "$ConditionType for the environment: \'$Condition\'";
12105    my $Comment = "$ConditionType for the environment failed: \'$Condition\'";
12106    $TraceFunc{"REQ"}=1;
12107    return "REQ(\"$ReqId\",\n\"$Comment\",\n$Condition);\n";
12108}
12109
12110sub get_env_conditions($$)
12111{
12112    my ($Interface, $SpecEnv_Id) = @_;
12113    my %Conditions = ();
12114    if(my $InitCode = $SpecType{$SpecEnv_Id}{"InitCode"}) {
12115        $Conditions{"Preamble"} .= $InitCode."\n";
12116    }
12117    if(my $FinalCode = $SpecType{$SpecEnv_Id}{"FinalCode"}) {
12118        $Conditions{"Finalization"} .= $FinalCode."\n";
12119    }
12120    if(my $GlobalCode = $SpecType{$SpecEnv_Id}{"GlobalCode"}) {
12121        $Conditions{"Env_CommonCode"} .= $GlobalCode."\n";
12122        $SpecCode{$SpecEnv_Id} = 1;
12123    }
12124    if(my $PreCondition = $SpecType{$SpecEnv_Id}{"PreCondition"}) {
12125        $Conditions{"Env_PreRequirements"} .= constraint_for_environment($Interface, "precondition", $PreCondition);
12126    }
12127    if(my $PostCondition = $SpecType{$SpecEnv_Id}{"PostCondition"}) {
12128        $Conditions{"Env_PostRequirements"} .= constraint_for_environment($Interface, "postcondition", $PostCondition);
12129    }
12130    foreach my $Lib (keys(%{$SpecType{$SpecEnv_Id}{"Libs"}})) {
12131        $SpecLibs{$Lib} = 1;
12132    }
12133    return %Conditions;
12134}
12135
12136sub path_format($$)
12137{
12138    my ($Path, $Fmt) = @_;
12139    $Path=~s/[\/\\]+\.?\Z//g;
12140    if($Fmt eq "windows")
12141    {
12142        $Path=~s/\//\\/g;
12143        $Path=lc($Path);
12144    }
12145    else
12146    { # forward slash to pass into MinGW GCC
12147        $Path=~s/\\/\//g;
12148    }
12149    return $Path;
12150}
12151
12152sub inc_opt($$)
12153{
12154    my ($Path, $Style) = @_;
12155    $Path=~s/\A\"//;
12156    $Path=~s/\"\Z//;
12157    return "" if(not $Path);
12158    if($Style eq "GCC")
12159    { # GCC options
12160        if($OSgroup eq "windows")
12161        { # to MinGW GCC
12162            return "-I\"".path_format($Path, "unix")."\"";
12163        }
12164        elsif($OSgroup eq "macos"
12165        and $Path=~/\.framework\Z/)
12166        { # to Apple's GCC
12167            return "-F".esc(get_dirname($Path));
12168        }
12169        else {
12170            return "-I".esc($Path);
12171        }
12172    }
12173    elsif($Style eq "CL") {
12174        return "/I \"$Path\"";
12175    }
12176    return "";
12177}
12178
12179sub esc_option($$)
12180{
12181    my ($Path, $Style) = @_;
12182    return "" if(not $Path);
12183    if($Style eq "GCC")
12184    { # GCC options
12185        if($OSgroup eq "windows")
12186        { # to MinGW GCC
12187            return "\"".path_format($Path, "unix")."\"";
12188        }
12189        else {
12190            return esc($Path);
12191        }
12192    }
12193    elsif($Style eq "CL") {
12194        return "\"".$Path."\"";
12195    }
12196    return "";
12197}
12198
12199sub generateTest($)
12200{
12201    my %Result = ();
12202    my $Interface = $_[0];
12203    return () if(not $Interface);
12204    my $CommonCode = "";
12205    my %TestComponents = ();
12206    $TestedInterface = $Interface;
12207    $CurrentBlock = "main";
12208    $ValueCollection{$CurrentBlock}{"argc"} = get_TypeIdByName("int");
12209    $Block_Param{$CurrentBlock}{"argc"} = get_TypeIdByName("int");
12210    $Block_Variable{$CurrentBlock}{"argc"} = 1;
12211    $ValueCollection{$CurrentBlock}{"argv"} = get_TypeIdByName("char**");
12212    $Block_Param{$CurrentBlock}{"argv"} = get_TypeIdByName("char**");
12213    $Block_Variable{$CurrentBlock}{"argv"} = 1;
12214
12215    my ($CommonPreamble, $Preamble, $Finalization, $Env_CommonCode, $Env_PreRequirements, $Env_PostRequirements) = ();
12216    foreach my $SpecEnv_Id (sort {int($a)<=>int($b)} (keys(%Common_SpecEnv)))
12217    { # common environments
12218        next if($Common_SpecType_Exceptions{$Interface}{$SpecEnv_Id});
12219        my %Conditions = get_env_conditions($Interface, $SpecEnv_Id);
12220        $CommonPreamble .= $Conditions{"Preamble"};# in the direct order
12221        $Finalization = $Conditions{"Finalization"}.$Finalization;# in the backward order
12222        $Env_CommonCode .= $Conditions{"Env_CommonCode"};
12223        $Env_PreRequirements .= $Conditions{"Env_PreRequirements"};# in the direct order
12224        $Env_PostRequirements = $Conditions{"Env_PostRequirements"}.$Env_PostRequirements;# in the backward order
12225    }
12226
12227    # parsing of common preamble code for using
12228    # created variables in the following test case
12229    my %CommonPreamble_Parsed = parseCode($CommonPreamble, "Code");
12230    $CommonPreamble = $CommonPreamble_Parsed{"Code"};
12231    $CommonCode = $CommonPreamble_Parsed{"NewGlobalCode"}.$CommonCode;
12232    $TestComponents{"Headers"} = addHeaders($CommonPreamble_Parsed{"Headers"}, $TestComponents{"Headers"});
12233
12234    # creating test case
12235    if($CompleteSignature{$Interface}{"Constructor"})
12236    {
12237        %TestComponents = testForConstructor($Interface);
12238        $CommonCode .= $TestComponents{"Code"};
12239    }
12240    elsif($CompleteSignature{$Interface}{"Destructor"})
12241    {
12242        %TestComponents = testForDestructor($Interface);
12243        $CommonCode .= $TestComponents{"Code"};
12244    }
12245    else
12246    {
12247        %TestComponents = callInterface((
12248            "Interface"=>$Interface));
12249        $CommonCode .= $TestComponents{"Code"};
12250    }
12251    if(not $TestComponents{"IsCorrect"})
12252    {
12253        $ResultCounter{"Gen"}{"Fail"} += 1;
12254        $GenResult{$Interface}{"IsCorrect"} = 0;
12255        return ();
12256    }
12257    if($TraceFunc{"REQ"} and not defined $Template2Code) {
12258        $CommonCode = get_REQ_define($Interface)."\n".$CommonCode;
12259    }
12260    if($TraceFunc{"REQva"} and not defined $Template2Code) {
12261        $CommonCode = get_REQva_define($Interface)."\n".$CommonCode;
12262    }
12263
12264    foreach my $SpecEnv_Id (sort {int($a)<=>int($b)} (keys(%SpecEnv)))
12265    { # environments used in the test case
12266        my %Conditions = get_env_conditions($Interface, $SpecEnv_Id);
12267        $Preamble .= $Conditions{"Preamble"};# in the direct order
12268        $Finalization = $Conditions{"Finalization"}.$Finalization;# in the backward order
12269        $Env_CommonCode .= $Conditions{"Env_CommonCode"};
12270        $Env_PreRequirements .= $Conditions{"Env_PreRequirements"};# in the direct order
12271        $Env_PostRequirements = $Conditions{"Env_PostRequirements"}.$Env_PostRequirements;# in the backward order
12272    }
12273
12274    my %Preamble_Parsed = parseCode($Preamble, "Code");
12275    $Preamble = $Preamble_Parsed{"Code"};
12276    $CommonCode = $Preamble_Parsed{"NewGlobalCode"}.$CommonCode;
12277    $TestComponents{"Headers"} = addHeaders($Preamble_Parsed{"Headers"}, $TestComponents{"Headers"});
12278
12279    my %Finalization_Parsed = parseCode($Finalization, "Code");
12280    $Finalization = $Finalization_Parsed{"Code"};
12281    $CommonCode = $Finalization_Parsed{"NewGlobalCode"}.$CommonCode;
12282    $TestComponents{"Headers"} = addHeaders($Finalization_Parsed{"Headers"}, $TestComponents{"Headers"});
12283
12284    my %Env_ParsedCode = parseCode($Env_CommonCode, "Code");
12285    $CommonCode = $Env_ParsedCode{"NewGlobalCode"}.$Env_ParsedCode{"Code"}.$CommonCode;
12286    $TestComponents{"Headers"} = addHeaders($Env_ParsedCode{"Headers"}, $TestComponents{"Headers"});
12287    foreach my $Header (@{$Env_ParsedCode{"Headers"}}) {
12288        $SpecTypeHeaders{get_filename($Header)}=1;
12289    }
12290    # insert subclasses
12291    my ($SubClasses_Code, $SubClasses_Headers) = create_SubClasses(keys(%Create_SubClass));
12292    $TestComponents{"Headers"} = addHeaders($SubClasses_Headers, $TestComponents{"Headers"});
12293    $CommonCode = $SubClasses_Code.$CommonCode;
12294    # close streams
12295    foreach my $Stream (keys(%{$OpenStreams{"main"}})) {
12296        $Finalization .= "fclose($Stream);\n";
12297    }
12298    # assemble test
12299    my ($SanityTest, $SanityTestMain, $SanityTestBody) = ();
12300    if($CommonPreamble.$Preamble)
12301    {
12302        $SanityTestMain .= "//preamble\n";
12303        $SanityTestMain .= $CommonPreamble.$Preamble."\n";
12304    }
12305    if($Env_PreRequirements) {
12306        $SanityTestMain .= $Env_PreRequirements."\n";
12307    }
12308    if($TestComponents{"Init"}) {
12309        $SanityTestBody .= $TestComponents{"Init"};
12310    }
12311    # precondition for parameters
12312    if($TestComponents{"PreCondition"}) {
12313        $SanityTestBody .= $TestComponents{"PreCondition"};
12314    }
12315    if($TestComponents{"Call"})
12316    {
12317        if($TestComponents{"ReturnRequirement"} and $CompleteSignature{$Interface}{"Return"})
12318        { # call interface and check return value
12319            my $ReturnType_Id = $CompleteSignature{$Interface}{"Return"};
12320            my $ReturnType_Name = $TypeInfo{$ReturnType_Id}{"Name"};
12321            my $ReturnType_PointerLevel = get_PointerLevel($ReturnType_Id);
12322            my $ReturnFType_Id = get_FoundationTypeId($ReturnType_Id);
12323            my $ReturnFType_Name = get_TypeName($ReturnFType_Id);
12324            if($ReturnFType_Name eq "void" and $ReturnType_PointerLevel==1)
12325            {
12326                my $RetVal = select_var_name("retval", "");
12327                $TestComponents{"ReturnRequirement"}=~s/(\$0|\$retval)/$RetVal/gi;
12328                $SanityTestBody .= "int* $RetVal = (int*)".$TestComponents{"Call"}."; //target call\n";
12329                $Block_Variable{$CurrentBlock}{$RetVal} = 1;
12330            }
12331            elsif($ReturnFType_Name eq "void" and $ReturnType_PointerLevel==0) {
12332                $SanityTestBody .= $TestComponents{"Call"}."; //target call\n";
12333            }
12334            else
12335            {
12336                my $RetVal = select_var_name("retval", "");
12337                $TestComponents{"ReturnRequirement"}=~s/(\$0|\$retval)/$RetVal/gi;
12338                my ($InitializedEType_Id, $Declarations, $Headers) = get_ExtTypeId($RetVal, $ReturnType_Id);
12339                my $InitializedType_Name = get_TypeName($InitializedEType_Id);
12340                $TestComponents{"Code"} .= $Declarations;
12341                $TestComponents{"Headers"} = addHeaders($Headers, $TestComponents{"Headers"});
12342                my $Break = ((length($InitializedType_Name)>20)?"\n":" ");
12343                my $InitializedFType_Id = get_FoundationTypeId($ReturnType_Id);
12344                if(($InitializedType_Name eq $ReturnType_Name)) {
12345                    $SanityTestBody .= $ReturnType_Name.$Break.$RetVal." = ".$TestComponents{"Call"}."; //target call\n";
12346                }
12347                else {
12348                    $SanityTestBody .= $InitializedType_Name.$Break.$RetVal." = "."(".$InitializedType_Name.")".$TestComponents{"Call"}."; //target call\n";
12349                }
12350                $Block_Variable{$CurrentBlock}{$RetVal} = 1;
12351                $TestComponents{"Headers"} = addHeaders(getTypeHeaders($InitializedFType_Id), $TestComponents{"Headers"});
12352            }
12353        }
12354        else {
12355            $SanityTestBody .= $TestComponents{"Call"}."; //target call\n";
12356        }
12357    }
12358    elsif($CompleteSignature{$Interface}{"Destructor"}) {
12359        $SanityTestBody .= "//target interface will be called at the end of main() function automatically\n";
12360    }
12361    if($TestComponents{"ReturnRequirement"}) {
12362        $SanityTestBody .= $TestComponents{"ReturnRequirement"}."\n";
12363    }
12364    # postcondition for parameters
12365    if($TestComponents{"PostCondition"}) {
12366        $SanityTestBody .= $TestComponents{"PostCondition"}."\n";
12367    }
12368    if($TestComponents{"FinalCode"})
12369    {
12370        $SanityTestBody .= "//final code\n";
12371        $SanityTestBody .= $TestComponents{"FinalCode"}."\n";
12372    }
12373    $SanityTestMain .= $SanityTestBody;
12374    if($Finalization)
12375    {
12376        $SanityTestMain .= "\n//finalization\n";
12377        $SanityTestMain .= $Finalization."\n";
12378    }
12379    if($Env_PostRequirements) {
12380        $SanityTestMain .= $Env_PostRequirements."\n";
12381    }
12382    if(my $AddDefines = $Descriptor{"Defines"})
12383    {
12384        $AddDefines=~s/\n\s+/\n/g;
12385        $SanityTest .= $AddDefines."\n";
12386    }
12387    # clear code syntax
12388    $SanityTestMain = alignCode($SanityTestMain, "    ", 0);
12389    @{$TestComponents{"Headers"}} = reverse(@{$TestComponents{"Headers"}});
12390    if(keys(%ConstraintNum)>0)
12391    {
12392        if(getTestLang($Interface) eq "C++")
12393        {
12394            $TestComponents{"Headers"} = addHeaders(["iostream"], $TestComponents{"Headers"});
12395            $AuxHeaders{"iostream"} = 1;
12396        }
12397        else
12398        {
12399            $TestComponents{"Headers"} = addHeaders(["stdio.h"], $TestComponents{"Headers"});
12400            $AuxHeaders{"stdio.h"} = 1;
12401        }
12402    }
12403    @{$TestComponents{"Headers"}} = (@Include_Preamble, @{$TestComponents{"Headers"}});
12404
12405    if(keys(%Include_Order))
12406    {
12407        if(grep {defined $Include_Order{$_}} @{$TestComponents{"Headers"}}) {
12408            $TestComponents{"Headers"} = orderHeaders($TestComponents{"Headers"});
12409        }
12410    }
12411
12412    my ($Headers, $IncPaths) = prepareHeaders(@{$TestComponents{"Headers"}});
12413
12414    $Result{"Headers"} = [];
12415    my $HList = "";
12416    foreach my $Header (@{$Headers})
12417    {
12418        $HList .= "#include <".$Header.">\n";
12419        push(@{$Result{"Headers"}}, $Header);
12420        if($Header=~/\+\+(\.h|)\Z/) {
12421            $UsedInterfaces{"__gxx_personality"} = 1;
12422        }
12423    }
12424    $SanityTest .= $HList;
12425
12426    my %UsedNameSpaces = ();
12427    foreach my $NameSpace (add_namespaces(\$CommonCode), add_namespaces(\$SanityTestMain)) {
12428        $UsedNameSpaces{$NameSpace} = 1;
12429    }
12430    if(keys(%UsedNameSpaces))
12431    {
12432        $SanityTest .= "\n";
12433        foreach my $NameSpace (sort {get_depth($a,"::")<=>get_depth($b,"::")} keys(%UsedNameSpaces)) {
12434            $SanityTest .= "using namespace $NameSpace;\n";
12435        }
12436        $SanityTest .= "\n";
12437    }
12438    if($CommonCode)
12439    {
12440        $SanityTest .= "\n$CommonCode\n\n";
12441        $Result{"Code"} = $CommonCode;
12442    }
12443    $SanityTest .= "int main(int argc, char *argv[])\n";
12444    $SanityTest .= "{\n";
12445    $Result{"main"} = correct_spaces($SanityTestMain);
12446    $SanityTestMain .= "    return 0;\n";
12447    $SanityTest .= $SanityTestMain;
12448    $SanityTest .= "}\n";
12449    $SanityTest = correct_spaces($SanityTest); # cleaning code
12450    if(getTestLang($Interface) eq "C++" and getSymLang($Interface) eq "C")
12451    { # removing extended initializer lists
12452        $SanityTest=~s/({\s*|\s)\.[a-z_][a-z_\d]*\s*=\s*/$1  /ig;
12453    }
12454    if(defined $Standalone)
12455    { # create stuff for building and running test
12456        my $TestFileName = (getTestLang($Interface) eq "C++")?"test.cpp":"test.c";
12457        my $TestPath = getTestPath($Interface);
12458        if(-e $TestPath) {
12459            rmtree($TestPath);
12460        }
12461        mkpath($TestPath);
12462        $Interface_TestDir{$Interface} = $TestPath;
12463        $SanityTest = add_VirtualTestData($SanityTest, $TestPath."/testdata/");
12464        $SanityTest = add_TestData($SanityTest, $TestPath."/testdata/");
12465        writeFile("$TestPath/$TestFileName", $SanityTest);
12466        my $SharedObject = $Symbol_Library{$Interface};
12467        $SharedObject = $DepSymbol_Library{$Interface} if(not $SharedObject);
12468        my $TestInfo = "Library: $TargetLibraryName-".$Descriptor{"Version"};
12469        $TestInfo .= "\nInterface: ".get_Signature($Interface);
12470        $TestInfo .= "\nSymbol: $Interface";
12471
12472        my %SInfo = %{$CompleteSignature{$Interface}};
12473
12474        if($Interface=~/\A(_Z|\?)/) {
12475            $TestInfo .= "\nShort Name: ".$SInfo{"ShortName"};
12476        }
12477        $TestInfo .= "\nHeader: ".$SInfo{"Header"};
12478        if($SharedObject) {
12479            $TestInfo .= "\nShared Object: ".get_filename($SharedObject);
12480        }
12481        my $NameSpace = select_Symbol_NS($Interface);
12482        if($NameSpace) {
12483            $TestInfo .= "\nNamespace: ".$NameSpace;
12484        }
12485        writeFile("$TestPath/info", $TestInfo);
12486        my $Signature = get_Signature($Interface);
12487
12488        $Signature=~s/\s+:.+\Z//; # return value
12489        $Signature=~s/\s*\[[a-z\-]+\]//g; # [in-charge], [static], etc.
12490        if($NameSpace) {
12491            $Signature=~s/(\W|\A)\Q$NameSpace\E\:\:(\w)/$1$2/g;
12492        }
12493
12494        my $Title = "Test for ".htmlSpecChars($Signature);
12495        my $Keywords = htmlSpecChars($SInfo{"ShortName"}).", unit test";
12496        my $Description = "Sanity test for ".htmlSpecChars($Signature);
12497
12498        my $View = "";
12499
12500        if(my $Class = $SInfo{"Class"})
12501        {
12502            my $ClassName = get_TypeName($Class);
12503            if($NameSpace) {
12504                $ClassName=~s/(\W|\A)\Q$NameSpace\E\:\:(\w)/$1$2/g;
12505            }
12506            if($SInfo{"Constructor"})
12507            { # c-tor
12508                $View .= "<h1>Test for c-tor of <span style='color:Red'>".htmlSpecChars($ClassName)."</span> class</h1>\n";
12509            }
12510            elsif($SInfo{"Destructor"})
12511            { # d-tor
12512                $View .= "<h1>Test for d-tor of <span style='color:Red'>".htmlSpecChars($ClassName)."</span> class</h1>\n";
12513            }
12514            else
12515            { # method
12516                $View .= "<h1>Test for <span style='color:Red'>".htmlSpecChars($SInfo{"ShortName"})."</span> method of <span style='color:Blue'>".htmlSpecChars($ClassName)."</span> class</h1>\n";
12517            }
12518        }
12519        else {
12520            $View .= "<h1>Test for <span style='color:Red'>".htmlSpecChars($SInfo{"ShortName"})."</span> function</h1>\n";
12521        }
12522        # $View .= highLight_Signature_Italic_Color($Signature)."\n";
12523        my $Unmangled = $tr_name{$Interface};
12524        if($NameSpace) {
12525            $Unmangled=~s/(\W|\A)\Q$NameSpace\E\:\:(\w)/$1$2/g;
12526        }
12527        $View .= "<span class='yellow'>".highLight_Signature_Italic_Color($Signature)."</span>\n";
12528        if($Interface=~/\A(_Z|\?)/) {
12529            $View .= "<br/><i><span class='yellow'>$Interface</span></i>\n";
12530        }
12531
12532        # summary
12533        $View .= "<h2>Symbol Info</h2><hr/>\n";
12534
12535        $View .= "<table class='summary'>\n";
12536        $View .= "<tr><th>Header File</th><td>".$SInfo{"Header"}."</td></tr>\n";
12537
12538#         my $SharedObject = get_filename($Symbol_Library{$Interface});
12539#         $SharedObject = get_filename($DepSymbol_Library{$Interface}) if(not $SharedObject);
12540#
12541#         if($SharedObject) {
12542#             $View .= "<tr><th>Library</th><td>".$SharedObject."</td></tr>\n";
12543#         }
12544
12545        if($NameSpace) {
12546            $View .= "<tr><th>Namespace</th><td>".$NameSpace."</td></tr>\n";
12547        }
12548        if(my $Class = $SInfo{"Class"})
12549        {
12550            my $ClassName = get_TypeName($Class);
12551            if($NameSpace) {
12552                $ClassName=~s/(\W|\A)\Q$NameSpace\E\:\:(\w)/$1$2/g;
12553            }
12554            $View .= "<tr><th>Class</th><td>".htmlSpecChars($ClassName)."</td></tr>\n";
12555            if($SInfo{"Constructor"})
12556            { # c-tor
12557                $View .= "<tr><th>Method</th><td>Constructor</td></tr>\n";
12558                if(my $ChargeLevel = get_ChargeLevel($Interface)) {
12559                    $View .= "<tr><th>Kind</th><td>$ChargeLevel</td></tr>\n";
12560                }
12561            }
12562            elsif($SInfo{"Destructor"})
12563            { # d-tor
12564                $View .= "<tr><th>Method</th><td>Destructor</td></tr>\n";
12565                if(my $ChargeLevel = get_ChargeLevel($Interface)) {
12566                    $View .= "<tr><th>Kind</th><td>$ChargeLevel</td></tr>\n";
12567                }
12568            }
12569            else
12570            { # method
12571                $View .= "<tr><th>Method</th><td>".htmlSpecChars($SInfo{"ShortName"})."</td></tr>\n";
12572            }
12573        }
12574        else
12575        {
12576            $View .= "<tr><th>Function</th><td>".htmlSpecChars($SInfo{"ShortName"})."</td></tr>\n";
12577        }
12578        if(my $Return = $SInfo{"Return"})
12579        {
12580            my $ReturnType = get_TypeName($Return);
12581            if($NameSpace) {
12582                $ReturnType=~s/(\W|\A)\Q$NameSpace\E\:\:(\w)/$1$2/g;
12583            }
12584            $View .= "<tr><th>Return Type</th><td>".htmlSpecChars($ReturnType)."</td></tr>\n";
12585        }
12586        if(my @Params = keys(%{$SInfo{"Param"}})) {
12587            $View .= "<tr><th>Parameters</th><td><a href='#Params'>".($#Params+1)."</a></td></tr>\n";
12588        }
12589        else {
12590            # $View .= "<tr><th>Parameters</th><td>none</td></tr>\n";
12591        }
12592
12593        $View .= "</table>\n";
12594
12595        if(keys(%{$SInfo{"Param"}}))
12596        {
12597            $View .= "<a name='Params'></a>\n";
12598            $View .= "<h2>Parameters</h2><hr/>\n";
12599            $View .= "<table class='summary'>\n";
12600            $View .= "<tr><th width='20px'>#</th><th>Name</th><th>Type</th></tr>\n";
12601            foreach my $Pos (sort {int($a)<=>int($b)} keys(%{$SInfo{"Param"}}))
12602            {
12603                my $TName = get_TypeName($SInfo{"Param"}{$Pos}{"type"});
12604                if($NameSpace) {
12605                    $TName=~s/(\W|\A)\Q$NameSpace\E\:\:(\w)/$1$2/g;
12606                }
12607                $View .= "<tr><td>$Pos</td><td><span class='color_p'>".$SInfo{"Param"}{$Pos}{"name"}."</span></td><td>".htmlSpecChars($TName)."</td></tr>\n";
12608            }
12609            $View .= "</table>\n";
12610        }
12611
12612        # code
12613        $View .= "<h2>Code</h2><hr/>\n";
12614        $View .= "<!--Test-->\n".get_TestView($SanityTest, $Interface)."<!--Test_End-->\n";
12615
12616        my $CssStyles = readModule("Styles", "Test.css");
12617        $View = composeHTML_Head($Title, $Keywords, $Description, $CssStyles, "")."<body>\n".$View.$TOOL_SIGNATURE."\n<div style='height:700px;'></div>\n</body>\n</html>\n";
12618        writeFile("$TestPath/view.html", $View);
12619
12620        %UsedSharedObjects = ();
12621
12622        foreach my $Sym (keys(%UsedInterfaces))
12623        { # add v-tables
12624            if(index($Sym, "C1E")!=-1
12625            or index($Sym, "C2E")!=-1)
12626            {
12627                if(my $VTable = getVTSymbol($Sym))
12628                { # guess v-table name
12629                    $UsedInterfaces{$VTable} = 1;
12630
12631                    $VTable=~s/\A_ZTVN/_ZTV/;
12632                    $VTable=~s/E\Z//;
12633                    $UsedInterfaces{$VTable} = 1;
12634                }
12635                if(my $TInfo = getTISymbol($Sym))
12636                { # guess typeinfo name
12637                    $UsedInterfaces{$TInfo} = 1;
12638
12639                    $TInfo=~s/\A_ZTIN/_ZTI/;
12640                    $UsedInterfaces{$TInfo} = 1;
12641                }
12642            }
12643        }
12644
12645        # used symbols
12646        foreach my $Sym (keys(%UsedInterfaces))
12647        {
12648            if(my $Path = $Symbol_Library{$Sym}) {
12649                $UsedSharedObjects{$Path} = 1;
12650            }
12651            elsif(my $Path = $DepSymbol_Library{$Sym})
12652            {
12653                if(index(get_filename($Path), "libstdc++")!=-1)
12654                { # will be included by the compiler automatically
12655                    next;
12656                }
12657                $UsedSharedObjects{$Path} = 1;
12658            }
12659            else
12660            {
12661                # TODO
12662            }
12663        }
12664
12665        # undefined symbols
12666        foreach my $Path (keys(%UsedSharedObjects))
12667        {
12668            foreach my $Dep (getLib_Deps($Path))
12669            { # required libraries
12670                $UsedSharedObjects{$Dep} = 1;
12671            }
12672        }
12673
12674        # needed libs
12675        my %LibName_P = ();
12676        foreach my $Path (keys(%UsedSharedObjects)) {
12677            $LibName_P{get_filename($Path)}{$Path} = 1;
12678        }
12679
12680        foreach my $Path (keys(%UsedSharedObjects))
12681        {
12682            my $Name = get_filename($Path);
12683            foreach my $Dep (keys(%{$Library_Needed{$Name}}))
12684            {
12685                $Dep = identifyLibrary($Dep);
12686                if(is_abs($Dep))
12687                { # links
12688                    $Dep = realpath($Dep);
12689                }
12690                $Dep = get_filename($Dep);
12691                if(defined $LibName_P{$Dep})
12692                {
12693                    my @Paths = keys(%{$LibName_P{$Dep}});
12694                    if($#Paths==0)
12695                    {
12696                        my $Dir = get_dirname($Paths[0]);
12697                        if(not grep {$Dir eq $_} @DefaultLibPaths)
12698                        { # non-default
12699                            next;
12700                        }
12701                        delete($UsedSharedObjects{$Paths[0]});
12702                    }
12703                }
12704            }
12705        }
12706
12707        writeFile("$TestPath/Makefile", get_Makefile($Interface, $IncPaths));
12708
12709        my $RunScript = ($OSgroup eq "windows")?"run_test.bat":"run_test.sh";
12710        writeFile("$TestPath/$RunScript", get_RunScript($Interface));
12711        chmod(0775, $TestPath."/$RunScript");
12712    }
12713    else
12714    { # t2c
12715    }
12716    $GenResult{$Interface}{"IsCorrect"} = 1;
12717    $ResultCounter{"Gen"}{"Success"} += 1;
12718    $Result{"IsCorrect"} = 1;
12719    return %Result;
12720}
12721
12722sub getLib_Deps($)
12723{
12724    my $Path = $_[0];
12725
12726    if(grep {$Path eq $_} @RecurLib)
12727    { # lock
12728        return ();
12729    }
12730    push(@RecurLib, $Path);
12731
12732    my %Deps = ();
12733    foreach my $Sym (keys(%{$UndefinedSymbols{get_filename($Path)}}))
12734    {
12735        if(my $P = $Symbol_Library{$Sym}) {
12736            $Deps{$P} = 1;
12737        }
12738        elsif(my $P = $DepSymbol_Library{$Sym}) {
12739            $Deps{$P} = 1;
12740        }
12741        elsif(index($Sym, '@')!=-1)
12742        {
12743            $Sym=~s/\@/\@\@/;
12744            if(my $P = $Symbol_Library{$Sym}) {
12745                $Deps{$P} = 1;
12746            }
12747            elsif(my $P = $DepSymbol_Library{$Sym}) {
12748                $Deps{$P} = 1;
12749            }
12750        }
12751    }
12752    foreach my $P (keys(%Deps))
12753    {
12754        foreach my $Dep (getLib_Deps($P))
12755        { # recursive
12756            $Deps{$Dep} = 1;
12757        }
12758    }
12759
12760    pop(@RecurLib);
12761    return keys(%Deps);
12762}
12763
12764sub getVTSymbol($)
12765{
12766    my $Symbol = $_[0];
12767    $Symbol=~s/\A_ZN/_ZTVN/;
12768    $Symbol=~s/(C1E|C2E).*?\Z/E/;
12769    return $Symbol;
12770}
12771
12772sub getTISymbol($)
12773{
12774    my $Symbol = $_[0];
12775    $Symbol=~s/\A_ZN/_ZTIN/;
12776    $Symbol=~s/(C1E|C2E).*?\Z//;
12777    return $Symbol;
12778}
12779
12780sub getTestLang($)
12781{
12782    my $Symbol = $_[0];
12783
12784    if(getSymLang($Symbol) eq "C++") {
12785        return "C++";
12786    }
12787
12788    foreach my $S (keys(%UsedInterfaces))
12789    {
12790        if(getSymLang($S) eq "C++") {
12791            return "C++";
12792        }
12793    }
12794
12795    return $COMMON_LANGUAGE;
12796}
12797
12798sub getSymLang($)
12799{
12800    my $Symbol = $_[0];
12801    my $Header = $CompleteSignature{$Symbol}{"Header"};
12802
12803    if($Header=~/\.(hh|hp|hxx|hpp|h\+\+)\Z/i
12804    or $Header!~/\.[^\.]+\Z/) {
12805        return "C++";
12806    }
12807    if(index($Symbol, "_Z")==0)
12808    { # mangled symbols
12809        if($Symbol!~/\A_Z(L|)\d/)
12810        { # mangled C functions and global data
12811            return "C++";
12812        }
12813    }
12814    if(index($Symbol, "__gxx_")==0) {
12815        return "C++";
12816    }
12817
12818    if(my $Lib = get_filename($Symbol_Library{$Symbol}))
12819    {
12820        if($Language{$Lib}) {
12821            return $Language{$Lib};
12822        }
12823    }
12824    elsif(my $Lib = get_filename($DepSymbol_Library{$Symbol}))
12825    {
12826        if($Language{$Lib}) {
12827            return $Language{$Lib};
12828        }
12829    }
12830
12831    return $COMMON_LANGUAGE;
12832}
12833
12834sub add_namespaces($)
12835{
12836    my $CodeRef = $_[0];
12837    my @UsedNameSpaces = ();
12838    foreach my $NameSpace (sort {get_depth($b,"::")<=>get_depth($a,"::")} keys(%NestedNameSpaces))
12839    {
12840        next if($NameSpace eq "std");
12841        my $NameSpace_InCode = $NameSpace."::";
12842        if(${$CodeRef}=~s/(\W|\A)(\Q$NameSpace_InCode\E)(\w)/$1$3/g) {
12843            push(@UsedNameSpaces, $NameSpace);
12844        }
12845        my $NameSpace_InSubClass = getSubClassBaseName($NameSpace_InCode);
12846        if(${$CodeRef}=~s/(\W|\A)($NameSpace_InSubClass)(\w+_SubClass)/$1$3/g) {
12847            push(@UsedNameSpaces, $NameSpace);
12848        }
12849    }
12850    return @UsedNameSpaces;
12851}
12852
12853sub correct_spaces($)
12854{
12855    my $Code = $_[0];
12856    $Code=~s/\n\n\n\n/\n\n/g;
12857    $Code=~s/\n\n\n/\n\n/g;
12858    $Code=~s/\n    \n    /\n\n    /g;
12859    $Code=~s/\n    \n\n/\n/g;
12860    $Code=~s/\n\n\};/\n};/g;
12861    return $Code;
12862}
12863
12864sub orderHeaders($)
12865{ # ordering headers according to descriptor
12866    my @List = ();
12867    my %Replace = ();
12868    my $Num = 1;
12869    my %ElemNum = map {$_=>$Num++} @{$_[0]};
12870
12871    foreach my $Elem (@{$_[0]})
12872    {
12873        if(my $Preamble = $Include_Order{$Elem})
12874        {
12875            if(not $ElemNum{$Preamble})
12876            {
12877                push(@List, $Preamble);
12878                push(@List, $Elem);
12879            }
12880            elsif($ElemNum{$Preamble}>$ElemNum{$Elem})
12881            {
12882                push(@List, $Preamble);
12883                $Replace{$Preamble} = $Elem;
12884            }
12885            else {
12886                push(@List, $Elem);
12887            }
12888        }
12889        elsif($Replace{$Elem}) {
12890            push(@List, $Replace{$Elem});
12891        }
12892        else {
12893            push(@List, $Elem);
12894        }
12895    }
12896    return \@List;
12897}
12898
12899sub alignSpaces($)
12900{
12901    my $Code = $_[0];
12902    my $Code_Copy = $Code;
12903    my ($MinParagraph, $Paragraph);
12904    while($Code=~s/\A([ ]+)//) {
12905        $MinParagraph = length($1) if(not defined $MinParagraph or $MinParagraph>length($1));
12906    }
12907    foreach (1 .. $MinParagraph) {
12908        $Paragraph .= " ";
12909    }
12910    $Code_Copy=~s/(\A|\n)$Paragraph/$1/g;
12911    return $Code_Copy;
12912}
12913
12914sub alignCode($$$)
12915{
12916    my ($Code, $Code_Align, $Single) = @_;
12917    return "" if($Code eq "" or $Code_Align eq "");
12918    my $Paragraph = get_paragraph($Code_Align, 0);
12919    $Code=~s/\n([^\n])/\n$Paragraph$1/g;
12920    if(not $Single) {
12921        $Code=~s/\A/$Paragraph/g;
12922    }
12923    return $Code;
12924}
12925
12926sub get_paragraph($$)
12927{
12928    my ($Code, $MaxMin) = @_;
12929    my ($MinParagraph_Length, $MinParagraph);
12930    while($Code=~s/\A([ ]+)//)
12931    {
12932        if(not defined $MinParagraph_Length or
12933        (($MaxMin)?$MinParagraph_Length<length($1):$MinParagraph_Length>length($1))) {
12934            $MinParagraph_Length = length($1);
12935        }
12936    }
12937    foreach (1 .. $MinParagraph_Length) {
12938        $MinParagraph .= " ";
12939    }
12940    return $MinParagraph;
12941}
12942
12943sub writeFile($$)
12944{
12945    my ($Path, $Content) = @_;
12946    return if(not $Path);
12947    if(my $Dir = get_dirname($Path)) {
12948        mkpath($Dir);
12949    }
12950    open (FILE, ">".$Path) || die ("can't open file \'$Path\': $!\n");
12951    print FILE $Content;
12952    close(FILE);
12953}
12954
12955sub readFile($)
12956{
12957    my $Path = $_[0];
12958    return "" if(not $Path or not -f $Path);
12959    open (FILE, $Path);
12960    my $Content = join("", <FILE>);
12961    close(FILE);
12962    $Content=~s/\r//g;
12963    return $Content;
12964}
12965
12966sub get_RunScript($)
12967{
12968    my $Interface = $_[0];
12969    my @Paths = ();
12970    foreach my $Path (sort (keys(%UsedSharedObjects), keys(%LibsDepend), keys(%SpecLibs)))
12971    {
12972        if(my $Dir = get_dirname($Path))
12973        {
12974            next if(grep {$Dir eq $_} @DefaultLibPaths);
12975            push_U(\@Paths, $Dir);
12976        }
12977    }
12978    if($OSgroup eq "windows")
12979    {
12980        if(@Paths)
12981        {
12982            my $EnvSet = "\@set PATH=".join(";", @Paths).";\%PATH\%";
12983            return $EnvSet."\ntest.exe arg1 arg2 arg3 >output 2>&1\n";
12984        }
12985        else {
12986            return "test.exe arg1 arg2 arg3 >output 2>&1\n";
12987        }
12988    }
12989    elsif($OSgroup eq "macos")
12990    {
12991        if(@Paths)
12992        {
12993            my $EnvSet = "export DYLD_LIBRARY_PATH=\$DYLD_LIBRARY_PATH:\"".join(":", @Paths)."\"";
12994            return "#!/bin/sh\n$EnvSet && ./test arg1 arg2 arg3 >output 2>&1\n";
12995        }
12996        else {
12997            return "#!/bin/sh\n./test arg1 arg2 arg3 >output 2>&1\n";
12998        }
12999    }
13000    else
13001    {
13002        if(@Paths)
13003        {
13004            my $EnvSet = "export LD_LIBRARY_PATH=\$LD_LIBRARY_PATH:\"".join(":", @Paths)."\"";
13005            return "#!/bin/sh\n$EnvSet && ./test arg1 arg2 arg3 >output 2>&1\n";
13006        }
13007        else {
13008            return "#!/bin/sh\n./test arg1 arg2 arg3 >output 2>&1\n";
13009        }
13010    }
13011}
13012
13013sub short_soname($)
13014{
13015    my $Name = $_[0];
13016    $Name=~s/(?<=\.$LIB_EXT)\.[0-9.]+\Z//g;
13017    return $Name;
13018}
13019
13020sub checkHeader($)
13021{
13022    if(defined $Cache{"checkHeader"}{$_[0]}) {
13023        return $Cache{"checkHeader"}{$_[0]}
13024    }
13025    foreach my $Path (@DefaultIncPaths)
13026    {
13027        if(-f $Path."/".$_[0]) {
13028            return ($Cache{"checkHeader"}{$_[0]} = join_P($Path, $_[0]));
13029        }
13030    }
13031    return ($Cache{"checkHeader"}{$_[0]} = "");
13032}
13033
13034sub optimizeIncludes($$)
13035{
13036    my %Paths = %{$_[0]};
13037    my $Level = $_[1];
13038
13039    if($Level=~/Low|Medium|High/i)
13040    { # optimization N1: included by others
13041        foreach my $Path1 (sort {$Paths{$b}<=>$Paths{$a}} keys(%Paths))
13042        {
13043            if($Paths{$Path1}<0)
13044            { # preamble headers (%Include_Preamble)
13045                next;
13046            }
13047
13048            my $N = $Paths{$Path1};
13049            foreach my $Path2 (sort {$Paths{$b}<=>$Paths{$a}} keys(%Paths))
13050            {
13051                next if($Path1 eq $Path2);
13052                next if($Paths{$Path2}<=$N); # top-to-bottom
13053                if(grep {get_dirname($Path2) eq $_} @DefaultIncPaths)
13054                { # save
13055                    next if(not defined $Include_RevOrder{get_filename($Path2)});
13056                }
13057
13058                if(defined $RecursiveIncludes{$Path1}{$Path2})
13059                {
13060                    my $Name = get_filename($Path2);
13061                    my $Dir = get_filename(get_dirname($Path2));
13062                    my $DirName = join_P($Dir, $Name);
13063
13064                    if(defined $DirectIncludes{$Path1}{$Name}
13065                    or defined $DirectIncludes{$Path1}{$DirName}) {
13066                        delete($Paths{$Path2});
13067                    }
13068                }
13069            }
13070        }
13071    }
13072
13073    if($Level=~/Medium|High/i)
13074    { # optimization N2: non registered
13075        foreach my $Path (sort {$Paths{$b}<=>$Paths{$a}} keys(%Paths))
13076        {
13077            if($Paths{$Path}<0)
13078            { # preamble headers (%Include_Preamble)
13079                next;
13080            }
13081
13082            if(not $RegisteredHeaders_R{$Path})
13083            {
13084                my $Dir = get_dirname($Path);
13085                next if(grep {$Dir eq $_} @DefaultIncPaths); # save
13086
13087                my @Tops = sort keys(%{$RecursiveIncludes_R{$Path}});
13088                @Tops = sort {keys(%{$DirectIncludes{$b}}) <=> keys(%{$DirectIncludes{$a}})} @Tops;
13089                foreach my $Top (@Tops)
13090                {
13091                    if(defined $RegisteredHeaders_R{$Top})
13092                    {
13093                        if(not defined $Paths{$Top}) {
13094                            $Paths{$Top} = $Paths{$Path};
13095                        }
13096                        delete($Paths{$Path});
13097                        last;
13098                    }
13099                }
13100            }
13101        }
13102    }
13103
13104    if($Level=~/High/i)
13105    { # optimization N3: top headers
13106        foreach my $Path (sort {$Paths{$b}<=>$Paths{$a}} keys(%Paths))
13107        {
13108            if($Paths{$Path}<0)
13109            { # preamble headers (%Include_Preamble)
13110                next;
13111            }
13112
13113            if($RegisteredHeaders_R{$Path})
13114            {
13115                if(my @Tops = sort keys(%{$RegisteredIncludes_R{$Path}}))
13116                {
13117                    my $Name = get_filename($Path);
13118                    my $Short = $Name;
13119                    $Short=~s/\.\w+\Z//;
13120
13121                    @Tops = sort {keys(%{$DirectIncludes{$b}}) <=> keys(%{$DirectIncludes{$a}})} @Tops;
13122                    @Tops = sort {$b=~/\Q$Short\E/i cmp $a=~/\Q$Short\E/i} @Tops;
13123
13124                    foreach my $Top (@Tops)
13125                    {
13126                        if(get_filename($Top) ne $Name)
13127                        {
13128                            next if(keys(%{$DirectIncludes{$Top}})<=keys(%{$DirectIncludes{$Path}}));
13129                            next if(keys(%{$DirectIncludes{$Path}})>$MAX_INC/3);
13130                        }
13131
13132                        next if(skipHeader($Top));
13133
13134                        # replace
13135                        if(not defined $Paths{$Top}) {
13136                            $Paths{$Top} = $Paths{$Path};
13137                        }
13138                        delete($Paths{$Path});
13139                        last;
13140                    }
13141                }
13142            }
13143        }
13144    }
13145
13146    %{$_[0]} = %Paths;
13147}
13148
13149sub identifyHeader($)
13150{
13151    if(defined $Cache{"identifyHeader"}{$_[0]}) {
13152        return $Cache{"identifyHeader"}{$_[0]}
13153    }
13154    return ($Cache{"identifyHeader"}{$_[0]} = identifyHeader_I($_[0]));
13155}
13156
13157sub identifyHeader_I($)
13158{
13159    my $Name = $_[0];
13160    if(my $Path = $RegisteredHeaders{$Name}) {
13161        return $Path;
13162    }
13163    elsif(my $Path = $KnownHeaders{$Name}) {
13164        return $Path;
13165    }
13166    elsif(my $Path = checkHeader($Name)) {
13167        return $Path;
13168    }
13169    return $Name;
13170}
13171
13172sub prepareHeaders(@)
13173{
13174    my @List = @_;
13175    my %Paths = ();
13176    my ($Num, $PNum) = (0, -$#List-2);
13177
13178    # determine header paths
13179    foreach my $Name (@_)
13180    {
13181        if(my $Path = identifyHeader($Name))
13182        {
13183            if(my $Redirect = $Include_Redirect{$Path}) {
13184                $Path = $Redirect;
13185            }
13186            if(not defined $Paths{$Path})
13187            {
13188                if(grep {$Name eq $_} @Include_Preamble) {
13189                    $Paths{$Path} = $PNum++;
13190                }
13191                else {
13192                    $Paths{$Path} = $Num++;
13193                }
13194            }
13195        }
13196    }
13197
13198    if(my $Level = lc($OptimizeIncludes))
13199    {
13200        if($Level ne "none") {
13201            optimizeIncludes(\%Paths, $Level);
13202        }
13203    }
13204    else
13205    { # default
13206        optimizeIncludes(\%Paths, "High");
13207    }
13208
13209    foreach my $Path (sort {$Paths{$a}<=>$Paths{$b}} keys(%Paths))
13210    {
13211        if(my $Redirect = $Include_Redirect{$Path})
13212        {
13213            if(not defined $Paths{$Redirect}) {
13214                $Paths{$Redirect} = $Paths{$Path};
13215            }
13216            delete($Paths{$Path});
13217        }
13218    }
13219
13220    my (@Headers, %IncPaths) = ();
13221
13222    # determine include paths
13223    foreach my $Path (sort {$Paths{$a}<=>$Paths{$b}} keys(%Paths))
13224    {
13225        my $FName = get_filename($Path);
13226        my $Dir = get_dirname($Path);
13227
13228        my $Prefix = undef;
13229
13230        if(my @Prefixes = keys(%{$IncludePrefix{$FName}}))
13231        {
13232            @Prefixes = sort {length($a)<=>length($b)} sort @Prefixes;
13233
13234            foreach my $P (@Prefixes)
13235            {
13236                if($Dir=~s/[\/\\]+\Q$P\E\Z//g)
13237                {
13238                    push(@Headers, join_P($P, $FName));
13239                    $Prefix = $P;
13240                    last;
13241                }
13242            }
13243        }
13244        if(not $Prefix)
13245        { # default
13246            if($Prefix = getFilePrefix($Path))
13247            { # NOTE: /usr/include/sys/...
13248                push(@Headers, join_P($Prefix, $FName));
13249                $Dir=~s/[\/\\]+\Q$Prefix\E\Z//;
13250            }
13251            else {
13252                push(@Headers, $FName);
13253            }
13254        }
13255
13256        if($Dir)
13257        {
13258            if(not grep {$Dir eq $_} @DefaultIncPaths) {
13259                $IncPaths{$Dir} = $Num++;
13260            }
13261        }
13262
13263        # if(index($Dir, "/usr/include/c++/")!=0) {
13264        #     $IncPaths{$Dir} = $Num;
13265        # }
13266    }
13267
13268    my @IncPaths = sort {$IncPaths{$b} <=> $IncPaths{$a}} keys(%IncPaths);
13269    return (\@Headers, \@IncPaths);
13270}
13271
13272sub get_Makefile($$)
13273{
13274    my ($Interface, $IncPaths) = @_;
13275
13276    my (%LibPaths_All, %LibNames_All) = (); # Win
13277
13278    my (%LibPaths, %LibSuffixes) = ();
13279    my $LIBS = "";
13280    foreach my $Path (sort (keys(%UsedSharedObjects), keys(%LibsDepend), keys(%SpecLibs)))
13281    {
13282        if($TestFormat eq "CL")
13283        {
13284            $Path=~s/\.dll\Z/.lib/;
13285            $LibPaths_All{"\"".get_dirname($Path)."\""} = 1;
13286            $LibNames_All{get_filename($Path)} = 1;
13287        }
13288        else
13289        {
13290            if(($Path=~/\.$LIB_EXT\Z/ or -f short_soname($Path))
13291            and $Path=~/\A(.*)[\/\\]lib([^\/\\]+)\.$LIB_EXT[^\/\\]*\Z/)
13292            {
13293                $LibPaths{$1} = 1;
13294                $LibSuffixes{$2} = 1;
13295            }
13296            elsif($Path=~/\Alib([^\/\\]+)\.$LIB_EXT[^\/\\]*\Z/) {
13297                $LibSuffixes{$1} = 1;
13298            }
13299            else {
13300                $LIBS .= " ".$Path;
13301            }
13302        }
13303    }
13304    foreach my $Path (keys(%LibPaths))
13305    {
13306        next if(not $Path);
13307        next if(grep {$Path eq $_} @DefaultLibPaths);
13308        $LIBS .= " -L".esc_option($Path, "GCC");
13309    }
13310    foreach my $Suffix (keys(%LibSuffixes)) {
13311        $LIBS .= " -l".$Suffix;
13312    }
13313
13314    if($LibString)
13315    { # undefined symbols
13316        $LIBS .= " ".$LibString;
13317    }
13318
13319    if($CompilerOptions_Libs) {
13320        $LIBS .= $CompilerOptions_Libs;
13321    }
13322
13323    my $IncStr = "";
13324    foreach my $Path (@{$IncPaths})
13325    {
13326        my $IncOpt = inc_opt($Path, $TestFormat);
13327        if($IncludeString!~/\Q$IncOpt\E( |\Z)/) {
13328            $IncStr .= " ".$IncOpt;
13329        }
13330    }
13331    if($IncludeString) {
13332        $IncStr .= " ".$IncludeString;
13333    }
13334
13335    my $Source = "test.c";
13336    my $Exe = "test";
13337    my $Obj = "test.o";
13338    my $Rm = "rm -f";
13339
13340    if(getTestLang($Interface) eq "C++")
13341    {
13342        $Source = "test.cpp";
13343    }
13344
13345    if($OSgroup eq "windows")
13346    {
13347        $Exe = "test.exe";
13348        $Rm = "del";
13349    }
13350
13351    if($TestFormat eq "CL")
13352    {
13353        $Obj = "test.obj";
13354    }
13355
13356    if($TestFormat eq "CL")
13357    { # compiling using CL and NMake
13358        my $Makefile = "CC       = cl";
13359        if($IncStr) {
13360            $Makefile .= "\nINCLUDES = $IncStr";
13361        }
13362        if(keys(%LibNames_All)) {
13363            $Makefile .= "\nLIBS     = ".join(" ", keys(%LibNames_All));
13364        }
13365        $Makefile .= "\n\nall: $Exe\n\n";
13366        $Makefile .= "$Exe: $Source\n\t";
13367        if(keys(%LibNames_All)) {
13368            $Makefile .= "set LIB=".join(";", keys(%LibPaths_All)).";\$(LIB)\n\t";
13369        }
13370        $Makefile .= "\$(CC) ";
13371        if($IncStr) {
13372            $Makefile .= "\$(INCLUDES) ";
13373        }
13374        $Makefile .= $Source;
13375        if(keys(%LibNames_All)) {
13376            $Makefile .= " \$(LIBS)";
13377        }
13378        $Makefile .= "\n\n";
13379        $Makefile .= "clean:\n\t$Rm $Exe $Obj\n";
13380        return $Makefile;
13381    }
13382    else
13383    { # compiling using GCC and Make
13384        if(getTestLang($Interface) eq "C++")
13385        {
13386            my $Makefile = "CXX      = g++\n";
13387            $Makefile .= "CXXFLAGS = -Wall".$CompilerOptions_Cflags;
13388            if($IncStr) {
13389                $Makefile .= "\nINCLUDES = $IncStr";
13390            }
13391            if($LIBS) {
13392                $Makefile .= "\nLIBS     = $LIBS";
13393            }
13394            $Makefile .= "\n\nall: $Exe\n\n";
13395            $Makefile .= "$Exe: $Source\n\t";
13396            $Makefile .= "\$(CXX) \$(CXXFLAGS)";
13397            if($IncStr) {
13398                $Makefile .= " \$(INCLUDES)";
13399            }
13400            $Makefile .= " $Source -o $Exe";
13401            if($LIBS) {
13402                $Makefile .= " \$(LIBS)";
13403            }
13404            $Makefile .= "\n\n";
13405            $Makefile .= "clean:\n\t$Rm $Exe $Obj\n";
13406            return $Makefile;
13407        }
13408        else
13409        {
13410            my $Makefile = "CC       = gcc\n";
13411            $Makefile .= "CFLAGS   = -Wall".$CompilerOptions_Cflags;
13412            if($IncStr) {
13413                $Makefile .= "\nINCLUDES = $IncStr";
13414            }
13415            if($LIBS) {
13416                $Makefile .= "\nLIBS     = $LIBS";
13417            }
13418            $Makefile .= "\n\nall: $Exe\n\n";
13419            $Makefile .= "$Exe: $Source\n\t";
13420            $Makefile .= "\$(CC) \$(CFLAGS)";
13421            if($IncStr) {
13422                $Makefile .= " \$(INCLUDES)";
13423            }
13424            $Makefile .= " $Source -o $Exe";
13425            if($LIBS) {
13426                $Makefile .= " \$(LIBS)";
13427            }
13428            $Makefile .= "\n\n";
13429            $Makefile .= "clean:\n\t$Rm $Exe $Obj\n";
13430            return $Makefile;
13431        }
13432    }
13433}
13434
13435sub get_one_step_title($$$$$)
13436{
13437    my ($Num, $All_Count, $Head, $Success, $Fail)  = @_;
13438    my $Title = "$Head: $Num/$All_Count [".cut_off_number($Num*100/$All_Count, 3)."%],";
13439    $Title .= " success/fail: $Success/$Fail";
13440    return $Title."    ";
13441}
13442
13443sub insertIDs($)
13444{
13445    my $Text = $_[0];
13446
13447    while($Text=~/CONTENT_ID/)
13448    {
13449        if(int($Content_Counter)%2) {
13450            $ContentID -= 1;
13451        }
13452        $Text=~s/CONTENT_ID/c_$ContentID/;
13453        $ContentID += 1;
13454        $Content_Counter += 1;
13455    }
13456    return $Text;
13457}
13458
13459sub cut_off_number($$)
13460{
13461    my ($num, $digs_to_cut) = @_;
13462    if($num!~/\./)
13463    {
13464        $num .= ".";
13465        foreach (1 .. $digs_to_cut-1) {
13466            $num .= "0";
13467        }
13468    }
13469    elsif($num=~/\.(.+)\Z/ and length($1)<$digs_to_cut-1)
13470    {
13471        foreach (1 .. $digs_to_cut - 1 - length($1)) {
13472            $num .= "0";
13473        }
13474    }
13475    elsif($num=~/\d+\.(\d){$digs_to_cut,}/) {
13476      $num=sprintf("%.".($digs_to_cut-1)."f", $num);
13477    }
13478    return $num;
13479}
13480
13481sub selectSymbol($)
13482{
13483    my $Symbol = $_[0];
13484
13485    if(defined $CompleteSignature{$Symbol})
13486    {
13487        if(my $Header = $CompleteSignature{$Symbol}{"Header"})
13488        {
13489            if(my $Path = identifyHeader($Header))
13490            {
13491                if(my $Skip = skipHeader($Path))
13492                {
13493                    if($Skip==1)
13494                    { # skip_headers
13495                        return 0;
13496                    }
13497                }
13498            }
13499            if($RegisteredHeaders{$Header})
13500            {
13501                if($Symbol_Library{$Symbol}) {
13502                    return 1;
13503                }
13504                if($CompleteSignature{$Symbol}{"InLine"})
13505                {
13506                    if(not defined $NoInline) {
13507                        return 1;
13508                    }
13509                }
13510            }
13511        }
13512    }
13513    return 0;
13514}
13515
13516sub generateTests()
13517{
13518    rmtree($TEST_SUITE_PATH) if(-e $TEST_SUITE_PATH);
13519    mkpath($TEST_SUITE_PATH);
13520    ($ResultCounter{"Gen"}{"Success"}, $ResultCounter{"Gen"}{"Fail"}) = (0, 0);
13521    my %TargetInterfaces = ();
13522    if($TargetHeaderName)
13523    { # for the header file
13524        foreach my $Symbol (sort keys(%CompleteSignature))
13525        {
13526            if(my $Header = $CompleteSignature{$Symbol}{"Header"})
13527            {
13528                if(get_filename($Header) eq $TargetHeaderName)
13529                {
13530                    if(selectSymbol($Symbol))
13531                    {
13532                        if(symbolFilter($Symbol)) {
13533                            $TargetInterfaces{$Symbol} = 1;
13534                        }
13535                    }
13536                }
13537            }
13538        }
13539    }
13540    elsif(keys(%InterfacesList))
13541    { # for the list
13542        foreach my $Symbol (sort keys(%InterfacesList))
13543        {
13544            if(symbolFilter($Symbol)) {
13545                $TargetInterfaces{$Symbol} = 1;
13546            }
13547        }
13548    }
13549    else
13550    { # all symbols (default)
13551        foreach my $Symbol (sort keys(%CompleteSignature))
13552        {
13553            if(selectSymbol($Symbol))
13554            {
13555                if(symbolFilter($Symbol)) {
13556                    $TargetInterfaces{$Symbol} = 1;
13557                }
13558            }
13559        }
13560        if(not keys(%TargetInterfaces)) {
13561            exitStatus("Error", "cannot obtain enough information from header files to generate tests");
13562        }
13563    }
13564    if(not keys(%TargetInterfaces)) {
13565        exitStatus("Error", "specified information is not enough to generate tests");
13566    }
13567    unlink($TEST_SUITE_PATH."/scenario");
13568    open(FAIL_LIST, ">$TEST_SUITE_PATH/gen_fail_list");
13569    if(defined $Template2Code)
13570    {
13571        if(keys(%LibGroups))
13572        {
13573            my %LibGroups_Filtered = ();
13574            my ($Test_Num, $All_Count) = (0, 0);
13575            foreach my $LibGroup (sort {lc($a) cmp lc($b)} keys(%LibGroups))
13576            {
13577                foreach my $Interface (keys(%{$LibGroups{$LibGroup}}))
13578                {
13579                    if($TargetInterfaces{$Interface})
13580                    {
13581                        $LibGroups_Filtered{$LibGroup}{$Interface} = 1;
13582                        $All_Count+=1;
13583                    }
13584                }
13585            }
13586            foreach my $LibGroup (sort {lc($a) cmp lc($b)} keys(%LibGroups_Filtered))
13587            {
13588                my @Ints = sort {lc($a) cmp lc($b)} keys(%{$LibGroups_Filtered{$LibGroup}});
13589                t2c_group_generation($LibGroup, "", \@Ints, 0, \$Test_Num, $All_Count);
13590            }
13591            print "\r".get_one_step_title($All_Count, $All_Count, "generating tests", $ResultCounter{"Gen"}{"Success"}, $ResultCounter{"Gen"}{"Fail"})."\n";
13592        }
13593        else
13594        {
13595            my $TwoComponets = 0;
13596            my %Header_Class_Interface = ();
13597            my ($Test_Num, $All_Count) = (0, int(keys(%TargetInterfaces)));
13598            foreach my $Interface (sort {lc($a) cmp lc($b)} keys(%TargetInterfaces))
13599            {
13600                my %Signature = %{$CompleteSignature{$Interface}};
13601                $Header_Class_Interface{$Signature{"Header"}}{get_type_short_name(get_TypeName($Signature{"Class"}))}{$Interface}=1;
13602                if($Signature{"Class"}) {
13603                    $TwoComponets=1;
13604                }
13605            }
13606            foreach my $Header (sort {lc($a) cmp lc($b)} keys(%Header_Class_Interface))
13607            {
13608                foreach my $ClassName (sort {lc($a) cmp lc($b)} keys(%{$Header_Class_Interface{$Header}}))
13609                {
13610                    my @Ints = sort {lc($a) cmp lc($b)} keys(%{$Header_Class_Interface{$Header}{$ClassName}});
13611                    t2c_group_generation($Header, $ClassName, \@Ints, $TwoComponets, \$Test_Num, $All_Count);
13612                }
13613            }
13614            print "\r".get_one_step_title($All_Count, $All_Count, "generating tests", $ResultCounter{"Gen"}{"Success"}, $ResultCounter{"Gen"}{"Fail"})."\n";
13615        }
13616        writeFile("$TEST_SUITE_PATH/$TargetLibraryName-t2c/$TargetLibraryName.cfg", "# Custom compiler options\nCOMPILER_FLAGS = -DCHECK_EXT_REQS `pkg-config --cflags $TargetLibraryName` -D_GNU_SOURCE\n\n# Custom linker options\nLINKER_FLAGS = `pkg-config --libs $TargetLibraryName`\n\n# Maximum time (in seconds) each test is allowed to run\nWAIT_TIME = $HANGED_EXECUTION_TIME\n\n# Copyright holder\nCOPYRIGHT_HOLDER = COMPANY\n");
13617    }
13618    else
13619    { # standalone
13620        my $Test_Num = 0;
13621        if(keys(%LibGroups))
13622        {
13623            foreach my $Interface (keys(%TargetInterfaces))
13624            {
13625                if(not $Interface_LibGroup{$Interface}) {
13626                    delete($TargetInterfaces{$Interface});
13627                }
13628            }
13629        }
13630        my $All_Count = keys(%TargetInterfaces);
13631        foreach my $Interface (sort {lc($a) cmp lc($b)} keys(%TargetInterfaces))
13632        {
13633            print "\r".get_one_step_title($Test_Num, $All_Count, "generating tests", $ResultCounter{"Gen"}{"Success"}, $ResultCounter{"Gen"}{"Fail"});
13634            # reset global state
13635            restore_state(());
13636            @RecurInterface = ();
13637            @RecurTypeId = ();
13638            @RecurSpecType = ();
13639            %SubClass_Created = ();
13640            my %Result = generateTest($Interface);
13641            if(not $Result{"IsCorrect"})
13642            {
13643                print FAIL_LIST $Interface."\n";
13644                if($StrictGen) {
13645                    exitStatus("Error", "can't generate test for $Interface");
13646                }
13647            }
13648            $Test_Num += 1;
13649        }
13650        write_scenario();
13651        print "\r".get_one_step_title($All_Count, $All_Count, "generating tests", $ResultCounter{"Gen"}{"Success"}, $ResultCounter{"Gen"}{"Fail"})."\n";
13652        restore_state(());
13653    }
13654    close(FAIL_LIST);
13655    unlink($TEST_SUITE_PATH."/gen_fail_list") if(not readFile($TEST_SUITE_PATH."/gen_fail_list"));
13656}
13657
13658sub t2c_group_generation($$$$$$)
13659{
13660    my ($C1, $C2, $Interfaces, $TwoComponets, $Test_NumRef, $All_Count) = @_;
13661    my ($SuitePath, $MediumPath, $TestName) = getLibGroupPath($C1, $C2, $TwoComponets);
13662    my $MaxLength = 0;
13663    my $LibGroupName = getLibGroupName($C1, $C2);
13664    my %TestComponents = ();
13665    # reset global state for section
13666    restore_state(());
13667    foreach my $Interface (@{$Interfaces})
13668    {
13669        print "\r".get_one_step_title(${$Test_NumRef}, $All_Count, "generating tests", $ResultCounter{"Gen"}{"Success"}, $ResultCounter{"Gen"}{"Fail"});
13670        restore_local_state(());
13671        %IntrinsicNum=(
13672            "Char"=>64,
13673            "Int"=>0,
13674            "Str"=>0,
13675            "Float"=>0);
13676        @RecurInterface = ();
13677        @RecurTypeId = ();
13678        @RecurSpecType = ();
13679        %SubClass_Created = ();
13680        my $Global_State = save_state();
13681        my %Result = generateTest($Interface);
13682        if(not $Result{"IsCorrect"})
13683        {
13684            restore_state($Global_State);
13685            print FAIL_LIST $Interface."\n";
13686        }
13687        ${$Test_NumRef} += 1;
13688        $TestComponents{"Headers"} = addHeaders($TestComponents{"Headers"}, $Result{"Headers"});
13689        $TestComponents{"Code"} .= $Result{"Code"};
13690        my ($DefinesList, $ValuesList) = list_t2c_defines();
13691        $TestComponents{"Blocks"} .= "##=========================================================================\n## ".get_Signature($Interface)."\n\n<BLOCK>\n\n<TARGETS>\n    ".$CompleteSignature{$Interface}{"ShortName"}."\n</TARGETS>\n\n".(($DefinesList)?"<DEFINE>\n".$DefinesList."</DEFINE>\n\n":"")."<CODE>\n".$Result{"main"}."</CODE>\n\n".(($ValuesList)?"<VALUES>\n".$ValuesList."</VALUES>\n\n":"")."</BLOCK>\n\n\n";
13692        $MaxLength = length($CompleteSignature{$Interface}{"ShortName"}) if($MaxLength<length($CompleteSignature{$Interface}{"ShortName"}));
13693    }
13694    # adding test data
13695    my $TestDataDir = $SuitePath."/testdata/".(($MediumPath)?"$MediumPath/":"")."$TestName/";
13696    mkpath($TestDataDir);
13697    $TestComponents{"Blocks"} = add_VirtualTestData($TestComponents{"Blocks"}, $TestDataDir);
13698    $TestComponents{"Blocks"} = add_TestData($TestComponents{"Blocks"}, $TestDataDir);
13699    my $Content = "#library $TargetLibraryName\n#libsection $LibGroupName\n\n<GLOBAL>\n\n// Tested here:\n";
13700    foreach my $Interface (@{$Interfaces})
13701    { # development progress
13702        $Content .= "// ".$CompleteSignature{$Interface}{"ShortName"};
13703        foreach (0 .. $MaxLength - length($CompleteSignature{$Interface}{"ShortName"}) + 2) {
13704            $Content .= " ";
13705        }
13706        $Content .= "DONE (shallow)\n";
13707    }
13708    $Content .= "\n";
13709    foreach my $Header (@{$TestComponents{"Headers"}})
13710    { # includes
13711        $Content .= "#include <$Header>\n";
13712    }
13713    $Content .= "\n".$TestComponents{"Code"}."\n" if($TestComponents{"Code"});
13714    $Content .= "\n</GLOBAL>\n\n".$TestComponents{"Blocks"};
13715    writeFile($SuitePath."/src/".(($MediumPath)?"$MediumPath/":"")."$TestName.t2c", $Content);
13716    writeFile($SuitePath."/reqs/".(($MediumPath)?"$MediumPath/":"")."$TestName.xml", get_requirements_catalog($Interfaces));
13717}
13718
13719sub get_requirements_catalog($)
13720{
13721    my @Interfaces = @{$_[0]};
13722    my $Reqs = "";
13723    foreach my $Interface (@Interfaces)
13724    {
13725        foreach my $ReqId (sort {int($a)<=>int($b)} keys(%{$RequirementsCatalog{$Interface}}))
13726        {
13727            my $Req = $RequirementsCatalog{$Interface}{$ReqId};
13728            $Req=~s/&/&amp;/g;
13729            $Req=~s/>/&gt;/g;
13730            $Req=~s/</&lt;/g;
13731            $Reqs .= "<req id=\"".$CompleteSignature{$Interface}{"ShortName"}.".".normalize_num($ReqId)."\">\n    $Req\n</req>\n";
13732        }
13733    }
13734    if(not $Reqs) {
13735        $Reqs = "<req id=\"function.01\">\n    If ... then ...\n</req>\n";
13736    }
13737    return "<?xml version=\"1.0\"?>\n<requirements>\n".$Reqs."</requirements>\n";
13738}
13739
13740sub list_t2c_defines()
13741{
13742    my (%Defines, $DefinesList, $ValuesList) = ();
13743    my $MaxLength = 0;
13744    foreach my $Define (sort keys(%Template2Code_Defines))
13745    {
13746        if($Define=~/\A(\d+):(.+)\Z/)
13747        {
13748            $Defines{$1}{"Name"} = $2;
13749            $Defines{$1}{"Value"} = $Template2Code_Defines{$Define};
13750            $MaxLength = length($2) if($MaxLength<length($2));
13751        }
13752    }
13753    foreach my $Pos (sort {int($a) <=> int($b)} keys(%Defines))
13754    {
13755        $DefinesList .= "#define ".$Defines{$Pos}{"Name"};
13756        foreach (0 .. $MaxLength - length($Defines{$Pos}{"Name"}) + 2) {
13757            $DefinesList .= " ";
13758        }
13759        $DefinesList .= "<%$Pos%>\n";
13760        $ValuesList .= "    ".$Defines{$Pos}{"Value"}."\n";
13761    }
13762    return ($DefinesList, $ValuesList);
13763}
13764
13765sub buildTests()
13766{
13767    if(-e $TEST_SUITE_PATH."/build_fail_list") {
13768        unlink($TEST_SUITE_PATH."/build_fail_list");
13769    }
13770    ($ResultCounter{"Build"}{"Success"}, $ResultCounter{"Build"}{"Fail"}) = (0, 0);
13771    readScenario();
13772    return if(not keys(%Interface_TestDir));
13773    my $All_Count = keys(%Interface_TestDir);
13774    my $Test_Num = 0;
13775    open(FAIL_LIST, ">$TEST_SUITE_PATH/build_fail_list");
13776    foreach my $Interface (sort {lc($a) cmp lc($b)} keys(%Interface_TestDir))
13777    { # building tests
13778        print "\r".get_one_step_title($Test_Num, $All_Count, "building tests", $ResultCounter{"Build"}{"Success"}, $ResultCounter{"Build"}{"Fail"});
13779        buildTest($Interface);
13780        if(not $BuildResult{$Interface}{"IsCorrect"})
13781        {
13782            print FAIL_LIST $Interface_TestDir{$Interface}."\n";
13783            if($StrictBuild) {
13784                exitStatus("Error", "can't build test for $Interface");
13785            }
13786        }
13787        $Test_Num += 1;
13788    }
13789    close(FAIL_LIST);
13790    unlink($TEST_SUITE_PATH."/build_fail_list") if(not readFile($TEST_SUITE_PATH."/build_fail_list"));
13791    print "\r".get_one_step_title($All_Count, $All_Count, "building tests", $ResultCounter{"Build"}{"Success"}, $ResultCounter{"Build"}{"Fail"})."\n";
13792}
13793
13794sub cleanTests()
13795{
13796    readScenario();
13797    return if(not keys(%Interface_TestDir));
13798    my $All_Count = keys(%Interface_TestDir);
13799    my $Test_Num = 0;
13800    foreach my $Interface (sort {lc($a) cmp lc($b)} keys(%Interface_TestDir))
13801    { # cleaning tests
13802        print "\r".get_one_step_title($Test_Num, $All_Count, "cleaning tests", $Test_Num, 0);
13803        cleanTest($Interface);
13804        $Test_Num += 1;
13805    }
13806    print "\r".get_one_step_title($All_Count, $All_Count, "cleaning tests", $All_Count, 0)."\n";
13807}
13808
13809sub run_tests()
13810{
13811    if(-f $TEST_SUITE_PATH."/run_fail_list") {
13812        unlink($TEST_SUITE_PATH."/run_fail_list");
13813    }
13814    ($ResultCounter{"Run"}{"Success"}, $ResultCounter{"Run"}{"Fail"}) = (0, 0);
13815    readScenario();
13816    if(not keys(%Interface_TestDir)) {
13817        exitStatus("Error", "tests were not generated yet");
13818    }
13819    my %ForRunning = ();
13820    foreach my $Interface (keys(%Interface_TestDir))
13821    {
13822        if(-f $Interface_TestDir{$Interface}."/test"
13823        or -f $Interface_TestDir{$Interface}."/test.exe") {
13824            $ForRunning{$Interface} = 1;
13825        }
13826    }
13827    my $All_Count = keys(%ForRunning);
13828    if($All_Count==0) {
13829        exitStatus("Error", "tests were not built yet");
13830    }
13831    my $Test_Num = 0;
13832    open(FAIL_LIST, ">$TEST_SUITE_PATH/run_fail_list");
13833    my $XvfbStarted = 0;
13834    $XvfbStarted = runXvfb() if($UseXvfb);
13835    foreach my $Interface (sort {lc($a) cmp lc($b)} keys(%ForRunning))
13836    { # running tests
13837        print "\r".get_one_step_title($Test_Num, $All_Count, "running tests", $ResultCounter{"Run"}{"Success"}, $ResultCounter{"Run"}{"Fail"});
13838        run_sanity_test($Interface);
13839        if(not $RunResult{$Interface}{"IsCorrect"})
13840        {
13841            print FAIL_LIST $Interface_TestDir{$Interface}."\n";
13842            if($StrictRun) {
13843                exitStatus("Error", "test run failed for $Interface");
13844            }
13845        }
13846        $Test_Num += 1;
13847    }
13848    stopXvfb($XvfbStarted) if($UseXvfb);
13849    close(FAIL_LIST);
13850    unlink($TEST_SUITE_PATH."/run_fail_list") if(not readFile($TEST_SUITE_PATH."/run_fail_list"));
13851    print "\r".get_one_step_title($All_Count, $All_Count, "running tests", $ResultCounter{"Run"}{"Success"}, $ResultCounter{"Run"}{"Fail"})."\n";
13852    return 0;
13853}
13854
13855sub initSignals()
13856{
13857    return if(not defined $Config{"sig_name"}
13858    or not defined $Config{"sig_num"});
13859    my $No = 0;
13860    my @Numbers = split(/\s/, $Config{"sig_num"} );
13861    foreach my $Name (split(/\s/, $Config{"sig_name"}))
13862    {
13863        if(not $SigName{$Numbers[$No]}
13864        or $Name=~/\A(SEGV|ABRT)\Z/)
13865        {
13866            $SigNo{$Name} = $Numbers[$No];
13867            $SigName{$Numbers[$No]} = $Name;
13868        }
13869        $No+=1;
13870    }
13871}
13872
13873sub genDescriptorTemplate()
13874{
13875    writeFile("VERSION.xml", $Descriptor_Template."\n");
13876    printMsg("INFO", "XML-descriptor template ./VERSION.xml has been generated");
13877}
13878
13879sub genSpecTypeTemplate()
13880{
13881    writeFile("SPECTYPES.xml", $SpecType_Template."\n");
13882    printMsg("INFO", "specialized type template ./SPECTYPES.xml has been generated");
13883}
13884
13885sub esc($)
13886{
13887    my $Str = $_[0];
13888    $Str=~s/([()\[\]{}$ &'"`;,<>\+])/\\$1/g;
13889    return $Str;
13890}
13891
13892sub remove_option($$)
13893{
13894    my ($OptionsRef, $Option) = @_;
13895    return if(not $OptionsRef or not $Option);
13896    $Option = esc($Option);
13897    my @Result = ();
13898    foreach my $Arg (@{$OptionsRef})
13899    {
13900        if($Arg!~/\A[-]+$Option\Z/) {
13901            push(@Result, $Arg);
13902        }
13903    }
13904    @{$OptionsRef} = @Result;
13905}
13906
13907sub get_RetValName($)
13908{
13909    my $Interface = $_[0];
13910    return "" if(not $Interface);
13911    if($Interface=~/\A(.+?)(_|)(init|initialize|initializer|install)\Z/) {
13912        return $1;
13913    }
13914    else {
13915        return getParamNameByTypeName($CompleteSignature{$Interface}{"Return"});
13916    }
13917}
13918
13919sub add_LibraryPreambleAndFinalization()
13920{
13921    if(not keys(%LibraryInitFunc)
13922    or keys(%LibraryInitFunc)>1) {
13923        return;
13924    }
13925    my $AddedPreamble = 0;
13926    my $Pos = 0;
13927    foreach my $Interface (sort {$Library_Prefixes{getPrefix($b)} <=> $Library_Prefixes{getPrefix($a)}}
13928    sort {$b=~/init/i <=> $a=~/init/i} sort {lc($a) cmp lc($b)} keys(%LibraryInitFunc))
13929    {
13930        next if(not symbolFilter($Interface));
13931        my $Prefix = getPrefix($Interface);
13932        next if($Library_Prefixes{$Prefix}<$LIBRARY_PREFIX_MAJORITY);
13933        next if($Interface=~/plugin/i);
13934        my $ReturnId = $CompleteSignature{$Interface}{"Return"};
13935        my $ReturnFId = get_FoundationTypeId($ReturnId);
13936        my $ReturnFTypeType = get_TypeType($ReturnFId);
13937        my $RPLevel = get_PointerLevel($ReturnId);
13938        my $RetValName = get_RetValName($Interface);
13939        if(defined $CompleteSignature{$Interface}{"Param"}{0})
13940        { # should not have a complex parameter type
13941            my $PTypeId = $CompleteSignature{$Interface}{"Param"}{0}{"type"};
13942            next if(get_TypeType(get_FoundationTypeId($PTypeId))!~/\A(Enum|Intrinsic)\Z/ and get_PointerLevel($PTypeId)!=0);
13943        }
13944        if(get_TypeName($ReturnId) eq "void"
13945        or ($ReturnFTypeType=~/\A(Enum|Intrinsic)\Z/ and $RPLevel==0)
13946        or ($ReturnFTypeType eq "Struct" and $RPLevel>=1))
13947        { # should return a simple type or structure pointer
13948            readSpecTypes("
13949            <spec_type>
13950                <name>
13951                    automatic preamble
13952                </name>
13953                <kind>
13954                    common_env
13955                </kind>
13956                <global_code>
13957                    #include <".$CompleteSignature{$Interface}{"Header"}.">
13958                </global_code>
13959                <init_code>
13960                    \$[$Interface".($ReturnFTypeType eq "Struct" and $RetValName?":$RetValName":"")."];
13961                </init_code>
13962                <libs>
13963                    ".get_filename($Symbol_Library{$Interface})."
13964                </libs>
13965                <associating>
13966                    <except>
13967                        $Interface
13968                    </except>
13969                </associating>
13970            </spec_type>");
13971            $AddedPreamble = 1;
13972            $LibraryInitFunc{$Interface} = $Pos++;
13973        }
13974    }
13975    if(not $AddedPreamble
13976    or keys(%LibraryExitFunc)>1) {
13977        return;
13978    }
13979    foreach my $Interface (sort {lc($a) cmp lc($b)} keys(%LibraryExitFunc))
13980    {
13981        next if(not symbolFilter($Interface));
13982        my $Prefix = getPrefix($Interface);
13983        next if($Library_Prefixes{$Prefix}<$LIBRARY_PREFIX_MAJORITY);
13984        next if($Interface=~/plugin/i);
13985        my $ReturnId = $CompleteSignature{$Interface}{"Return"};
13986        my $PTypeId = (defined $CompleteSignature{$Interface}{"Param"}{0})?$CompleteSignature{$Interface}{"Param"}{0}{"type"}:0;
13987        my $Interface_Pair = 0;
13988        foreach my $Interface_Init (keys(%LibraryInitFunc))
13989        { # search for a pair interface
13990            my $Prefix_Init = getPrefix($Interface_Init);
13991            my $ReturnId_Init = $CompleteSignature{$Interface_Init}{"Return"};
13992            my $PTypeId_Init = (defined $CompleteSignature{$Interface_Init}{"Param"}{0})?$CompleteSignature{$Interface_Init}{"Param"}{0}{"type"}:0;
13993            if($Prefix eq $Prefix_Init
13994            and ($PTypeId==0 or $PTypeId_Init==$ReturnId or $PTypeId==$ReturnId_Init or $PTypeId==$PTypeId_Init))
13995            { # libraw_init ( unsigned int flags ):libraw_data_t*
13996              # libraw_close ( libraw_data_t* p1 ):void
13997                $Interface_Pair = $Interface_Init;
13998                last;
13999            }
14000        }
14001        next if(not $Interface_Pair);
14002        if(get_TypeName($ReturnId) eq "void"
14003        or (get_TypeType(get_FoundationTypeId($ReturnId))=~/\A(Enum|Intrinsic)\Z/ and get_PointerLevel($ReturnId)==0))
14004        {
14005            readSpecTypes("
14006            <spec_type>
14007                <name>
14008                    automatic finalization
14009                </name>
14010                <kind>
14011                    common_env
14012                </kind>
14013                <global_code>
14014                    #include <".$CompleteSignature{$Interface}{"Header"}.">
14015                </global_code>
14016                <final_code>
14017                    \$[$Interface];
14018                </final_code>
14019                <libs>
14020                    ".get_filename($Symbol_Library{$Interface})."
14021                </libs>
14022                <associating>
14023                    <except>
14024                        $Interface
14025                    </except>
14026                </associating>
14027            </spec_type>");
14028        }
14029    }
14030}
14031
14032sub initLogging()
14033{
14034    $DEBUG_PATH = "debug/$TargetLibraryName/".$Descriptor{"Version"};
14035
14036    if($Debug)
14037    { # reset
14038        if(not ($UseCache and -d $CACHE_PATH))
14039        {
14040            rmtree($DEBUG_PATH);
14041            mkpath($DEBUG_PATH);
14042        }
14043    }
14044
14045}
14046
14047sub writeDebugLog()
14048{
14049    my $DEBUG_LOG = "";
14050    if(my @Interfaces = keys(%{$DebugInfo{"Init_InterfaceParams"}}))
14051    {
14052        $DEBUG_LOG .= "Failed to initialize parameters of these symbols:\n";
14053        foreach my $Interface (@Interfaces) {
14054            $DEBUG_LOG .= "  ".get_Signature($Interface)."\n";
14055        }
14056        delete($DebugInfo{"Init_InterfaceParams"});
14057    }
14058    if(my @Types = keys(%{$DebugInfo{"Init_Class"}}))
14059    {
14060        $DEBUG_LOG .= "Failed to create instances for these classes:\n";
14061        foreach my $Type (@Types) {
14062            $DEBUG_LOG .= "  $Type\n";
14063        }
14064        delete($DebugInfo{"Init_Class"});
14065    }
14066    if($DEBUG_LOG) {
14067        writeFile($DEBUG_PATH."/log.txt", $DEBUG_LOG."\n");
14068    }
14069}
14070
14071sub printMsg($$)
14072{
14073    my ($Type, $Msg) = @_;
14074    if($Type!~/\AINFO/) {
14075        $Msg = $Type.": ".$Msg;
14076    }
14077    if($Type!~/_C\Z/) {
14078        $Msg .= "\n";
14079    }
14080    if($Type eq "ERROR") {
14081        print STDERR $Msg;
14082    }
14083    else {
14084        print $Msg;
14085    }
14086}
14087
14088sub exitStatus($$)
14089{
14090    my ($Code, $Msg) = @_;
14091    printMsg("ERROR", $Msg);
14092    exit($ERROR_CODE{$Code});
14093}
14094
14095sub listDir($)
14096{
14097    my $Path = $_[0];
14098    return () if(not $Path or not -d $Path);
14099    opendir(my $DH, $Path);
14100    return () if(not $DH);
14101    my @Contents = grep { $_ ne "." and $_ ne ".." } readdir($DH);
14102    return @Contents;
14103}
14104
14105sub read_ABI($)
14106{
14107    my $Path = $_[0];
14108
14109    # check ACC
14110    if(my $Version = `$ABICC -dumpversion`)
14111    {
14112        if(cmpVersions($Version, $ABICC_VERSION)<0) {
14113            exitStatus("Module_Error", "the version of ABI Compliance Checker should be $ABICC_VERSION or newer");
14114        }
14115    }
14116    else {
14117        exitStatus("Module_Error", "cannot find \'$ABICC\'");
14118    }
14119
14120    my $Extra_Dir = $TMP_DIR."/extra-info";
14121    my $ABI_Dir = $TMP_DIR;
14122    if($Debug)
14123    {
14124        $Extra_Dir = $DEBUG_PATH."/extra-info";
14125        $ABI_Dir = $DEBUG_PATH;
14126    }
14127
14128    if($UseCache and -f $CACHE_PATH."/ABI.dump")
14129    { # use cache
14130        printMsg("INFO", "Using cached ABI dump");
14131        $Extra_Dir = $CACHE_PATH."/extra-info";
14132        $ABI_Dir = $CACHE_PATH;
14133    }
14134    else
14135    {
14136        mkpath($Extra_Dir);
14137
14138        # clear cache
14139        rmtree($CACHE_PATH);
14140
14141        my $Cmd = $ABICC." -l $TargetLibraryName -dump \"$Path\" -dump-path \"".$ABI_Dir."/ABI.dump\"";
14142        $Cmd .= " -extra-info \"$Extra_Dir\""; # include paths and dependent libs
14143        $Cmd .= " -extra-dump"; # dump all symbols
14144        if($TargetVersion) {
14145            $Cmd .= " -vnum \"$TargetVersion\"";
14146        }
14147        if($RelativeDirectory) {
14148            $Cmd .= " -relpath \"$RelativeDirectory\"";
14149        }
14150        if($CheckHeadersOnly) {
14151            $Cmd .= " -headers-only";
14152        }
14153        if($Debug)
14154        {
14155            $Cmd .= " -debug";
14156            printMsg("INFO", "running $Cmd");
14157        }
14158        system($Cmd);
14159
14160        if(not -f $ABI_Dir."/ABI.dump") {
14161            exit(1);
14162        }
14163        if($UseCache)
14164        { # cache ABI dump
14165            printMsg("INFO", "cache ABI dump");
14166            mkpath($CACHE_PATH."/extra-info");
14167            foreach (listDir($Extra_Dir)) {
14168                copy($Extra_Dir."/".$_, $CACHE_PATH."/extra-info");
14169            }
14170            copy($ABI_Dir."/ABI.dump", $CACHE_PATH);
14171        }
14172    }
14173
14174    # read ABI dump
14175    my $ABI_Dump = readFile($ABI_Dir."/ABI.dump");
14176
14177    # extra info
14178    if(my $Str = readFile($Extra_Dir."/include-string"))
14179    {
14180        if($TestFormat eq "GCC") {
14181            $IncludeString = $Str;
14182        }
14183        else
14184        {
14185            $Str=~s/\\//g; # unescape
14186
14187            foreach (split(/\s*\-I/, $Str))
14188            {
14189                if($_) {
14190                    $IncludeString .= " ".inc_opt($_, $TestFormat);
14191                }
14192            }
14193
14194        }
14195    }
14196
14197    $LibString = readFile($Extra_Dir."/libs-string");
14198
14199    if(my $RInc = eval(readFile($Extra_Dir."/recursive-includes")))
14200    {
14201        %RecursiveIncludes = %{$RInc};
14202        foreach my $K1 (sort {length($a)<=>length($b)} keys(%RecursiveIncludes))
14203        {
14204            registerHeader($K1, \%KnownHeaders);
14205            foreach my $K2 (sort {length($a)<=>length($b)} keys(%{$RecursiveIncludes{$K1}}))
14206            {
14207                registerHeader($K2, \%KnownHeaders);
14208                $RecursiveIncludes_R{$K2}{$K1} = 1;
14209
14210                if($RegisteredHeaders_R{$K1}
14211                and $RegisteredHeaders_R{$K2})
14212                {
14213                    $RegisteredIncludes{$K1}{$K2} = 1;
14214                    $RegisteredIncludes_R{$K2}{$K1} = 1;
14215                }
14216            }
14217        }
14218    }
14219
14220    if(my @Paths = split(/\n/, readFile($Extra_Dir."/header-paths")))
14221    {
14222        foreach my $P (sort {length($a)<=>length($b)} @Paths) {
14223            registerHeader($P, \%KnownHeaders);
14224        }
14225    }
14226
14227    if(my @Paths = split(/\n/, readFile($Extra_Dir."/lib-paths")))
14228    {
14229        foreach my $P (@Paths) {
14230            $KnownLibs{get_filename($P)} = $P;
14231        }
14232    }
14233
14234    if(my @Paths = split(/\n/, readFile($Extra_Dir."/default-includes")))
14235    { # default include paths
14236        @DefaultIncPaths = @Paths;
14237    }
14238
14239    if(my @Paths = split(/\n/, readFile($Extra_Dir."/default-libs")))
14240    { # default lib paths
14241        @DefaultLibPaths = @Paths;
14242    }
14243
14244    if(my @Lines = split(/\n/, readFile($Extra_Dir."/include-redirect")))
14245    {
14246        foreach (@Lines)
14247        {
14248            if(my ($P1, $P2) = split(";", $_))
14249            { # separated by ";"
14250                $Include_Redirect{$P1} = $P2;
14251            }
14252        }
14253    }
14254
14255    if(my $DInc = eval(readFile($Extra_Dir."/direct-includes"))) {
14256        %DirectIncludes = %{$DInc};
14257    }
14258
14259    if(not $Debug and not $UseCache)
14260    {
14261        rmtree($Extra_Dir);
14262        unlink($ABI_Dir."/ABI.dump");
14263    }
14264
14265    if(not $ABI_Dump) {
14266        exitStatus("Error", "internal error - ABI dump cannot be created");
14267    }
14268
14269    my $ABI = eval($ABI_Dump);
14270
14271    if(not $ABI) {
14272        exitStatus("Error", "internal error - eval() procedure seem to not working correctly, try to remove 'use strict' and try again");
14273    }
14274
14275    %TypeInfo = %{$ABI->{"TypeInfo"}};
14276    %SymbolInfo = %{$ABI->{"SymbolInfo"}};
14277    %DepLibrary_Symbol = %{$ABI->{"DepSymbols"}};
14278    %Library_Symbol = %{$ABI->{"Symbols"}};
14279    %UndefinedSymbols = %{$ABI->{"UndefinedSymbols"}};
14280    %Library_Needed = %{$ABI->{"Needed"}};
14281
14282    %Constants = %{$ABI->{"Constants"}};
14283    %NestedNameSpaces = %{$ABI->{"NameSpaces"}};
14284
14285    $COMMON_LANGUAGE = $ABI->{"Language"};
14286
14287    $ABI = undef; # clear memory
14288
14289    if(defined $UserLang) {
14290        $COMMON_LANGUAGE = uc($UserLang);
14291    }
14292
14293    foreach my $P (keys(%DirectIncludes))
14294    {
14295        if(defined $RegisteredHeaders_R{$P})
14296        {
14297            if($MAX_INC<keys(%{$DirectIncludes{$P}})) {
14298                $MAX_INC = keys(%{$DirectIncludes{$P}});
14299            }
14300        }
14301
14302        foreach my $Inc (keys(%{$DirectIncludes{$P}}))
14303        {
14304            if(defined $Constants{$Inc})
14305            { # FT_FREETYPE_H, etc.
14306                $Inc = $Constants{$Inc}{"Value"};
14307                if($Inc=~s/\A([<"])//g
14308                and $Inc=~s/([>"])\Z//g)
14309                {
14310                    $DirectIncludes{$P}{$Inc} = 1;
14311                    my $Kind = $1 eq ">"?1:-1;
14312                    if(my $IncP = $KnownHeaders{get_filename($Inc)})
14313                    {
14314                        if(defined $RecursiveIncludes{$P}
14315                        and not defined $RecursiveIncludes{$P}{$IncP})
14316                        { # add to known headers to recursive includes
14317                            $RecursiveIncludes{$P}{$IncP} = $Kind;
14318                            foreach (keys(%{$RecursiveIncludes_R{$P}})) {
14319                                $RecursiveIncludes{$_}{$IncP} = $Kind;
14320                            }
14321                        }
14322                    }
14323                }
14324            }
14325
14326            if(my $Dir = get_dirname($Inc))
14327            {
14328                my $Name = get_filename($Inc);
14329                if($Name ne get_filename($P))
14330                { # NOTE: stdlib.h includes bits/stdlib.h
14331                    $IncludePrefix{$Name}{$Dir} = 1;
14332                }
14333            }
14334        }
14335    }
14336
14337    # recreate environment
14338    foreach my $Lib_Name (keys(%Library_Symbol))
14339    {
14340        foreach my $Symbol (keys(%{$Library_Symbol{$Lib_Name}}))
14341        {
14342            if(my $P = identifyLibrary($Lib_Name))
14343            {
14344                $Symbol_Library{$Symbol} = $P;
14345
14346                if(index($Symbol, "?")!=0)
14347                { # remove version
14348                    $Symbol=~s/[\@\$]+.+?\Z//g;
14349                    $Symbol_Library{$Symbol} = $P;
14350                }
14351
14352                if(not defined $Language{$Lib_Name})
14353                {
14354                    if(index($Symbol, "_ZN")==0
14355                    or index($Symbol, "?")==0) {
14356                        $Language{$Lib_Name} = "C++"
14357                    }
14358                }
14359            }
14360        }
14361    }
14362    foreach my $Lib_Name (keys(%DepLibrary_Symbol))
14363    {
14364        foreach my $Symbol (keys(%{$DepLibrary_Symbol{$Lib_Name}}))
14365        {
14366            if(my $P = identifyLibrary($Lib_Name))
14367            {
14368                $DepSymbol_Library{$Symbol} = $P;
14369
14370                if(index($Symbol, "?")!=0)
14371                { # remove version
14372                    $Symbol=~s/[\@\$]+.+?\Z//g;
14373                    $DepSymbol_Library{$Symbol} = $P;
14374                }
14375
14376                if(not defined $Language{$Lib_Name})
14377                {
14378                    if(index($Symbol, "_ZN")==0
14379                    or index($Symbol, "?")==0) {
14380                        $Language{$Lib_Name} = "C++"
14381                    }
14382                }
14383            }
14384        }
14385    }
14386    foreach my $NS (keys(%NestedNameSpaces))
14387    {
14388        foreach (split("::", $NS)) {
14389            $NameSpaces{$NS} = 1;
14390        }
14391    }
14392
14393    my %Ctors = ();
14394    my @IDs = sort {int($a)<=>int($b)} keys(%SymbolInfo);
14395
14396    foreach my $InfoId (@IDs)
14397    {
14398        if(my $Mangled = $SymbolInfo{$InfoId}{"MnglName"})
14399        { # unmangling
14400            $tr_name{$Mangled} = $SymbolInfo{$InfoId}{"Unmangled"};
14401        }
14402        else
14403        { # ABI dumps have no mangled names for C-functions
14404            $SymbolInfo{$InfoId}{"MnglName"} = $SymbolInfo{$InfoId}{"ShortName"};
14405        }
14406        if(my $ClassId = $SymbolInfo{$InfoId}{"Class"}) {
14407            $Library_Class{$ClassId} = 1;
14408        }
14409        if(defined $SymbolInfo{$InfoId}{"Param"})
14410        {
14411            foreach my $Pos (keys(%{$SymbolInfo{$InfoId}{"Param"}}))
14412            {
14413                my $TypeId = $SymbolInfo{$InfoId}{"Param"}{$Pos}{"type"};
14414                if($TypeInfo{$TypeId}{"Type"} eq "Restrict") {
14415                    $SymbolInfo{$InfoId}{"Param"}{$Pos}{"type"} = $TypeInfo{$TypeId}{"BaseType"};
14416                }
14417            }
14418        }
14419        if(defined $SymbolInfo{$InfoId}{"Constructor"}) {
14420            $Ctors{$SymbolInfo{$InfoId}{"Class"}}{$InfoId} = 1;
14421        }
14422    }
14423
14424    my $MAX = $IDs[$#IDs] + 1;
14425
14426    foreach my $TypeId (sort {int($a)<=>int($b)} keys(%TypeInfo))
14427    { # order is important
14428        if(not defined $TypeInfo{$TypeId}{"Tid"}) {
14429            $TypeInfo{$TypeId}{"Tid"} = $TypeId;
14430        }
14431        if(defined $TypeInfo{$TypeId}{"BaseType"})
14432        {
14433            if(defined $TypeInfo{$TypeId}{"BaseType"}{"Tid"})
14434            { # format of ABI dump changed in ACC 1.99
14435                $TypeInfo{$TypeId}{"BaseType"} = $TypeInfo{$TypeId}{"BaseType"}{"Tid"};
14436            }
14437        }
14438        my %TInfo = %{$TypeInfo{$TypeId}};
14439        if(defined $TInfo{"Base"})
14440        {
14441            foreach (keys(%{$TInfo{"Base"}})) {
14442                $Class_SubClasses{$_}{$TypeId} = 1;
14443            }
14444        }
14445        if($TInfo{"Type"} eq "Typedef"
14446        and defined $TInfo{"BaseType"})
14447        {
14448            if(my $BTid = $TInfo{"BaseType"})
14449            {
14450                my $BName = $TypeInfo{$BTid}{"Name"};
14451                if(not $BName)
14452                { # broken type
14453                    next;
14454                }
14455                if($TInfo{"Name"} eq $BName)
14456                { # typedef to "class Class"
14457                  # should not be registered in TName_Tid
14458                    next;
14459                }
14460                if(not $Typedef_BaseName{$TInfo{"Name"}}) {
14461                    $Typedef_BaseName{$TInfo{"Name"}} = $BName;
14462                }
14463                if(selectType($TypeId)) {
14464                    $Type_Typedef{$BTid}{$TypeId} = 1;
14465                }
14466            }
14467        }
14468        if(not $TName_Tid{$TInfo{"Name"}})
14469        { # classes: class (id1), typedef (artificial, id2 > id1)
14470            $TName_Tid{$TInfo{"Name"}} = $TypeId;
14471        }
14472        if(my $Prefix = getPrefix($TInfo{"Name"})) {
14473            $Library_Prefixes{$Prefix} += 1;
14474        }
14475
14476        if($TInfo{"Type"} eq "Array")
14477        { # size in bytes to size in elements
14478            if($TInfo{"Name"}=~/\[(\d+)\]/) {
14479                $TypeInfo{$TypeId}{"Count"} = $1;
14480            }
14481        }
14482
14483        if($TInfo{"Type"} eq "Class"
14484        and not defined $Ctors{$TypeId})
14485        { # add default c-tors
14486            %{$SymbolInfo{$MAX++}} = (
14487                "Class"=>$TypeId,
14488                "Constructor"=>1,
14489                "Header"=>$TInfo{"Header"},
14490                "InLine"=>1,
14491                "Line"=>$TInfo{"Line"},
14492                "ShortName"=>$TInfo{"Name"},
14493                "MnglName"=>"_aux_".$MAX."_C1E"
14494            );
14495        }
14496    }
14497
14498    if($COMMON_LANGUAGE eq "C")
14499    {
14500        if(my $TypeId = get_TypeIdByName("struct __exception*"))
14501        {
14502            $TypeInfo{$TypeId}{"Name"} = "struct exception*";
14503            $TypeInfo{$TypeInfo{$TypeId}{"BaseType"}}{"Name"} = "struct exception";
14504        }
14505    }
14506}
14507
14508sub identifyLibrary($)
14509{
14510    my $Name = $_[0];
14511    if(my $Path = $RegisteredLibs{$Name}) {
14512        return $Path;
14513    }
14514    elsif(my $Path = $KnownLibs{$Name}) {
14515        return $Path;
14516    }
14517    return $Name;
14518}
14519
14520sub selectType($)
14521{
14522    my $Tid = $_[0];
14523    my $Name = $TypeInfo{$Tid}{"Name"};
14524    if(index($Name, "::_")!=-1)
14525    { # std::basic_istream<wchar_t>::__streambuf_type
14526        return 0;
14527    }
14528    if(index($Name, "_")==0)
14529    { # __gthread_t
14530        return 0;
14531    }
14532    if(get_depth($Name, "::")>=2)
14533    { # std::vector::difference_type
14534        return 0;
14535    }
14536    if(get_depth($Name, "_")>=3)
14537    { # std::random_access_iterator_tag
14538        return 0;
14539    }
14540    if(index($Name, ">::")!=-1)
14541    { # std::collate<char>::collate
14542        return 0;
14543    }
14544    return 1;
14545}
14546
14547sub skipHeader($)
14548{
14549    if(defined $Cache{"skipHeader"}{$_[0]}) {
14550        return $Cache{"skipHeader"}{$_[0]}
14551    }
14552    return ($Cache{"checkHeader"}{$_[0]} = skipHeader_I($_[0]));
14553}
14554
14555sub skipHeader_I($)
14556{
14557    my $Path = $_[0];
14558    return 1 if(not $Path);
14559    if(not keys(%SkipHeaders)) {
14560        return 0;
14561    }
14562    my $Name = get_filename($Path);
14563    if(my $Kind = $SkipHeaders{"Name"}{$Name}) {
14564        return $Kind;
14565    }
14566    foreach my $D (keys(%{$SkipHeaders{"Path"}}))
14567    {
14568        if(index($Path, $D)!=-1)
14569        {
14570            if($Path=~/\Q$D\E([\/\\]|\Z)/) {
14571                return $SkipHeaders{"Path"}{$D};
14572            }
14573        }
14574    }
14575    foreach my $P (keys(%{$SkipHeaders{"Pattern"}}))
14576    {
14577        if(my $Kind = $SkipHeaders{"Pattern"}{$P})
14578        {
14579            if($Name=~/$P/) {
14580                return $Kind;
14581            }
14582            if($P=~/[\/\\]/ and $Path=~/$P/) {
14583                return $Kind;
14584            }
14585        }
14586    }
14587    return 0;
14588}
14589
14590sub classifyPath($)
14591{
14592    my $Path = $_[0];
14593    if($Path=~/[\*\[]/)
14594    { # wildcard
14595        $Path=~s/\*/.*/g;
14596        $Path=~s/\\/\\\\/g;
14597        return ($Path, "Pattern");
14598    }
14599    elsif($Path=~/[\/\\]/)
14600    { # directory or relative path
14601        return (path_format($Path, $OSgroup), "Path");
14602    }
14603    else {
14604        return ($Path, "Name");
14605    }
14606}
14607
14608sub registerFiles()
14609{
14610
14611    foreach my $Path (split(/\s*\n\s*/, $Descriptor{"SkipHeaders"}))
14612    {
14613        my ($CPath, $Type) = classifyPath($Path);
14614        $SkipHeaders{$Type}{$CPath} = 1;
14615    }
14616
14617    foreach my $Path (split(/\s*\n\s*/, $Descriptor{"SkipIncluding"}))
14618    {
14619        my ($CPath, $Type) = classifyPath($Path);
14620        $SkipHeaders{$Type}{$CPath} = 2;
14621    }
14622
14623    foreach my $Path (split(/\s*\n\s*/, $Descriptor{"Headers"})) {
14624        registerHeaders($Path);
14625    }
14626
14627    foreach my $Path (split(/\s*\n\s*/, $Descriptor{"Libs"})) {
14628        registerLibs($Path);
14629    }
14630}
14631
14632sub scenario()
14633{
14634    if(defined $Help)
14635    {
14636        HELP_MESSAGE();
14637        exit(0);
14638    }
14639    if(defined $InfoMsg)
14640    {
14641        INFO_MESSAGE();
14642        exit(0);
14643    }
14644    if(defined $ShowVersion)
14645    {
14646        printMsg("INFO", "API Sanity Checker $TOOL_VERSION\nCopyright (C) 2013 ROSA Lab\nLicense: LGPL or GPL <http://www.gnu.org/licenses/>\nThis program is free software: you can redistribute it and/or modify it.\n\nWritten by Andrey Ponomarenko.");
14647        exit(0);
14648    }
14649    if(defined $DumpVersion)
14650    {
14651        printMsg("INFO", $TOOL_VERSION);
14652        exit(0);
14653    }
14654    if(not defined $Template2Code) {
14655        $Standalone = 1;
14656    }
14657    if($GenerateDescriptorTemplate)
14658    {
14659        genDescriptorTemplate();
14660        exit(0);
14661    }
14662    if($GenerateSpecTypeTemplate)
14663    {
14664        genSpecTypeTemplate();
14665        exit(0);
14666    }
14667    if($OSgroup eq "windows")
14668    {
14669        if(not $ENV{"DevEnvDir"}
14670        or not $ENV{"LIB"}) {
14671            exitStatus("Error", "can't start without VS environment (vsvars32.bat)");
14672        }
14673    }
14674    if(defined $TargetCompiler)
14675    {
14676        $TargetCompiler = uc($TargetCompiler);
14677        if($TargetCompiler!~/\A(GCC|CL)\Z/) {
14678            exitStatus("Error", "Target compiler is not either gcc or cl");
14679        }
14680    }
14681    else
14682    { # default
14683        if($OSgroup eq "windows") {
14684            $TargetCompiler = "CL";
14685        }
14686    }
14687    if(defined $TestTool)
14688    {
14689        loadModule("RegTests");
14690        testTool($Debug, $LIB_EXT, $OpenReport, $TargetCompiler);
14691        exit(0);
14692    }
14693    if(not defined $TargetLibraryName) {
14694        exitStatus("Error", "library name is not selected (-l option)");
14695    }
14696    else
14697    { # validate library name
14698        if($TargetLibraryName=~/[\*\/\\]/) {
14699            exitStatus("Error", "These symbols are not allowed in the library name: \"\\\", \"\/\" and \"*\"");
14700        }
14701    }
14702    if(not $TargetLibraryFullName) {
14703        $TargetLibraryFullName = $TargetLibraryName;
14704    }
14705    if($TestDataPath and not -d $TestDataPath) {
14706        exitStatus("Access_Error", "can't access directory \'$TestDataPath\'");
14707    }
14708    if($SpecTypes_PackagePath and not -f $SpecTypes_PackagePath) {
14709        exitStatus("Access_Error", "ERROR: can't access file \'$SpecTypes_PackagePath\'");
14710    }
14711    if($InterfacesListPath)
14712    {
14713        if(-f $InterfacesListPath)
14714        {
14715            foreach my $Interface (split(/\n/, readFile($InterfacesListPath))) {
14716                $InterfacesList{$Interface} = 1;
14717            }
14718        }
14719        else {
14720            exitStatus("Access_Error", "can't access file \'$InterfacesListPath\'");
14721        }
14722    }
14723
14724    if(not $Descriptor{"Path"}) {
14725        exitStatus("Error", "library descriptor is not selected (option -d PATH)");
14726    }
14727    elsif(not -f $Descriptor{"Path"}) {
14728        exitStatus("Access_Error", "can't access file \'".$Descriptor{"Path"}."\'");
14729    }
14730    elsif($Descriptor{"Path"}!~/\.(xml|desc)\Z/i) {
14731        exitStatus("Error", "descriptor should be *.xml file");
14732    }
14733
14734    if(not $GenerateTests and not $BuildTests
14735    and not $RunTests and not $CleanTests and not $CleanSources) {
14736        exitStatus("Error", "one of these options is not specified: -gen, -build, -run or -clean");
14737    }
14738    $TOOL_SIGNATURE = "<hr/><div style='width:100%;font-family:Arial;font-size:11px;' align='right'><i>Generated on ".(localtime time)." for <b>$TargetLibraryFullName</b> by <a href='".$HomePage{"Dev"}."'>API Sanity Checker</a> $TOOL_VERSION &nbsp;<br/>An automatic generator of basic unit tests for a C/C++ library API&nbsp;&nbsp;</i></div>";
14739    if($ParameterNamesFilePath)
14740    {
14741        if(-f $ParameterNamesFilePath)
14742        {
14743            foreach my $Line (split(/\n/, readFile($ParameterNamesFilePath)))
14744            {
14745                if($Line=~s/\A(\w+)\;//)
14746                {
14747                    my $Interface = $1;
14748                    if($Line=~/;(\d+);/)
14749                    {
14750                        while($Line=~s/(\d+);(\w+)//) {
14751                            $AddIntParams{$Interface}{$1}=$2;
14752                        }
14753                    }
14754                    else
14755                    {
14756                        my $Num = 0;
14757                        foreach my $Name (split(/;/, $Line))
14758                        {
14759                            $AddIntParams{$Interface}{$Num}=$Name;
14760                            $Num+=1;
14761                        }
14762                    }
14763                }
14764            }
14765        }
14766        else {
14767            exitStatus("Access_Error", "can't access file \'$ParameterNamesFilePath\'");
14768        }
14769    }
14770    if($TargetInterfaceName and defined $Template2Code) {
14771        exitStatus("Error", "selecting of symbol is not supported in the Template2Code format");
14772    }
14773    if(($BuildTests or $RunTests or $CleanTests) and defined $Template2Code
14774    and not defined $GenerateTests) {
14775        exitStatus("Error", "see Template2Code technology documentation for building and running tests:\n       http://template2code.sourceforge.net/t2c-doc/index.htm");
14776    }
14777    if($Strict) {
14778        ($StrictGen, $StrictBuild, $StrictRun) = (1, 1, 1);
14779    }
14780    if($GenerateTests)
14781    {
14782        readDescriptor($Descriptor{"Path"});
14783        registerFiles();
14784
14785        $TestFormat = "GCC";
14786        if($OSgroup eq "windows"
14787        and $TargetCompiler eq "CL")
14788        { # default for Windows
14789            $TestFormat = "CL";
14790        }
14791
14792        $TEST_SUITE_PATH = ((defined $Template2Code)?"tests_t2c":"tests")."/$TargetLibraryName/".$Descriptor{"Version"};
14793        my $LOG_DIR = "logs/".$TargetLibraryName."/".$Descriptor{"Version"};
14794        rmtree($LOG_DIR);
14795        mkpath($LOG_DIR);
14796        $LOG_PATH = abs_path($LOG_DIR)."/log.txt";
14797        $CACHE_PATH = "cache/".$TargetLibraryName."/".$Descriptor{"Version"};
14798
14799        initLogging();
14800
14801        read_ABI($Descriptor{"Path"});
14802
14803        prepareInterfaces();
14804        add_os_spectypes();
14805        if($SpecTypes_PackagePath) {
14806            readSpecTypes(readFile($SpecTypes_PackagePath));
14807        }
14808
14809        setRegularities();
14810        markAbstractClasses();
14811
14812        if(not keys(%Common_SpecEnv))
14813        { # automatic preamble and finalization
14814            add_LibraryPreambleAndFinalization();
14815        }
14816        if($TargetInterfaceName)
14817        {
14818            if(not $CompleteSignature{$TargetInterfaceName})
14819            {
14820                my $EMsg = "specified symbol is not found\n";
14821                if($Func_ShortName_MangledName{$TargetInterfaceName})
14822                {
14823                    if(keys(%{$Func_ShortName_MangledName{$TargetInterfaceName}})==1) {
14824                        $EMsg .= "did you mean ".(keys(%{$Func_ShortName_MangledName{$TargetInterfaceName}}))[0]." ?";
14825                    }
14826                    else {
14827                        $EMsg .= "candidates are:\n ".join("\n ", keys(%{$Func_ShortName_MangledName{$TargetInterfaceName}}));
14828                    }
14829                }
14830                exitStatus("Error", $EMsg);
14831            }
14832            if(not symbolFilter($TargetInterfaceName)) {
14833                exitStatus("Error", "can't generate test for $TargetInterfaceName");
14834            }
14835            printMsg("INFO_C", "generating test for $TargetInterfaceName ... ");
14836            readScenario();
14837            generateTest($TargetInterfaceName);
14838            write_scenario();
14839            if($GenResult{$TargetInterfaceName}{"IsCorrect"}) {
14840                printMsg("INFO", "success");
14841            }
14842            else {
14843                printMsg("INFO", "fail");
14844            }
14845            create_Index();
14846        }
14847        else
14848        {
14849            generateTests();
14850            create_Index() if(not defined $Template2Code);
14851        }
14852        if($ResultCounter{"Gen"}{"Success"}>0)
14853        {
14854            if($TargetInterfaceName)
14855            {
14856                my $TestPath = getTestPath($TargetInterfaceName);
14857                printMsg("INFO", "see generated test in \'$TestPath/\'");
14858            }
14859            else
14860            {
14861                printMsg("INFO", "");
14862                if($Template2Code)
14863                {
14864                    printMsg("INFO", "1. see generated test suite in the directory \'$TEST_SUITE_PATH/\'");
14865                    printMsg("INFO", "2. see Template2Code technology documentation for building and running tests:\nhttp://template2code.sourceforge.net/t2c-doc/index.html");
14866                }
14867                else
14868                {
14869                    printMsg("INFO", "1. see generated test suite in the directory \'$TEST_SUITE_PATH/\'");
14870                    printMsg("INFO", "2. for viewing tests use \'$TEST_SUITE_PATH/view_tests.html\'");
14871                    printMsg("INFO", "3. use -build option for building tests");
14872                }
14873                printMsg("INFO", "");
14874            }
14875        }
14876        if($Debug)
14877        { # write debug log
14878            writeDebugLog();
14879        }
14880        remove_option(\@INPUT_OPTIONS, "gen");
14881        remove_option(\@INPUT_OPTIONS, "generate");
14882    }
14883    if($BuildTests and $GenerateTests and defined $Standalone)
14884    { # allocated memory for tests generation should be returned to OS
14885        system("perl", $0, @INPUT_OPTIONS); # build + run
14886        exit($?>>8);
14887    }
14888    elsif($BuildTests and defined $Standalone)
14889    {
14890        readDescriptor($Descriptor{"Path"});
14891        $TEST_SUITE_PATH = "tests/$TargetLibraryName/".$Descriptor{"Version"};
14892        if(not -e $TEST_SUITE_PATH) {
14893            exitStatus("Error", "tests were not generated yet");
14894        }
14895        if($TargetInterfaceName)
14896        {
14897            printMsg("INFO_C", "building test for $TargetInterfaceName ... ");
14898            readScenario();
14899            buildTest($TargetInterfaceName);
14900            if($BuildResult{$TargetInterfaceName}{"IsCorrect"})
14901            {
14902                if($BuildResult{$TargetInterfaceName}{"Warnings"}) {
14903                    printMsg("INFO", "success (Warnings)");
14904                }
14905                else {
14906                    printMsg("INFO", "success");
14907                }
14908            }
14909            elsif(not $BuildResult{$TargetInterfaceName}{"TestNotExists"}) {
14910                printMsg("INFO", "fail");
14911            }
14912        }
14913        else {
14914            buildTests();
14915        }
14916        if($ResultCounter{"Build"}{"Success"}>0
14917        and not $TargetInterfaceName and not $RunTests) {
14918            printMsg("INFO", "use -run option to run tests");
14919        }
14920        remove_option(\@INPUT_OPTIONS, "build");
14921        remove_option(\@INPUT_OPTIONS, "make");
14922    }
14923    if(($CleanTests or $CleanSources) and defined $Standalone)
14924    {
14925        readDescriptor($Descriptor{"Path"});
14926        $TEST_SUITE_PATH = "tests/$TargetLibraryName/".$Descriptor{"Version"};
14927        if(not -e $TEST_SUITE_PATH) {
14928            exitStatus("Error", "tests were not generated yet");
14929        }
14930        if($TargetInterfaceName)
14931        {
14932            printMsg("INFO_C", "cleaning test for $TargetInterfaceName ... ");
14933            readScenario();
14934            cleanTest($TargetInterfaceName);
14935            printMsg("INFO", "success");
14936        }
14937        else {
14938            cleanTests();
14939        }
14940        remove_option(\@INPUT_OPTIONS, "clean") if($CleanTests);
14941        remove_option(\@INPUT_OPTIONS, "view-only") if($CleanSources);
14942
14943    }
14944    if($RunTests and $GenerateTests and defined $Standalone)
14945    { # tests running requires creation of two processes, so allocated memory must be returned to the system
14946        system("perl", $0, @INPUT_OPTIONS);
14947        exit($ResultCounter{"Build"}{"Fail"}!=0 or $?>>8);
14948    }
14949    elsif($RunTests and defined $Standalone)
14950    {
14951        initSignals();
14952        readDescriptor($Descriptor{"Path"});
14953        $TEST_SUITE_PATH = "tests/$TargetLibraryName/".$Descriptor{"Version"};
14954        $REPORT_PATH = "test_results/$TargetLibraryName/".$Descriptor{"Version"};
14955        if(not -e $TEST_SUITE_PATH) {
14956            exitStatus("Error", "tests were not generated yet");
14957        }
14958        if($OSgroup eq "windows") {
14959            createTestRunner();
14960        }
14961        my $ErrCode = 0;
14962        if($TargetInterfaceName)
14963        {
14964            readScenario();
14965            my $XvfbStarted = 0;
14966            if($UseXvfb and (-f $Interface_TestDir{$TargetInterfaceName}."/test"
14967            or -f $Interface_TestDir{$TargetInterfaceName}."/test.exe")) {
14968                $XvfbStarted = runXvfb();
14969            }
14970            printMsg("INFO_C", "running test for $TargetInterfaceName ... ");
14971            $ErrCode = run_sanity_test($TargetInterfaceName);
14972            stopXvfb($XvfbStarted) if($UseXvfb);
14973            if($RunResult{$TargetInterfaceName}{"IsCorrect"})
14974            {
14975                if($RunResult{$TargetInterfaceName}{"Warnings"}) {
14976                    printMsg("INFO", "success (Warnings)");
14977                }
14978                else {
14979                    printMsg("INFO", "success");
14980                }
14981            }
14982            elsif(not $RunResult{$TargetInterfaceName}{"TestNotExists"}) {
14983                printMsg("INFO", "fail (".get_problem_title($RunResult{$TargetInterfaceName}{"Type"}, $RunResult{$TargetInterfaceName}{"Value"}).")");
14984            }
14985        }
14986        else {
14987            $ErrCode = run_tests();
14988        }
14989        mkpath($REPORT_PATH);
14990        if((not $TargetInterfaceName or not $RunResult{$TargetInterfaceName}{"TestNotExists"})
14991        and keys(%Interface_TestDir) and not $ErrCode)
14992        {
14993            unlink($REPORT_PATH."/test_results.html");# removing old report
14994            printMsg("INFO", "creating report ...");
14995            createReport();
14996            printMsg("INFO", "see test results in the file:\n  $REPORT_PATH/test_results.html");
14997        }
14998        exit($ResultCounter{"Run"}{"Fail"}!=0);
14999    }
15000    exit($ResultCounter{"Build"}{"Fail"}!=0);
15001}
15002
15003scenario();
15004