├── .gitignore ├── .travis.yml ├── Build.PL ├── Changes ├── LICENSE ├── META.json ├── README.md ├── config ├── .orangerc-compiler.cnf ├── .orangerc-executor.cnf ├── .orangerc.cnf ├── clang-compiler.cnf ├── clang-executor.cnf ├── clang.cnf ├── i386-cygwin-gcc-compiler.cnf ├── i386-cygwin-gcc-executor.cnf ├── i386-cygwin-gcc.cnf ├── linux-gcc-compiler.cnf ├── linux-gcc-executor.cnf ├── linux-gcc.cnf ├── linux-m32r-elf-gcc-compiler.cnf ├── linux-m32r-elf-gcc-executor.cnf ├── linux-m32r-elf-gcc.cnf ├── x86_64-cygwin-gcc-compiler.cnf ├── x86_64-cygwin-gcc-executor.cnf ├── x86_64-cygwin-gcc.cnf ├── x86_64-linux-gcc-compiler.cnf ├── x86_64-linux-gcc-executor.cnf └── x86_64-linux-gcc.cnf ├── cpanfile ├── lib ├── Orange3.pm └── Orange3 │ ├── Config.pm │ ├── Dumper.pm │ ├── Generator.pm │ ├── Generator │ ├── Arithmetic.pm │ ├── Convert.pm │ ├── Expect.pm │ ├── Program.pm │ └── Util.pm │ ├── Log.pm │ ├── Mini.pm │ ├── Mini │ ├── Backup.pm │ ├── Bottomup.pm │ ├── Compute.pm │ ├── Constant.pm │ ├── Executor.pm │ ├── Expression.pm │ ├── Minimize.pm │ ├── Topdown.pm │ ├── Util.pm │ └── Var.pm │ ├── Runner.pm │ ├── Runner │ ├── Compiler.pm │ └── Executor.pm │ └── Util.pm ├── minil.toml ├── script ├── orange3 └── orange3-minimizer └── t ├── 00_compile.t ├── 100_runner └── 01_basic.t ├── 200_generator └── 01_basic.t ├── 300_config └── 01_basic.t ├── 400_log └── 01_basic.t ├── 500_dumper └── 01_basic.t ├── 600_mini └── 01_basic.t └── Util.pm /.gitignore: -------------------------------------------------------------------------------- 1 | /.build/ 2 | /_build/ 3 | /Build 4 | /blib 5 | 6 | /carton.lock 7 | /.carton/ 8 | /local/ 9 | 10 | nytprof.out 11 | nytprof/ 12 | 13 | cover_db/ 14 | 15 | *.bak 16 | *.old 17 | *~ 18 | *.swp 19 | *.o 20 | *.obj 21 | *.c 22 | *.s 23 | *.exe 24 | *.out 25 | *.bs 26 | MYMETA.yml 27 | MYMETA.json 28 | 29 | !LICENSE 30 | LOG 31 | 32 | MYMETA.* 33 | 34 | /Orange3-* 35 | 36 | /test 37 | !/my_conf 38 | /my_conf/* 39 | 40 | *.asm 41 | /orange3-* 42 | /.build 43 | /_build_params 44 | /Build.bat 45 | !Build/ 46 | !META.json 47 | 48 | *.tmp 49 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: perl 2 | perl: 3 | - 5.12 4 | - 5.14 5 | - 5.16 6 | install: cpanm --with-develop --installdeps --notest . -------------------------------------------------------------------------------- /Build.PL: -------------------------------------------------------------------------------- 1 | # ========================================================================= 2 | # THIS FILE IS AUTOMATICALLY GENERATED BY MINILLA. 3 | # DO NOT EDIT DIRECTLY. 4 | # ========================================================================= 5 | 6 | use 5.008_001; 7 | 8 | use strict; 9 | use warnings; 10 | use utf8; 11 | 12 | use Module::Build; 13 | use File::Basename; 14 | use File::Spec; 15 | 16 | my %args = ( 17 | license => 'perl', 18 | dynamic_config => 0, 19 | 20 | configure_requires => { 21 | 'Module::Build' => 0.38, 22 | }, 23 | 24 | name => 'Orange3', 25 | module_name => 'Orange3', 26 | allow_pureperl => 0, 27 | 28 | script_files => [glob('script/*'), glob('config/.*')], 29 | c_source => [qw()], 30 | PL_files => {}, 31 | 32 | test_files => ((-d '.git' || $ENV{RELEASE_TESTING}) && -d 'xt') ? 't/ xt/' : 't/', 33 | recursive_test_files => 1, 34 | 35 | 36 | ); 37 | if (-d 'share') { 38 | $args{share_dir} = 'share'; 39 | } 40 | 41 | my $builder = Module::Build->subclass( 42 | class => 'MyBuilder', 43 | code => q{ 44 | sub ACTION_distmeta { 45 | die "Do not run distmeta. Install Minilla and `minil install` instead.\n"; 46 | } 47 | sub ACTION_installdeps { 48 | die "Do not run installdeps. Run `cpanm --installdeps .` instead.\n"; 49 | } 50 | } 51 | )->new(%args); 52 | $builder->create_build_script(); 53 | 54 | use File::Copy; 55 | 56 | print "cp META.json MYMETA.json\n"; 57 | copy("META.json","MYMETA.json") or die "Copy failed(META.json): $!"; 58 | 59 | if (-f 'META.yml') { 60 | print "cp META.yml MYMETA.yml\n"; 61 | copy("META.yml","MYMETA.yml") or die "Copy failed(META.yml): $!"; 62 | } else { 63 | print "There is no META.yml... You may install this module from the repository...\n"; 64 | } 65 | 66 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | {{$NEXT}} 2 | 3 | 3.00 First release. -------------------------------------------------------------------------------- /META.json: -------------------------------------------------------------------------------- 1 | { 2 | "abstract" : "Randomtest of C compilers", 3 | "author" : [ 4 | "Ishiura Lab. " 5 | ], 6 | "dynamic_config" : 0, 7 | "generated_by" : "Minilla/v2.3.0, CPAN::Meta::Converter version 2.143240", 8 | "license" : [ 9 | "perl_5" 10 | ], 11 | "meta-spec" : { 12 | "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", 13 | "version" : "2" 14 | }, 15 | "name" : "Orange3", 16 | "no_index" : { 17 | "directory" : [ 18 | "t", 19 | "xt", 20 | "inc", 21 | "share", 22 | "eg", 23 | "examples", 24 | "author", 25 | "builder" 26 | ] 27 | }, 28 | "prereqs" : { 29 | "configure" : { 30 | "requires" : { 31 | "Module::Build" : "0.38", 32 | "Module::Install" : "0", 33 | "Module::Install::CPANfile" : "0" 34 | } 35 | }, 36 | "develop" : { 37 | "requires" : { 38 | "Test::CPAN::Meta" : "0", 39 | "Test::MinimumVersion::Fast" : "0.04", 40 | "Test::PAUSE::Permissions" : "0.04", 41 | "Test::Pod" : "1.41", 42 | "Test::Spellunker" : "v0.2.7" 43 | } 44 | }, 45 | "runtime" : { 46 | "requires" : { 47 | "CPAN::Meta" : "0", 48 | "Carp" : "0", 49 | "Data::Dumper" : "0", 50 | "Encode" : "0", 51 | "File::Basename" : "0", 52 | "File::Copy" : "0", 53 | "File::Path" : "0", 54 | "File::Spec" : "0", 55 | "File::Temp" : "0", 56 | "FindBin" : "0", 57 | "Getopt::Long" : "0", 58 | "List::MoreUtils" : "0", 59 | "Math::BigFloat" : "0", 60 | "Math::BigInt" : "0", 61 | "Math::BigInt::FastCalc" : "0.27", 62 | "Math::BigInt::GMP" : "1.37", 63 | "Math::BigInt::Pari" : "1.16", 64 | "POSIX" : "0", 65 | "Test::More" : "0", 66 | "Time::HiRes" : "0", 67 | "base" : "0", 68 | "perl" : "5.008001" 69 | } 70 | }, 71 | "test" : { 72 | "requires" : { 73 | "List::MoreUtils" : "0.33", 74 | "Test::More" : "0.98" 75 | } 76 | } 77 | }, 78 | "release_status" : "unstable", 79 | "version" : "3.00", 80 | } 81 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # NAME 2 | 3 | Orange3 - Randomtest of C compilers 4 | 5 | # About "Orange3" 6 | 7 | Orange3 is a system to test validity of C compilers by randomly 8 | generated programs. It currently aims at testing optimization 9 | regarding arithmetic expressions. 10 | 11 | Orange3 has been developed by the following persons at the compiler 12 | team of Ishiura Laboratory, School of science and Technology, Kwansei 13 | Gakuin University 14 | 15 | # AUTHOR 16 | 17 | Ishiura Lab. 18 | 19 | Mr. Atsushi Hashimoto 20 | Ms. Eriko Nagai 21 | Mr. Ryo Nakamura 22 | Prof. Nagisa Ishiura 23 | 24 | # INSTALLATION 25 | 26 | Please try the following command sequence. 27 | 28 | $ perl Build.PL 29 | $ ./Build 30 | $ ./Build test 31 | $ ./Build install 32 | 33 | * Internet connection is required. 34 | * If error occurs during installation, please remove Orange3 and re-download. 35 | * If copy error occurs during installation, please retry. 36 | 37 | # CONFIGURATION FILES OF Orange3 38 | 39 | To use orange3, users need to specify settings in the three 40 | configuration files. In the case of the “i386\_Cygwin” target. 41 | for example, the configuration files are: 42 | 43 | * i386-cygwin-gcc.cnf (general settings) 44 | * i386-cygwin-gcc-compiler.cnf (compilation settings) 45 | * i386-cygwin-gcc-executor.cnf (execution settings) 46 | 47 | We are sorry but the detailed manuals for composing the configuration 48 | files are under construction. Please copy & edit the above files. 49 | For most of the compilers and execution environments with standard 50 | I/O support, you just need to edit several lines. 51 | 52 | # SYNOPSIS 53 | 54 | An "orange3" command repeats the process of generating a test program 55 | and compile & executes it. The number of tests or time for testing 56 | should be specified. 57 | 58 | $ orange3 [-c config file] [options] 59 | 60 | * OPTION 61 | 62 | -c |--config= : Config File. (must) 63 | Default: /.orangerc.cnf 64 | -n : Number of tesing. 65 | Default: 1 66 | -s : Seed number of Starting 67 | Default: 0 68 | -t : Time (hour) of testing. 69 | Cannot specify -s and -n option simultaneously. 70 | -h : Help 71 | 72 | If an error is detected, Error File Set is saved to the following 73 | directories. 74 | 75 | Directory : ./LOG// 76 | 77 | Error File Set : Report File (*.log), 78 | Config File (*.cnf), 79 | Seed information File (*.pl), 80 | Detected error C source File (*.c) 81 | 82 | # MINIMIZATION OF ERROR FILE 83 | 84 | Orange3 can reduce programs that detected errors by Orange3's minimizer. 85 | 86 | # SYNOPSIS OF Orange3's MINIMIZER 87 | 88 | "File" is a seed information file saved by orange3. If "Directory" is 89 | specified, add the Files in the directory and processed. 90 | 91 | $ orange3-minimizer 92 | 93 | # LICENSE 94 | 95 | Copyright (C) Ishiura Lab. 96 | 97 | This library is free software; you can redistribute it and/or modify 98 | it under the same terms as Perl itself. 99 | -------------------------------------------------------------------------------- /config/.orangerc-compiler.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | compile => sub { 3 | my ( $config, $option ) = @_; 4 | 5 | my $command = 6 | "$config->{compiler} $config->{source_file} -o $config->{exec_file} $option"; 7 | my $error = 0; 8 | 9 | while (1) { 10 | print STDERR "$command\n" if $config->{debug_mode}; 11 | 12 | # Execute the command 13 | my $output = `$command 2>&1`; 14 | 15 | if ( $output =~ /error/ ) { 16 | 17 | # Compiling is failed 18 | print $output; 19 | $error = $output; 20 | last; 21 | } 22 | elsif ( $output =~ /function/ ) { 23 | 24 | # Compiling is failed temporarily 25 | last; 26 | } 27 | elsif ( $output =~ /resource/ ) { 28 | 29 | # Compiling is failed temporarily 30 | ; 31 | } 32 | elsif ( $output ne '' ) { 33 | 34 | # Compiling is failed 35 | print $output; 36 | $error = $output; 37 | last; 38 | } 39 | else { 40 | # Compiling is successful 41 | last; 42 | } 43 | } 44 | 45 | # error ... Error message for LOG (Success:0, Error:message) 46 | # command ... Command for reproducing 47 | return ( $error, $command ); 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /config/.orangerc-executor.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | execute => sub { 3 | my $config = shift; 4 | my $exec_error = []; 5 | my $error_msg = ""; 6 | my $command = "./$config->{exec_file}"; 7 | 8 | print STDERR "$command\n" if $config->{debug_mode}; 9 | 10 | # Execute the command 11 | my $output = `$command 2>&1`; 12 | my $count = -1; 13 | 14 | unless ( $output =~ /(OK|NG)/ ) { 15 | 16 | # Executing is failed 17 | if ( $output eq "" ) { 18 | 19 | # Re-execute the command 20 | $output = `$command 2>&1 3>&1`; 21 | } 22 | if ( $output eq "" ) { 23 | 24 | # Executing is failed 25 | $output = "execution error! ($command)\n"; 26 | } 27 | print "$output\n"; 28 | 29 | # push exec_error <= -1 30 | push @$exec_error, $count; 31 | $error_msg = $output; 32 | } 33 | else { 34 | # Executing is successful 35 | my @lines = split m{\n}, $output; 36 | for my $line (@lines) { 37 | if ( $line =~ /OK/ ) { 38 | $count++; 39 | } 40 | elsif ( $line =~ /NG/ ) { 41 | $count++; 42 | print "$count: $line\n"; 43 | push @$exec_error, $count; 44 | $error_msg .= "$count: $line\n"; 45 | } 46 | else { ; } 47 | } 48 | 49 | if ( @{$exec_error} == 0 ) { 50 | print "\@OK\@"; 51 | } 52 | } 53 | 54 | # error_msg ... Error message for LOG 55 | # exec_error ... Numbers of the errored arithmetic expression 56 | # (succeess:no array elements, fail:some array elements) 57 | # command ... Command for reproducing 58 | return ( $error_msg, $exec_error, $command ); 59 | }, 60 | } 61 | -------------------------------------------------------------------------------- /config/.orangerc.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | debug_mode => 0, 3 | 4 | # Multiplication of number of operators and expressionis 5 | e_size_num => 100, 6 | 7 | # Option of the compiler, separated by commas 8 | options => [ "-O0", "-O3" ], 9 | 10 | # Name of C file 11 | source_file => 'test.c', 12 | 13 | # Name of Executable file 14 | exec_file => 'test.exe', 15 | 16 | # Macro (OK) of C source 17 | macro_ok => 'printf("@OK@\n")', 18 | 19 | # Macro (NG) of C source 20 | macro_ng => 'printf("@NG@ (test = " fmt ")\n",val)', 21 | 22 | # Command of the compiler 23 | compiler => 'gcc', 24 | 25 | # Operators, separated by spaces 26 | operators => [ 27 | qw(+ + + - - - * * * * * * / / / / / / % % % % % % << << << << << << >> >> >> >> >> >> == != < > <= >= && || | | | & & & ^ ^ ^) 28 | ], 29 | 30 | # Storage classes, separated by commas 31 | classes => [ "static", "" ], 32 | 33 | # Modifiers, separated by commas 34 | # ("const" is unused in some variables.) 35 | modifiers => [ "const", "volatile", "const volatile", "" ], 36 | 37 | # Types, separated by commas 38 | types => [ 39 | "signed char", 40 | "unsigned char", 41 | "signed short", 42 | "unsigned short", 43 | "signed int", 44 | "unsigned int", 45 | "signed long", 46 | "unsigned long", 47 | "signed long long", 48 | "unsigned long long", 49 | "float", 50 | "double", 51 | "long double", 52 | ], 53 | 54 | # Scopes, separated by commas 55 | scopes => [ "LOCAL", "GLOBAL" ], 56 | 57 | # Details of types 58 | type => { 59 | "signed char" => { 60 | order => 1, 61 | printf_format => '%d', 62 | const_suffix => '', 63 | bits => 8, 64 | min => -128, 65 | max => 127, 66 | }, 67 | "unsigned char" => { 68 | order => 2, 69 | printf_format => '%u', 70 | const_suffix => 'U', 71 | bits => 8, 72 | min => 0, 73 | max => 255, 74 | }, 75 | "signed short" => { 76 | order => 3, 77 | printf_format => '%hhd', 78 | const_suffix => '', 79 | bits => 16, 80 | min => -32768, 81 | max => 32767, 82 | }, 83 | "unsigned short" => { 84 | order => 4, 85 | printf_format => '%hhu', 86 | const_suffix => 'U', 87 | bits => 16, 88 | min => 0, 89 | max => 65535, 90 | }, 91 | "signed int" => { 92 | order => 5, 93 | printf_format => '%d', 94 | const_suffix => '', 95 | bits => 32, 96 | min => -2147483648, 97 | max => 2147483647, 98 | }, 99 | "unsigned int" => { 100 | order => 6, 101 | printf_format => '%u', 102 | const_suffix => 'U', 103 | bits => 32, 104 | min => 0, 105 | max => 4294967295, 106 | }, 107 | "signed long" => { 108 | order => 7, 109 | printf_format => '%ld', 110 | const_suffix => 'L', 111 | bits => 32, 112 | min => -2147483648, 113 | max => 2147483647, 114 | }, 115 | "unsigned long" => { 116 | order => 8, 117 | printf_format => '%lu', 118 | const_suffix => 'LU', 119 | bits => 32, 120 | min => 0, 121 | max => 4294967295, 122 | }, 123 | "signed long long" => { 124 | order => 9, 125 | printf_format => '%lld', 126 | const_suffix => 'LL', 127 | bits => 64, 128 | min => -9223372036854775808, 129 | max => 9223372036854775807, 130 | }, 131 | "unsigned long long" => { 132 | order => 10, 133 | printf_format => '%llu', 134 | const_suffix => 'LLU', 135 | bits => 64, 136 | min => 0, 137 | max => '18446744073709551615', 138 | }, 139 | "float" => { 140 | order => 11, 141 | printf_format => '%0.5e', 142 | const_suffix => 'F', 143 | bits => 24, 144 | min => -8388608, 145 | max => 8388607, 146 | }, 147 | "double" => { 148 | order => 12, 149 | printf_format => '%0.15e', 150 | const_suffix => '', 151 | bits => 53, 152 | min => -4503599627370496, 153 | max => 4503599627370495, 154 | }, 155 | "long double" => { 156 | order => 13, 157 | printf_format => '%0.17Le', 158 | const_suffix => 'L', 159 | bits => 65, 160 | min => '-18446744073709551616', 161 | max => '18446744073709551615', 162 | }, 163 | } 164 | } 165 | -------------------------------------------------------------------------------- /config/clang-compiler.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | compile => sub { 3 | my ( $config, $option ) = @_; 4 | 5 | my $command = 6 | "$config->{compiler} $config->{source_file} -o $config->{exec_file} $option -w"; 7 | my $error = 0; 8 | 9 | while (1) { 10 | print STDERR "$command\n" if $config->{debug_mode}; 11 | 12 | # Execute the command 13 | my $output = `$command 2>&1`; 14 | 15 | if ( $output =~ /error/ ) { 16 | 17 | # Compiling is failed 18 | print $output; 19 | $error = $output; 20 | last; 21 | } 22 | elsif ( $output =~ /function/ ) { 23 | 24 | # Compiling is failed temporarily 25 | last; 26 | } 27 | elsif ( $output =~ /resource/ ) { 28 | 29 | # Compiling is failed temporarily 30 | ; 31 | } 32 | elsif ( $output ne '' ) { 33 | 34 | # Compiling is failed 35 | print $output; 36 | $error = $output; 37 | last; 38 | } 39 | else { 40 | # Compiling is successful 41 | last; 42 | } 43 | } 44 | 45 | # error ... Error message for LOG (Success:0, Error:message) 46 | # command ... Command for reproducing 47 | return ( $error, $command ); 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /config/clang-executor.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | execute => sub { 3 | my $config = shift; 4 | my $exec_error = []; 5 | my $error_msg = ""; 6 | my $command = "./$config->{exec_file}"; 7 | 8 | print STDERR "$command\n" if $config->{debug_mode}; 9 | 10 | # Execute the command 11 | my $output = `$command 2>&1`; 12 | my $count = -1; 13 | 14 | unless ( $output =~ /(OK|NG)/ ) { 15 | 16 | # Executing is failed 17 | if ( $output eq "" ) { 18 | 19 | # Re-execute the command 20 | $output = `$command 2>&1 3>&1`; 21 | } 22 | if ( $output eq "" ) { 23 | 24 | # Executing is failed 25 | $output = "execution error! ($command)\n"; 26 | } 27 | print "$output\n"; 28 | 29 | # push exec_error <= -1 30 | push @$exec_error, $count; 31 | $error_msg = $output; 32 | } 33 | else { 34 | # Executing is successful 35 | my @lines = split m{\n}, $output; 36 | for my $line (@lines) { 37 | if ( $line =~ /OK/ ) { 38 | $count++; 39 | } 40 | elsif ( $line =~ /NG/ ) { 41 | $count++; 42 | print "$count: $line\n"; 43 | push @$exec_error, $count; 44 | $error_msg .= "$count: $line\n"; 45 | } 46 | else { ; } 47 | } 48 | 49 | if ( @{$exec_error} == 0 ) { 50 | print "\@OK\@"; 51 | } 52 | } 53 | 54 | # error_msg ... Error message for LOG 55 | # exec_error ... Numbers of the errored arithmetic expression 56 | # (succeess:no array elements, fail:some array elements) 57 | # command ... Command for reproducing 58 | return ( $error_msg, $exec_error, $command ); 59 | }, 60 | } 61 | -------------------------------------------------------------------------------- /config/clang.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | debug_mode => 0, 3 | 4 | # Multiplication of number of operators and expressionis 5 | e_size_num => 301, 6 | 7 | # Option of the compiler, separated by commas 8 | options => ["-O3"], 9 | 10 | # Name of C file 11 | source_file => 'clang-test.c', 12 | 13 | # Name of Executable file 14 | exec_file => 'clang-test.out', 15 | 16 | # Macro (OK) of C source 17 | macro_ok => 'printf("@OK@\n")', 18 | 19 | # Macro (NG) of C source 20 | macro_ng => 'printf("@NG@ (test = " fmt ")\n",val)', 21 | 22 | # Command of the compiler 23 | compiler => 'clang', 24 | 25 | # Operators, separated by spaces 26 | operators => [ 27 | qw(+ + + - - - * * * * * * / / / / / / % % % % % % << << << << << << >> >> >> >> >> >> == != < > <= >= && || | | | & & & ^ ^ ^) 28 | ], 29 | 30 | # Storage classes, separated by commas 31 | classes => [ "static", "" ], 32 | 33 | # Modifiers, separated by commas 34 | # ("const" is unused in some variables.) 35 | modifiers => [ "const", "volatile", "const volatile", "" ], 36 | 37 | # Types, separated by commas 38 | types => [ 39 | "signed char", 40 | "unsigned char", 41 | "signed short", 42 | "unsigned short", 43 | "signed int", 44 | "unsigned int", 45 | "signed long", 46 | "unsigned long", 47 | "signed long long", 48 | "unsigned long long", 49 | "float", 50 | "double", 51 | "long double", 52 | ], 53 | 54 | # Scopes, separated by commas 55 | scopes => [ "LOCAL", "GLOBAL" ], 56 | 57 | # Details of types 58 | type => { 59 | "signed char" => { 60 | order => 1, 61 | printf_format => '%d', 62 | const_suffix => '', 63 | bits => 8, 64 | min => -128, 65 | max => 127, 66 | }, 67 | "unsigned char" => { 68 | order => 2, 69 | printf_format => '%u', 70 | const_suffix => 'U', 71 | bits => 8, 72 | min => 0, 73 | max => 255, 74 | }, 75 | "signed short" => { 76 | order => 3, 77 | printf_format => '%hhd', 78 | const_suffix => '', 79 | bits => 16, 80 | min => -32768, 81 | max => 32767, 82 | }, 83 | "unsigned short" => { 84 | order => 4, 85 | printf_format => '%hhu', 86 | const_suffix => 'U', 87 | bits => 16, 88 | min => 0, 89 | max => 65535, 90 | }, 91 | "signed int" => { 92 | order => 5, 93 | printf_format => '%d', 94 | const_suffix => '', 95 | bits => 32, 96 | min => -2147483648, 97 | max => 2147483647, 98 | }, 99 | "unsigned int" => { 100 | order => 6, 101 | printf_format => '%u', 102 | const_suffix => 'U', 103 | bits => 32, 104 | min => 0, 105 | max => 4294967295, 106 | }, 107 | "signed long" => { 108 | order => 7, 109 | printf_format => '%ld', 110 | const_suffix => 'L', 111 | bits => 64, 112 | min => -9223372036854775808, 113 | max => 9223372036854775807, 114 | }, 115 | "unsigned long" => { 116 | order => 8, 117 | printf_format => '%lu', 118 | const_suffix => 'LU', 119 | bits => 64, 120 | min => 0, 121 | max => '18446744073709551615', 122 | }, 123 | "signed long long" => { 124 | order => 9, 125 | printf_format => '%lld', 126 | const_suffix => 'LL', 127 | bits => 64, 128 | min => -9223372036854775808, 129 | max => 9223372036854775807, 130 | }, 131 | "unsigned long long" => { 132 | order => 10, 133 | printf_format => '%llu', 134 | const_suffix => 'LLU', 135 | bits => 64, 136 | min => 0, 137 | max => '18446744073709551615', 138 | }, 139 | "float" => { 140 | order => 11, 141 | printf_format => '%0.5e', 142 | const_suffix => 'F', 143 | bits => 24, 144 | min => -8388608, 145 | max => 8388607, 146 | }, 147 | "double" => { 148 | order => 12, 149 | printf_format => '%0.15e', 150 | const_suffix => '', 151 | bits => 53, 152 | min => -4503599627370496, 153 | max => 4503599627370495, 154 | }, 155 | "long double" => { 156 | order => 13, 157 | printf_format => '%0.17Le', 158 | const_suffix => 'L', 159 | bits => 65, 160 | min => '-18446744073709551616', 161 | max => '18446744073709551615', 162 | }, 163 | } 164 | } 165 | -------------------------------------------------------------------------------- /config/i386-cygwin-gcc-compiler.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | compile => sub { 3 | my ( $config, $option ) = @_; 4 | 5 | my $command = 6 | "$config->{compiler} $config->{source_file} -o $config->{exec_file} $option"; 7 | my $error = 0; 8 | 9 | while (1) { 10 | print STDERR "$command\n" if $config->{debug_mode}; 11 | 12 | # Execute the command 13 | my $output = `$command 2>&1`; 14 | 15 | if ( $output =~ /error/ ) { 16 | 17 | # Compiling is failed 18 | print $output; 19 | $error = $output; 20 | last; 21 | } 22 | elsif ( $output =~ /function/ ) { 23 | 24 | # Compiling is failed temporarily 25 | last; 26 | } 27 | elsif ( $output =~ /resource/ ) { 28 | 29 | # Compiling is failed temporarily 30 | ; 31 | } 32 | elsif ( $output ne '' ) { 33 | 34 | # Compiling is failed 35 | print $output; 36 | $error = $output; 37 | last; 38 | } 39 | else { 40 | # Compiling is successful 41 | last; 42 | } 43 | } 44 | 45 | # error ... Error message for LOG (Success:0, Error:message) 46 | # command ... Command for reproducing 47 | return ( $error, $command ); 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /config/i386-cygwin-gcc-executor.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | execute => sub { 3 | my $config = shift; 4 | my $exec_error = []; 5 | my $error_msg = ""; 6 | my $command = "./$config->{exec_file}"; 7 | 8 | print STDERR "$command\n" if $config->{debug_mode}; 9 | 10 | # Execute the command 11 | my $output = `$command 2>&1`; 12 | my $count = -1; 13 | 14 | unless ( $output =~ /(OK|NG)/ ) { 15 | 16 | # Executing is failed 17 | if ( $output eq "" ) { 18 | 19 | # Re-execute the command 20 | $output = `$command 2>&1 3>&1`; 21 | } 22 | if ( $output eq "" ) { 23 | 24 | # Executing is failed 25 | $output = "execution error! ($command)\n"; 26 | } 27 | print "$output\n"; 28 | 29 | # push exec_error <= -1 30 | push @$exec_error, $count; 31 | $error_msg = $output; 32 | } 33 | else { 34 | # Executing is successful 35 | my @lines = split m{\n}, $output; 36 | for my $line (@lines) { 37 | if ( $line =~ /OK/ ) { 38 | $count++; 39 | } 40 | elsif ( $line =~ /NG/ ) { 41 | $count++; 42 | print "$count: $line\n"; 43 | push @$exec_error, $count; 44 | $error_msg .= "$count: $line\n"; 45 | } 46 | else { ; } 47 | } 48 | 49 | if ( @{$exec_error} == 0 ) { 50 | print "\@OK\@"; 51 | } 52 | } 53 | 54 | # error_msg ... Error message for LOG 55 | # exec_error ... Numbers of the errored arithmetic expression 56 | # (succeess:no array elements, fail:some array elements) 57 | # command ... Command for reproducing 58 | return ( $error_msg, $exec_error, $command ); 59 | }, 60 | } 61 | -------------------------------------------------------------------------------- /config/i386-cygwin-gcc.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | debug_mode => 0, 3 | 4 | # Multiplication of number of operators and expressionis 5 | e_size_num => 10, 6 | 7 | # Option of the compiler, separated by commas 8 | options => ["-O3"], 9 | 10 | # Name of C file 11 | source_file => 'i386-cygwin-gcc-test.c', 12 | 13 | # Name of Executable file 14 | exec_file => 'i386-cygwin-gcc-test.exe', 15 | 16 | # Macro (OK) of C source 17 | macro_ok => 'printf("@OK@\n")', 18 | 19 | # Macro (NG) of C source 20 | macro_ng => 'printf("@NG@ (test = " fmt ")\n",val)', 21 | 22 | # Command of the compiler 23 | compiler => 'gcc', 24 | 25 | # Operators, separated by spaces 26 | operators => [ 27 | qw(+ + + - - - * * * * * * / / / / / / % % % % % % << << << << << << >> >> >> >> >> >> == != < > <= >= && || | | | & & & ^ ^ ^) 28 | ], 29 | 30 | # Storage classes, separated by commas 31 | classes => [ "static", "" ], 32 | 33 | # Modifiers, separated by commas 34 | # ("const" is unused in some variables.) 35 | modifiers => [ "const", "volatile", "const volatile", "" ], 36 | 37 | # Types, separated by commas 38 | types => [ 39 | "signed char", 40 | "unsigned char", 41 | "signed short", 42 | "unsigned short", 43 | "signed int", 44 | "unsigned int", 45 | "signed long", 46 | "unsigned long", 47 | "signed long long", 48 | "unsigned long long", 49 | "float", 50 | "double", 51 | "long double", 52 | ], 53 | 54 | # Scopes, separated by commas 55 | scopes => [ "LOCAL", "GLOBAL" ], 56 | 57 | # Details of types 58 | type => { 59 | "signed char" => { 60 | order => 1, 61 | printf_format => '%d', 62 | const_suffix => '', 63 | bits => 8, 64 | min => -128, 65 | max => 127, 66 | }, 67 | "unsigned char" => { 68 | order => 2, 69 | printf_format => '%u', 70 | const_suffix => 'U', 71 | bits => 8, 72 | min => 0, 73 | max => 255, 74 | }, 75 | "signed short" => { 76 | order => 3, 77 | printf_format => '%hhd', 78 | const_suffix => '', 79 | bits => 16, 80 | min => -32768, 81 | max => 32767, 82 | }, 83 | "unsigned short" => { 84 | order => 4, 85 | printf_format => '%hhu', 86 | const_suffix => 'U', 87 | bits => 16, 88 | min => 0, 89 | max => 65535, 90 | }, 91 | "signed int" => { 92 | order => 5, 93 | printf_format => '%d', 94 | const_suffix => '', 95 | bits => 32, 96 | min => -2147483648, 97 | max => 2147483647, 98 | }, 99 | "unsigned int" => { 100 | order => 6, 101 | printf_format => '%u', 102 | const_suffix => 'U', 103 | bits => 32, 104 | min => 0, 105 | max => 4294967295, 106 | }, 107 | "signed long" => { 108 | order => 7, 109 | printf_format => '%ld', 110 | const_suffix => 'L', 111 | bits => 32, 112 | min => -2147483648, 113 | max => 2147483647, 114 | }, 115 | "unsigned long" => { 116 | order => 8, 117 | printf_format => '%lu', 118 | const_suffix => 'LU', 119 | bits => 32, 120 | min => 0, 121 | max => 4294967295, 122 | }, 123 | "signed long long" => { 124 | order => 9, 125 | printf_format => '%lld', 126 | const_suffix => 'LL', 127 | bits => 64, 128 | min => -9223372036854775808, 129 | max => 9223372036854775807, 130 | }, 131 | "unsigned long long" => { 132 | order => 10, 133 | printf_format => '%llu', 134 | const_suffix => 'LLU', 135 | bits => 64, 136 | min => 0, 137 | max => '18446744073709551615', 138 | }, 139 | "float" => { 140 | order => 11, 141 | printf_format => '%0.5e', 142 | const_suffix => 'F', 143 | bits => 24, 144 | min => -8388608, 145 | max => 8388607, 146 | }, 147 | "double" => { 148 | order => 12, 149 | printf_format => '%0.15e', 150 | const_suffix => '', 151 | bits => 53, 152 | min => -4503599627370496, 153 | max => 4503599627370495, 154 | }, 155 | "long double" => { 156 | order => 13, 157 | printf_format => '%0.17Le', 158 | const_suffix => 'L', 159 | bits => 65, 160 | min => '-18446744073709551616', 161 | max => '18446744073709551615', 162 | }, 163 | } 164 | } 165 | -------------------------------------------------------------------------------- /config/linux-gcc-compiler.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | compile => sub { 3 | my ( $config, $option ) = @_; 4 | 5 | my $command = "gcc $config->{source_file} -o $config->{exec_file} $option"; 6 | my $error = 0; 7 | 8 | while (1) { 9 | print STDERR "$command\n" if $config->{debug_mode}; 10 | 11 | # Execute the command 12 | my $output = `$command 2>&1`; 13 | 14 | if ( $output =~ /error/ ) { 15 | 16 | # Compiling is failed 17 | print $output; 18 | $error = $output; 19 | last; 20 | } 21 | elsif ( $output =~ /function/ ) { 22 | 23 | # Compiling is failed temporarily 24 | last; 25 | } 26 | elsif ( $output =~ /resource/ ) { 27 | 28 | # Compiling is failed temporarily 29 | ; 30 | } 31 | elsif ( $output ne '' ) { 32 | 33 | # Compiling is failed 34 | print $output; 35 | $error = $output; 36 | last; 37 | } 38 | else { 39 | # Compiling is successful 40 | last; 41 | } 42 | } 43 | 44 | # error ... Error message for LOG (Success:0, Error:message) 45 | # command ... Command for reproducing 46 | return ( $error, $command ); 47 | } 48 | } 49 | -------------------------------------------------------------------------------- /config/linux-gcc-executor.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | execute => sub { 3 | my $config = shift; 4 | my $exec_error = []; 5 | my $error_msg = ""; 6 | my $command = "./$config->{exec_file}"; 7 | 8 | print STDERR "$command\n" if $config->{debug_mode}; 9 | 10 | # Execute the command 11 | my $output = `$command 2>&1`; 12 | my $count = -1; 13 | 14 | unless ( $output =~ /(OK|NG)/ ) { 15 | 16 | # Executing is failed 17 | if ( $output eq "" ) { 18 | 19 | # Re-execute the command 20 | $output = `$command 2>&1 3>&1`; 21 | } 22 | if ( $output eq "" ) { 23 | 24 | # Executing is failed 25 | $output = "execution error! ($command)\n"; 26 | } 27 | print "$output\n"; 28 | 29 | # push exec_error <= -1 30 | push @$exec_error, $count; 31 | $error_msg = $output; 32 | } 33 | else { 34 | # Executing is successful 35 | my @lines = split m{\n}, $output; 36 | for my $line (@lines) { 37 | if ( $line =~ /OK/ ) { 38 | $count++; 39 | } 40 | elsif ( $line =~ /NG/ ) { 41 | $count++; 42 | print "$count: $line\n"; 43 | push @$exec_error, $count; 44 | $error_msg .= "$count: $line\n"; 45 | } 46 | else { ; } 47 | } 48 | 49 | if ( @{$exec_error} == 0 ) { 50 | print "\@OK\@"; 51 | } 52 | } 53 | 54 | # error_msg ... Error message for LOG 55 | # exec_error ... Numbers of the errored arithmetic expression 56 | # (succeess:no array elements, fail:some array elements) 57 | # command ... Command for reproducing 58 | return ( $error_msg, $exec_error, $command ); 59 | }, 60 | } 61 | -------------------------------------------------------------------------------- /config/linux-gcc.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | debug_mode => 0, 3 | 4 | # Multiplication of number of operators and expressionis 5 | e_size_num => 100, 6 | 7 | # Option of the compiler, separated by commas 8 | options => [ "-O0", "-O3" ], 9 | 10 | # Name of C file 11 | source_file => 'linux-gcc-test.c', 12 | 13 | # Name of Executable file 14 | exec_file => 'linux-gcc-test.out', 15 | 16 | # Macro (OK) of C source 17 | macro_ok => 'printf("@OK@\n")', 18 | 19 | # Macro (NG) of C source 20 | macro_ng => 'printf("@NG@ (test = " fmt ")\n",val)', 21 | 22 | # Command of the compiler 23 | compiler => 'gcc', 24 | 25 | # Operators, separated by spaces 26 | operators => [ 27 | qw(+ + + - - - * * * * * * / / / / / / % % % % % % << << << << << << >> >> >> >> >> >> == != < > <= >= && || | | | & & & ^ ^ ^) 28 | ], 29 | 30 | # Storage classes, separated by commas 31 | classes => [ "static", "", "", "", "" ], 32 | 33 | # Modifiers, separated by commas 34 | # ("const" is unused in some variables.) 35 | modifiers => 36 | [ "const", "volatile", "const volatile", "", "", "", "", "", "" ], 37 | 38 | # Types, separated by commas 39 | types => [ 40 | "signed char", 41 | "unsigned char", 42 | "signed short", 43 | "unsigned short", 44 | "signed int", 45 | "unsigned int", 46 | "signed long", 47 | "unsigned long", 48 | "signed long long", 49 | "unsigned long long", 50 | "float", 51 | "double", 52 | "long double", 53 | ], 54 | 55 | # Scopes, separated by commas 56 | scopes => [ "LOCAL", "GLOBAL" ], 57 | 58 | # Details of types 59 | type => { 60 | "signed char" => { 61 | order => 1, 62 | printf_format => '%d', 63 | const_suffix => '', 64 | bits => 8, 65 | min => -128, 66 | max => 127, 67 | }, 68 | "unsigned char" => { 69 | order => 2, 70 | printf_format => '%u', 71 | const_suffix => 'U', 72 | bits => 8, 73 | min => 0, 74 | max => 255, 75 | }, 76 | "signed short" => { 77 | order => 3, 78 | printf_format => '%hhd', 79 | const_suffix => '', 80 | bits => 16, 81 | min => -32768, 82 | max => 32767, 83 | }, 84 | "unsigned short" => { 85 | order => 4, 86 | printf_format => '%hhu', 87 | const_suffix => 'U', 88 | bits => 16, 89 | min => 0, 90 | max => 65535, 91 | }, 92 | "signed int" => { 93 | order => 5, 94 | printf_format => '%d', 95 | const_suffix => '', 96 | bits => 32, 97 | min => -2147483648, 98 | max => 2147483647, 99 | }, 100 | "unsigned int" => { 101 | order => 6, 102 | printf_format => '%u', 103 | const_suffix => 'U', 104 | bits => 32, 105 | min => 0, 106 | max => 4294967295, 107 | }, 108 | "signed long" => { 109 | order => 7, 110 | printf_format => '%ld', 111 | const_suffix => 'L', 112 | bits => 64, 113 | min => -9223372036854775808, 114 | max => 9223372036854775807, 115 | }, 116 | "unsigned long" => { 117 | order => 8, 118 | printf_format => '%lu', 119 | const_suffix => 'LU', 120 | bits => 64, 121 | min => 0, 122 | max => '18446744073709551615', 123 | }, 124 | "signed long long" => { 125 | order => 9, 126 | printf_format => '%lld', 127 | const_suffix => 'LL', 128 | bits => 64, 129 | min => -9223372036854775808, 130 | max => 9223372036854775807, 131 | }, 132 | "unsigned long long" => { 133 | order => 10, 134 | printf_format => '%llu', 135 | const_suffix => 'LLU', 136 | bits => 64, 137 | min => 0, 138 | max => '18446744073709551615', 139 | }, 140 | "float" => { 141 | order => 11, 142 | printf_format => '%0.5e', 143 | const_suffix => 'F', 144 | bits => 24, 145 | min => -8388608, 146 | max => 8388607, 147 | }, 148 | "double" => { 149 | order => 12, 150 | printf_format => '%0.15e', 151 | const_suffix => '', 152 | bits => 53, 153 | min => -4503599627370496, 154 | max => 4503599627370495, 155 | }, 156 | "long double" => { 157 | order => 13, 158 | printf_format => '%0.17Le', 159 | const_suffix => 'L', 160 | bits => 65, 161 | min => '-18446744073709551616', 162 | max => '18446744073709551615', 163 | }, 164 | } 165 | } 166 | -------------------------------------------------------------------------------- /config/linux-m32r-elf-gcc-compiler.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | compile => sub { 3 | my ( $config, $option ) = @_; 4 | 5 | my $command = 6 | "$config->{compiler} $config->{source_file} -o $config->{exec_file} $option"; 7 | my $error = 0; 8 | 9 | while (1) { 10 | print STDERR "$command\n" if $config->{debug_mode}; 11 | 12 | # Execute the command 13 | my $output = `$command 2>&1`; 14 | 15 | if ( $output =~ /error/ ) { 16 | 17 | # Compiling is failed 18 | print $output; 19 | $error = $output; 20 | last; 21 | } 22 | elsif ( $output =~ /function/ ) { 23 | 24 | # Compiling is failed temporarily 25 | last; 26 | } 27 | elsif ( $output =~ /resource/ ) { 28 | 29 | # Compiling is failed temporarily 30 | ; 31 | } 32 | elsif ( $output ne '' ) { 33 | 34 | # Compiling is failed 35 | print $output; 36 | $error = $output; 37 | last; 38 | } 39 | else { 40 | # Compiling is successful 41 | last; 42 | } 43 | } 44 | 45 | # error ... Error message for LOG (Success:0, Error:message) 46 | # command ... Command for reproducing 47 | return ( $error, $command ); 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /config/linux-m32r-elf-gcc-executor.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | execute => sub { 3 | my $config = shift; 4 | my $exec_error = []; 5 | my $error_msg = ""; 6 | my $command = "m32r-elf-run ./$config->{exec_file}"; 7 | 8 | print STDERR "$command\n" if $config->{debug_mode}; 9 | 10 | # Execute the command 11 | my $output = `$command 2>&1`; 12 | my $count = -1; 13 | 14 | unless ( $output =~ /(OK|NG)/ ) { 15 | 16 | # Executing is failed 17 | if ( $output eq "" ) { 18 | 19 | # Re-execute the command 20 | $output = `$command 2>&1 3>&1`; 21 | } 22 | if ( $output eq "" ) { 23 | 24 | # Executing is failed 25 | $output = "execution error! ($command)\n"; 26 | } 27 | print "$output\n"; 28 | 29 | # push exec_error <= -1 30 | push @$exec_error, $count; 31 | $error_msg = $output; 32 | } 33 | else { 34 | # Executing is successful 35 | my @lines = split m{\n}, $output; 36 | for my $line (@lines) { 37 | if ( $line =~ /OK/ ) { 38 | $count++; 39 | } 40 | elsif ( $line =~ /NG/ ) { 41 | $count++; 42 | print "$count: $line\n"; 43 | push @$exec_error, $count; 44 | $error_msg .= "$count: $line\n"; 45 | } 46 | else { ; } 47 | } 48 | 49 | if ( @{$exec_error} == 0 ) { 50 | print "\@OK\@"; 51 | } 52 | } 53 | 54 | # error_msg ... Error message for LOG 55 | # exec_error ... Numbers of the errored arithmetic expression 56 | # (succeess:no array elements, fail:some array elements) 57 | # command ... Command for reproducing 58 | return ( $error_msg, $exec_error, $command ); 59 | }, 60 | } 61 | -------------------------------------------------------------------------------- /config/linux-m32r-elf-gcc.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | debug_mode => 0, 3 | 4 | # Multiplication of number of operators and expressionis 5 | e_size_num => 10, 6 | 7 | # Option of the compiler, separated by commas 8 | options => [ "-O0", "-O3" ], 9 | 10 | # Name of C file 11 | source_file => 'm32r-elf-gcc-test.c', 12 | 13 | # Name of Executable file 14 | exec_file => 'm32r-elf-gcc-test.exe', 15 | 16 | # Macro (OK) of C source 17 | macro_ok => 'printf("@OK@\n")', 18 | 19 | # Macro (NG) of C source 20 | macro_ng => 'printf("@NG@ (test = " fmt ")\n",val)', 21 | 22 | # Command of the compiler 23 | compiler => 'm32r-elf-gcc', 24 | 25 | # Operators, separated by spaces 26 | operators => [ 27 | qw(+ + + - - - * * * * * * / / / / / / % % % % % % << << << << << << >> >> >> >> >> >> == != < > <= >= && || | | | & & & ^ ^ ^) 28 | ], 29 | 30 | # Storage classes, separated by commas 31 | classes => [ "static", "" ], 32 | 33 | # Modifiers, separated by commas 34 | # ("const" is unused in some variables.) 35 | modifiers => [ "const", "volatile", "const volatile", "" ], 36 | 37 | # Types, separated by commas 38 | types => [ 39 | "signed char", 40 | "unsigned char", 41 | "signed short", 42 | "unsigned short", 43 | "signed int", 44 | "unsigned int", 45 | "signed long", 46 | "unsigned long", 47 | "signed long long", 48 | "unsigned long long", 49 | "float", 50 | "double", 51 | "long double", 52 | ], 53 | 54 | # Scopes, separated by commas 55 | scopes => [ "LOCAL", "GLOBAL" ], 56 | 57 | # Details of types 58 | type => { 59 | "signed char" => { 60 | order => 1, 61 | printf_format => '%d', 62 | const_suffix => '', 63 | bits => 8, 64 | min => -128, 65 | max => 127, 66 | }, 67 | "unsigned char" => { 68 | order => 2, 69 | printf_format => '%u', 70 | const_suffix => 'U', 71 | bits => 8, 72 | min => 0, 73 | max => 255, 74 | }, 75 | "signed short" => { 76 | order => 3, 77 | printf_format => '%hhd', 78 | const_suffix => '', 79 | bits => 16, 80 | min => -32768, 81 | max => 32767, 82 | }, 83 | "unsigned short" => { 84 | order => 4, 85 | printf_format => '%hhu', 86 | const_suffix => 'U', 87 | bits => 16, 88 | min => 0, 89 | max => 65535, 90 | }, 91 | "signed int" => { 92 | order => 5, 93 | printf_format => '%d', 94 | const_suffix => '', 95 | bits => 32, 96 | min => -2147483648, 97 | max => 2147483647, 98 | }, 99 | "unsigned int" => { 100 | order => 6, 101 | printf_format => '%u', 102 | const_suffix => 'U', 103 | bits => 32, 104 | min => 0, 105 | max => 4294967295, 106 | }, 107 | "signed long" => { 108 | order => 7, 109 | printf_format => '%ld', 110 | const_suffix => 'L', 111 | bits => 32, 112 | min => -2147483648, 113 | max => 2147483647, 114 | }, 115 | "unsigned long" => { 116 | order => 8, 117 | printf_format => '%lu', 118 | const_suffix => 'LU', 119 | bits => 32, 120 | min => 0, 121 | max => '4294967295', 122 | }, 123 | "signed long long" => { 124 | order => 9, 125 | printf_format => '%lld', 126 | const_suffix => 'LL', 127 | bits => 64, 128 | min => -9223372036854775808, 129 | max => 9223372036854775807, 130 | }, 131 | "unsigned long long" => { 132 | order => 10, 133 | printf_format => '%llu', 134 | const_suffix => 'LLU', 135 | bits => 64, 136 | min => 0, 137 | max => '18446744073709551615', 138 | }, 139 | "float" => { 140 | order => 11, 141 | printf_format => '%0.5e', 142 | const_suffix => 'F', 143 | bits => 24, 144 | min => -8388608, 145 | max => 8388607, 146 | }, 147 | "double" => { 148 | order => 12, 149 | printf_format => '%0.15e', 150 | const_suffix => '', 151 | bits => 53, 152 | min => -4503599627370496, 153 | max => 4503599627370495, 154 | }, 155 | "long double" => { 156 | order => 13, 157 | printf_format => '%0.17Le', 158 | const_suffix => 'L', 159 | bits => 53, 160 | min => '-4503599627370496', 161 | max => '4503599627370495', 162 | }, 163 | } 164 | } 165 | -------------------------------------------------------------------------------- /config/x86_64-cygwin-gcc-compiler.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | compile => sub { 3 | my ( $config, $option ) = @_; 4 | 5 | my $command = 6 | "$config->{compiler} $config->{source_file} -o $config->{exec_file} $option"; 7 | my $error = 0; 8 | 9 | while (1) { 10 | print STDERR "$command\n" if $config->{debug_mode}; 11 | 12 | # Execute the command 13 | my $output = `$command 2>&1`; 14 | 15 | if ( $output =~ /error/ ) { 16 | 17 | # Compiling is failed 18 | print $output; 19 | $error = $output; 20 | last; 21 | } 22 | elsif ( $output =~ /function/ ) { 23 | 24 | # Compiling is failed temporarily 25 | last; 26 | } 27 | elsif ( $output =~ /resource/ ) { 28 | 29 | # Compiling is failed temporarily 30 | ; 31 | } 32 | elsif ( $output ne '' ) { 33 | 34 | # Compiling is failed 35 | print $output; 36 | $error = $output; 37 | last; 38 | } 39 | else { 40 | # Compiling is successful 41 | last; 42 | } 43 | } 44 | 45 | # error ... Error message for LOG (Success:0, Error:message) 46 | # command ... Command for reproducing 47 | return ( $error, $command ); 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /config/x86_64-cygwin-gcc-executor.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | execute => sub { 3 | my $config = shift; 4 | my $exec_error = []; 5 | my $error_msg = ""; 6 | my $command = "./$config->{exec_file}"; 7 | 8 | print STDERR "$command\n" if $config->{debug_mode}; 9 | 10 | # Execute the command 11 | my $output = `$command 2>&1`; 12 | my $count = -1; 13 | 14 | unless ( $output =~ /(OK|NG)/ ) { 15 | 16 | # Executing is failed 17 | if ( $output eq "" ) { 18 | 19 | # Re-execute the command 20 | $output = `$command 2>&1 3>&1`; 21 | } 22 | if ( $output eq "" ) { 23 | 24 | # Executing is failed 25 | $output = "execution error! ($command)\n"; 26 | } 27 | print "$output\n"; 28 | 29 | # push exec_error <= -1 30 | push @$exec_error, $count; 31 | $error_msg = $output; 32 | } 33 | else { 34 | # Executing is successful 35 | my @lines = split m{\n}, $output; 36 | for my $line (@lines) { 37 | if ( $line =~ /OK/ ) { 38 | $count++; 39 | } 40 | elsif ( $line =~ /NG/ ) { 41 | $count++; 42 | print "$count: $line\n"; 43 | push @$exec_error, $count; 44 | $error_msg .= "$count: $line\n"; 45 | } 46 | else { ; } 47 | } 48 | 49 | if ( @{$exec_error} == 0 ) { 50 | print "\@OK\@"; 51 | } 52 | } 53 | 54 | # error_msg ... Error message for LOG 55 | # exec_error ... Numbers of the errored arithmetic expression 56 | # (succeess:no array elements, fail:some array elements) 57 | # command ... Command for reproducing 58 | return ( $error_msg, $exec_error, $command ); 59 | }, 60 | } 61 | -------------------------------------------------------------------------------- /config/x86_64-cygwin-gcc.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | debug_mode => 0, 3 | 4 | # Multiplication of number of operators and expressionis 5 | e_size_num => 10, 6 | 7 | # Option of the compiler, separated by commas 8 | options => [ "-O0", "-O3" ], 9 | 10 | # Name of C file 11 | source_file => 'x86_64-cygwin-gcc-test.c', 12 | 13 | # Name of Executable file 14 | exec_file => 'x86_64-cygwin-gcc-test.exe', 15 | 16 | # Macro (OK) of C source 17 | macro_ok => 'printf("@OK@\n")', 18 | 19 | # Macro (NG) of C source 20 | macro_ng => 'printf("@NG@ (test = " fmt ")\n",val)', 21 | 22 | # Command of the compiler 23 | compiler => 'gcc', 24 | 25 | # Operators, separated by spaces 26 | operators => [ 27 | qw(+ + + - - - * * * * * * / / / / / / % % % % % % << << << << << << >> >> >> >> >> >> == != < > <= >= && || | | | & & & ^ ^ ^) 28 | ], 29 | 30 | # Storage classes, separated by commas 31 | classes => [ "static", "" ], 32 | 33 | # Modifiers, separated by commas 34 | # ("const" is unused in some variables.) 35 | modifiers => [ "const", "volatile", "const volatile", "" ], 36 | 37 | # Types, separated by commas 38 | types => [ 39 | "signed char", 40 | "unsigned char", 41 | "signed short", 42 | "unsigned short", 43 | "signed int", 44 | "unsigned int", 45 | "signed long", 46 | "unsigned long", 47 | "signed long long", 48 | "unsigned long long", 49 | "float", 50 | "double", 51 | "long double", 52 | ], 53 | 54 | # Scopes, separated by commas 55 | scopes => [ "LOCAL", "GLOBAL" ], 56 | 57 | # Details of types 58 | type => { 59 | "signed char" => { 60 | order => 1, 61 | printf_format => '%d', 62 | const_suffix => '', 63 | bits => 8, 64 | min => -128, 65 | max => 127, 66 | }, 67 | "unsigned char" => { 68 | order => 2, 69 | printf_format => '%u', 70 | const_suffix => 'U', 71 | bits => 8, 72 | min => 0, 73 | max => 255, 74 | }, 75 | "signed short" => { 76 | order => 3, 77 | printf_format => '%hhd', 78 | const_suffix => '', 79 | bits => 16, 80 | min => -32768, 81 | max => 32767, 82 | }, 83 | "unsigned short" => { 84 | order => 4, 85 | printf_format => '%hhu', 86 | const_suffix => 'U', 87 | bits => 16, 88 | min => 0, 89 | max => 65535, 90 | }, 91 | "signed int" => { 92 | order => 5, 93 | printf_format => '%d', 94 | const_suffix => '', 95 | bits => 32, 96 | min => -2147483648, 97 | max => 2147483647, 98 | }, 99 | "unsigned int" => { 100 | order => 6, 101 | printf_format => '%u', 102 | const_suffix => 'U', 103 | bits => 32, 104 | min => 0, 105 | max => 4294967295, 106 | }, 107 | "signed long" => { 108 | order => 7, 109 | printf_format => '%ld', 110 | const_suffix => 'L', 111 | bits => 64, 112 | min => -9223372036854775808, 113 | max => 9223372036854775807, 114 | }, 115 | "unsigned long" => { 116 | order => 8, 117 | printf_format => '%lu', 118 | const_suffix => 'LU', 119 | bits => 64, 120 | min => 0, 121 | max => '18446744073709551615', 122 | }, 123 | "signed long long" => { 124 | order => 9, 125 | printf_format => '%lld', 126 | const_suffix => 'LL', 127 | bits => 64, 128 | min => -9223372036854775808, 129 | max => 9223372036854775807, 130 | }, 131 | "unsigned long long" => { 132 | order => 10, 133 | printf_format => '%llu', 134 | const_suffix => 'LLU', 135 | bits => 64, 136 | min => 0, 137 | max => '18446744073709551615', 138 | }, 139 | "float" => { 140 | order => 11, 141 | printf_format => '%0.5e', 142 | const_suffix => 'F', 143 | bits => 24, 144 | min => -8388608, 145 | max => 8388607, 146 | }, 147 | "double" => { 148 | order => 12, 149 | printf_format => '%0.15e', 150 | const_suffix => '', 151 | bits => 53, 152 | min => -4503599627370496, 153 | max => 4503599627370495, 154 | }, 155 | "long double" => { 156 | order => 13, 157 | printf_format => '%0.17Le', 158 | const_suffix => 'L', 159 | bits => 64, 160 | min => '-9223372036854775808', 161 | max => '9223372036854775807', 162 | }, 163 | } 164 | } 165 | -------------------------------------------------------------------------------- /config/x86_64-linux-gcc-compiler.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | compile => sub { 3 | my ( $config, $option ) = @_; 4 | 5 | my $command = 6 | "$config->{compiler} $config->{source_file} -o $config->{exec_file} $option"; 7 | my $error = 0; 8 | 9 | while (1) { 10 | print STDERR "$command\n" if $config->{debug_mode}; 11 | 12 | # Execute the command 13 | my $output = `$command 2>&1`; 14 | 15 | if ( $output =~ /error/ ) { 16 | 17 | # Compiling is failed 18 | print $output; 19 | $error = $output; 20 | last; 21 | } 22 | elsif ( $output =~ /function/ ) { 23 | 24 | # Compiling is failed temporarily 25 | last; 26 | } 27 | elsif ( $output =~ /resource/ ) { 28 | 29 | # Compiling is failed temporarily 30 | ; 31 | } 32 | elsif ( $output ne '' ) { 33 | 34 | # Compiling is failed 35 | print $output; 36 | $error = $output; 37 | last; 38 | } 39 | else { 40 | # Compiling is successful 41 | last; 42 | } 43 | } 44 | 45 | # error ... Error message for LOG (Success:0, Error:message) 46 | # command ... Command for reproducing 47 | return ( $error, $command ); 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /config/x86_64-linux-gcc-executor.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | execute => sub { 3 | my $config = shift; 4 | my $exec_error = []; 5 | my $error_msg = ""; 6 | my $command = "./$config->{exec_file}"; 7 | 8 | print STDERR "$command\n" if $config->{debug_mode}; 9 | 10 | # Execute the command 11 | my $output = `$command 2>&1`; 12 | my $count = -1; 13 | 14 | unless ( $output =~ /(OK|NG)/ ) { 15 | 16 | # Executing is failed 17 | if ( $output eq "" ) { 18 | 19 | # Re-execute the command 20 | $output = `$command 2>&1 3>&1`; 21 | } 22 | if ( $output eq "" ) { 23 | 24 | # Executing is failed 25 | $output = "execution error! ($command)\n"; 26 | } 27 | print "$output\n"; 28 | 29 | # push exec_error <= -1 30 | push @$exec_error, $count; 31 | $error_msg = $output; 32 | } 33 | else { 34 | # Executing is successful 35 | my @lines = split m{\n}, $output; 36 | for my $line (@lines) { 37 | if ( $line =~ /OK/ ) { 38 | $count++; 39 | } 40 | elsif ( $line =~ /NG/ ) { 41 | $count++; 42 | print "$count: $line\n"; 43 | push @$exec_error, $count; 44 | $error_msg .= "$count: $line\n"; 45 | } 46 | else { ; } 47 | } 48 | 49 | if ( @{$exec_error} == 0 ) { 50 | print "\@OK\@"; 51 | } 52 | } 53 | 54 | # error_msg ... Error message for LOG 55 | # exec_error ... Numbers of the errored arithmetic expression 56 | # (succeess:no array elements, fail:some array elements) 57 | # command ... Command for reproducing 58 | return ( $error_msg, $exec_error, $command ); 59 | }, 60 | } 61 | -------------------------------------------------------------------------------- /config/x86_64-linux-gcc.cnf: -------------------------------------------------------------------------------- 1 | +{ 2 | debug_mode => 0, 3 | 4 | # Multiplication of number of operators and expressionis 5 | e_size_num => 10, 6 | 7 | # Option of the compiler, separated by commas 8 | options => [ "-O0", "-O3" ], 9 | 10 | # Name of C file 11 | source_file => 'x86_64-cygwin-gcc-test.c', 12 | 13 | # Name of Executable file 14 | exec_file => 'x86_64-cygwin-gcc-test.exe', 15 | 16 | # Macro (OK) of C source 17 | macro_ok => 'printf("@OK@\n")', 18 | 19 | # Macro (NG) of C source 20 | macro_ng => 'printf("@NG@ (test = " fmt ")\n",val)', 21 | 22 | # Command of the compiler 23 | compiler => 'gcc', 24 | 25 | # Operators, separated by spaces 26 | operators => [ 27 | qw(+ + + - - - * * * * * * / / / / / / % % % % % % << << << << << << >> >> >> >> >> >> == != < > <= >= && || | | | & & & ^ ^ ^) 28 | ], 29 | 30 | # Storage classes, separated by commas 31 | classes => [ "static", "" ], 32 | 33 | # Modifiers, separated by commas 34 | # ("const" is unused in some variables.) 35 | modifiers => [ "const", "volatile", "const volatile", "" ], 36 | 37 | # Types, separated by commas 38 | types => [ 39 | "signed char", 40 | "unsigned char", 41 | "signed short", 42 | "unsigned short", 43 | "signed int", 44 | "unsigned int", 45 | "signed long", 46 | "unsigned long", 47 | "signed long long", 48 | "unsigned long long", 49 | "float", 50 | "double", 51 | "long double", 52 | ], 53 | 54 | # Scopes, separated by commas 55 | scopes => [ "LOCAL", "GLOBAL" ], 56 | 57 | # Details of types 58 | type => { 59 | "signed char" => { 60 | order => 1, 61 | printf_format => '%d', 62 | const_suffix => '', 63 | bits => 8, 64 | min => -128, 65 | max => 127, 66 | }, 67 | "unsigned char" => { 68 | order => 2, 69 | printf_format => '%u', 70 | const_suffix => 'U', 71 | bits => 8, 72 | min => 0, 73 | max => 255, 74 | }, 75 | "signed short" => { 76 | order => 3, 77 | printf_format => '%hhd', 78 | const_suffix => '', 79 | bits => 16, 80 | min => -32768, 81 | max => 32767, 82 | }, 83 | "unsigned short" => { 84 | order => 4, 85 | printf_format => '%hhu', 86 | const_suffix => 'U', 87 | bits => 16, 88 | min => 0, 89 | max => 65535, 90 | }, 91 | "signed int" => { 92 | order => 5, 93 | printf_format => '%d', 94 | const_suffix => '', 95 | bits => 32, 96 | min => -2147483648, 97 | max => 2147483647, 98 | }, 99 | "unsigned int" => { 100 | order => 6, 101 | printf_format => '%u', 102 | const_suffix => 'U', 103 | bits => 32, 104 | min => 0, 105 | max => 4294967295, 106 | }, 107 | "signed long" => { 108 | order => 7, 109 | printf_format => '%ld', 110 | const_suffix => 'L', 111 | bits => 64, 112 | min => -9223372036854775808, 113 | max => 9223372036854775807, 114 | }, 115 | "unsigned long" => { 116 | order => 8, 117 | printf_format => '%lu', 118 | const_suffix => 'LU', 119 | bits => 64, 120 | min => 0, 121 | max => '18446744073709551615', 122 | }, 123 | "signed long long" => { 124 | order => 9, 125 | printf_format => '%lld', 126 | const_suffix => 'LL', 127 | bits => 64, 128 | min => -9223372036854775808, 129 | max => 9223372036854775807, 130 | }, 131 | "unsigned long long" => { 132 | order => 10, 133 | printf_format => '%llu', 134 | const_suffix => 'LLU', 135 | bits => 64, 136 | min => 0, 137 | max => '18446744073709551615', 138 | }, 139 | "float" => { 140 | order => 11, 141 | printf_format => '%0.5e', 142 | const_suffix => 'F', 143 | bits => 24, 144 | min => -8388608, 145 | max => 8388607, 146 | }, 147 | "double" => { 148 | order => 12, 149 | printf_format => '%0.15e', 150 | const_suffix => '', 151 | bits => 53, 152 | min => -4503599627370496, 153 | max => 4503599627370495, 154 | }, 155 | "long double" => { 156 | order => 13, 157 | printf_format => '%0.17Le', 158 | const_suffix => 'L', 159 | bits => 65, 160 | min => '-18446744073709551616', 161 | max => '18446744073709551615', 162 | }, 163 | } 164 | } 165 | -------------------------------------------------------------------------------- /cpanfile: -------------------------------------------------------------------------------- 1 | requires 'perl', '5.008001'; 2 | requires 'base'; 3 | requires 'Carp'; 4 | requires 'CPAN::Meta'; 5 | requires 'Data::Dumper'; 6 | requires 'Encode'; 7 | requires 'FindBin'; 8 | requires 'File::Basename'; 9 | requires 'File::Copy'; 10 | requires 'File::Spec'; 11 | requires 'File::Path'; 12 | requires 'File::Temp'; 13 | requires 'Getopt::Long'; 14 | requires 'List::MoreUtils'; 15 | requires 'Math::BigFloat'; 16 | requires 'Math::BigInt::FastCalc', '0.27'; 17 | requires 'Math::BigInt::GMP', '1.37'; 18 | requires 'Math::BigInt::Pari', '1.16'; 19 | requires 'Math::BigInt'; 20 | requires 'POSIX'; 21 | requires 'Time::HiRes'; 22 | requires 'Test::More'; 23 | 24 | on 'test' => sub { 25 | requires 'List::MoreUtils', '0.33'; 26 | requires 'Test::More', '0.98'; 27 | }; 28 | 29 | on 'configure' => sub { 30 | requires 'Module::Install'; 31 | requires 'Module::Install::CPANfile'; 32 | }; 33 | -------------------------------------------------------------------------------- /lib/Orange3.pm: -------------------------------------------------------------------------------- 1 | package Orange3; 2 | use 5.008001; 3 | use strict; 4 | use warnings; 5 | 6 | our $VERSION = "3.00"; 7 | 8 | 9 | 10 | 1; 11 | __END__ 12 | 13 | =encoding utf-8 14 | 15 | =head1 NAME 16 | 17 | Orange3 - Randomtest of C compilers 18 | 19 | =head1 About "Orange3" 20 | 21 | Orange3 is a system to test validity of C compilers by randomly 22 | generated programs. It currently aims at testing optimization 23 | regarding arithmetic expressions. 24 | 25 | Orange3 has been developed by the following persons at the compiler 26 | team of Ishiura Laboratory, School of science and Technology, Kwansei 27 | Gakuin University 28 | 29 | =head1 AUTHOR 30 | 31 | Ishiura Lab. Eishiura-compiler@ml.kwansei.ac.jpE 32 | 33 | Mr. Atsushi Hashimoto 34 | Ms. Eriko Nagai 35 | Mr. Ryo Nakamura 36 | Prof. Nagisa Ishiura 37 | 38 | =head1 INSTALLATION 39 | 40 | Please try the following command sequence. 41 | 42 | $ perl Build.PL 43 | $ ./Build 44 | $ ./Build test 45 | $ ./Build install 46 | 47 | * Internet connection is required. 48 | * If error occurs during installation, please remove Orange3 and re-download. 49 | * If copy error occurs during installation, please retry. 50 | 51 | =head1 CONFIGURATION FILES OF Orange3 52 | 53 | To use orange3, users need to specify settings in the three 54 | configuration files. In the case of the “i386_Cygwin” target. 55 | for example, the configuration files are: 56 | 57 | * i386-cygwin-gcc.cnf (general settings) 58 | * i386-cygwin-gcc-compiler.cnf (compilation settings) 59 | * i386-cygwin-gcc-executor.cnf (execution settings) 60 | 61 | We are sorry but the detailed manuals for composing the configuration 62 | files are under construction. Please copy & edit the above files. 63 | For most of the compilers and execution environments with standard 64 | I/O support, you just need to edit several lines. 65 | 66 | =head1 SYNOPSIS 67 | 68 | An "orange3" command repeats the process of generating a test program 69 | and compile & executes it. The number of tests or time for testing 70 | should be specified. 71 | 72 | $ orange3 [-c config file] [options] 73 | 74 | * OPTION 75 | 76 | -c |--config= : Config File. (must) 77 | Default: /.orangerc.cnf 78 | -n : Number of tesing. 79 | Default: 1 80 | -s : Seed number of Starting 81 | Default: 0 82 | -t : Time (hour) of testing. 83 | Cannot specify -s and -n option simultaneously. 84 | -h : Help 85 | 86 | If an error is detected, Error File Set is saved to the following 87 | directories. 88 | 89 | Directory : ./LOG// 90 | 91 | Error File Set : Report File (*.log), 92 | Config File (*.cnf), 93 | Seed information File (*.pl), 94 | Detected error C source File (*.c) 95 | 96 | =head1 MINIMIZATION OF ERROR FILE 97 | 98 | Orange3 can reduce programs that detected errors by Orange3's minimizer. 99 | 100 | =head1 SYNOPSIS OF Orange3's MINIMIZER 101 | 102 | "File" is a seed information file saved by orange3. If "Directory" is 103 | specified, add the Files in the directory and processed. 104 | 105 | $ orange3-minimizer 106 | 107 | =head1 LICENSE 108 | 109 | Copyright (C) Ishiura Lab. 110 | 111 | This library is free software; you can redistribute it and/or modify 112 | it under the same terms as Perl itself. 113 | 114 | =cut 115 | 116 | -------------------------------------------------------------------------------- /lib/Orange3/Config.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Config; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Math::BigInt; 7 | 8 | sub new { 9 | my ( $class, $file ) = @_; 10 | my $conf = do $file or die "Can't load $file: $!"; 11 | 12 | bless $conf, $class; 13 | } 14 | 15 | sub get { 16 | my ( $self, $param ) = @_; 17 | 18 | unless ( exists $self->{$param} ) { 19 | return undef; 20 | } 21 | 22 | return $self->{$param}; 23 | } 24 | 25 | sub _print_check_config { 26 | my $caution = shift; 27 | 28 | if ( $caution eq "" ) { ; } 29 | else { 30 | print <_check_config_e_size_num; 45 | $caution .= $self->_check_config_options; 46 | $caution .= $self->_check_config_source_file; 47 | $caution .= $self->_check_config_exec_file; 48 | $caution .= $self->_check_config_macro_ok; 49 | $caution .= $self->_check_config_macro_ng; 50 | $caution .= $self->_check_config_compiler; 51 | $caution .= $self->_check_config_operators; 52 | $caution .= $self->_check_config_classes; 53 | $caution .= $self->_check_config_modifiers; 54 | $caution .= $self->_check_config_types; 55 | $caution .= $self->_check_config_scopes; 56 | $caution .= $self->_check_config_type; 57 | 58 | _print_check_config($caution); 59 | } 60 | 61 | sub _check_config_type { 62 | my $self = shift; 63 | if ( !defined $self->{type} || ref($self->{type}) ne "HASH") { 64 | return _c_msg("Undefined types."); 65 | } 66 | my $caution = ""; 67 | foreach my $type ( keys %{$self->{type}} ) { 68 | if ( $type eq "" ) { 69 | return _c_msg("Undefined types."); 70 | } 71 | elsif ( $type =~ 72 | /^((signed|unsigned) (char|short|int|long|long long)|(float|double|long double))$/ 73 | ) 74 | { 75 | my $type_ = $self->{type}->{$type}; 76 | if ( !defined $type_->{order} 77 | || $type_->{order} !~ /^[0-9]+$/ ) 78 | { 79 | $caution .= _c_msg("Order of type '$type' is wrong."); 80 | } 81 | elsif ( !defined $type_->{printf_format} ) { 82 | $caution .= _c_msg("Printf_format of type '$type' is wrong."); 83 | } 84 | elsif ( !defined $type_->{const_suffix} ) { 85 | $caution .= _c_msg("Const_suffix of type '$type' is wrong."); 86 | } 87 | elsif ( !defined $type_->{bits} 88 | || $type_->{bits} !~ /^[0-9]+$/ ) 89 | { 90 | $caution .= _c_msg("Bit of type '$type' is wrong."); 91 | } 92 | elsif ( $type =~ /^(unsigned|signed)/ 93 | && ( $type_->{bits} % 4 ) != 0 ) 94 | { 95 | $caution .= _c_msg("Bit of type '$type' is not divisible by 4."); 96 | } 97 | elsif ( !defined $type_->{min} 98 | || $type_->{min} !~ /^[+-]?[0-9]+$/ ) 99 | { 100 | $caution .= _c_msg("Min of type '$type' is wrong."); 101 | } 102 | elsif ( !defined $type_->{max} 103 | || $type_->{max} !~ /^[+-]?[0-9]+$/ ) 104 | { 105 | $caution .= _c_msg("Max of type '$type' is wrong."); 106 | } 107 | elsif ( $type =~ /^(signed)/ ) { 108 | my $two_bit = Math::BigInt->new(2) << ( $type_->{bits} - 2 ); 109 | if ( $type_->{min} != -$two_bit ) { 110 | $caution .= _c_msg("Bit OR min of type '$type' may be wrong"); 111 | } 112 | if ( $type_->{max} != ( $two_bit - 1 ) ) { 113 | $caution .= _c_msg("Bit OR max of type '$type' may be wrong"); 114 | } 115 | } 116 | elsif ( $type =~ /^(unsigned)/ ) { 117 | my $two_bit = Math::BigInt->new(2) << ( $type_->{bits} - 1 ); 118 | if ( $type_->{min} != 0 ) { 119 | $caution .= _c_msg("Bit OR min of type '$type' may be wrong"); 120 | } 121 | if ( $type_->{max} != ( $two_bit - 1 ) ) { 122 | $caution .= _c_msg("Bit OR max of type '$type' may be wrong"); 123 | } 124 | } 125 | } 126 | else { 127 | return _c_msg("Type contains the unsupported type '$type'."); 128 | } 129 | } 130 | return $caution; 131 | } 132 | 133 | sub _check_config_scopes { 134 | my $self = shift; 135 | if ( !defined $self->{scopes}->[0] ) { 136 | return _c_msg("Undefined types."); 137 | } 138 | foreach my $scope ( @{ $self->{scopes} } ) { 139 | if ( $scope eq "" ) { 140 | return _c_msg("Undefined types."); 141 | } 142 | elsif ( $scope =~ /^(LOCAL|GLOBAL)$/ ) { 143 | ; 144 | } 145 | else { 146 | return _c_msg("Scopes contain the unsupported type '$scope'."); 147 | } 148 | } 149 | return ""; 150 | } 151 | 152 | sub _check_config_types { 153 | my $self = shift; 154 | if ( !defined $self->{types}->[0] ) { 155 | return _c_msg("Undefined types."); 156 | } 157 | foreach my $type ( @{ $self->{types} } ) { 158 | if ( $type eq "" ) { 159 | return _c_msg("Undefined types."); 160 | } 161 | elsif ( $type =~ 162 | /^((signed|unsigned) (char|short|int|long|long long)|(float|double|long double))$/ 163 | ) 164 | { 165 | ; 166 | } 167 | else { 168 | return _c_msg("Types contain the unsupported type '$type'."); 169 | } 170 | } 171 | return ""; 172 | } 173 | 174 | sub _check_config_modifiers { 175 | my $self = shift; 176 | if ( !defined $self->{modifiers}->[0] ) { 177 | return _c_msg("Undefined modifiers."); 178 | } 179 | foreach my $modifier ( @{ $self->{modifiers} } ) { 180 | if ( $modifier eq "" 181 | || $modifier =~ /(const|volatile)/ ) 182 | { 183 | ; 184 | } 185 | else { 186 | return _c_msg("Classes contain the unsupported class '$modifier'."); 187 | } 188 | } 189 | return ""; 190 | } 191 | 192 | sub _check_config_classes { 193 | my $self = shift; 194 | if ( !defined $self->{classes}->[0] ) { 195 | return _c_msg("Undefined classes."); 196 | } 197 | foreach my $class ( @{ $self->{classes} } ) { 198 | if ( $class eq "" 199 | || $class =~ /^(static)$/ ) 200 | { 201 | ; 202 | } 203 | else { 204 | return _c_msg("Classes contain the unsupported class '$class'."); 205 | } 206 | } 207 | return ""; 208 | } 209 | 210 | sub _check_config_operators { 211 | my $self = shift; 212 | if ( !defined $self->{operators}->[0] ) { 213 | return _c_msg("Undefined operators."); 214 | } 215 | foreach my $operator ( @{ $self->{operators} } ) { 216 | if ( $operator eq "" ) { 217 | return _c_msg("Undefined operators."); 218 | } 219 | elsif ( $operator =~ 220 | /^(\+|-|\*|\/|\%|<<|>>|==|!=|<|>|<=|>=|\&\&|\|\||\||\&|\^)$/ ) 221 | { 222 | ; 223 | } 224 | else { 225 | return _c_msg("Operators contain the unsupported operator '$operator'."); 226 | } 227 | } 228 | return ""; 229 | } 230 | 231 | sub _check_config_compiler { 232 | my $self = shift; 233 | if ( !defined $self->{compiler} 234 | || $self->{compiler} eq "" ) 235 | { 236 | return _c_msg("Undefined source_file."); 237 | } 238 | elsif ( system "which $self->{compiler} > /dev/null" ) { 239 | return _c_msg("Compiler Command '$self->{compiler}' is not found."); 240 | } 241 | else { 242 | return ""; 243 | } 244 | } 245 | 246 | sub _check_config_macro_ng { 247 | my $self = shift; 248 | if ( !defined $self->{macro_ng} 249 | || $self->{macro_ng} eq "" ) 250 | { 251 | return _c_msg("Undefined source_file."); 252 | } 253 | elsif ( $self->{macro_ng} !~ /NG|abort/ ) { 254 | return _c_msg( 255 | "macro_ng does not contain 'NG' word. Please rewrite the executor.cnf" ); 256 | } 257 | else { 258 | return ""; 259 | } 260 | } 261 | 262 | sub _check_config_macro_ok { 263 | my $self = shift; 264 | if ( !defined $self->{macro_ok} 265 | || $self->{macro_ok} eq "" ) 266 | { 267 | return _c_msg("Undefined source_file."); 268 | } 269 | elsif ( $self->{macro_ok} !~ /OK/ ) { 270 | return _c_msg( 271 | "macro_ok does not contain 'OK' word. Please rewrite the executor.cnf" ); 272 | } 273 | else { 274 | return ""; 275 | } 276 | } 277 | 278 | sub _check_config_exec_file { 279 | my $self = shift; 280 | if ( !defined $self->{exec_file} 281 | || $self->{exec_file} eq "" ) 282 | { 283 | return _c_msg("Undefined source_file."); 284 | } 285 | elsif ( $self->{exec_file} =~ /\s|\$|\%|\'|\@|\!|\`|\(|\)|\~/ ) { 286 | return _c_msg("Source_file contain the special character."); 287 | } 288 | else { 289 | return ""; 290 | } 291 | } 292 | 293 | sub _check_config_source_file { 294 | my $self = shift; 295 | if ( !defined $self->{source_file} 296 | || $self->{source_file} eq "" ) 297 | { 298 | return _c_msg("Undefined source_file."); 299 | } 300 | elsif ( $self->{source_file} =~ /\s|\$|\%|\'|\@|\!|\`|\(|\)|\~/ ) { 301 | return _c_msg("Source_file contain the special character."); 302 | } 303 | else { 304 | return ""; 305 | } 306 | } 307 | 308 | sub _check_config_options { 309 | my $self = shift; 310 | if ( !defined $self->{options}->[0] ) { 311 | $self->{options}->[0] = ""; 312 | return _c_msg( 313 | "Undefined options. No-string element is added to the array of options."); 314 | } 315 | foreach my $option ( @{ $self->{options} } ) { 316 | if ( $option eq "" ) { 317 | ; 318 | } 319 | elsif ( $option =~ /\s|\$|\%|\'|\@|\!|\`|\(|\)|\~/ ) { 320 | return _c_msg("Options contain the special character."); 321 | } 322 | } 323 | return ""; 324 | } 325 | 326 | sub _c_msg { 327 | my $massage = shift; 328 | return "! $massage\n"; 329 | } 330 | 331 | sub _check_config_e_size_num { 332 | my $self = shift; 333 | 334 | if ( !defined $self->{e_size_num} ) { 335 | return _c_msg("Undefined e_size_num."); 336 | } 337 | elsif ( $self->{e_size_num} > 10000 ) { 338 | return _c_msg("! e_size_num is too big."); 339 | } 340 | elsif ( $self->{e_size_num} < 1 341 | || $self->{e_size_num} !~ /^[0-9]+$/ ) 342 | { 343 | return _c_msg("! e_size_num is wrong."); 344 | } 345 | elsif ( $self->{e_size_num} > 0 346 | && $self->{e_size_num} < 10000 ) 347 | { 348 | return ""; 349 | } 350 | else { 351 | Carp::croak("! e_size_num is wrong."); 352 | } 353 | } 354 | 355 | 1; 356 | -------------------------------------------------------------------------------- /lib/Orange3/Dumper.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Dumper; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Carp (); 7 | use Math::BigInt; 8 | 9 | sub new { 10 | my ( $class, %args ) = @_; 11 | 12 | for my $key (qw(vars roots)) { 13 | unless ( exists $args{$key} ) { 14 | Carp::croak("Missing mandatory parameter: $key"); 15 | } 16 | } 17 | 18 | my $vars = delete $args{vars}; 19 | my $roots = delete $args{roots}; 20 | 21 | bless { 22 | vars => $vars, 23 | roots => $roots, 24 | %args 25 | }, $class; 26 | } 27 | 28 | sub all { 29 | my ( $self, %args ) = @_; 30 | 31 | my @params; 32 | for my $key ( keys %args ) { 33 | push @params, "$key => $args{$key},"; 34 | } 35 | return join "\n", "+{", @params, $self->_vars, $self->_roots, "}"; 36 | } 37 | 38 | sub vars_and_roots { 39 | my $self = shift; 40 | 41 | return join "\n", $self->_vars, $self->_roots; 42 | } 43 | 44 | sub _vars { 45 | my $self = shift; 46 | 47 | my $varset = $self->{vars}; 48 | 49 | my $s = "vars => [\n"; 50 | my $indent = ' '; 51 | my $n = "\n"; 52 | 53 | for my $i ( 0 .. $#{$varset} ) { 54 | $s .= "{\n"; 55 | my $v = $varset->[$i]; 56 | $s .= $indent . "'type'=>'$v->{type}'," . $n; 57 | if ( ref $v->{val} ne 'Math::BigInt' ) { 58 | $s .= $indent . "'ival'=>'$v->{ival}'," . $n; 59 | } 60 | else { 61 | $s .= $indent . "'ival'=>" . _bigint_dumper( $v->{ival} ) . "," . $n; 62 | } 63 | if ( ref $v->{val} ne 'Math::BigInt' ) { 64 | $s .= $indent . "'val'=>'$v->{val}'," . $n; 65 | } 66 | else { 67 | $s .= $indent . "'val'=>" . _bigint_dumper( $v->{val} ) . "," . $n; 68 | } 69 | $s .= $indent . "'name_type'=>'$v->{name_type}'," . $n; 70 | $s .= $indent . "'name_num'=>'$v->{name_num}'," . $n; 71 | $s .= $indent . "'class'=>'$v->{class}'," . $n; 72 | $s .= $indent . "'modifier'=>'$v->{modifier}'," . $n; 73 | $s .= $indent . "'scope'=>'$v->{scope}'," . $n; 74 | $s .= $indent . "'used'=>'$v->{used}'," . $n; 75 | $s .= "}," . $n; 76 | } 77 | 78 | $s .= "],"; 79 | 80 | return $s; 81 | } 82 | 83 | sub _bigint_dumper { 84 | my $val = shift; 85 | 86 | # my $sign = $val->sign; 87 | # my $value = $val->babs->bstr; # destructive... 88 | 89 | # my $content = "bless({'value'=>[$value], 'sign'=>'$sign'}, 'Math::BigInt')"; 90 | my $content = "'$val'"; 91 | 92 | return $content; 93 | } 94 | 95 | sub _roots { 96 | my $self = shift; 97 | 98 | my $roots = $self->{roots}; 99 | 100 | my $s = "roots => [\n"; 101 | my $indent = ' '; 102 | my $new_indent = ' '; 103 | my $indent1 = $indent . $new_indent x 2; 104 | my $n = "\n"; 105 | 106 | for my $i ( 0 .. $#{$roots} ) { 107 | if ( $roots->[$i]->{st_type} eq 'assign' ) { 108 | $s .= '{' . $n; 109 | $s .= $indent . "'val'=>'$roots->[$i]->{val}'," . $n; 110 | $s .= $indent . "'type'=>'$roots->[$i]->{type}'," . $n; 111 | $s .= $indent . "'st_type'=>'$roots->[$i]->{st_type}'," . $n; 112 | $s .= 113 | $indent . "'print_statement'=>'$roots->[$i]->{print_statement}'," . $n; 114 | $s .= $indent . "'var'=>{" . $n; 115 | $s .= $indent1 . "'type'=>'$roots->[$i]->{var}->{type}'," . $n; 116 | if ( ref $roots->[$i]->{var}->{ival} ne 'Math::BigInt' ) { 117 | $s .= $indent1 . "'ival'=>'$roots->[$i]->{var}->{ival}'," . $n; 118 | } 119 | else { 120 | $s .= 121 | $indent1 122 | . "'ival'=>" 123 | . _bigint_dumper( $roots->[$i]->{var}->{ival} ) . "," 124 | . $n; 125 | } 126 | if ( ref $roots->[$i]->{var}->{val} ne 'Math::BigInt' ) { 127 | $s .= $indent1 . "'val'=>'$roots->[$i]->{var}->{val}'," . $n; 128 | } 129 | else { 130 | $s .= 131 | $indent1 132 | . "'val'=>" 133 | . _bigint_dumper( $roots->[$i]->{var}->{val} ) . "," 134 | . $n; 135 | } 136 | $s .= $indent1 . "'name_type'=>'$roots->[$i]->{var}->{name_type}'," . $n; 137 | $s .= $indent1 . "'name_num'=>'$roots->[$i]->{var}->{name_num}'," . $n; 138 | $s .= $indent1 . "'class'=>'$roots->[$i]->{var}->{class}'," . $n; 139 | $s .= $indent1 . "'modifier'=>'$roots->[$i]->{var}->{modifier}'," . $n; 140 | $s .= $indent1 . "'scope'=>'$roots->[$i]->{var}->{scope}'," . $n; 141 | $s .= $indent . "}," . $n; 142 | $s .= $indent . "'root' => {" . $n; 143 | 144 | if ( $roots->[$i]->{print_statement} ) { 145 | $s .= _root_dumper( $roots->[$i]->{root}, $indent ); 146 | } 147 | $s .= $indent . "}," . $n; 148 | $s .= '},' . $n; 149 | } 150 | else { 151 | $s .= 'undef;' . $n; 152 | } 153 | } 154 | 155 | $s .= "],"; 156 | 157 | return $s; 158 | } 159 | 160 | sub _root_dumper { 161 | my ( $ref, $indent ) = @_; 162 | 163 | my $s = ''; 164 | my $new_indent = ' '; 165 | my $indent1 = $indent . $new_indent x 2; 166 | my $indent2 = $indent . $new_indent x 3; 167 | my $indent3 = $indent . $new_indent x 4; 168 | my $n = "\n"; 169 | 170 | $s .= $indent . "'out'=>{" . $n; 171 | if ( ref $ref->{val} ne 'Math::BigInt' ) { 172 | $s .= $indent1 . "'val'=>'$ref->{out}->{val}'," . $n; 173 | } 174 | else { 175 | $s .= 176 | $indent1 . "'val'=>" . _bigint_dumper( $ref->{out}->{val} ) . "," . $n; 177 | } 178 | $s .= $indent1 . "'type'=>'$ref->{out}->{type}'," . $n; 179 | $s .= $indent . "}," . $n; 180 | 181 | $s .= $indent . "'ntype'=>'$ref->{ntype}'," . $n; 182 | 183 | if ( $ref->{ntype} eq 'op' ) { 184 | $s .= $indent . "'otype'=>'$ref->{otype}'," . $n; 185 | $s .= $indent . "'ins_add'=>'$ref->{ins_add}'," . $n 186 | if ( defined( $ref->{ins_add} ) ); 187 | $s .= $indent . "'in'=>[" . $n; 188 | for my $r ( @{ $ref->{in} } ) { 189 | $s .= $indent1 . "{" . $n; 190 | $s .= $indent2 . "'print_value'=>$r->{print_value}," . $n; 191 | if ( ref $r->{val} ne 'Math::BigInt' ) { 192 | $s .= $indent2 . "'val'=>'$r->{val}'," . $n; 193 | } 194 | else { 195 | $s .= $indent2 . "'val'=>" . _bigint_dumper( $r->{val} ) . "," . $n; 196 | } 197 | $s .= $indent2 . "'type'=>'$r->{type}'," . $n; 198 | $s .= $indent2 . "'ref'=>{" . $n; 199 | $s .= _root_dumper( $r->{ref}, $indent3 ); 200 | $s .= $indent2 . "}," . $n; 201 | $s .= $indent1 . "}," . $n; 202 | } 203 | $s .= $indent . "]," . $n; 204 | } 205 | elsif ( $ref->{ntype} eq 'var' ) { 206 | $s .= $indent . "'var'=>{" . $n; 207 | $s .= $indent1 . "'type'=>'$ref->{var}->{type}'," . $n; 208 | if ( ref $ref->{var}->{ival} ne 'Math::BigInt' ) { 209 | $s .= $indent1 . "'ival'=>'$ref->{var}->{ival}'," . $n; 210 | } 211 | else { 212 | $s .= 213 | $indent1 214 | . "'ival'=>" 215 | . _bigint_dumper( $ref->{var}->{ival} ) . "," 216 | . $n; 217 | } 218 | if ( ref $ref->{var}->{val} ne 'Math::BigInt' ) { 219 | $s .= $indent1 . "'val'=>'$ref->{var}->{val}'," . $n; 220 | } 221 | else { 222 | $s .= 223 | $indent1 . "'val'=>" . _bigint_dumper( $ref->{var}->{val} ) . "," . $n; 224 | } 225 | $s .= $indent1 . "'name_type'=>'$ref->{var}->{name_type}'," . $n; 226 | $s .= $indent1 . "'name_num'=>'$ref->{var}->{name_num}'," . $n; 227 | $s .= $indent1 . "'class'=>'$ref->{var}->{class}'," . $n; 228 | $s .= $indent1 . "'modifier'=>'$ref->{var}->{modifier}'," . $n; 229 | $s .= $indent1 . "'scope'=>'$ref->{var}->{scope}'," . $n; 230 | $s .= $indent . "}," . $n; 231 | } 232 | else { 233 | Carp::croak("$ref->{ntype} is undefined"); 234 | } 235 | 236 | return $s; 237 | } 238 | 239 | 1; 240 | 241 | -------------------------------------------------------------------------------- /lib/Orange3/Generator/Convert.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Generator::Convert; 2 | 3 | # Generator/Convert 4 | # To reverse the comparison operator for the undefined behavior avoidance 5 | # (division by zero, zero remainder calculation measures) 6 | sub change_relational_operators { 7 | my ($n) = @_; 8 | my $in1_ref = $n->{in}->[1]->{ref}; 9 | my $otype = $in1_ref->{otype}; 10 | 11 | if ( $otype eq '<' ) { $n->{in}->[1]->{ref}->{otype} = '>='; } 12 | elsif ( $otype eq '>' ) { $n->{in}->[1]->{ref}->{otype} = '<='; } 13 | elsif ( $otype eq '<=' ) { $n->{in}->[1]->{ref}->{otype} = '>'; } 14 | elsif ( $otype eq '>=' ) { $n->{in}->[1]->{ref}->{otype} = '<'; } 15 | elsif ( $otype eq '==' ) { $n->{in}->[1]->{ref}->{otype} = '!='; } 16 | elsif ( $otype eq '!=' ) { $n->{in}->[1]->{ref}->{otype} = '=='; } 17 | else { die; } 18 | 19 | } 20 | 21 | sub change_div_to_mod { 22 | my ($n) = @_; 23 | my $in1_ref = $n->{in}->[1]->{ref}; 24 | my $otype = $in1_ref->{otype}; 25 | 26 | if ( $otype eq '/' ) { $n->{in}->[1]->{ref}->{otype} = '%'; } 27 | else { die; } 28 | 29 | } 30 | 31 | # Four arithmetic operations for the undefined behavior avoidance, 32 | # the shift operator to reverse (overflow measures) 33 | sub change_arithmetic_operators { 34 | my ($n) = @_; 35 | my $otype = $n->{otype}; 36 | 37 | if ( $otype eq '+' ) { $n->{otype} = '-'; } 38 | elsif ( $otype eq '-' ) { $n->{otype} = '+'; } 39 | elsif ( $otype eq '*' ) { $n->{otype} = '/'; } 40 | elsif ( $otype eq '/' ) { $n->{otype} = '*'; } 41 | elsif ( $otype eq '<<' ) { $n->{otype} = '>>'; } 42 | elsif ( $otype eq '>>' ) { $n->{otype} = '<<'; } 43 | else { die; } 44 | 45 | } 46 | 47 | # Because of undefined behavior avoidance, 48 | # to change the value of the analysis leaves 49 | sub change_value { 50 | my ( $n, $min, $max, $varset ) = @_; 51 | my $n_ref = $n->{ref}; 52 | my $ref_type = $n_ref->{out}->{type}; 53 | my $val = &random_range( $max, $min, $ref_type ); 54 | my $num_new_var = scalar @$varset; 55 | my $rand_classes = rand @CLASSES; 56 | my $rand_modifiers = rand @MODIFIERS; 57 | my $scopes = rand @SCOPES; 58 | 59 | my $new_var = { 60 | name_type => "x", 61 | name_num => $num_new_var, 62 | type => $ref_type, 63 | ival => $val, 64 | val => $val, 65 | class => $CLASSES[$rand_classes], 66 | modifier => $MODIFIERS[$rand_modifiers], 67 | scope => $SCOPES[$scopes], 68 | used => 1, 69 | }; 70 | 71 | push @$varset, $new_var; 72 | 73 | $n->{ref}->{var} = $new_var; 74 | $n->{ref}->{out}->{type} = $new_var->{type}; 75 | $n->{ref}->{out}->{val} = $new_var->{val}; 76 | } 77 | 78 | 1; 79 | -------------------------------------------------------------------------------- /lib/Orange3/Generator/Expect.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Generator::Expect; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Orange3::Generator::Arithmetic; 7 | 8 | sub value_compute { 9 | my ( $n, $varset, $config, $avoide_undef ) = @_; 10 | 11 | if ( $n->{ntype} eq 'var' ) { 12 | $n->{out}->{val} = $n->{var}->{val}; 13 | } 14 | elsif ( $n->{ntype} eq 'op' ) { 15 | for my $i ( @{ $n->{in} } ) { 16 | if ( $i->{print_value} == 0 ) { 17 | value_compute( $i->{ref}, $varset, $config, $avoide_undef ); 18 | } 19 | if ( $i->{print_value} <= 1 ) { 20 | $i->{val} = $i->{ref}->{out}->{val}; 21 | } 22 | if ( $i->{val} eq "UNDEF" ) { 23 | $n->{out}->{val} = "UNDEF"; 24 | return; 25 | } 26 | } 27 | 28 | my $arithmetic = Orange3::Generator::Arithmetic->new( 29 | config => $config, 30 | avoide_undef => $avoide_undef, 31 | ); 32 | 33 | for my $l ( @{ $n->{in} } ) { 34 | if ( $l->{print_value} <= 1 ) { 35 | $l->{val} = $arithmetic->value_conversion( 36 | $l->{ref}->{out}->{val}, 37 | $l->{ref}->{out}->{type}, 38 | $l->{type} 39 | ); 40 | } 41 | } 42 | 43 | $n->{out}->{val} = $arithmetic->arithmetic_expectation_value( $n, $varset ); 44 | } 45 | } 46 | 47 | 1; 48 | -------------------------------------------------------------------------------- /lib/Orange3/Generator/Program.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Generator::Program; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Carp (); 7 | 8 | sub new { 9 | my ( $class, $config ) = @_; 10 | 11 | bless { config => $config }, $class; 12 | 13 | } 14 | 15 | sub _check_structure { 16 | my ( $self, $roots ) = @_; 17 | 18 | foreach my $i ( 0 .. $#{$roots} ) { 19 | my $root_i = $roots->[$i]; 20 | if ( defined( $root_i->{st_type} ) ) { 21 | if ( defined( $root_i->{val} ) ) { ; } 22 | else { Carp::croak("undefined val($i)"); } 23 | if ( defined( $root_i->{type} ) ) { ; } 24 | else { Carp::croak("undefined type($i)"); } 25 | 26 | if ( $root_i->{st_type} eq 'assign' ) { 27 | if ( defined( $root_i->{print_statement} ) 28 | && $root_i->{print_statement} ) 29 | { 30 | if ( $root_i->{var}->{type} eq $root_i->{type} ) { ; } 31 | else { Carp::croak("type ne assgign-var-type($i)"); } 32 | if ( $root_i->{var}->{val} eq $root_i->{val} ) { ; } 33 | else { Carp::croak("val ne assgign-var-val($i)"); } 34 | if ( defined( $root_i->{root}->{out}->{type} ) ) { ; } 35 | else { Carp::croak("undefined root-out-type($i)"); } 36 | if ( defined( $root_i->{root}->{out}->{val} ) ) { ; } 37 | else { Carp::croak("undefined root-out-val($i)"); } 38 | if ( defined( $root_i->{root}->{ntype} ) ) { ; } 39 | else { Carp::croak("undefined root-ntype($i)"); } 40 | if ( defined( $root_i->{root}->{otype} ) ) { ; } 41 | else { Carp::croak("undefined root-otype($i)"); } 42 | if ( $root_i->{root}->{out}->{type} eq $root_i->{type} ) { ; } 43 | else { Carp::croak("type ne root-out-type($i)"); } 44 | if ( $root_i->{root}->{out}->{val} eq $root_i->{val} ) { ; } 45 | else { Carp::croak("val ne root-out-val($i)"); } 46 | } 47 | elsif ( defined( $root_i->{print_statement} ) 48 | && !$root_i->{print_statement} ) 49 | { 50 | ; 51 | } 52 | else { Carp::croak("undefined print_statement($i)"); } 53 | if ( defined( $root_i->{var} ) ) { ; } 54 | else { Carp::croak("undefined assgign-var($i)"); } 55 | if ( defined( $root_i->{type} ) ) { ; } 56 | else { Carp::croak("undefined assgign-type($i)"); } 57 | if ( defined( $root_i->{val} ) ) { ; } 58 | else { Carp::croak("undefined assgign-val($i)"); } 59 | } 60 | else { 61 | Carp::croak("unexpected st_type($i)"); 62 | } 63 | } 64 | else { 65 | Carp::croak("undefined st_type($i)"); 66 | } 67 | } 68 | } 69 | 70 | sub generate_program { 71 | my ( $self, $varset, $roots ) = @_; 72 | 73 | my $config = $self->{config}; 74 | my %declared_name = (); 75 | my $COMPARE; 76 | my $specifier; 77 | my $specification_part; 78 | my $suffix = ''; 79 | 80 | my $DR_mode = 1; 81 | my $GLOBAL_VAR_DECLARATION = ""; 82 | my $LOCAL_VAR_DECLARATION = ""; 83 | 84 | my $flt_eq = ""; 85 | my $dbl_eq = ""; 86 | my $ldbl_eq = ""; 87 | my $abs = ""; 88 | my $max = ""; 89 | 90 | my $header = ""; 91 | 92 | my $macrosd = ""; 93 | my $MACROS = ""; 94 | my $MACROS_2 = ""; 95 | 96 | my $func_arg = ""; 97 | my $func_par = ""; 98 | 99 | my $tests = ""; 100 | my $funcr = ""; 101 | 102 | my $gvar_set = []; 103 | my $lvar_set = []; 104 | my $test_name = ""; 105 | my $test = ""; 106 | my $check = ""; 107 | my $fmt = ""; 108 | 109 | my $macro_ok = $config->get('macro_ok'); 110 | my $macro_ng = $config->get('macro_ng'); 111 | $MACROS = "#include \n"; 112 | $macrosd .= "#define OK() $macro_ok\n"; 113 | $macrosd .= "#define NG(fmt,val) $macro_ng\n"; 114 | 115 | $MACROS .= $macrosd; 116 | 117 | chomp($MACROS); 118 | chomp($MACROS_2); 119 | chomp($header); 120 | 121 | # root structure check 122 | $self->_check_structure($roots); 123 | 124 | # not display variables that are not used 125 | $self->reset_varset_used( $varset, $roots ); 126 | 127 | my $i = 0; 128 | for my $statement (@$roots) { 129 | if ( $statement->{print_statement} && $statement->{st_type} eq 'assign' ) { 130 | 131 | my $type = $statement->{root}->{out}->{type}; 132 | $self->mark_used_vars( $statement->{root}, $varset ); 133 | $test_name = "t$i"; 134 | $test .= "\t$test_name = @{[$self->tree_sprint($statement->{root})]};\n"; 135 | 136 | if ( $statement->{print_statement} == 1 ) { 137 | my $val = Math::BigInt->new(0); 138 | $val = $self->val_with_suffix( $statement->{root}->{out}->{val}, 139 | $statement->{root}->{out}->{type} ); 140 | $specifier = $self->{config}->get('type')->{$type}->{printf_format}; 141 | $COMPARE = "$test_name == $val"; 142 | $fmt = "\"@{[$specifier]}\""; 143 | $check .= "\tif ($COMPARE) { OK(); } "; 144 | $check .= "else { NG($fmt, t$i); }\n"; 145 | } 146 | } 147 | $i++; 148 | } 149 | 150 | for my $k (@$varset) { 151 | $k->{used} = 0 unless ( defined( $k->{used} ) ); 152 | push @$lvar_set, $k if ( $k->{scope} eq "LOCAL" ); 153 | push @$gvar_set, $k if ( $k->{scope} eq "GLOBAL" ); 154 | } 155 | 156 | # DR_mode:2 CLASS:extern(Forcing) 157 | $GLOBAL_VAR_DECLARATION = 158 | $self->make_c_var_declaration( $DR_mode, $gvar_set, '' ); 159 | $LOCAL_VAR_DECLARATION = 160 | $self->make_c_var_declaration( $DR_mode, $lvar_set, "\t" ); 161 | 162 | chomp($LOCAL_VAR_DECLARATION); 163 | chomp($GLOBAL_VAR_DECLARATION); 164 | 165 | # Program ############################### 166 | 167 | my $C_PROGRAM_1 = ( $header eq "" ) ? "" : $header . "\n\n"; 168 | $C_PROGRAM_1 .= ( $MACROS eq "" ) ? "" : $MACROS . "\n\n"; 169 | $C_PROGRAM_1 .= 170 | ( $GLOBAL_VAR_DECLARATION eq "" ) ? "" : $GLOBAL_VAR_DECLARATION . "\n"; 171 | my $C_PROGRAM_2 = 172 | ( $LOCAL_VAR_DECLARATION eq "" ) ? "" : $LOCAL_VAR_DECLARATION . "\n\n"; 173 | $C_PROGRAM_2 .= ( $test eq "" ) ? "" : $test . "\n"; 174 | $C_PROGRAM_2 .= ( $check eq "" ) ? "" : $check . ""; 175 | my $C_PROGRAM = <<"__END__"; 176 | $C_PROGRAM_1 177 | int main (void) 178 | { 179 | $C_PROGRAM_2 180 | return 0; 181 | } 182 | __END__ 183 | system "rm -f $config->{source_file} > /dev/null"; 184 | my $source_file = $self->{config}->get('source_file'); 185 | open( OUT, ">$source_file" ); 186 | print OUT "$C_PROGRAM"; 187 | close OUT; 188 | $self->{program} = $C_PROGRAM; 189 | } 190 | 191 | sub reset_varset_used { 192 | my ( $self, $varset, $roots ) = @_; 193 | 194 | #varsetis Hashed (Speeding up) 195 | my $varset_hash = $self->hash_varset($varset); 196 | for my $var (@$varset) { 197 | $var->{used} = 0; 198 | } 199 | $self->_hash_from_root( $roots, $varset_hash ); 200 | $self->_check_used_from_hash( $roots, $varset_hash ); 201 | } 202 | 203 | sub _hash_from_root { 204 | my ( $self, $roots, $varset_hash ) = @_; 205 | for my $i ( 0 .. $#{$roots} ) { 206 | my $root_i = $roots->[$i]; 207 | if ( $root_i->{print_statement} && $root_i->{st_type} eq 'assign' ) { 208 | $self->reset_varset_used2( $root_i->{root}, $varset_hash ); 209 | } 210 | } 211 | } 212 | 213 | sub _check_used_from_hash { 214 | my ( $self, $roots, $varset_hash ) = @_; 215 | for my $i ( 0 .. $#{$roots} ) { 216 | my $root_i = $roots->[$i]; 217 | if ( $root_i->{print_statement} && $root_i->{st_type} eq 'assign' ) { 218 | my $key = 't' . $i; 219 | $$varset_hash{$key}->{used} = 1; 220 | } 221 | } 222 | } 223 | 224 | sub hash_varset { 225 | my ( $self, $varset ) = @_; 226 | 227 | my %varset_hash = (); 228 | for my $var (@$varset) { 229 | my $key = $var->{name_type} . $var->{name_num}; 230 | $varset_hash{$key} = $var; 231 | } 232 | 233 | return \%varset_hash; 234 | } 235 | 236 | sub reset_varset_used2 { 237 | my ( $self, $n, $varset_hash ) = @_; 238 | 239 | unless ( defined( $n->{ntype} ) ) { 240 | Carp::croak("ntype is undefined"); 241 | } 242 | 243 | if ( $n->{ntype} eq 'op' ) { 244 | for my $r ( @{ $n->{in} } ) { 245 | if ( $r->{print_value} == 0 ) { 246 | if ( $r->{ref}->{ntype} eq 'var' ) { 247 | my $key = 248 | "$r->{ref}->{var}->{name_type}" . "$r->{ref}->{var}->{name_num}"; 249 | $$varset_hash{$key}->{used} = 1; 250 | } 251 | else { 252 | $self->reset_varset_used2( $r->{ref}, $varset_hash ); 253 | } 254 | } 255 | } 256 | } 257 | } 258 | 259 | sub mark_used_vars { 260 | my ( $self, $ref, $var_set ) = @_; 261 | 262 | if ( $ref->{ntype} eq "var" ) { 263 | ; 264 | } 265 | else { 266 | for my $k ( @{ $ref->{in} } ) { 267 | if ( $k->{ref}->{ntype} eq "op" ) { 268 | if ( $k->{print_value} == 2 ) { ; } 269 | elsif ( $k->{print_value} == 1 ) { 270 | $k->{ref}->{var}->{used} = 1; 271 | } 272 | else { 273 | my $all_two = 1; 274 | for my $i ( @{ $ref->{in} } ) { 275 | 276 | # When all of the child print_value is "2" 277 | if ( $i->{print_value} != 2 ) { 278 | $all_two = 0; 279 | } 280 | if ( $all_two == 1 ) { 281 | $k->{ref}->{var}->{used} = 1; 282 | } 283 | 284 | } 285 | 286 | # when print_value is "0" 287 | $self->mark_used_vars( $k->{ref}, $var_set ); 288 | } 289 | } 290 | elsif ( $k->{ref}->{ntype} eq "var" ) { 291 | if ( $k->{print_value} != 2 ) { 292 | $k->{ref}->{var}->{used} = 1; 293 | } 294 | } 295 | } 296 | } 297 | } 298 | 299 | # display tree 300 | # Tree.pm or Dumper.pm 301 | sub tree_sprint { 302 | my ( $self, $n ) = @_; 303 | 304 | my $k; 305 | my $s = ""; 306 | 307 | if ( $n->{ntype} eq 'var' ) { 308 | 309 | $s .= "$n->{var}->{name_type}" . "$n->{var}->{name_num}"; 310 | } 311 | elsif ( $n->{ntype} eq 'op' ) { 312 | my $print_value; 313 | if ( $n->{otype} eq '(signed int)' ) { 314 | $s .= "("; 315 | $s .= "(signed int)"; 316 | 317 | for my $l ( @{ $n->{in} } ) { 318 | $print_value = $l->{print_value}; 319 | if ( $print_value == 0 ) { 320 | my $h = $l->{ref}; 321 | $s .= $self->tree_sprint($h); 322 | } 323 | elsif ( $print_value == 1 ) { 324 | my $o = $l->{ref}->{out}; 325 | $s .= 326 | "($o->{type}) " . $self->val_with_suffix( $o->{val}, $o->{type} ); 327 | } 328 | elsif ( $print_value == 2 ) { 329 | $s .= 330 | "($l->{type})" . $self->val_with_suffix( $l->{val}, $l->{type} ); 331 | } 332 | else { 333 | Carp::croak("Invalid print_value: $print_value"); 334 | } 335 | } 336 | $s .= ")"; 337 | } 338 | else { 339 | $s .= "("; 340 | 341 | $print_value = $n->{in}->[0]->{print_value}; 342 | if ( $print_value == 0 ) { 343 | my $h = $n->{in}->[0]->{ref}; 344 | $s .= $self->tree_sprint($h); 345 | } 346 | elsif ( $print_value == 1 ) { 347 | my $o; 348 | if ( $n->{in}->[0]->{ref}->{ntype} eq 'op' ) { 349 | $o = $n->{in}->[0]->{ref}->{out}; 350 | } 351 | elsif ( $n->{in}->[0]->{ref}->{ntype} eq 'var' ) { 352 | 353 | # $o = $n->{in}->[0]->{ref}->{var}; 354 | $o = $n->{in}->[0]->{ref}->{out}; # 20141031 355 | } 356 | else { 357 | Carp::croak("Invalid ntype: $n->{in}->[0]->{ntype}"); 358 | } 359 | $s .= "($o->{type})" . $self->val_with_suffix( $o->{val}, $o->{type} ); 360 | } 361 | elsif ( $print_value == 2 ) { 362 | $s .= 363 | "($n->{in}->[0]->{type})" 364 | . $self->val_with_suffix( $n->{in}->[0]->{val}, 365 | $n->{in}->[0]->{type} ); 366 | } 367 | else { 368 | Carp::croak("Invalid print_value: $print_value"); 369 | } 370 | 371 | $s .= "$n->{otype}"; 372 | 373 | $print_value = $n->{in}->[1]->{print_value}; 374 | if ( $print_value == 0 ) { 375 | my $h = $n->{in}->[1]->{ref}; 376 | $s .= $self->tree_sprint($h); 377 | } 378 | elsif ( $print_value == 1 ) { 379 | my $o; 380 | if ( $n->{in}->[1]->{ref}->{ntype} eq 'op' ) { 381 | $o = $n->{in}->[1]->{ref}->{out}; 382 | } 383 | elsif ( $n->{in}->[1]->{ref}->{ntype} eq 'var' ) { 384 | $o = $n->{in}->[1]->{ref}->{var}; 385 | } 386 | else { 387 | Carp::croak("Invalid ntype: $n->{in}->[1]->{ntype}"); 388 | } 389 | $s .= "($o->{type})" . $self->val_with_suffix( $o->{val}, $o->{type} ); 390 | } 391 | elsif ( $print_value == 2 ) { 392 | $s .= 393 | "($n->{in}->[1]->{type})" 394 | . $self->val_with_suffix( $n->{in}->[1]->{val}, 395 | $n->{in}->[1]->{type} ); 396 | } 397 | else { 398 | Carp::croak("Invalid print_value: $print_value"); 399 | } 400 | 401 | $s .= ")"; 402 | } 403 | } 404 | else { 405 | Carp::croak("Invalid type: $n->{ntype}"); 406 | } 407 | 408 | return $s; 409 | } 410 | 411 | sub val_with_suffix { 412 | my ( $self, $val, $type ) = @_; 413 | 414 | my $config = $self->{config}; 415 | if ( $type eq 'float' || $type eq 'double' || $type eq 'long double' ) { 416 | if ( $val !~ /\./ && $val !~ /e/ ) { 417 | $val .= '.0'; 418 | } 419 | } 420 | 421 | return $val . $config->get('type')->{$type}->{const_suffix}; 422 | } 423 | 424 | sub make_c_var_declaration { 425 | my ( $self, $DR_mode, $var_set, $indent ) = @_; 426 | 427 | my $declaration = ""; 428 | 429 | for my $k (@$var_set) { 430 | my $val = $self->val_with_suffix( $k->{ival}, $k->{type} ); 431 | if ( $k->{name_type} eq "t" ) { 432 | if ( $k->{used} == 1 ) { 433 | $declaration .= $indent; 434 | $declaration .= "$k->{class} " 435 | if ( $DR_mode == 1 && $k->{class} ne '' ); 436 | $declaration .= "extern " if ( $DR_mode == 2 ); 437 | $declaration .= "$k->{modifier} " if ( $k->{modifier} ne '' ); 438 | $declaration .= "$k->{type} "; 439 | $declaration .= "$k->{name_type}" . "$k->{name_num}"; 440 | $declaration .= " = $val" unless ( $DR_mode == 2 ); 441 | $declaration .= ";\n"; 442 | } 443 | } 444 | else { 445 | if ( $k->{used} == 1 ) { 446 | $declaration .= $indent; 447 | $declaration .= "$k->{class} " 448 | if ( $DR_mode == 1 && $k->{class} ne '' ); 449 | $declaration .= "extern " if ( $DR_mode == 2 ); 450 | $declaration .= "$k->{modifier} " if ( $k->{modifier} ne '' ); 451 | $declaration .= "$k->{type} "; 452 | $declaration .= "$k->{name_type}" . "$k->{name_num}"; 453 | $declaration .= " = $val" unless ( $DR_mode == 2 ); 454 | $declaration .= ";\n"; 455 | } 456 | } 457 | } 458 | 459 | return $declaration; 460 | } 461 | 462 | sub program { shift->{program}; } 463 | 464 | 1; 465 | -------------------------------------------------------------------------------- /lib/Orange3/Generator/Util.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Generator::Util; 2 | 3 | use Math::BigInt; 4 | use Math::BigFloat; 5 | 6 | sub reverse_operator { 7 | my $operator = shift; 8 | 9 | my %reverse = ( 10 | '<' => '>=', 11 | '>' => '<=', 12 | '<=' => '>', 13 | '>=' => '<', 14 | '==' => '!=', 15 | '!=' => '==', 16 | ); 17 | 18 | return $reverse{$operator}; 19 | } 20 | 21 | sub int2bits_floor { 22 | 23 | my ($i) = @_; 24 | my $b = 0; 25 | 26 | while ( 0 < $i ) { 27 | if ( ( $i & 1 ) == 0 ) { $i--; } 28 | $b++; 29 | $i >>= 1; 30 | } 31 | return $b; 32 | } 33 | 34 | sub get_perl_int_max { 35 | 36 | # $k is it possible integer representation, 37 | # $k * 2 I ask the $k that integer representation disabled 38 | my $k; 39 | for ( $k = 1 ; ( $k * 2 ) !~ /e/ ; $k *= 2 ) { 40 | } 41 | 42 | # look for an integer that can be represented $m in binary search 43 | my $lo = $k; 44 | my $hi = $k * 2; 45 | for ( ; ; ) { 46 | my $m = int( ( $lo + $hi ) / 2 ); 47 | if ( $m =~ /e/ ) { 48 | if ( $hi == $m ) { last; } 49 | $hi = $m; 50 | } 51 | else { 52 | if ( $lo == $m ) { last; } 53 | $lo = $m; 54 | } 55 | } 56 | 57 | # seek the limit 58 | my $max = 0; 59 | for ( $max = $lo ; ( $max + 1 ) !~ /e/ ; $max++ ) { 60 | } 61 | 62 | return $max; 63 | } 64 | 65 | sub get_perl_int_min { 66 | 67 | # $k is it possible integer representation, 68 | # $k * 2 I ask the $k that integer representation disabled 69 | my $k; 70 | for ( $k = -1 ; ( $k * 2 ) !~ /e/ ; $k *= 2 ) { 71 | } 72 | 73 | # look for an integer that can be represented $m in binary search 74 | my $lo = $k; 75 | my $hi = $k * 2; 76 | for ( ; ; ) { 77 | my $m = int( ( $lo + $hi ) / 2 ); 78 | if ( $m =~ /e/ ) { 79 | if ( $hi == $m ) { last; } 80 | $hi = $m; 81 | } 82 | else { 83 | if ( $lo == $m ) { last; } 84 | $lo = $m; 85 | } 86 | } 87 | 88 | # seek the limit 89 | my $min = 0; 90 | for ( $min = $lo ; ( $min - 1 ) !~ /e/ ; $min-- ) { 91 | } 92 | 93 | } 94 | 95 | sub random_range { 96 | 97 | #TODO $config; 98 | my ( $top, $bottom, $type ) = @_; 99 | my $ans = Math::BigFloat->new(0); 100 | my ( $si, $ty ) = split( / /, $type, 2 ); 101 | my $max = Math::BigInt->new( $TYPE{$type}->{max} ); 102 | 103 | if ( $FLOAT_MODE != 1 ) { 104 | if ( $type eq "float" || $type eq "double" || $type eq "long double" ) { 105 | $ans = ( ( $top - $bottom ) * rand() ) + $bottom; 106 | 107 | if ( $type eq "float" ) { 108 | $ans = sprintf( "%0.5e", $ans ); 109 | } 110 | elsif ( $type eq "double" ) { 111 | $ans = sprintf( "%0.15e", $ans ); 112 | } 113 | elsif ( $type eq "long double" ) { 114 | $ans = sprintf( "%0.17Le", $ans ); 115 | } 116 | else { die; } 117 | 118 | } 119 | } 120 | else { 121 | if ( ref $top ne 'Math::BigInt' ) { $top = Math::BigInt->new($top); } 122 | if ( ref $bottom ne 'Math::BigInt' ) { $bottom = Math::BigInt->new($top); } 123 | $ans = Math::BigInt->new(0); 124 | $ans = $top->as_int()->bsub($bottom); # top - $bottom + 1; 125 | my $rand = Math::BigFloat->new( rand() ); 126 | $rand = $rand->copy()->bmul($ans)->ffround(0)->bstr() 127 | ; # rand * $ans , Integer and rounds to a point below 0 direction 128 | $rand = Math::BigInt->new($rand); 129 | $ans = $rand->as_int()->badd($bottom); # rand + $bottom 130 | 131 | unless ( $bottom <= $ans && $ans <= $top ) { 132 | die "$bottom < $ans < $top\n"; 133 | } 134 | } 135 | 136 | # print "$bottom < $ans < $top\n"; 137 | if ( $ans eq 'NaN' 138 | || $ans eq 'nan' 139 | ) # NaN is I've been avoiding because generated by that accidentally get a few rare cases very small in rand 140 | { 141 | print "Nan is occured.\n" if (DEBUG_MODE); 142 | $ans = $bottom; # Interim 143 | if ( $bottom eq 'NaN' 144 | || $top eq 'NaN' 145 | || $bottom eq 'nan' 146 | || $top eq 'nan' 147 | || $bottom eq 'inf' 148 | || $top eq 'inf' ) 149 | { 150 | $ans = 0; 151 | } 152 | } 153 | elsif ( $ans eq 'inf' ) { 154 | print "inf is occured.\n" if (DEBUG_MODE); 155 | $ans = 0; 156 | } 157 | else { ; } 158 | 159 | if ( $si eq "unsigned" ) { 160 | $ans = ( $ans % ( $max + 1 ) ); 161 | } 162 | 163 | return $ans; 164 | } 165 | 1; 166 | -------------------------------------------------------------------------------- /lib/Orange3/Log.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Log; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Carp (); 7 | use Encode (); 8 | use File::Spec (); 9 | use File::Temp (); 10 | 11 | my $TMPL = 'tmpXXXXXXX'; 12 | 13 | sub new { 14 | my ( $class, %args ) = @_; 15 | 16 | unless ( exists $args{dir} ) { 17 | Carp::croak("Missing mandatory parameter: dir"); 18 | } 19 | 20 | my $encoding = delete $args{encoding} || 'utf8'; 21 | my $encoder = Encode::find_encoding($encoding); 22 | unless ( defined $encoder ) { 23 | Carp::croak("Not found encoding '$encoding'"); 24 | } 25 | 26 | my $fh = do { 27 | my $file_handle; 28 | 29 | if ( exists $args{name} ) { 30 | my $log = File::Spec->catfile( $args{dir}, $args{name} ); 31 | open $file_handle, '>', $log or Carp::croak("Can't open $log: $!"); 32 | } 33 | else { 34 | ($file_handle) = File::Temp::tempfile( $TMPL, DIR => $args{dir} ); 35 | } 36 | $file_handle; 37 | }; 38 | 39 | bless { 40 | fh => $fh, 41 | encoder => $encoder, 42 | %args, 43 | }, $class; 44 | } 45 | 46 | sub print { 47 | my ( $self, $message ) = @_; 48 | print { $self->{fh} } $self->{encoder}->encode($message); 49 | } 50 | 51 | 1; 52 | -------------------------------------------------------------------------------- /lib/Orange3/Mini.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Mini; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Carp (); 7 | use File::Basename; 8 | use File::Copy (); 9 | use File::Path (); 10 | use File::Spec (); 11 | use Getopt::Long qw/:config posix_default no_ignore_case bundling auto_help/; 12 | use Math::BigInt; 13 | 14 | use Orange3::Config; 15 | use Orange3::Log; 16 | use Orange3::Mini::Executor; 17 | use Orange3::Util; 18 | 19 | use Data::Dumper; 20 | 21 | sub new { 22 | my ( $class, %args ) = @_; 23 | 24 | bless { 25 | config => undef, 26 | help => undef, 27 | log_dir => undef, 28 | time_out => undef, 29 | debug => undef, 30 | mini_dir => 'MINI', 31 | %args 32 | }, $class; 33 | } 34 | 35 | sub parse_options { 36 | my $self = shift; 37 | 38 | local @ARGV = @_; 39 | 40 | # default 41 | $self->{time_out} = 7; 42 | $self->{debug} = 0; 43 | 44 | GetOptions( 45 | "h|help" => \$self->{help}, 46 | "t|time-out=i" => \$self->{time_out}, 47 | "d|debbug" => \$self->{debug}, 48 | ) or _usage(); 49 | 50 | _usage() if $self->{help}; 51 | 52 | $self->{argv} = [@ARGV]; 53 | } 54 | 55 | sub run { 56 | my $self = shift; 57 | 58 | $self->_check_argument; 59 | $self->_collect_targets; 60 | $self->_init; 61 | 62 | for my $file ( @{ $self->{target_files} } ) { 63 | my $guard = Orange3::Util::Chdir->new( $self->{target_directory} ); 64 | $self->{content} = do $file or Carp::croak("Cannot load $file"); 65 | 66 | Orange3::Mini::Executor->new( 67 | content => $self->{content}, 68 | config => $self->{config}, 69 | compiler => $self->{compiler}, 70 | debug => $self->{debug}, 71 | executor => $self->{executor}, 72 | mini_dir => $self->{mini_dir}, 73 | option => $self->{content}->{option}, 74 | time_out => $self->{time_out}, 75 | file => $file, 76 | )->execute; 77 | } 78 | } 79 | 80 | sub _check_argument { 81 | my $self = shift; 82 | 83 | for my $path ( @{ $self->{argv} } ) { 84 | if ( Orange3::Util::is_file($path) ) { 85 | $self->{target_file} = $path; 86 | } 87 | elsif ( Orange3::Util::is_dir($path) ) { 88 | $self->{target_directory} = $path; 89 | } 90 | else { 91 | Carp::croak("Invalid path $path"); 92 | } 93 | } 94 | } 95 | 96 | sub _collect_targets { 97 | my $self = shift; 98 | 99 | my @files; 100 | if ( $self->{target_file} ) { 101 | $self->{target_directory} = dirname( $self->{target_file} ); 102 | } 103 | elsif ( $self->{target_directory} ) { 104 | my $guard = Orange3::Util::Chdir->new( $self->{target_directory} ); 105 | @files = glob "error*_*.pl"; 106 | @files = map { $_->[0] } 107 | sort { $a->[1] <=> $b->[1] } 108 | map { [ $_, /^error(\d+)_(.+).pl/ ] } @files; 109 | if ( !@files ) { 110 | Carp::croak("There are no targets"); 111 | } 112 | } 113 | else { 114 | Carp::croak("There are no targets"); 115 | } 116 | $self->{target_files} = @files ? \@files : [ basename $self->{target_file} ]; 117 | } 118 | 119 | sub _init { 120 | my $self = shift; 121 | 122 | $self->_load_configs; 123 | 124 | $self->{log_dir} = 125 | File::Spec->catdir( $self->{target_directory}, $self->{mini_dir} ); 126 | 127 | unless ( -d $self->{log_dir} ) { 128 | File::Path::mkpath( [ $self->{log_dir} ], 0, oct(777) ); 129 | } 130 | } 131 | 132 | sub _load_configs { 133 | my $self = shift; 134 | 135 | my $config_file = 136 | File::Spec->catfile( $self->{target_directory}, 'orange3.cnf' ); 137 | $self->{config} = Orange3::Config->new($config_file); 138 | 139 | my $compiler_cnf = 140 | File::Spec->catfile( $self->{target_directory}, 'orange3-compiler.cnf' ); 141 | my $executor_cnf = 142 | File::Spec->catfile( $self->{target_directory}, 'orange3-executor.cnf' ); 143 | 144 | $self->{compiler} = do $compiler_cnf if -e $compiler_cnf; 145 | $self->{executor} = do $executor_cnf if -e $executor_cnf; 146 | } 147 | 148 | sub _usage { 149 | die <<'...'; 150 | Usage: mini [options] [File|Directory] 151 | 152 | Options: 153 | -h,--help show this help message 154 | -d,--debug print more info of debug 155 | -t,--time-out one test timeout (sec) [default 7 (sec)] 156 | ... 157 | } 158 | 159 | 1; 160 | -------------------------------------------------------------------------------- /lib/Orange3/Mini/Backup.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Mini::Backup; 2 | 3 | use strict; 4 | use warnings; 5 | use Carp (); 6 | 7 | sub new { 8 | my ( $class, $vars, $assigns ) = @_; 9 | 10 | bless { 11 | vars => $vars, 12 | assigns => $assigns, 13 | data => undef, 14 | }, $class; 15 | 16 | } 17 | 18 | sub _restore_var_and_assigns { 19 | my $self = shift; 20 | $self->_restore_var; 21 | $self->_restore_assigns; 22 | } 23 | 24 | sub _restore_var { 25 | my $self = shift; 26 | my $varset_tmp = $self->{data}->{varset_tmp}; 27 | $self->copy_varset( $varset_tmp, $self->{vars} ); 28 | } 29 | 30 | sub _restore_assigns { 31 | my $self = shift; 32 | my $assigns_tmp = $self->{data}->{assigns_tmp}; 33 | $self->copy_assigns( $assigns_tmp, $self->{assigns} ); 34 | } 35 | 36 | sub _restore_assign_number { 37 | my ( $self, $number ) = @_; 38 | my $assigns_tmp = $self->{data}->{assigns_tmp}; 39 | $self->{assigns}->[$number]->{root} = $assigns_tmp->[$number]->{root}; 40 | $self->copy_assign_number( $assigns_tmp, $self->{assigns}, $number ); 41 | } 42 | 43 | sub _backup_var_and_assigns { 44 | my $self = shift; 45 | $self->_backup_var; 46 | $self->_backup_assigns; 47 | } 48 | 49 | sub _backup_var { 50 | my $self = shift; 51 | if ( defined $self->{data}->{varset_tmp} ) { 52 | undef $self->{data}->{varset_tmp}; 53 | } 54 | my $varset_tmp = []; 55 | $self->copy_varset( $self->{vars}, $varset_tmp ); 56 | $self->{data}->{varset_tmp} = $varset_tmp; 57 | } 58 | 59 | sub _backup_assigns { 60 | my $self = shift; 61 | if ( defined $self->{data}->{assigns_tmp} ) { 62 | undef $self->{data}->{assigns_tmp}; 63 | } 64 | my $assigns_tmp = []; 65 | $self->copy_assigns( $self->{assigns}, $assigns_tmp ); 66 | $self->{data}->{assigns_tmp} = $assigns_tmp; 67 | } 68 | 69 | sub remove_var_and_assigns { 70 | my $self = shift; 71 | if ( defined $self->{data}->{assigns_tmp} ) { 72 | undef $self->{data}->{assigns_tmp}; 73 | } 74 | if ( defined $self->{data}->{varset_tmp} ) { 75 | undef $self->{data}->{varset_tmp}; 76 | } 77 | } 78 | 79 | sub copy_assigns { 80 | my ( $self, $assigns, $clone_assigns ) = @_; 81 | 82 | foreach my $i ( 0 .. $#{$assigns} ) { 83 | $self->copy_assign_number( $assigns, $clone_assigns, $i ); 84 | } 85 | } 86 | 87 | sub copy_assign_number { 88 | my ( $self, $assigns, $clone_assigns, $i ) = @_; 89 | my $assign_i = $assigns->[$i]; 90 | if ( Orange3::Mini::Util::_check_assign($assign_i) ) { 91 | $clone_assigns->[$i]->{val} = $assign_i->{val}; 92 | $clone_assigns->[$i]->{type} = $assign_i->{type}; 93 | $clone_assigns->[$i]->{print_statement} = $assign_i->{print_statement}; 94 | $clone_assigns->[$i]->{root} = {} 95 | unless ( defined( $clone_assigns->[$i]->{root} ) ); 96 | $self->copy_assign( $assigns->[$i]->{root}, $clone_assigns->[$i]->{root} ); 97 | } 98 | elsif ( !$assign_i->{print_value} ) { 99 | $clone_assigns->[$i]->{root} = {}; 100 | $clone_assigns->[$i]->{print_statement} = $assign_i->{print_statement}; 101 | $clone_assigns->[$i]->{val} = $assign_i->{val}; 102 | $clone_assigns->[$i]->{type} = $assign_i->{type}; 103 | } 104 | else { 105 | Carp::croak("\$assigns->[$i]->{print_value} : $assign_i->{print_value}"); 106 | } 107 | } 108 | 109 | sub _bigint_dumper { 110 | my $val = shift; 111 | 112 | my $content; 113 | 114 | # if (ref $val eq 'Math::BigInt') { 115 | # my $sign = $val->sign; 116 | # my $value = $val->babs->bstr; # destructive... 117 | # 118 | # $content = Math::BigInt->new('$val'); 119 | # } 120 | # else { 121 | $content = "$val"; 122 | 123 | # } 124 | 125 | return $content; 126 | } 127 | 128 | sub copy_assign { 129 | my ( $self, $ref, $ref_clone ) = @_; 130 | 131 | $ref_clone->{out} = {} unless ( defined( $ref_clone->{out} ) ); 132 | $ref_clone->{out}->{type} = "$ref->{out}->{type}"; 133 | $ref_clone->{out}->{val} = _bigint_dumper( $ref->{out}->{val} ); 134 | $ref_clone->{ntype} = "$ref->{ntype}"; 135 | if ( $ref->{ntype} eq 'op' ) { 136 | $ref_clone->{otype} = "$ref->{otype}"; 137 | if ( defined( $ref->{ins_add} ) ) { 138 | $ref_clone->{ins_add} = "$ref->{ins_add}"; 139 | 140 | } 141 | elsif ( defined( $ref_clone->{ins_add} ) ) { 142 | delete $ref_clone->{ins_add}; 143 | } 144 | foreach my $i ( 0 .. $#{ $ref->{in} } ) { 145 | $ref_clone->{in}->[$i] = {} unless ( defined( $ref_clone->{in}->[$i] ) ); 146 | $ref_clone->{in}->[$i]->{print_value} = "$ref->{in}->[$i]->{print_value}"; 147 | $ref_clone->{in}->[$i]->{type} = "$ref->{in}->[$i]->{type}"; 148 | $ref_clone->{in}->[$i]->{val} = _bigint_dumper( $ref->{in}->[$i]->{val} ); 149 | $ref_clone->{in}->[$i]->{ref} = {} 150 | unless ( defined( $ref_clone->{in}->[$i]->{ref} ) ); 151 | $self->copy_assign( $ref->{in}->[$i]->{ref}, 152 | $ref_clone->{in}->[$i]->{ref} ); 153 | } 154 | } 155 | elsif ( $ref->{ntype} eq 'var' ) { 156 | $ref_clone->{var} = {} unless ( defined( $ref_clone->{var} ) ); 157 | $ref_clone->{var}->{type} = "$ref->{var}->{type}"; 158 | $ref_clone->{var}->{val} = _bigint_dumper( $ref->{var}->{val} ); 159 | $ref_clone->{var}->{ival} = _bigint_dumper( $ref->{var}->{ival} ); 160 | $ref_clone->{var}->{name_type} = "$ref->{var}->{name_type}"; 161 | $ref_clone->{var}->{name_num} = "$ref->{var}->{name_num}"; 162 | $ref_clone->{var}->{class} = "$ref->{var}->{class}"; 163 | $ref_clone->{var}->{modifier} = "$ref->{var}->{modifier}"; 164 | $ref_clone->{var}->{scope} = "$ref->{var}->{scope}"; 165 | } 166 | else { Carp::croak("$ref->{ntype}"); } 167 | } 168 | 169 | sub copy_varset { 170 | my ( $self, $varset, $clone_varset ) = @_; 171 | 172 | foreach my $i ( 0 .. $#{$varset} ) { 173 | $clone_varset->[$i] = {} unless ( defined( $clone_varset->[$i] ) ); 174 | $clone_varset->[$i]->{type} = "$varset->[$i]->{type}"; 175 | $clone_varset->[$i]->{ival} = "$varset->[$i]->{ival}"; 176 | $clone_varset->[$i]->{val} = "$varset->[$i]->{val}"; 177 | $clone_varset->[$i]->{name_type} = "$varset->[$i]->{name_type}"; 178 | $clone_varset->[$i]->{name_num} = "$varset->[$i]->{name_num}"; 179 | $clone_varset->[$i]->{class} = "$varset->[$i]->{class}"; 180 | $clone_varset->[$i]->{modifier} = "$varset->[$i]->{modifier}"; 181 | $clone_varset->[$i]->{scope} = "$varset->[$i]->{scope}"; 182 | $clone_varset->[$i]->{used} = "$varset->[$i]->{used}"; 183 | } 184 | } 185 | 186 | 1; 187 | 188 | -------------------------------------------------------------------------------- /lib/Orange3/Mini/Bottomup.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Mini::Bottomup; 2 | 3 | use strict; 4 | use warnings; 5 | use Carp (); 6 | 7 | use Orange3::Mini::Backup; 8 | use Orange3::Mini::Util; 9 | use Orange3::Mini::Compute; 10 | 11 | sub new { 12 | my ( $class, $config, $vars, $assigns, %args ) = @_; 13 | 14 | bless { 15 | config => $config, 16 | vars => $vars, 17 | assigns => $assigns, 18 | run => $args{run}, 19 | status => $args{status}, 20 | backup => Orange3::Mini::Backup->new( $vars, $assigns ), 21 | %args, 22 | }, $class; 23 | } 24 | 25 | sub minimize_inorder_head 26 | 27 | # inorder; only parent on the No. 1 special 28 | { 29 | my ( $self, $ref, $i ) = @_; 30 | 31 | my $reduced = 0; 32 | 33 | if ( $ref->{ntype} eq "op" ) { 34 | for my $k ( @{ $ref->{in} } ) { 35 | if ( $k->{print_value} == 0 ) { 36 | $reduced = $self->minimize_inorder( $k->{ref}, $i ); 37 | if ( $reduced == -1 || $reduced == 2 ) { 38 | if ( $self->try_reduce( $k, $i ) ) { 39 | $reduced = 1; 40 | } 41 | else { 42 | # Check the right grandson of child 43 | $reduced = $self->minimize_inorder( $k->{ref}, $i ); 44 | if ( $reduced > 0 ) { 45 | $reduced = 1; 46 | } 47 | else { 48 | $reduced = 0; 49 | } 50 | } 51 | } 52 | } 53 | } 54 | } 55 | 56 | return $reduced; 57 | } 58 | 59 | sub minimize_inorder 60 | 61 | # inorder; Try to top-down if successful examines only one child 62 | { 63 | my ( $self, $ref, $i ) = @_; 64 | 65 | my $reduced = -1; 66 | 67 | if ( $ref->{ntype} eq "op" ) { 68 | for my $k ( @{ $ref->{in} } ) { 69 | if ( $k->{print_value} == 0 ) { 70 | 71 | # Check the left grandson of child 72 | $reduced = $self->minimize_inorder( $k->{ref}, $i ); 73 | if ( $reduced == -1 || $reduced == 2 ) { 74 | 75 | # Check child 76 | if ( $self->try_reduce( $k, $i ) ) { 77 | $reduced = 2; 78 | return $reduced; 79 | } 80 | else { 81 | # Check the right grandson of child 82 | $reduced = $self->minimize_inorder( $k->{ref}, $i ); 83 | if ( $reduced > 0 ) { 84 | $reduced = 1; 85 | } 86 | else { 87 | $reduced = 0; 88 | } 89 | } 90 | } 91 | } 92 | } 93 | } 94 | 95 | return $reduced; 96 | } 97 | 98 | sub minimize_preorder 99 | 100 | # preorder, Bisection exploration version (top-down manner I examine) 101 | { 102 | my ( $self, $ref, $i ) = @_; 103 | 104 | my $reduced = 0; 105 | 106 | if ( $ref->{ntype} eq "op" ) { 107 | for my $k ( @{ $ref->{in} } ) { 108 | if ( $k->{print_value} == 0 ) { 109 | if ( $self->try_reduce( $k, $i ) ) { 110 | $reduced = 1; 111 | } 112 | elsif ( $self->minimize_preorder( $k->{ref}, $i ) ) { 113 | $reduced = 1; 114 | } 115 | } 116 | } 117 | } 118 | return $reduced; 119 | } 120 | 121 | sub minimize_postorder 122 | 123 | # Solid plate of the bottom-up 124 | # (I find out one by one minimization from the node below) 125 | { 126 | my ( $self, $ref, $i, $s, $assign_in_locate ) = @_; 127 | 128 | my $reduced = -1; 129 | my $reduced_next = 0; 130 | 131 | if ( $ref->{ntype} eq "op" ) { 132 | $s .= "{'in'}"; 133 | my $ii = 0; 134 | for my $k ( @{ $ref->{in} } ) { 135 | my $sr = $s . "[$ii]"; 136 | if ( $sr eq $$assign_in_locate || $$assign_in_locate eq 'SKIP' ) { 137 | $reduced = 0; 138 | $$assign_in_locate = 'SKIP'; 139 | return $reduced; 140 | } 141 | elsif ( $k->{print_value} == 0 ) { 142 | $sr .= "{'ref'}"; 143 | $reduced_next = 144 | $self->minimize_postorder( $k->{ref}, $i, $sr, $assign_in_locate ); 145 | if ( $reduced_next == -1 || $reduced_next == 2 ) { 146 | if ( $self->try_reduce( $k, $i ) ) { 147 | $$assign_in_locate = 'BLANK'; 148 | $reduced_next = 2; 149 | } 150 | else { 151 | # To leave the OK after NG. 152 | # (Recompile prevention of the same type) 153 | if ( $$assign_in_locate eq 'BLANK' ) { 154 | $$assign_in_locate = "$sr"; 155 | } 156 | if ( $reduced_next == 2 ) { $reduced_next = 1; } 157 | else { $reduced_next = 0; } 158 | } 159 | } 160 | } 161 | if ( $reduced < $reduced_next ) { 162 | $reduced = $reduced_next; 163 | } 164 | $ii++; 165 | } 166 | } 167 | return $reduced; 168 | } 169 | 170 | sub try_reduce { 171 | my ( $self, $vn, $i ) = @_; 172 | 173 | my $update = 0; 174 | my $o = $vn->{ref}->{out}; 175 | 176 | if ( $vn->{type} eq $o->{type} && $vn->{val} == $o->{val} ) { 177 | $vn->{print_value} = 2; 178 | } 179 | else { 180 | $vn->{print_value} = 1; 181 | } 182 | 183 | my $obj = Orange3::Generator::Program->new( $self->{config} ); 184 | my $tree_sprint = 185 | "$i: " . $obj->tree_sprint( $self->{assigns}->[$i]->{root} ) . "\n"; 186 | $self->_print($tree_sprint); 187 | my $ans = $self->_generate_and_test; 188 | if ( $ans == 1 ) { 189 | if ( $vn->{print_value} == 1 ) { 190 | $vn->{print_value} = 2; 191 | $tree_sprint = 192 | "$i: " . $obj->tree_sprint( $self->{assigns}->[$i]->{root} ) . "\n"; 193 | $self->_print($tree_sprint); 194 | $ans = $self->_generate_and_test; 195 | if ( $ans == 0 ) { 196 | $vn->{print_value} = 1; 197 | $self->_print(""); 198 | } 199 | } 200 | $update = 1; 201 | } 202 | elsif ( $ans == 0 ) { 203 | $vn->{print_value} = 0; # return to the original 204 | } 205 | return $update; 206 | } 207 | 208 | sub _generate_and_test { 209 | my $self = shift; 210 | 211 | return Orange3::Mini::Compute->new( 212 | $self->{config}, $self->{vars}, $self->{assigns}, 213 | run => $self->{run}, 214 | status => $self->{status}, 215 | )->_generate_and_test; 216 | } 217 | 218 | sub _print { 219 | my ( $self, $body ) = @_; 220 | Orange3::Mini::Util::print( $self->{status}->{debug}, $body ); 221 | } 222 | 223 | 1; 224 | -------------------------------------------------------------------------------- /lib/Orange3/Mini/Compute.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Mini::Compute; 2 | 3 | use strict; 4 | use warnings; 5 | use Carp (); 6 | 7 | use Orange3::Mini::Util; 8 | use Orange3::Generator; 9 | use Orange3::Generator::Expect; 10 | use Orange3::Generator::Program; 11 | use Orange3::Runner::Compiler; 12 | use Orange3::Runner::Executor; 13 | 14 | sub new { 15 | my ( $class, $config, $vars, $assigns, %args ) = @_; 16 | 17 | bless { 18 | config => $config, 19 | vars => $vars, 20 | assigns => $assigns, 21 | run => $args{run}, 22 | status => $args{status}, 23 | backup => Orange3::Mini::Backup->new( $vars, $assigns ), 24 | generator => $args{run}->{generator}, 25 | %args, 26 | }, $class; 27 | } 28 | 29 | sub dump_test { 30 | my ( $self, $assigns_i, $recompute ) = @_; 31 | 32 | $self->{backup}->_backup_var_and_assigns; 33 | for my $i ( $assigns_i .. $#{ $self->{assigns} } ) { 34 | my $assign_i = $self->{assigns}->[$i]; 35 | if ( $recompute && Orange3::Mini::Util::_check_assign($assign_i) ) { 36 | if ( 37 | ( 38 | $recompute == 1 39 | && $self->_type_insadd_value_compute( $assign_i->{root} ) 40 | ) 41 | || ( $recompute == 2 42 | && $self->_type_value_compute( $assign_i->{root} ) ) 43 | ) 44 | { 45 | $self->{backup}->_restore_var_and_assigns; 46 | return 2; 47 | } 48 | else { 49 | $self->_tvar_update_after_compute($i); 50 | } 51 | } 52 | } 53 | return $self->_generate_and_test; 54 | } 55 | 56 | sub _type_value_compute { 57 | my ( $self, $assign_i_root ) = @_; 58 | $self->{generator}->type_compute($assign_i_root); 59 | Orange3::Generator::Expect::value_compute( $assign_i_root, $self->{vars}, 60 | $self->{config}, $self->{status}->{avoide_undef} ); 61 | return ( $assign_i_root->{out}->{val} eq "UNDEF" ) ? 2 : 0; 62 | } 63 | 64 | sub _type_insadd_value_compute { 65 | my ( $self, $assign_i_root ) = @_; 66 | $self->{generator}->type_compute($assign_i_root); 67 | $self->insadd_value($assign_i_root); 68 | Orange3::Generator::Expect::value_compute( $assign_i_root, $self->{vars}, 69 | $self->{config}, $self->{status}->{avoide_undef} ); 70 | return ( $assign_i_root->{out}->{val} eq "UNDEF" ) ? 2 : 0; 71 | } 72 | 73 | sub _tvar_update_after_compute { 74 | my ( $self, $i ) = @_; 75 | my $assign_i = $self->{assigns}->[$i]; 76 | 77 | # re-store the expected value of the expression that was minimized to the variable table 78 | $self->varset_val_reset( "t", $i, $assign_i->{root}->{out}->{type}, 79 | 'UNCHANGE', $assign_i->{root}->{out}->{val} ); 80 | $self->reset_tvar_and_compute_exist( $i + 1, $i ); 81 | } 82 | 83 | sub _insadd_value_preparation_compute { 84 | my ( $self, $ref_in0 ) = @_; 85 | 86 | if ( $ref_in0->{ref}->{ntype} eq 'op' ) { 87 | if ( $ref_in0->{print_value} == 0 ) { 88 | $self->{generator}->type_compute( $ref_in0->{ref} ); 89 | Orange3::Generator::Expect::value_compute( $ref_in0->{ref}, 90 | $self->{vars}, $self->{config}, $self->{status}->{avoide_undef} ); 91 | } 92 | } 93 | elsif ( $ref_in0->{ref}->{ntype} eq 'var' ) { ; } 94 | else { 95 | Carp::croak("Unexpectedly ntype: $ref_in0->{ref}->{ntype}"); 96 | } 97 | return $ref_in0->{ref}->{out}->{val}; 98 | } 99 | 100 | sub _insadd_value_compute_value { 101 | my ( $self, $ref, $value0, $value ) = @_; 102 | my $type = $ref->{in}->[1]->{ref}->{out}->{type}; 103 | my $value1 = Math::BigInt->new(0); 104 | if ( $ref->{otype} eq '+' ) { $value1 = $value - $value0; } 105 | elsif ( $ref->{otype} eq '*' ) { $value1 = $value / $value0; } 106 | else { 107 | Carp::croak( 108 | "\$ref->{ins_add} $ref->{ins_add} \$ref->{optype} $ref->{otype}"); 109 | } 110 | my ( $s, $ty ) = split( / /, $type, 2 ); 111 | if ( $s eq "unsigned" ) { 112 | my $types = $self->{config}->get('type'); 113 | my $max = Math::BigInt->new( $types->{$type}->{max} ); 114 | $value1 = $value1 % ( $max + 1 ); 115 | } 116 | return $value1; 117 | } 118 | 119 | sub _insadd_value_compute { 120 | my ( $self, $ref ) = @_; 121 | 122 | my $value = $ref->{out}->{val}; 123 | my $value0 = $self->_insadd_value_preparation_compute( $ref->{in}->[0] ); 124 | if ( $value0 eq 'UNDEF' ) { $value = $value0; return; } 125 | my $value1 = $self->_insadd_value_compute_value( $ref, $value0, $value ); 126 | my $type = $ref->{in}->[1]->{ref}->{out}->{type}; 127 | my $ins_var = $ref->{in}->[1]->{ref}->{var}; 128 | $self->varset_val_reset( $ins_var->{name_type}, $ins_var->{name_num}, 129 | $type, $value1, $value1, ); 130 | $ins_var->{val} = $value1; 131 | $ins_var->{ival} = $value1; 132 | $ref->{in}->[1]->{ref}->{out}->{val} = $value1; 133 | } 134 | 135 | # re-calculate the value of the variable that was made by ins_add 136 | sub insadd_value { 137 | my ( $self, $ref ) = @_; 138 | 139 | if ( $ref->{ntype} eq 'op' ) { 140 | for my $r ( @{ $ref->{in} } ) { 141 | if ( $r->{print_value} == 0 ) { 142 | $self->insadd_value( $r->{ref} ); 143 | } 144 | } 145 | if ( defined $ref->{ins_add} && $ref->{out}->{val} ne 'UNDEF' ) { 146 | $self->_insadd_value_compute($ref); 147 | } 148 | } 149 | elsif ( $ref->{ntype} eq 'var' ) { 150 | $ref->{out}->{val} = $ref->{var}->{val}; 151 | } 152 | } 153 | 154 | sub varset_val_reset { 155 | my ( $self, $name_type, $name_num, $type, $ival, $val ) = @_; 156 | for my $var ( @{ $self->{vars} } ) { 157 | if ( $name_type eq $var->{name_type} && $name_num eq $var->{name_num} ) { 158 | $var->{type} = $type eq 'UNCHANGE' ? $var->{type} : $type; 159 | $var->{ival} = $ival eq 'UNCHANGE' ? $var->{ival} : $ival; 160 | $var->{val} = $val eq 'UNCHANGE' ? $var->{val} : $val; 161 | my $types = $self->{config}->get('type'); 162 | my $max = Math::BigInt->new( $types->{ $var->{type} }->{max} ); 163 | my $min = Math::BigInt->new( $types->{ $var->{type} }->{min} ); 164 | if ( $var->{ival} < $min ) { $var->{ival} = $min; } #ZANTEI 165 | elsif ( $max < $var->{ival} ) { $var->{ival} = $max; } #ZANTEI 166 | last; 167 | } 168 | } 169 | } 170 | 171 | sub _tval_compute_assigns { 172 | my ( $self, $modify_t_num ) = @_; 173 | 174 | # my $modify_t_set = [$modify_t_num]; 175 | # do { 176 | # my $modify_t_num = $modify_t_num; 177 | my $exist; 178 | for my $i ( ( $modify_t_num + 1 ) .. ( @{ $self->{assigns} } - 1 ) ) { 179 | my $assign_i = $self->{assigns}->[$i]; 180 | if ( Orange3::Mini::Util::_check_assign($assign_i) 181 | && $self->reset_tvar_and_compute_exist( $i, $modify_t_num ) ) 182 | { 183 | $exist = 1; 184 | 185 | # unshift @$modify_t_set, $i; 186 | # if($self->_type_insadd_value_compute($assign_i->{root})){ 187 | # return 2; # UNDEF is occurd. 188 | # } 189 | } 190 | } 191 | if ($exist) { 192 | for my $i ( ( $modify_t_num + 1 ) .. ( @{ $self->{assigns} } - 1 ) ) { 193 | my $assign_i = $self->{assigns}->[$i]; 194 | if ( $self->_type_insadd_value_compute( $assign_i->{root} ) ) { 195 | return 2; # UNDEF is occurd. 196 | } 197 | } 198 | } 199 | 200 | # } 201 | # while (defined($modify_t_set->[0])); 202 | return 0; 203 | } 204 | 205 | sub tval_compute { 206 | my ( $self, $i ) = @_; 207 | 208 | # return UNDEF ? 2 : 0; 209 | # return EXIST ? 1 : 0; 210 | return $self->_tval_compute_assigns($i); 211 | } 212 | 213 | # re-store the var from the variable table in var present in the assign 214 | sub reset_tvar_and_compute_exist { 215 | my ( $self, $begin_number, $number ) = @_; 216 | 217 | my $assign_var_locate = []; 218 | my $name = 't' . $number; 219 | my $exist = 220 | $self->_search_range_assigns_var( $begin_number, $name, 221 | $assign_var_locate ); 222 | 223 | for my $var ( @{ $self->{vars} } ) { 224 | my $var_name = $var->{name_type} . $var->{name_num}; 225 | if ( $var_name eq $name ) { 226 | $self->_put_assign_var( $assign_var_locate, $var ); 227 | } 228 | } 229 | return $exist; 230 | } 231 | 232 | sub _search_range_assigns_var { 233 | my ( $self, $begin_number, $name, $assign_var_locate ) = @_; 234 | 235 | my $assigns = $self->{assigns}; 236 | my $exist_total = 0; 237 | 238 | for my $i ( $begin_number .. $#{$assigns} ) { 239 | my $assign_i = $assigns->[$i]; 240 | if ( Orange3::Mini::Util::_check_assign($assign_i) ) { 241 | my $s = '$assigns->[' . $i . ']->{root}'; 242 | my $exist = $self->_search_assign_var( $assigns->[$i]->{root}, 243 | $name, $s, $assign_var_locate ); 244 | $exist_total += $exist; 245 | } 246 | } 247 | return $exist_total; 248 | } 249 | 250 | sub _generate_and_test { 251 | my $self = shift; 252 | 253 | if ( 254 | defined $self->{status}->{mode} 255 | && ( $self->{status}->{mode} eq 'optimize' 256 | || $self->{status}->{mode} eq 'volatile' ) 257 | ) 258 | { 259 | return $self->_vol_generate_and_test; # volatile minimize 260 | } 261 | else { 262 | my $time_out = $self->{status}->{time_out}; 263 | eval { 264 | local $SIG{ALRM} = sub { die "timeout" }; 265 | alarm($time_out); 266 | $self->_generate_test_program; 267 | $self->_compile; 268 | if ( $self->{generate_test}->{compile_error_msg} eq 0 ) { 269 | $self->_execute; 270 | } 271 | my $timeleft = alarm(0); 272 | }; 273 | alarm(0); 274 | if ( $@ =~ /timeout/ ) { 275 | $self->_print("WARNING: TIMEOUT! ($time_out [s])"); 276 | $self->{status}->{program} = "FAILED MINIMIZE. (TIME OUT)"; 277 | return 0; 278 | } 279 | return $self->_judgement_and_print; 280 | } 281 | } 282 | 283 | sub _assign_put { 284 | my $self = shift; 285 | for my $i ( 0 .. $#{ $self->{assigns} } ) { 286 | my $assign_i = $self->{assigns}->[$i]; 287 | if ( Orange3::Mini::Util::_check_assign($assign_i) ) { 288 | $assign_i->{var}->{val} = $assign_i->{val} = 289 | $assign_i->{root}->{out}->{val}; 290 | $assign_i->{var}->{type} = $assign_i->{type} = 291 | $assign_i->{root}->{out}->{type}; 292 | } 293 | } 294 | } 295 | 296 | sub _put_roots_from_assign { 297 | my $self = shift; 298 | my $roots = $self->{generator}->{roots}; 299 | 300 | foreach my $i ( 0 .. $#{$roots} ) { 301 | if ( $roots->[$i]->{st_type} eq 'assign' ) { 302 | my $assigns_num = $roots->[$i]->{assigns_num}; 303 | 304 | # if ($self->{assigns}->[$assigns_num]->{print_statement}) { 305 | $roots->[$i]->{root} = $self->{assigns}->[$assigns_num]->{root}; 306 | $roots->[$i]->{val} = $self->{assigns}->[$assigns_num]->{val}; 307 | $roots->[$i]->{type} = $self->{assigns}->[$assigns_num]->{type}; 308 | $roots->[$i]->{var} = $self->{assigns}->[$assigns_num]->{var}; 309 | $roots->[$i]->{print_statement} = 310 | $self->{assigns}->[$assigns_num]->{print_statement}; 311 | 312 | # } 313 | # else { 314 | # undef $roots->[$i]->{root}; 315 | # } 316 | } 317 | } 318 | } 319 | 320 | sub _generate_test_program { 321 | my $self = shift; 322 | $self->_assign_put; 323 | $self->_put_roots_from_assign; 324 | my $generator = Orange3::Generator::Program->new( $self->{config} ); 325 | $generator->generate_program( $self->{vars}, $self->{generator}->{roots} ); 326 | $self->{generate_test}->{program} = $generator->program; 327 | } 328 | 329 | sub _compile { 330 | my $self = shift; 331 | my $compiler = Orange3::Runner::Compiler->new( 332 | compile => $self->{run}->{compiler}->{compile}, 333 | config => $self->{config}, 334 | option => $self->{status}->{option}, 335 | ); 336 | if ( $self->{status}->{debug} ) { 337 | $compiler->run; 338 | } 339 | else { 340 | open my $fh, '>', '/dev/null' or die; 341 | my $stdout_fh = select $fh; 342 | $compiler->run; 343 | select $stdout_fh; 344 | } 345 | $self->{generate_test}->{compile_error_msg} = $compiler->error_msg; 346 | $self->{generate_test}->{compile_command} = $compiler->command; 347 | } 348 | 349 | sub _execute { 350 | my $self = shift; 351 | my $executor = Orange3::Runner::Executor->new( 352 | config => $self->{config}, 353 | execute => $self->{run}->{executor}->{execute}, 354 | ); 355 | if ( $self->{status}->{debug} ) { 356 | $executor->run; 357 | } 358 | else { 359 | open my $fh, '>', '/dev/null' or die; 360 | my $stdout_fh = select $fh; 361 | $executor->run; 362 | select $stdout_fh; 363 | } 364 | $self->{generate_test}->{execute_error_msg} = $executor->error_msg; 365 | $self->{generate_test}->{execute_command} = $executor->command; 366 | $self->{generate_test}->{execute_error} = $executor->error; 367 | } 368 | 369 | sub _judgement_and_print { 370 | my $self = shift; 371 | 372 | if ( !$self->{generate_test}->{execute_error} ) { 373 | $self->_print(""); 374 | } 375 | if ( $self->{generate_test}->{compile_error_msg} ne 0 376 | || $self->{generate_test}->{execute_error} != 0 ) 377 | { 378 | $self->_error_header; 379 | $self->{status}->{program} = $self->{generate_test}->{program}; 380 | return 1; 381 | } 382 | return 0; 383 | } 384 | 385 | sub _error_header { 386 | my $self = shift; 387 | 388 | my $compile_command = $self->{generate_test}->{compile_command}; 389 | my $compile_message = $self->{generate_test}->{compile_error_msg}; 390 | my $execute_command = $self->{generate_test}->{execute_command}; 391 | my $execute_message = $self->{generate_test}->{execute_error_msg}; 392 | 393 | my ( $expression_size, $assign_max, $var_max ) = ( 394 | $self->{status}->{exp_size}, 395 | $self->{status}->{root_size}, 396 | $self->{status}->{var_size} 397 | ); 398 | 399 | if ( $compile_message eq '0' ) { $compile_message = ""; } 400 | if ( !defined($execute_command) ) { $execute_command = ""; } 401 | if ( !defined($execute_message) ) { $execute_message = ""; } 402 | 403 | my $header = <<"..."; 404 | /* 405 | ( E_SIZE, NUM_ROOT, NUM_VAR ) = ( $expression_size, $assign_max, $var_max ) 406 | \$ $compile_command 407 | $compile_message 408 | 409 | \$ $execute_command 410 | $execute_message 411 | */ 412 | ... 413 | 414 | $self->{status}->{header} = $header; 415 | } 416 | 417 | sub _search_assign_var { 418 | my ( $self, $ref, $name, $s, $assign_var_locate ) = @_; 419 | 420 | return Orange3::Mini::Util::search_assign_var( $ref, $name, $s, 421 | $assign_var_locate ); 422 | } 423 | 424 | sub _put_assign_var { 425 | my ( $self, $assign_var_locate, $v ) = @_; 426 | 427 | Orange3::Mini::Util::put_assign_var( $self->{assigns}, $assign_var_locate, 428 | $v ); 429 | } 430 | 431 | sub _print { 432 | my ( $self, $body ) = @_; 433 | Orange3::Mini::Util::print( $self->{status}->{debug}, $body ); 434 | } 435 | 436 | 1; 437 | 438 | -------------------------------------------------------------------------------- /lib/Orange3/Mini/Constant.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Mini::Constant; 2 | 3 | use strict; 4 | use warnings; 5 | use Carp (); 6 | 7 | use Orange3::Mini::Backup; 8 | use Orange3::Mini::Util; 9 | use Orange3::Mini::Compute; 10 | 11 | sub new { 12 | my ( $class, $config, $vars, $assigns, %args ) = @_; 13 | 14 | bless { 15 | config => $config, 16 | vars => $vars, 17 | assigns => $assigns, 18 | run => $args{run}, 19 | status => $args{status}, 20 | backup => Orange3::Mini::Backup->new( $vars, $assigns ), 21 | minimize_cons => undef, 22 | %args, 23 | }, $class; 24 | } 25 | 26 | sub _minimize_constant { 27 | my $self = shift; 28 | 29 | my $update = 0; 30 | $self->{minimize_cons}->{final} = 0; 31 | for my $i ( 0 .. $#{ $self->{assigns} } ) { 32 | $self->{minimize_cons}->{current_assign_i} = $i; 33 | if ( Orange3::Mini::Util::_check_assign( $self->{assigns}->[$i] ) ) { 34 | $update = 35 | $self->_minimize_constant_assign_recursively( 36 | $self->{assigns}->[$i]->{root} ) ? 1 : $update; 37 | } 38 | } 39 | return $update; 40 | } 41 | 42 | sub _minimize_constant_final { 43 | my $self = shift; 44 | 45 | my $update = 0; 46 | $self->{minimize_cons}->{final} = 1; 47 | for my $i ( 0 .. $#{ $self->{assigns} } ) { 48 | $self->{minimize_cons}->{current_assign_i} = $i; 49 | if ( Orange3::Mini::Util::_check_assign( $self->{assigns}->[$i] ) ) { 50 | $update = 51 | $self->_minimize_constant_assign_recursively( 52 | $self->{assigns}->[$i]->{root} ) ? 1 : $update; 53 | } 54 | } 55 | return $update; 56 | } 57 | 58 | sub _minimize_constant_assign_recursively { 59 | my ( $self, $ref ) = @_; 60 | my $update = 0; 61 | if ( $ref->{ntype} eq 'op' ) { 62 | for my $r ( @{ $ref->{in} } ) { 63 | if ( $r->{print_value} == 0 ) { 64 | $update = 65 | $self->_minimize_constant_assign_recursively( $r->{ref} ) ? 1 : 0; 66 | } 67 | else { 68 | $self->_set_minimize_constant_from_current_r($r); 69 | $update = $self->_minimize_constant_value ? 1 : $update; 70 | $update = $self->_minimize_constant_type ? 1 : $update; 71 | } 72 | } 73 | } 74 | return $update; 75 | } 76 | 77 | sub _set_minimize_constant_from_current_r { 78 | my ( $self, $r ) = @_; 79 | if ( defined $self->{minimize_cons}->{current_r} ) { 80 | undef $self->{minimize_cons}->{current_r}; 81 | } 82 | $self->{minimize_cons}->{current_r} = $r; 83 | } 84 | 85 | sub _minimize_constant_value_first_try_val_set { 86 | my $self = shift; 87 | if ( $self->{minimize_cons}->{last_success_val} > 1 ) { 88 | $self->{minimize_cons}->{try_val} = Math::BigInt->new(1); 89 | } 90 | elsif ( $self->{minimize_cons}->{last_success_val} < -1 ) { 91 | $self->{minimize_cons}->{try_val} = Math::BigInt->new(-1); 92 | } 93 | else { 94 | die 95 | "unknown : last_success_val $self->{minimize_cons}->{last_success_val}\n"; 96 | } 97 | } 98 | 99 | sub _minimize_constant_value_first_init { 100 | my $self = shift; 101 | my $r = $self->{minimize_cons}->{current_r}; 102 | $self->{minimize_cons}->{last_success_val} = 103 | ( $r->{print_value} == 1 ) 104 | ? Math::BigInt->new( abs $r->{ref}->{out}->{val} ) 105 | : ( $r->{print_value} == 2 ) ? Math::BigInt->new( abs $r->{val} ) 106 | : undef; 107 | } 108 | 109 | sub _minimize_constant_value_set { 110 | my $self = shift; 111 | my $r = $self->{minimize_cons}->{current_r}; 112 | my $try_val = $self->{minimize_cons}->{try_val}; 113 | if ( $r->{print_value} == 1 ) { 114 | $self->_print( 115 | "MODIFIED : ($r->{type})($r->{ref}->{out}->{val}) => ($r->{type})($try_val)" 116 | ); 117 | $r->{ref}->{out}->{val} = $self->{minimize_cons}->{try_val}; 118 | } 119 | elsif ( $r->{print_value} == 2 ) { 120 | $self->_print( 121 | "MODIFIED : ($r->{type})($r->{val}) => ($r->{type})($try_val)"); 122 | $r->{val} = $self->{minimize_cons}->{try_val}; 123 | } 124 | else { die; } 125 | } 126 | 127 | sub _minimize_var_constant_value_decide_try_val { 128 | my $self = shift; 129 | 130 | my $current_val = $self->{minimize_cons}->{current_val}; 131 | my $last_fail_val = $self->{minimize_cons}->{last_fail_val}; 132 | my $last_success_val = $self->{minimize_cons}->{last_success_val}; 133 | 134 | my $case = 0; 135 | if ( $current_val > 0 && $last_fail_val > 0 ) { 136 | if ( $current_val > $last_success_val ) { $case = 1; } # Impossible 137 | elsif ( $current_val == $last_success_val ) { $case = 2; } 138 | elsif ( $current_val < $last_success_val ) { $case = 3; } 139 | } 140 | elsif ( $current_val < 0 && $last_fail_val < 0 ) { 141 | if ( $current_val < $last_success_val ) { $case = 1; } # Impossible 142 | elsif ( $current_val == $last_success_val ) { $case = 2; } 143 | elsif ( $current_val > $last_success_val ) { $case = 3; } 144 | } 145 | else { 146 | die 147 | "\$current_val < 0 && \$last_fail_val < 0 => $current_val < 0 && $last_fail_val < 0"; 148 | } 149 | 150 | my $two = Math::BigInt->new(2); 151 | my $try_val; 152 | 153 | if ( $case == 1 ) { die; } 154 | elsif ( $case == 2 ) { 155 | $try_val = $current_val - ( ( $current_val - $last_fail_val ) / $two ); 156 | } 157 | elsif ( $case == 3 ) { 158 | $try_val = $current_val + ( ( $last_success_val - $current_val ) / $two ); 159 | } 160 | else { die; } 161 | 162 | $self->{minimize_cons}->{try_val} = $try_val; 163 | } 164 | 165 | sub _minimize_constant_value_first { 166 | my $self = shift; 167 | $self->_minimize_constant_value_first_init; 168 | $self->_minimize_constant_value_first_try_val_set; 169 | $self->{backup}->_backup_var_and_assigns; 170 | $self->_minimize_constant_value_set; 171 | return $self->_minimize_constant_value_test_and_judge; 172 | } 173 | 174 | sub _minimize_constant_value_second_and_after_change { 175 | my $self = shift; 176 | $self->_minimize_var_constant_value_decide_try_val; 177 | $self->{backup}->_backup_var_and_assigns; 178 | $self->_minimize_constant_value_set; 179 | return $self->_minimize_constant_value_test_and_judge; 180 | } 181 | 182 | sub _minimize_constant_value_second_and_after { 183 | my $self = shift; 184 | my $update = 0; 185 | my $difference; 186 | do { 187 | $difference = abs( $self->{minimize_cons}->{last_success_val} - 188 | $self->{minimize_cons}->{last_fail_val} ); 189 | if ( $difference > 1 ) { 190 | $update = 191 | $self->_minimize_constant_value_second_and_after_change ? 1 : $update; 192 | } 193 | } while ( $difference != 1 ); 194 | return $update; 195 | } 196 | 197 | sub _minimize_constant_value_changeabl { 198 | my $self = shift; 199 | my $r = $self->{minimize_cons}->{current_r}; 200 | return ( 201 | ( 202 | $r->{ref}->{ntype} eq 'var' 203 | && ( 204 | ( 205 | !$self->{minimize_cons}->{final} 206 | && $r->{ref}->{var}->{name_type} ne 'k' 207 | ) 208 | || $self->{minimize_cons}->{final} 209 | ) 210 | ) 211 | || $r->{ref}->{ntype} eq 'op' 212 | ) ? 1 : 0; 213 | } 214 | 215 | sub _minimize_constant_value { 216 | my $self = shift; 217 | my $r = $self->{minimize_cons}->{current_r}; 218 | my $update = 0; 219 | 220 | my $difference = 221 | ( $r->{print_value} == 1 ) 222 | ? Math::BigInt->new( abs $r->{ref}->{out}->{val} ) 223 | : ( $r->{print_value} == 2 ) ? Math::BigInt->new( abs $r->{val} ) 224 | : undef; 225 | if ( !$self->_minimize_constant_value_changeabl ) { ; } 226 | elsif ( !defined $difference ) { die; } 227 | elsif ( $difference > 1 ) { 228 | $update = $self->_minimize_constant_value_first; 229 | if ( !$update ) { 230 | $update = $self->_minimize_constant_value_second_and_after ? 1 : 0; 231 | } 232 | } 233 | return $update; 234 | } 235 | 236 | sub _minimize_constant_type_change { 237 | my $self = shift; 238 | my $r = $self->{minimize_cons}->{current_r}; 239 | my $changeable = 0; 240 | my $bt = $self->{minimize_cons}->{before_type}; 241 | my $bv = $self->{minimize_cons}->{before_ival}; 242 | my ( $at, $av ) = $self->int_ification( $bt, $bv ); 243 | if ( $bt eq $at ) { return $changeable; } 244 | else { 245 | $self->_print("MODIFIED : ($bt)$bv => ($at)$av"); 246 | $self->{backup}->_backup_var_and_assigns; 247 | if ( $r->{print_value} == 1 ) { 248 | $r->{ref}->{out}->{type} = $at; 249 | $r->{ref}->{out}->{val} = $av; 250 | } 251 | elsif ( $r->{print_value} == 2 ) { 252 | $r->{type} = $at; 253 | $r->{val} = $av; 254 | } 255 | $changeable = 1; 256 | } 257 | return $changeable; 258 | } 259 | 260 | sub _minimize_constant_type_testable { 261 | my $self = shift; 262 | my $testable = 0; 263 | my $r = $self->{minimize_cons}->{current_r}; 264 | my $bt = 265 | ( $r->{print_value} == 1 ) ? $r->{ref}->{out}->{type} 266 | : ( $r->{print_value} == 2 ) ? $r->{type} 267 | : undef; 268 | my $bv = 269 | ( $r->{print_value} == 1 ) ? $r->{ref}->{out}->{val} 270 | : ( $r->{print_value} == 2 ) ? $r->{val} 271 | : undef; 272 | 273 | if ( ( $bt ne 'signed int' && $bt ne 'unsigned int' ) ) { 274 | $self->{minimize_cons}->{before_type} = $bt; 275 | $self->{minimize_cons}->{before_ival} = $bv; 276 | $testable = 1; 277 | } 278 | return $testable; 279 | } 280 | 281 | sub _minimize_constant_type_test { 282 | my $self = shift; 283 | my $assigns_i = $self->{minimize_cons}->{current_assign_i}; 284 | my $recompute = $self->{minimize_cons}->{final} ? 2 : 1; 285 | return $self->_dump_test( $assigns_i, $recompute ); 286 | } 287 | 288 | sub _minimize_constant_type_test_and_judge { 289 | my $self = shift; 290 | my $update = 0; 291 | my $r = $self->{minimize_cons}->{current_r}; 292 | 293 | if ( $self->_minimize_constant_type_test == 1 ) { 294 | if ( $self->{minimize_cons}->{before_type} eq $r->{type} ) { 295 | $self->{backup}->_restore_var_and_assigns; 296 | } 297 | else { $update = 1; } 298 | } 299 | else { 300 | $self->{backup}->_restore_var_and_assigns; 301 | } 302 | return $update; 303 | } 304 | 305 | sub _minimize_constant_type { 306 | my $self = shift; 307 | my $r = $self->{minimize_cons}->{current_r}; 308 | my $update = 0; 309 | while ( $self->_minimize_constant_type_testable ) { 310 | if ( $self->_minimize_constant_type_change 311 | && $self->_minimize_constant_type_test_and_judge ) 312 | { 313 | $update = 1; 314 | } 315 | else { last; } 316 | } 317 | return $update; 318 | } 319 | 320 | sub _minimize_constant_value_test { 321 | my $self = shift; 322 | my $assigns_i = $self->{minimize_cons}->{current_assign_i}; 323 | my $recompute = $self->{minimize_cons}->{final} ? 2 : 1; 324 | return $self->_dump_test( $assigns_i, $recompute ); 325 | } 326 | 327 | sub _minimize_constant_value_test_and_judge { 328 | my $self = shift; 329 | 330 | $self->{minimize_cons}->{current_val} = $self->{minimize_cons}->{try_val}; 331 | 332 | my $test = $self->_minimize_constant_value_test; 333 | 334 | if ( $test == 1 ) { 335 | $self->{minimize_cons}->{last_success_val} = 336 | $self->{minimize_cons}->{current_val}; 337 | } 338 | elsif ( $test == 0 || $test == 2 ) { 339 | $self->{backup}->_restore_var_and_assigns; 340 | $self->{minimize_cons}->{last_fail_val} = 341 | $self->{minimize_cons}->{current_val}; 342 | } 343 | return ( $test == 1 ) ? 1 : 0; 344 | } 345 | 346 | sub int_ification { 347 | my ( $self, $type, $val ) = @_; 348 | 349 | return Orange3::Mini::Util::int_ification( $self->{config}, $type, $val ); 350 | } 351 | 352 | sub _dump_test { 353 | my ( $self, $assigns_i, $recompute ) = @_; 354 | 355 | return Orange3::Mini::Compute->new( 356 | $self->{config}, $self->{vars}, $self->{assigns}, 357 | run => $self->{run}, 358 | status => $self->{status}, 359 | )->dump_test( $assigns_i, $recompute ); 360 | } 361 | 362 | sub _print { 363 | my ( $self, $body ) = @_; 364 | Orange3::Mini::Util::print( $self->{status}->{debug}, $body ); 365 | } 366 | 367 | 1; 368 | -------------------------------------------------------------------------------- /lib/Orange3/Mini/Executor.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Mini::Executor; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Carp (); 7 | 8 | use Orange3::Mini::Minimize; 9 | use Orange3::Util; 10 | 11 | sub new { 12 | my ( $class, %args ) = @_; 13 | 14 | bless { 15 | config => $args{config}, 16 | vars => $args{content}->{vars}, 17 | assigns => [], 18 | run => { 19 | compiler => $args{compiler}, 20 | executor => $args{executor}, 21 | generator => Orange3::Generator->new( 22 | vars => $args{content}->{vars}, 23 | roots => $args{content}->{roots}, 24 | config => $args{config}, 25 | ), 26 | }, 27 | status => { 28 | avoide_undef => 0, 29 | debug => $args{debug}, 30 | time_out => $args{time_out}, 31 | exp_size => $args{content}->{expression_size}, 32 | root_size => $args{content}->{root_size}, 33 | var_size => $args{content}->{var_size}, 34 | option => $args{content}->{option}, 35 | program => undef, 36 | header => undef, 37 | mini_dir => $args{mini_dir}, 38 | file => $args{file}, 39 | }, 40 | %args 41 | }, $class; 42 | 43 | } 44 | 45 | sub execute { 46 | my $self = shift; 47 | print "$self->{status}->{file}:\n"; 48 | $self->_make_assigns; 49 | $self->_print("\n****** NEXT MINIMIZE: $self->{status}->{file} ******"); 50 | my $guard = Orange3::Util::Chdir->new( $self->{mini_dir} ); 51 | my $minimize = Orange3::Mini::Minimize->new( 52 | $self->{config}, $self->{vars}, $self->{assigns}, 53 | run => $self->{run}, 54 | status => $self->{status}, 55 | ); 56 | $minimize->new_minimize; 57 | $self->_log( $self->{status}->{file} ); 58 | $self->_message; 59 | $self->_print("\n****** PREV MINIMIZE: $self->{status}->{file} ******\n"); 60 | } 61 | 62 | sub _make_assigns { 63 | my $self = shift; 64 | my $roots = $self->{run}->{generator}->{roots}; 65 | foreach my $i ( 0 .. $#{$roots} ) { 66 | 67 | # ===> zantei 68 | if ( defined $roots->[$i]->{root} 69 | && $roots->[$i]->{st_type} eq 'assign' 70 | && !defined $roots->[$i]->{name_num} ) 71 | { 72 | $roots->[$i]->{name_num} = $i; 73 | } 74 | if ( !defined $roots->[$i]->{print_statement} ) { 75 | $roots->[$i]->{print_statement} = 1; 76 | } 77 | if ( !defined $roots->[$i]->{var} ) { 78 | $roots->[$i]->{var} = $self->_zantei_var_tansaku($i); 79 | } 80 | 81 | # <=== 82 | $self->_make_assigns_from_st( $roots->[$i] ); 83 | } 84 | } 85 | 86 | sub _zantei_var_tansaku { 87 | my ( $self, $i ) = @_; 88 | for my $v ( @{ $self->{vars} } ) { 89 | if ( $v->{name_type} eq "t" && $v->{name_num} eq $i ) { 90 | return $v; 91 | } 92 | } 93 | } 94 | 95 | sub _make_assigns_from_st { 96 | my ( $self, $st ) = @_; 97 | if ( $st->{print_statement} && $st->{st_type} eq 'assign' ) { 98 | push @{ $self->{assigns} }, $self->_generate_assign_set($st); 99 | $st->{assigns_num} = $#{ $self->{assigns} }; 100 | } 101 | } 102 | 103 | sub _generate_assign_set { 104 | my ( $self, $st ) = @_; 105 | 106 | return +{ 107 | root => $st->{root}, 108 | val => $st->{val}, 109 | type => $st->{type}, 110 | print_statement => $st->{print_statement}, 111 | var => $st->{var}, 112 | }; 113 | } 114 | 115 | sub _message { 116 | my $self = shift; 117 | if ( !defined $self->{status}->{program} 118 | || $self->{status}->{program} =~ /TIME OUT/ ) 119 | { 120 | select STDOUT; 121 | print "FAILED MINIMIZE. (maybe TIME OUT.)\n"; 122 | } 123 | elsif ( $self->{status}->{program} =~ /FAILED/ ) { 124 | print $self->{status}->{program} . "\n"; 125 | } 126 | else { 127 | print $self->{status}->{program} . "\n"; 128 | } 129 | } 130 | 131 | sub _log { 132 | my ( $self, $file_name ) = @_; 133 | 134 | my $roots = $self->{run}->{generator}->{roots}; 135 | my $to = $file_name; 136 | $to =~ s/\.pl$//; 137 | 138 | my $header = $self->{status}->{header}; 139 | my $program = $self->{status}->{program}; 140 | 141 | $header = ( defined $header ) ? $header : ""; 142 | $program = ( defined $program ) ? $program : "FAILED MINIMIZE."; 143 | 144 | Orange3::Log->new( 145 | name => "$to\_mini.c", 146 | dir => "./", 147 | )->print( $header . $program ); 148 | 149 | my $content = Orange3::Dumper->new( 150 | vars => $self->{vars}, 151 | roots => $roots, 152 | )->all( 153 | expression_size => $self->{status}->{exp_size}, 154 | root_size => $self->{status}->{root_size}, 155 | var_size => $self->{status}->{var_size}, 156 | option => $self->{status}->{option} 157 | ); 158 | 159 | Orange3::Log->new( 160 | name => "$to\_mini.pl", 161 | dir => "./", 162 | )->print($content); 163 | 164 | } 165 | 166 | sub _print { 167 | my ( $self, $body ) = @_; 168 | Orange3::Mini::Util::print( $self->{status}->{debug}, $body ); 169 | } 170 | 171 | 1; 172 | -------------------------------------------------------------------------------- /lib/Orange3/Mini/Expression.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Mini::Expression; 2 | 3 | use strict; 4 | use warnings; 5 | use Carp (); 6 | 7 | use Orange3::Mini::Backup; 8 | use Orange3::Mini::Util; 9 | use Orange3::Mini::Compute; 10 | 11 | sub new { 12 | my ( $class, $config, $vars, $assigns, %args ) = @_; 13 | 14 | bless { 15 | config => $config, 16 | vars => $vars, 17 | assigns => $assigns, 18 | run => $args{run}, 19 | status => $args{status}, 20 | backup => Orange3::Mini::Backup->new( $vars, $assigns ), 21 | %args, 22 | }, $class; 23 | } 24 | 25 | sub binary_texpression_cut_first { 26 | my $self = shift; 27 | my $number = @{ $self->{assigns} }; 28 | $self->{backup}->_backup_var_and_assigns; 29 | $self->{expression}->{left_begin} = 0; 30 | $self->{expression}->{left_number} = int $number / 2; 31 | $self->{expression}->{right_begin} = $self->{expression}->{left_number}; 32 | $self->{expression}->{right_number} = 33 | $number - $self->{expression}->{left_number}; 34 | $self->binary_texpression_cut; 35 | } 36 | 37 | sub binary_texpression_cut_right { 38 | my $self = shift; 39 | $self->{expression}->{left_begin} = $self->{expression}->{right_begin}; 40 | $self->{expression}->{left_number} = 41 | int $self->{expression}->{right_number} / 2; 42 | $self->{expression}->{right_begin} = 43 | $self->{expression}->{left_begin} + $self->{expression}->{left_number}; 44 | $self->{expression}->{right_number} = 45 | $self->{expression}->{right_number} - $self->{expression}->{left_number}; 46 | $self->binary_texpression_cut; 47 | } 48 | 49 | sub binary_texpression_cut_left { 50 | my $self = shift; 51 | my $total = $self->{expression}->{left_number}; 52 | $self->{expression}->{left_begin} = $self->{expression}->{left_begin}; 53 | $self->{expression}->{left_number} = 54 | int $self->{expression}->{left_number} / 2; 55 | $self->{expression}->{right_begin} = 56 | $self->{expression}->{left_begin} + $self->{expression}->{left_number}; 57 | $self->{expression}->{right_number} = 58 | $total - $self->{expression}->{left_number}; 59 | $self->binary_texpression_cut; 60 | } 61 | 62 | sub binary_texpression_cut_both { 63 | my $self = shift; 64 | my $expression; 65 | $expression = 66 | $self->_clone_expression_number( $self->{expression}, $expression ); 67 | $self->binary_texpression_cut_left; 68 | $self->{expression} = 69 | $self->_clone_expression_number( $expression, $self->{expression} ); 70 | $self->binary_texpression_cut_right; 71 | } 72 | 73 | sub _clone_expression_number { 74 | my ( $self, $expression, $clone_expression ) = @_; 75 | $clone_expression->{left_begin} = $expression->{left_begin}; 76 | $clone_expression->{left_number} = $expression->{left_number}; 77 | $clone_expression->{right_begin} = $expression->{right_begin}; 78 | $clone_expression->{right_number} = $expression->{right_number}; 79 | return $clone_expression; 80 | } 81 | 82 | sub binary_texpression_cut { 83 | my $self = shift; 84 | 85 | if ( 86 | $self->{expression}->{left_number} + $self->{expression}->{right_number} > 87 | 1 ) 88 | { 89 | $self->_expression_tree_off_right; 90 | $self->texpression_cut_mask; 91 | if ( !$self->_generate_and_test ) { 92 | $self->_expression_tree_on_right; 93 | $self->_expression_tree_off_left; 94 | $self->texpression_cut_mask; 95 | if ( !$self->_generate_and_test ) { 96 | $self->_expression_tree_on_left; 97 | $self->binary_texpression_cut_both; 98 | } 99 | else { 100 | $self->binary_texpression_cut_right; 101 | } 102 | } 103 | else { 104 | $self->binary_texpression_cut_left; 105 | } 106 | } 107 | } 108 | 109 | sub _expression_tree_off_right { 110 | my $self = shift; 111 | $self->_expression_tree_off( $self->{expression}->{right_begin}, 112 | $self->{expression}->{right_begin} + 113 | $self->{expression}->{right_number} - 114 | 1 ); 115 | } 116 | 117 | sub _expression_tree_off_left { 118 | my $self = shift; 119 | $self->_expression_tree_off( $self->{expression}->{left_begin}, 120 | $self->{expression}->{left_begin} + 121 | $self->{expression}->{left_number} - 122 | 1 ); 123 | } 124 | 125 | sub _expression_tree_on_right { 126 | my $self = shift; 127 | $self->_expression_tree_on( $self->{expression}->{right_begin}, 128 | $self->{expression}->{right_begin} + 129 | $self->{expression}->{right_number} - 130 | 1 ); 131 | } 132 | 133 | sub _expression_tree_on_left { 134 | my $self = shift; 135 | $self->_expression_tree_on( $self->{expression}->{left_begin}, 136 | $self->{expression}->{left_begin} + 137 | $self->{expression}->{left_number} - 138 | 1 ); 139 | } 140 | 141 | sub lossy_texpression_cut_possible { 142 | my $self = shift; 143 | 144 | my $all_update = 0; 145 | my $one_update = 0; 146 | $self->{backup}->_backup_var_and_assigns; 147 | do { 148 | $one_update = $self->lossy_texpression_cut; 149 | $all_update = $one_update ? 1 : $all_update; 150 | } while ( Orange3::Mini::Util::_count_defined_assign( $self->{assigns} ) > 1 151 | && $one_update ); 152 | return $all_update; 153 | } 154 | 155 | sub lossy_texpression_cut { 156 | my $self = shift; 157 | 158 | my $update = 0; 159 | 160 | for my $i ( 0 .. $#{ $self->{assigns} } ) { 161 | my $expression = Orange3::Mini::Util::_count_assign_exp( $self->{assigns} ); 162 | my $expression_only = 163 | Orange3::Mini::Util::_count_assign_exp_only( $self->{assigns} ); 164 | my $ps = $self->{assigns}->[$i]->{print_statement}; 165 | if ( $expression > 1 166 | && Orange3::Mini::Util::_check_assign( $self->{assigns}->[$i] ) ) 167 | { 168 | $self->_expression_tree_off( $i, $i ); 169 | $self->texpression_cut_mask; 170 | if ( !$self->_generate_and_test ) { 171 | if ( $ps != 2 && $expression - $expression_only > 1 ) { 172 | $self->_expression_tree_exp_only_on( $i, $i ); 173 | $self->texpression_cut_mask; 174 | if ( !$self->_generate_and_test ) { 175 | $self->{assigns}->[$i]->{print_statement} = $ps; 176 | } 177 | else { 178 | $update = 1; 179 | } 180 | } 181 | else { 182 | $self->{assigns}->[$i]->{print_statement} = $ps; 183 | } 184 | } 185 | else { 186 | $expression--; 187 | $update = 1; 188 | } 189 | } 190 | } 191 | return $update; 192 | } 193 | 194 | sub _expression_tree_on { 195 | my ( $self, $start, $end ) = @_; 196 | $self->{backup}->_restore_var; 197 | for my $i ( $start .. $end ) { 198 | 199 | # $self->{backup}->_restore_assign_number($i); 200 | $self->{assigns}->[$i]->{print_statement} = 1; 201 | } 202 | } 203 | 204 | sub _expression_tree_off { 205 | my ( $self, $start, $end ) = @_; 206 | $self->{backup}->_backup_var; 207 | for my $i ( $start .. $end ) { 208 | my $assign_i = $self->{assigns}->[$i]; 209 | if ( Orange3::Mini::Util::_check_assign($assign_i) ) { 210 | $self->varset_t_val_reset($i); 211 | 212 | # delete $assign_i->{root}; 213 | $assign_i->{print_statement} = 0; 214 | } 215 | } 216 | } 217 | 218 | sub _expression_tree_exp_only_on { 219 | my ( $self, $start, $end ) = @_; 220 | $self->{backup}->_restore_var; 221 | for my $i ( $start .. $end ) { 222 | 223 | # $self->{backup}->_restore_assign_number($i); 224 | $self->{assigns}->[$i]->{print_statement} = 2; 225 | } 226 | } 227 | 228 | sub varset_t_val_reset { 229 | my ( $self, $i ) = @_; 230 | my $assign_i = $self->{assigns}->[$i]; 231 | for my $var ( @{ $self->{vars} } ) { 232 | if ( $var->{name_type} eq 't' && $var->{name_num} eq $i ) { 233 | $var->{type} = $assign_i->{root}->{out}->{type}; 234 | $var->{ival} = $assign_i->{root}->{out}->{val}; 235 | $var->{val} = $assign_i->{root}->{out}->{val}; 236 | $assign_i->{var} = $var; 237 | last; 238 | } 239 | } 240 | } 241 | 242 | sub texpression_cut_mask { 243 | my $self = shift; 244 | 245 | my $s = "t("; 246 | for my $i ( 0 .. @{ $self->{assigns} } - 1 ) { 247 | my $assign_i = $self->{assigns}->[$i]; 248 | if ( Orange3::Mini::Util::_check_assign($assign_i) ) { 249 | if ( $assign_i->{print_statement} == 1 ) { 250 | $s .= "@"; 251 | } 252 | elsif ( $assign_i->{print_statement} == 2 ) { 253 | $s .= "%"; 254 | } 255 | } 256 | else { 257 | $s .= "+"; 258 | } 259 | } 260 | $s .= ")"; 261 | $self->_print("$s"); 262 | } 263 | 264 | sub _generate_and_test { 265 | my $self = shift; 266 | 267 | return Orange3::Mini::Compute->new( 268 | $self->{config}, $self->{vars}, $self->{assigns}, 269 | run => $self->{run}, 270 | status => $self->{status}, 271 | )->_generate_and_test; 272 | } 273 | 274 | sub _print { 275 | my ( $self, $body ) = @_; 276 | Orange3::Mini::Util::print( $self->{status}->{debug}, $body ); 277 | } 278 | 279 | 1; 280 | -------------------------------------------------------------------------------- /lib/Orange3/Mini/Minimize.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Mini::Minimize; 2 | 3 | use strict; 4 | use warnings; 5 | use Carp (); 6 | use Time::HiRes qw(usleep ualarm gettimeofday tv_interval); 7 | 8 | use Orange3::Mini::Bottomup; 9 | use Orange3::Mini::Constant; 10 | use Orange3::Mini::Compute; 11 | use Orange3::Mini::Expression; 12 | use Orange3::Mini::Topdown; 13 | use Orange3::Mini::Var; 14 | use Orange3::Dumper; 15 | use Orange3::Mini::Util; 16 | 17 | sub new { 18 | my ( $class, $config, $vars, $assigns, %args ) = @_; 19 | bless { 20 | config => $config, 21 | vars => $vars, 22 | assigns => $assigns, 23 | run => $args{run}, 24 | status => $args{status}, 25 | backup => Orange3::Mini::Backup->new( $vars, $assigns ), 26 | %args, 27 | }, $class; 28 | } 29 | 30 | sub new_minimize { 31 | my $self = shift; 32 | if ( !$self->first_check ) { 33 | return 1; 34 | } 35 | if ( Orange3::Mini::Util::_count_defined_assign( $self->{assigns} ) == 36 | @{ $self->{assigns} } ) 37 | { 38 | $self->_new_minimize_first; 39 | } 40 | $self->_new_minimize_second_and_after; 41 | $self->final_check; 42 | } 43 | 44 | sub final_check { 45 | my $self = shift; 46 | 47 | if ( $self->_generate_and_test ) { 48 | $self->_print("\n****** COMPLETE MINIMIZE ******"); 49 | } 50 | else { 51 | $self->_print("\n****** FAILED MINIMIZE ******"); 52 | } 53 | } 54 | 55 | sub first_check { 56 | my $self = shift; 57 | 58 | $self->_print("\n****** REPRODUCIBLE CHECK ******"); 59 | $self->{status}->{time_out} = 999; 60 | my $t0 = [gettimeofday]; 61 | my $rreproducible = $self->_generate_and_test ? 1 : 0; 62 | my $t1 = [gettimeofday]; 63 | if ($rreproducible) { $self->_print("\n****** START MINIMIZE ******"); } 64 | else { 65 | $self->_print("\n****** FAILED MINIMIZE (irreproducible) ******"); 66 | $self->{status}->{program} = "FAILED MINIMIZE. (IRREPRODUCIBLE)"; 67 | } 68 | my $execTime = int tv_interval( $t0, $t1 ); 69 | $self->{status}->{time_out} = $execTime * 2 > 5 ? $execTime * 2 : 5; 70 | return $rreproducible; 71 | } 72 | 73 | sub _new_minimize_first_binary_texpression_cut { 74 | my $self = shift; 75 | 76 | if ( Orange3::Mini::Util::_count_defined_assign( $self->{assigns} ) > 1 ) { 77 | $self->_must_print("------ BINARY EXPRESSION CUT ------\n"); 78 | my $expression = Orange3::Mini::Expression->new( 79 | $self->{config}, $self->{vars}, $self->{assigns}, 80 | run => $self->{run}, 81 | status => $self->{status}, 82 | ); 83 | $expression->binary_texpression_cut_first; 84 | } 85 | } 86 | 87 | sub _new_minimize_first_assign_minimize { 88 | my $self = shift; 89 | 90 | if ( $self->_new_minimize_top_down ) { $self->_new_minimize_first_inorder; } 91 | else { $self->_new_minimize_first_preorder; } 92 | } 93 | 94 | sub _new_minimize_top_down { 95 | my $self = shift; 96 | 97 | my $update = 0; 98 | $self->_must_print("------ TOP-DOWN EXPRESSION REDUCE ------\n"); 99 | for my $i ( 0 .. $#{ $self->{assigns} } ) { 100 | if ( Orange3::Mini::Util::_check_assign( $self->{assigns}->[$i] ) ) { 101 | $self->_print("\n------ TOP-DOWN EXPRESSION REDUCE(t$i) ------\n"); 102 | my $topdown = Orange3::Mini::Topdown->new( 103 | $self->{config}, $self->{vars}, $self->{assigns}, 104 | run => $self->{run}, 105 | status => $self->{status}, 106 | ); 107 | $update = $topdown->top_down_prepare($i) ? 1 : $update; 108 | } 109 | } 110 | return $update; 111 | } 112 | 113 | sub _new_minimize_final_top_down { 114 | my $self = shift; 115 | 116 | my $update = 0; 117 | $self->_must_print("------ TOP-DOWN FINAL EXPRESSION REDUCE ------\n"); 118 | for my $i ( 0 .. $#{ $self->{assigns} } ) { 119 | if ( Orange3::Mini::Util::_check_assign( $self->{assigns}->[$i] ) ) { 120 | $self->_print("\n------ TOP-DOWN FINAL EXPRESSION REDUCE(t$i) ------\n"); 121 | my $topdown = Orange3::Mini::Topdown->new( 122 | $self->{config}, $self->{vars}, $self->{assigns}, 123 | run => $self->{run}, 124 | status => $self->{status}, 125 | ); 126 | $update = $topdown->top_down_final_prepare($i) ? 1 : $update; 127 | } 128 | } 129 | return $update; 130 | } 131 | 132 | sub _new_minimize_first_inorder { 133 | my $self = shift; 134 | 135 | $self->_must_print("------ BOTTOM-UP INORDER EXPRESSION REDUCE ------\n"); 136 | for my $i ( 0 .. $#{ $self->{assigns} } ) { 137 | if ( Orange3::Mini::Util::_check_assign( $self->{assigns}->[$i] ) ) { 138 | $self->_print( 139 | "\n------ BOTTOM-UP INORDER EXPRESSION REDUCE(t$i) ------\n"); 140 | my $bottomup = Orange3::Mini::Bottomup->new( 141 | $self->{config}, $self->{vars}, $self->{assigns}, 142 | run => $self->{run}, 143 | status => $self->{status}, 144 | ); 145 | $bottomup->minimize_inorder_head( $self->{assigns}->[$i]->{root}, $i ); 146 | } 147 | } 148 | } 149 | 150 | sub _new_minimize_first_preorder { 151 | my $self = shift; 152 | 153 | $self->_must_print("------ BOTTOM-UP PREORDER EXPRESSION REDUCE ------\n"); 154 | for my $i ( 0 .. $#{ $self->{assigns} } ) { 155 | if ( Orange3::Mini::Util::_check_assign( $self->{assigns}->[$i] ) ) { 156 | $self->_print( 157 | "\n------ BOTTOM-UP PREORDER EXPRESSION REDUCE(t$i) ------\n"); 158 | my $bottomup = Orange3::Mini::Bottomup->new( 159 | $self->{config}, $self->{vars}, $self->{assigns}, 160 | run => $self->{run}, 161 | status => $self->{status}, 162 | ); 163 | $bottomup->minimize_preorder( $self->{assigns}->[$i]->{root}, $i ); 164 | } 165 | } 166 | } 167 | 168 | sub _new_minimize_first { 169 | my $self = shift; 170 | 171 | $self->_new_minimize_first_binary_texpression_cut; 172 | $self->_new_minimize_first_assign_minimize; 173 | } 174 | 175 | sub _new_minimize_second_and_after_lossy_texpression_cut { 176 | my $self = shift; 177 | 178 | my $update = 0; 179 | if ( Orange3::Mini::Util::_count_defined_assign( $self->{assigns} ) > 1 ) { 180 | $self->_must_print("------ LOSSY EXPRESSION CUT ------\n"); 181 | my $expression = Orange3::Mini::Expression->new( 182 | $self->{config}, $self->{vars}, $self->{assigns}, 183 | run => $self->{run}, 184 | status => $self->{status}, 185 | ); 186 | $update = $expression->lossy_texpression_cut_possible ? 1 : 0; 187 | } 188 | return $update; 189 | } 190 | 191 | sub _new_minimize_second_and_after_assign_minimize { 192 | my $self = shift; 193 | 194 | my $update_top_post = 0; 195 | 196 | my $update = 0; 197 | do { 198 | $update = $self->_new_minimize_top_down ? 1 : 0; 199 | $update = 200 | $self->_new_minimize_second_and_after_possible_postorder ? 1 : $update; 201 | $update_top_post = $update ? $update : $update_top_post; 202 | } while ( $update > 0 ); 203 | return $update_top_post; 204 | } 205 | 206 | sub _new_minimize_final_assign_minimize { 207 | my $self = shift; 208 | 209 | my $update_top_post = 0; 210 | 211 | my $update = 0; 212 | do { 213 | $update = $self->_new_minimize_final_top_down ? 1 : 0; 214 | $update_top_post = $update ? $update : $update_top_post; 215 | } while ( $update > 0 ); 216 | 217 | return $update_top_post; 218 | } 219 | 220 | sub _new_minimize_second_and_after_possible_postorder { 221 | my $self = shift; 222 | 223 | my $update_postorder = 0; 224 | $self->_must_print("------ BOTTOM-UP POSTORDER EXPRESSION REDUCE ------\n"); 225 | for my $i ( 0 .. $#{ $self->{assigns} } ) { 226 | my $update = 0; 227 | if ( Orange3::Mini::Util::_check_assign( $self->{assigns}->[$i] ) ) { 228 | do { 229 | $update = $self->_new_minimize_second_and_after_postorder($i) ? 1 : 0; 230 | $update_postorder = $update ? $update : $update_postorder; 231 | } while ( $update == 1 ); 232 | } 233 | } 234 | return $update_postorder; 235 | 236 | } 237 | 238 | sub _new_minimize_second_and_after_postorder { 239 | my ( $self, $i ) = @_; 240 | 241 | $self->_print("\n------ BOTTOM-UP POSTORDER EXPRESSION REDUCE(t$i) ------\n"); 242 | my $bottomup = Orange3::Mini::Bottomup->new( 243 | $self->{config}, $self->{vars}, $self->{assigns}, 244 | run => $self->{run}, 245 | status => $self->{status}, 246 | ); 247 | my $s = '$assigns->[' . $i . ']'; 248 | my $assign_in_locate = 'BLANK'; 249 | return $bottomup->minimize_postorder( $self->{assigns}->[$i]->{root}, 250 | $i, $s, \$assign_in_locate ) ? 1 : 0; 251 | } 252 | 253 | sub _new_minimize_second_and_after_var_constant_minimize { 254 | my $self = shift; 255 | 256 | my $update = $self->_new_minimize_second_and_after_varset_minimize ? 1 : 0; 257 | $update = 258 | $self->_new_minimize_second_and_after_constant_minimize ? 1 : $update; 259 | return $update; 260 | } 261 | 262 | sub _new_minimize_final_var_constant_minimize { 263 | my $self = shift; 264 | 265 | my $update = $self->_new_minimize_final_varset_minimize ? 1 : 0; 266 | $update = $self->_new_minimize_final_constant_minimize ? 1 : $update; 267 | return $update; 268 | } 269 | 270 | sub _new_minimize_second_and_after_varset_minimize { 271 | my $self = shift; 272 | 273 | $self->_must_print("------ VARIABLE MINIMIZE ------\n"); 274 | my $var = Orange3::Mini::Var->new( 275 | $self->{config}, $self->{vars}, $self->{assigns}, 276 | run => $self->{run}, 277 | status => $self->{status}, 278 | ); 279 | return $var->_minimize_var ? 1 : 0; 280 | } 281 | 282 | sub _new_minimize_final_varset_minimize { 283 | my $self = shift; 284 | 285 | $self->_must_print("------ VARIABLE FINAL MINIMIZE ------\n"); 286 | my $var = Orange3::Mini::Var->new( 287 | $self->{config}, $self->{vars}, $self->{assigns}, 288 | run => $self->{run}, 289 | status => $self->{status}, 290 | ); 291 | return $var->_minimize_var_final ? 1 : 0; 292 | } 293 | 294 | sub _new_minimize_second_and_after_constant_minimize { 295 | my $self = shift; 296 | 297 | $self->_must_print("------ CONSTANT MINIMIZE ------\n"); 298 | my $constant = Orange3::Mini::Constant->new( 299 | $self->{config}, $self->{vars}, $self->{assigns}, 300 | run => $self->{run}, 301 | status => $self->{status}, 302 | ); 303 | return $constant->_minimize_constant ? 1 : 0; 304 | } 305 | 306 | sub _new_minimize_final_constant_minimize { 307 | my $self = shift; 308 | 309 | $self->_must_print("------ CONSTANT FINAL MINIMIZE ------\n"); 310 | my $constant = Orange3::Mini::Constant->new( 311 | $self->{config}, $self->{vars}, $self->{assigns}, 312 | run => $self->{run}, 313 | status => $self->{status}, 314 | ); 315 | return $constant->_minimize_constant_final ? 1 : 0; 316 | } 317 | 318 | sub _new_minimize_second_and_after { 319 | my $self = shift; 320 | 321 | my $update = 0; 322 | my $count = 0; 323 | do { 324 | do { 325 | $update = 0; 326 | do { 327 | $update = 328 | $self->_new_minimize_second_and_after_lossy_texpression_cut ? 1 : 0; 329 | $update = 330 | $self->_new_minimize_second_and_after_assign_minimize ? 1 : $update; 331 | $count++; 332 | } while ( $update == 1 && $count < 10 ); 333 | $update = 334 | $self->_new_minimize_second_and_after_var_constant_minimize 335 | ? 2 336 | : $update; 337 | $count++; 338 | } while ( $update == 2 && $count < 20 ); 339 | $update = $self->_new_minimize_final_assign_minimize ? 3 : $update; 340 | $update = $self->_new_minimize_final_var_constant_minimize ? 3 : $update; 341 | $count++; 342 | } while ( $update == 3 && $count < 30 ); 343 | } 344 | 345 | sub _generate_and_test { 346 | my $self = shift; 347 | 348 | return Orange3::Mini::Compute->new( 349 | $self->{config}, $self->{vars}, $self->{assigns}, 350 | run => $self->{run}, 351 | status => $self->{status}, 352 | )->_generate_and_test; 353 | } 354 | 355 | sub _print { 356 | my ( $self, $body ) = @_; 357 | Orange3::Mini::Util::print( $self->{status}->{debug}, $body ); 358 | } 359 | 360 | sub _must_print { 361 | my ( $self, $body ) = @_; 362 | print $body; 363 | } 364 | 365 | 1; 366 | -------------------------------------------------------------------------------- /lib/Orange3/Mini/Topdown.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Mini::Topdown; 2 | 3 | use strict; 4 | use warnings; 5 | use Carp (); 6 | 7 | use Orange3::Mini::Backup; 8 | use Orange3::Mini::Util; 9 | use Orange3::Mini::Compute; 10 | 11 | sub new { 12 | my ( $class, $config, $vars, $assigns, %args ) = @_; 13 | 14 | bless { 15 | config => $config, 16 | vars => $vars, 17 | assigns => $assigns, 18 | run => $args{run}, 19 | status => $args{status}, 20 | backup => Orange3::Mini::Backup->new( $vars, $assigns ), 21 | topdown => undef, 22 | %args, 23 | }, $class; 24 | } 25 | 26 | sub top_down_prepare { 27 | my ( $self, $i ) = @_; 28 | my $assign_var_locate = []; 29 | my $name = 't' . $i; 30 | $self->{top_down}->{current_assign_i} = $i; 31 | $self->{top_down}->{update} = 0; 32 | if ( 33 | !$self->_search_assigns_var_and_exist_check( $name, $assign_var_locate ) ) 34 | { 35 | $self->top_down( $self->{assigns}->[$i]->{root} ); 36 | } 37 | else { 38 | $self->_print("t$i is unchangeable, missed TOP_DOWN"); 39 | } 40 | return $self->{top_down}->{update}; 41 | } 42 | 43 | sub top_down_final_prepare { 44 | my ( $self, $i ) = @_; 45 | $self->{top_down}->{current_assign_i} = $i; 46 | $self->{top_down}->{update} = 0; 47 | return $self->top_down_final( $self->{assigns}->[$i]->{root} ); 48 | } 49 | 50 | sub _top_down_ref_cut_and_judge { 51 | my $self = shift; 52 | my $k = $self->{top_down}->{current_ref_in}; 53 | if ( $k->{ref}->{ntype} eq "op" && $k->{print_value} == 0 ) { 54 | my $i = $self->{top_down}->{current_assign_i}; 55 | $self->{backup}->_backup_var_and_assigns; 56 | $self->{assigns}->[$i]->{root} = $k->{ref} 57 | ; # put an expression that was carried out to minimize the sequence of Formula 58 | $self->{assigns}->[$i]->{val} = 59 | $self->{assigns}->[$i]->{root}->{out}->{val}; 60 | $self->{assigns}->[$i]->{type} = 61 | $self->{assigns}->[$i]->{root}->{out}->{type}; 62 | my $obj = Orange3::Generator::Program->new( $self->{config} ); 63 | my $tree_sprint = 64 | "$i: " . $obj->tree_sprint( $self->{assigns}->[$i]->{root} ) . "\n"; 65 | $self->_print($tree_sprint); 66 | $self->_varset_val_reset($i); 67 | return 1; 68 | } 69 | else { 70 | return 0; 71 | } 72 | } 73 | 74 | sub _top_down_ntype_op_check { 75 | my ( $self, $n ) = @_; 76 | if ( $n->{ntype} eq "var" ) { 77 | return 0; 78 | } 79 | return 1; 80 | } 81 | 82 | sub top_down { 83 | my ( $self, $n ) = @_; 84 | 85 | if ( $self->_top_down_ntype_op_check($n) ) { 86 | for my $k ( @{ $n->{in} } ) { 87 | $self->{top_down}->{current_ref_in} = $k; 88 | if ( $self->_top_down_ref_cut_and_judge ) { 89 | if ( $self->_generate_and_test ) { 90 | $self->{top_down}->{update} = 1; 91 | $self->top_down( $self->{top_down}->{current_ref_in}->{ref} ); 92 | return; 93 | } 94 | my $i = $self->{top_down}->{current_assign_i}; 95 | $self->{backup}->_restore_assign_number($i); 96 | $self->{backup}->_restore_var_and_assigns; 97 | } 98 | } 99 | } 100 | } 101 | 102 | sub top_down_final { 103 | my ( $self, $n ) = @_; 104 | 105 | if ( $self->_top_down_ntype_op_check($n) ) { 106 | for my $k ( @{ $n->{in} } ) { 107 | my $recompute = 1; 108 | my $i = $self->{top_down}->{current_assign_i}; 109 | $self->{top_down}->{current_ref_in} = $k; 110 | if ( $self->_top_down_ref_cut_and_judge ) { 111 | if ( $self->_dump_test( $i, $recompute ) == 1 ) { 112 | $self->{top_down}->{update} = 1; 113 | $self->top_down_final( $self->{top_down}->{current_ref_in}->{ref} ); 114 | return; 115 | } 116 | my $i = $self->{top_down}->{current_assign_i}; 117 | $self->{backup}->_restore_assign_number($i); 118 | $self->{backup}->_restore_var_and_assigns; 119 | } 120 | } 121 | } 122 | } 123 | 124 | sub _varset_val_reset { 125 | my ( $self, $i ) = @_; 126 | my $new_type = $self->{assigns}->[$i]->{root}->{out}->{type}; 127 | Orange3::Mini::Compute->new( 128 | $self->{config}, $self->{vars}, $self->{assigns}, 129 | run => $self->{run}, 130 | status => $self->{status}, 131 | ) 132 | ->varset_val_reset( "t", $i, $new_type, 133 | "UNCHANGE", $self->{assigns}->[$i]->{root}->{out}->{val} ); 134 | } 135 | 136 | sub _tval_compute { 137 | my ( $self, $modify_t_num ) = @_; 138 | return Orange3::Mini::Compute->new( 139 | $self->{config}, $self->{vars}, $self->{assigns}, 140 | run => $self->{run}, 141 | status => $self->{status}, 142 | )->tval_compute($modify_t_num); 143 | } 144 | 145 | sub _search_assigns_var_and_exist_check { 146 | my ( $self, $name, $assign_var_locate ) = @_; 147 | 148 | return Orange3::Mini::Util::search_assigns_var( $self->{assigns}, $name, 149 | $assign_var_locate ); 150 | } 151 | 152 | sub _generate_and_test { 153 | my $self = shift; 154 | 155 | return Orange3::Mini::Compute->new( 156 | $self->{config}, $self->{vars}, $self->{assigns}, 157 | run => $self->{run}, 158 | status => $self->{status}, 159 | )->_generate_and_test; 160 | } 161 | 162 | sub _dump_test { 163 | my ( $self, $assigns_i, $recompute ) = @_; 164 | 165 | return Orange3::Mini::Compute->new( 166 | $self->{config}, $self->{vars}, $self->{assigns}, 167 | run => $self->{run}, 168 | status => $self->{status}, 169 | )->dump_test( $assigns_i, $recompute ); 170 | } 171 | 172 | sub _print { 173 | my ( $self, $body ) = @_; 174 | Orange3::Mini::Util::print( $self->{status}->{debug}, $body ); 175 | } 176 | 177 | 1; 178 | -------------------------------------------------------------------------------- /lib/Orange3/Mini/Util.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Mini::Util; 2 | 3 | use strict; 4 | use warnings; 5 | use Carp (); 6 | 7 | sub _check_assign { 8 | my ($assign_i) = @_; 9 | return ( defined $assign_i->{root} && $assign_i->{print_statement} ) ? 1 : 0; 10 | } 11 | 12 | sub print { 13 | my ( $debug, $body ) = @_; 14 | if ($debug) { print $body . "\n"; } 15 | else { ; } 16 | } 17 | 18 | sub _count_defined_assign { 19 | my ($assigns) = @_; 20 | my $assign_define = 0; 21 | for my $i ( 0 .. $#{$assigns} ) { 22 | $assign_define = 23 | _check_assign( $assigns->[$i] ) ? ++$assign_define : $assign_define; 24 | } 25 | return $assign_define; 26 | } 27 | 28 | sub _check_assign_exp_only { 29 | my ($assign_i) = @_; 30 | return ( defined $assign_i->{root} && $assign_i->{print_statement} == 2 ) 31 | ? 1 32 | : 0; 33 | } 34 | 35 | sub _check_assign_exp { 36 | my ($assign_i) = @_; 37 | return ( defined $assign_i->{root} && $assign_i->{print_statement} == 1 ) 38 | ? 1 39 | : 0; 40 | } 41 | 42 | sub _count_assign_exp { 43 | my ($assigns) = @_; 44 | my $assign_define = 0; 45 | for my $i ( 0 .. $#{$assigns} ) { 46 | $assign_define = 47 | _check_assign_exp( $assigns->[$i] ) ? ++$assign_define : $assign_define; 48 | } 49 | return $assign_define; 50 | } 51 | 52 | sub _count_assign_exp_only { 53 | my ($assigns) = @_; 54 | my $assign_define = 0; 55 | for my $i ( 0 .. $#{$assigns} ) { 56 | $assign_define = 57 | _check_assign_exp_only( $assigns->[$i] ) 58 | ? ++$assign_define 59 | : $assign_define; 60 | } 61 | return $assign_define; 62 | } 63 | 64 | sub search_assigns_var { 65 | my ( $assigns, $name, $assign_var_locate ) = @_; 66 | 67 | my $exist_total = 0; 68 | 69 | for my $i ( 0 .. $#{$assigns} ) { 70 | my $assign_i = $assigns->[$i]; 71 | if ( _check_assign($assign_i) ) { 72 | my $s = '$assigns->[' . $i . ']->{root}'; 73 | my $exist = search_assign_var( $assigns->[$i]->{root}, 74 | $name, $s, $assign_var_locate ); 75 | $exist_total += $exist; 76 | } 77 | } 78 | return $exist_total; 79 | } 80 | 81 | sub search_assign_var { 82 | my ( $ref, $name, $s, $assign_var_locate ) = @_; 83 | 84 | my $exist_total = 0; 85 | 86 | if ( $ref->{ntype} eq 'op' ) { 87 | $s .= "{'in'}"; 88 | my $i = 0; 89 | for my $r ( @{ $ref->{in} } ) { 90 | if ( $r->{print_value} == 0 ) { 91 | my $sr .= $s . "[$i]{'ref'}"; 92 | my $exist = 93 | search_assign_var( $r->{ref}, $name, $sr, $assign_var_locate ); 94 | $exist_total += $exist; 95 | } 96 | $i++; 97 | } 98 | return $exist_total; 99 | } 100 | elsif ( $ref->{ntype} eq 'var' ) { 101 | my $var_name = $ref->{var}->{name_type} . $ref->{var}->{name_num}; 102 | $s .= "{'var'}"; 103 | if ( $var_name eq $name ) { 104 | push @$assign_var_locate, $s; 105 | return ++$exist_total; 106 | } 107 | return $exist_total; 108 | } 109 | else { 110 | Carp::croak("$ref->{ntype}"); 111 | } 112 | } 113 | 114 | sub put_assign_var { 115 | my ( $assigns, $assign_var_locate, $v ) = @_; 116 | 117 | for my $i ( 0 .. $#{$assign_var_locate} ) { 118 | if ( defined $assign_var_locate->[$i] ) { 119 | my $s = $assign_var_locate->[$i]; 120 | my $sr = $s . "{type}='" . $v->{type} . "';"; 121 | $sr .= $s . "{ival}='" . $v->{ival} . "';"; 122 | $sr .= $s . "{val}='" . $v->{val} . "';"; 123 | $sr .= $s . "{name_type}='" . $v->{name_type} . "';"; 124 | $sr .= $s . "{name_num}='" . $v->{name_num} . "';"; 125 | $sr .= $s . "{class}='" . $v->{class} . "';"; 126 | $sr .= $s . "{modifier}='" . $v->{modifier} . "';"; 127 | $sr .= $s . "{scope}='" . $v->{scope} . "';"; 128 | $sr .= $s . "{used}='" . $v->{used} . "';"; 129 | eval $sr; 130 | 131 | if ($@) { 132 | Carp::croak("eval $sr\n$@\n"); 133 | } 134 | } 135 | } 136 | } 137 | 138 | sub int_ification { 139 | my ( $conifg, $type, $val ) = @_; 140 | 141 | my ( $s, $ty ) = split( / /, $type, 2 ); 142 | my $at; 143 | 144 | if ( $s eq "signed" || $s eq "unsigned" ) { 145 | if ( $ty eq "long long" ) { $at = $s . ' long'; } 146 | elsif ( $ty eq "long" ) { $at = $s . ' int'; } 147 | elsif ( $ty eq "int" ) { $at = $s . ' int'; } 148 | elsif ( $ty eq "short" ) { $at = $s . ' int'; } 149 | elsif ( $ty eq "char" ) { $at = $s . ' short'; } 150 | else { Carp::croak("type = $s $ty"); } 151 | } 152 | else { 153 | if ( $type eq "long double" ) { $at = 'double'; } 154 | elsif ( $type eq "double" ) { $at = 'float'; } 155 | elsif ( $type eq "float" ) { $at = 'signed long long'; } 156 | else { Carp::croak("type = $type($s $ty)"); } 157 | } 158 | 159 | my $types = $conifg->get('type'); 160 | my $max = Math::BigInt->new( $types->{$at}->{max} ); 161 | my $min = Math::BigInt->new( $types->{$at}->{min} ); 162 | if ( $s eq "unsigned" ) { 163 | $val = $val % ( $max + 1 ); 164 | } 165 | else { 166 | unless ( $min <= $val && $val <= $max ) { 167 | $at = $type; 168 | } 169 | } 170 | return ( $at, $val ); 171 | 172 | } 173 | 1; 174 | -------------------------------------------------------------------------------- /lib/Orange3/Runner.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Runner; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Carp (); 7 | use POSIX; 8 | use File::Basename; 9 | use File::Copy (); 10 | use File::Path (); 11 | use File::Spec (); 12 | use Getopt::Long qw/:config posix_default no_ignore_case bundling auto_help/; 13 | 14 | use Orange3::Config; 15 | use Orange3::Dumper; 16 | use Orange3::Generator; 17 | use Orange3::Generator::Program; 18 | use Orange3::Log; 19 | use Orange3::Runner::Compiler; 20 | use Orange3::Runner::Executor; 21 | 22 | use constant MAX_TEST_COUNT => 10000000; 23 | 24 | sub new { 25 | my ( $class, $scriptdir ) = @_; 26 | bless { 27 | count => undef, 28 | config => undef, 29 | config_file => undef, 30 | start_seed => 0, 31 | start_time => undef, 32 | time => undef, 33 | log_dir => 'LOG', 34 | scriptdir => $scriptdir, 35 | }, $class; 36 | } 37 | 38 | sub parse_options { 39 | my $self = shift; 40 | 41 | local @ARGV = @_; 42 | 43 | GetOptions( 44 | "c|config:s" => \$self->{config_file}, 45 | "h|help" => \$self->{help}, 46 | "n:i" => \$self->{count}, 47 | "s|seed:i" => \$self->{start_seed}, 48 | "t|time:f" => \$self->{time}, 49 | ) or _usage(); 50 | 51 | if ( $self->{count} && $self->{time} ) { 52 | Carp::croak("Cannot enable 'count' and 'time' option"); 53 | } 54 | 55 | if ( $self->{help} ) { 56 | _usage(); 57 | } 58 | 59 | $self->{argv} = [@ARGV]; 60 | } 61 | 62 | sub run { 63 | my $self = shift; 64 | 65 | $self->_validate; 66 | $self->_load_config_file; 67 | $self->_init; 68 | 69 | my @ng_seeds = (); 70 | 71 | my ( $start_seed, $count, $time ) = 72 | ( $self->{start_seed}, $self->{count}, $self->{time} ); 73 | 74 | for my $seed ( $start_seed .. $start_seed + $count - 1 ) { 75 | srand($seed); 76 | $self->{seed} = $seed; 77 | if ( $self->_randomtest ) { 78 | push @ng_seeds, $seed; 79 | } 80 | if ( defined $self->{time} 81 | && ( time - $self->{start_time} ) / 3600 > $self->{time} ) 82 | { 83 | last; 84 | } 85 | } 86 | my $seed_sum = $self->{seed} - $start_seed + 1; 87 | my $time_sum = ( time - $self->{start_time} ) / 3600; 88 | $time_sum = sprintf( "%.1f", $time_sum ); 89 | my $ng_seed_sum = @ng_seeds; 90 | my $print = "NG_SEED => @ng_seeds\n"; 91 | $print .= "NG / SEED : $ng_seed_sum / $seed_sum ($time_sum [h])\n"; 92 | Orange3::Log->new( 93 | name => "orange3.log", 94 | dir => $self->{log_dir} 95 | )->print($print); 96 | print "$print"; 97 | } 98 | 99 | sub _validate { 100 | my $self = shift; 101 | 102 | unless ( $self->{time} || $self->{count} ) { 103 | $self->{count} = 1; 104 | } 105 | 106 | if ( $self->{time} ) { 107 | $self->{count} = MAX_TEST_COUNT; 108 | } 109 | } 110 | 111 | sub _load_config_file { 112 | my $self = shift; 113 | 114 | my $config_file = $self->{config_file}; 115 | if ( defined($config_file) ) { 116 | if ( -e $config_file ) { 117 | $self->{config} = Orange3::Config->new($config_file); 118 | $self->{config}->_check_config; 119 | } 120 | else { 121 | Carp::croak("$config_file does not exist"); 122 | } 123 | } 124 | else { 125 | print "--config option: none,\n"; 126 | $config_file = ".orangerc.cnf"; 127 | my $base = $self->{scriptdir}; 128 | if ( -e "$base/.orangerc.cnf" ) { 129 | $config_file = $self->{config_file} = "$base/.orangerc.cnf"; 130 | $self->{config} = Orange3::Config->new($config_file); 131 | $self->{config}->_check_config; 132 | print "Load default config file at $config_file\n"; 133 | } 134 | elsif ( -e "./config/$config_file" ) { 135 | $self->{config_file} = $config_file = "./config/$config_file"; 136 | $self->{config} = Orange3::Config->new($config_file); 137 | $self->{config}->_check_config; 138 | print "Load default config file at $config_file\n"; 139 | } 140 | else { 141 | Carp::croak("Load default config file, but .orangerc.cnf does not exist"); 142 | } 143 | 144 | } 145 | 146 | my $file = $config_file; 147 | $file =~ s/\.cnf$//; 148 | my $compiler_cnf = "$file-compiler.cnf"; 149 | my $executor_cnf = "$file-executor.cnf"; 150 | if ( -e $compiler_cnf ) { 151 | $self->{compiler} = do $compiler_cnf; 152 | } 153 | if ( -e $executor_cnf ) { 154 | $self->{executor} = do $executor_cnf; 155 | } 156 | } 157 | 158 | sub _copy_config { 159 | my $self = shift; 160 | 161 | my $file = $self->{config_file}; 162 | 163 | $file =~ s/\.cnf$//; 164 | 165 | my %config_files = ( 166 | basic => $self->{config_file}, 167 | compiler => "$file-compiler.cnf", 168 | executor => "$file-executor.cnf", 169 | ); 170 | my %target_paths = ( 171 | basic => File::Spec->catfile( $self->{log_dir}, 'orange3.cnf' ), 172 | compiler => File::Spec->catfile( $self->{log_dir}, 'orange3-compiler.cnf' ), 173 | executor => File::Spec->catfile( $self->{log_dir}, 'orange3-executor.cnf' ), 174 | ); 175 | 176 | for my $key ( keys %config_files ) { 177 | File::Copy::copy( $config_files{$key}, $target_paths{$key} ) 178 | or Carp::croak("Cannot copy to $target_paths{$key}"); 179 | } 180 | } 181 | 182 | sub _randomtest { 183 | my $self = shift; 184 | 185 | my $config = $self->{config}; 186 | 187 | my $test_ng = 0; 188 | 189 | my ( $varset, $roots ) = $self->_generate_vars_and_roots; 190 | 191 | my $generator = Orange3::Generator::Program->new($config); 192 | $generator->generate_program( $varset, $roots ); 193 | 194 | for my $option ( @{ $config->get('options') } ) { 195 | my $compiler = Orange3::Runner::Compiler->new( 196 | compile => $self->{compiler}->{compile}, 197 | config => $config, 198 | option => $option, 199 | ); 200 | $compiler->run(); 201 | 202 | my $executor = Orange3::Runner::Executor->new( 203 | config => $self->{config}, 204 | execute => $self->{executor}->{execute}, 205 | ); 206 | if ( $compiler->error_msg eq 0 ) { #TODO msg should be undef or '' 207 | $executor->run; 208 | } 209 | 210 | if ( $compiler->error_msg ne 0 || $executor->error != 0 ) { 211 | my $header = $self->_error_header( 212 | $compiler->command, $compiler->error_msg, 213 | $executor->command, $executor->error_msg, 214 | ); 215 | my $seed = $self->{seed}; 216 | Orange3::Log->new( 217 | name => "error$seed\_$option.c", 218 | dir => $self->{log_dir} 219 | )->print( $header . $generator->program ); 220 | 221 | my $content = Orange3::Dumper->new( 222 | vars => $varset, 223 | roots => $roots, 224 | )->all( 225 | expression_size => $self->{generator}->expression_size, 226 | root_size => $self->{generator}->root_max, 227 | var_size => $self->{generator}->var_max, 228 | option => $option 229 | ); 230 | 231 | Orange3::Log->new( 232 | name => "error$seed\_$option.pl", 233 | dir => $self->{log_dir} 234 | )->print($content); 235 | 236 | $test_ng = 1; 237 | } 238 | else { 239 | print " "; 240 | } 241 | } 242 | if ( $test_ng == 0 ) { 243 | print "\n"; 244 | } 245 | return $test_ng; 246 | } 247 | 248 | sub _init { 249 | my $self = shift; 250 | 251 | $self->{start_time} = time; 252 | 253 | my $base = _log_name( $self->{start_time} ); 254 | $self->{log_dir} = File::Spec->catfile( $self->{log_dir}, $base ); 255 | 256 | unless ( -d $self->{log_dir} ) { 257 | File::Path::mkpath( [ $self->{log_dir} ], 0, oct(777) ); 258 | } 259 | 260 | $self->_copy_config(); 261 | } 262 | 263 | sub _generate_vars_and_roots { 264 | my $self = shift; 265 | 266 | $self->{generator} = Orange3::Generator->new( 267 | seed => $self->{seed}, 268 | config => $self->{config}, 269 | ); 270 | $self->{generator}->run; 271 | 272 | return ( $self->{generator}->{vars}, $self->{generator}->{roots} ); 273 | } 274 | 275 | sub _error_header { 276 | my ( 277 | $self, $compile_command, $compile_message, 278 | $execute_command, $execute_message 279 | ) = @_; 280 | 281 | my ( $expression_size, $root_max, $var_max ) = ( 282 | $self->{generator}->expression_size, 283 | $self->{generator}->root_max, 284 | $self->{generator}->var_max 285 | ); 286 | 287 | my $header_message = ""; 288 | if ( defined $compile_command ) { 289 | chomp($compile_command); 290 | $header_message .= "\$ $compile_command\n"; 291 | } 292 | if ( defined $compile_message ) { 293 | chomp($compile_message); 294 | $header_message .= "$compile_message\n"; 295 | } 296 | if ( defined $execute_command ) { 297 | chomp($execute_command); 298 | $header_message .= "\$ $execute_command\n"; 299 | } 300 | if ( defined $execute_message ) { 301 | chomp($execute_message); 302 | $header_message .= "$execute_message\n"; 303 | } 304 | 305 | my $header = <<"..."; 306 | /* 307 | SIZE=$expression_size NUM=$root_max, VAR_NUM=$var_max 308 | 309 | $header_message 310 | 311 | */ 312 | ... 313 | 314 | return $header; 315 | } 316 | 317 | sub _log_name { 318 | my $time = shift; 319 | 320 | # my ($sec, $min, $hour, $mday, $mon, $year) = localtime($time); 321 | # $year += 1900; 322 | # $mon += 1; 323 | # return "${year}${mon}${mday}-${hour}${min}${sec}"; 324 | return POSIX::strftime "%Y%m%d-%H%M%S", localtime($time); 325 | } 326 | 327 | sub _usage { 328 | die < "", 11 | command => "", 12 | %args, 13 | }, $class; 14 | } 15 | 16 | sub run { 17 | my $self = shift; 18 | 19 | system "rm -f $self->{config}->{exec_file} > /dev/null"; 20 | ( $self->{error_msg}, $self->{command} ) = 21 | $self->{compile}->( $self->{config}, $self->{option} ); 22 | } 23 | 24 | sub error_msg { shift->{error_msg}; } 25 | sub command { shift->{command}; } 26 | 27 | 1; 28 | -------------------------------------------------------------------------------- /lib/Orange3/Runner/Executor.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Runner::Executor; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | sub new { 7 | my ( $class, %args ) = @_; 8 | 9 | bless { 10 | error => [], 11 | error_msg => "", 12 | command => "", 13 | %args, 14 | }, $class; 15 | } 16 | 17 | sub run { 18 | my $self = shift; 19 | 20 | ( $self->{error_msg}, $self->{error}, $self->{command} ) = 21 | $self->{execute}->( $self->{config} ); 22 | } 23 | 24 | sub error { @{ shift->{error} }; } 25 | sub error_msg { shift->{error_msg}; } 26 | sub command { shift->{command}; } 27 | 28 | 1; 29 | -------------------------------------------------------------------------------- /lib/Orange3/Util.pm: -------------------------------------------------------------------------------- 1 | package Orange3::Util; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Carp (); 7 | use File::Spec (); 8 | 9 | sub is_dir { 10 | my $path = shift; 11 | 12 | return -d $path ? 1 : 0; 13 | } 14 | 15 | sub is_file { 16 | my $path = shift; 17 | 18 | return -f $path ? 1 : 0; 19 | } 20 | 21 | sub read_directory { 22 | my $dir = shift; 23 | 24 | opendir my $dh, $dir or Carp::croak("Can't open directory $dir: $!"); 25 | my @dirs = grep { !m{^\.\.?$} } readdir $dh; 26 | closedir $dh; 27 | 28 | return @dirs; 29 | } 30 | 31 | sub which { 32 | my $command = shift; 33 | 34 | my @paths = File::Spec->path; 35 | my @extensions = (''); 36 | 37 | for my $path (@paths) { 38 | my $path = File::Spec->catfile( $path, $command ); 39 | 40 | for my $extension (@extensions) { 41 | my $file = $path . $extension; 42 | next if -d $file; 43 | 44 | if ( -e $file && -x $file ) { 45 | return 1; 46 | } 47 | } 48 | } 49 | 50 | return 0; 51 | } 52 | 53 | package Orange3::Util::Chdir; 54 | 55 | use Cwd qw(getcwd); 56 | 57 | sub new { 58 | my ( $class, $dir ) = @_; 59 | 60 | my $cwd = getcwd(); 61 | my $guard = sub { chdir $cwd; }; 62 | 63 | chdir($dir) or die "Can't chdir '$dir'"; 64 | bless \$guard, $class; 65 | } 66 | 67 | sub DESTROY { 68 | ${ $_[0] }->(); 69 | } 70 | 71 | 1; 72 | 73 | -------------------------------------------------------------------------------- /minil.toml: -------------------------------------------------------------------------------- 1 | name = "Orange3" 2 | script_files = ['script/*', 'config/.*'] 3 | [FileGatherer] 4 | include_dotfiles=true -------------------------------------------------------------------------------- /script/orange3: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use File::Basename; 7 | use File::Spec (); 8 | 9 | use lib qw/lib/; 10 | 11 | use Orange3::Runner; 12 | 13 | my $scriptdir = File::Spec->rel2abs( dirname(__FILE__) ); 14 | 15 | my $runner = Orange3::Runner->new($scriptdir); 16 | $runner->parse_options(@ARGV); 17 | $runner->run(); 18 | -------------------------------------------------------------------------------- /script/orange3-minimizer: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib qw/lib/; 7 | 8 | use Orange3::Mini; 9 | 10 | my $runner = Orange3::Mini->new(); 11 | $runner->parse_options(@ARGV); 12 | $runner->run; 13 | 14 | -------------------------------------------------------------------------------- /t/00_compile.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Test::More; 3 | 4 | use_ok $_ for qw( 5 | Orange3 6 | ); 7 | 8 | done_testing; 9 | 10 | -------------------------------------------------------------------------------- /t/100_runner/01_basic.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | 6 | use Orange3::Runner; 7 | 8 | subtest 'basic' => sub { 9 | my $runner = Orange3::Runner->new(); 10 | isa_ok $runner, 'Orange3::Runner'; 11 | 12 | can_ok $runner, 'run'; 13 | can_ok $runner, 'parse_options'; 14 | 15 | subtest 'parse_options' => sub { 16 | subtest 'option: config' => sub { 17 | $runner = Orange3::Runner->new(); 18 | subtest 'short option' => sub { 19 | $runner->parse_options(qw/-c hoge/); 20 | ok $runner->{config_file}; 21 | is $runner->{config_file}, 'hoge'; 22 | }; 23 | 24 | subtest 'long option' => sub { 25 | $runner->parse_options(qw/--config=hoge/); 26 | ok $runner->{config_file}; 27 | is $runner->{config_file}, 'hoge'; 28 | }; 29 | }; 30 | 31 | subtest 'option: count' => sub { 32 | $runner = Orange3::Runner->new(); 33 | subtest 'short option' => sub { 34 | $runner->parse_options(qw/-n 100/); 35 | ok $runner->{count}; 36 | is $runner->{count}, 100, 'option:count is ok'; 37 | }; 38 | }; 39 | 40 | subtest 'option: seed' => sub { 41 | $runner = Orange3::Runner->new(); 42 | subtest 'short option' => sub { 43 | $runner->parse_options(qw/-s 100/); 44 | ok $runner->{start_seed}; 45 | is $runner->{start_seed}, 100, 'option:seed is ok'; 46 | }; 47 | 48 | subtest 'long option' => sub { 49 | $runner->parse_options(qw/--seed=100/); 50 | ok $runner->{start_seed}; 51 | is $runner->{start_seed}, 100, 'option:seed is ok'; 52 | }; 53 | }; 54 | 55 | subtest 'option: time' => sub { 56 | $runner = Orange3::Runner->new(); 57 | subtest 'short option' => sub { 58 | $runner->parse_options(qw/-t 100/); 59 | ok $runner->{time}; 60 | is $runner->{time}, 100, 'option:time is ok'; 61 | }; 62 | 63 | subtest 'long option' => sub { 64 | $runner->parse_options(qw/--time=100/); 65 | ok $runner->{time}; 66 | is $runner->{time}, 100, 'option:time is ok'; 67 | }; 68 | }; 69 | 70 | subtest 'option: help' => sub { 71 | $runner = Orange3::Runner->new(); 72 | subtest 'short option' => sub { 73 | eval { 74 | $runner->parse_options(qw/-h/); 75 | }; 76 | like $@, qr/^Usage/, 'show usage'; 77 | }; 78 | 79 | subtest 'long option' => sub { 80 | eval { 81 | $runner->parse_options(qw/--help/); 82 | }; 83 | like $@, qr/^Usage/, 'show usage'; 84 | }; 85 | }; 86 | 87 | subtest 'die' => sub { 88 | $runner = Orange3::Runner->new(); 89 | eval { 90 | $runner->parse_options(qw/-n 100 -t 100/); 91 | }; 92 | like $@, qr/Cannot enable 'count' and 'time' option/, 'die ok'; 93 | }; 94 | }; 95 | 96 | subtest 'validate' => sub { 97 | $runner = Orange3::Runner->new(); 98 | $runner->parse_options(); 99 | $runner->_validate(); 100 | is $runner->{count}, 1, 'set default value' 101 | }; 102 | }; 103 | 104 | done_testing; 105 | -------------------------------------------------------------------------------- /t/200_generator/01_basic.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use List::MoreUtils qw/any/; #TODO recommend 6 | 7 | use Orange3::Config; 8 | use Orange3::Generator; 9 | use t::Util qw/create_configfile/; 10 | 11 | my $test_config = { 12 | debug_mode => 1, 13 | e_size_num => 3001, 14 | classes => ['static', ''], 15 | modifiers => ['const', 'volatile', 'const volatile', ''], 16 | tmodifiers => ['volatile', ''], 17 | types => [ 18 | 'signed char', 19 | 'unsigned char', 20 | 'signed short', 21 | 'unsigned short', 22 | 'signed int', 23 | 'unsigned int', 24 | 'signed long', 25 | 'unsigned long', 26 | 'signed long long', 27 | 'unsigned long long', 28 | 'float', 29 | 'double', 30 | 'long double', 31 | ], 32 | scopes => ['LOCAL', 'GLOBAL'], 33 | operators => [qw(+ + + - - - * * * * * * / / / / / / % % % % % % << << << << << << >> >> >> >> >> >> == != < > <= >= && || | | | & & & ^ ^ ^)], 34 | type => { 35 | "signed char" => { 36 | bits => 8, 37 | }, 38 | "unsigned char" => { 39 | bits => 8, 40 | }, 41 | "signed short" => { 42 | bits => 16, 43 | }, 44 | "unsigned short" => { 45 | bits => 16, 46 | }, 47 | "signed int" => { 48 | bits => 32, 49 | }, 50 | "unsigned int" => { 51 | bits => 32, 52 | }, 53 | "signed long" => { 54 | bits => 32, 55 | }, 56 | "unsigned long" => { 57 | bits => 32, 58 | }, 59 | "signed long long" => { 60 | bits => 64, 61 | }, 62 | "unsigned long long" => { 63 | bits => 64, 64 | }, 65 | "float" => { 66 | bits => 24, 67 | }, 68 | "double" => { 69 | bits => 53, 70 | }, 71 | "long double" => { 72 | bits => 65, 73 | }, 74 | } 75 | }; 76 | 77 | my $config_file = create_configfile($test_config); 78 | 79 | subtest 'basic' => sub { 80 | my $generator = Orange3::Generator->new( 81 | config => Orange3::Config->new($config_file->filename) 82 | ); 83 | 84 | isa_ok $generator, 'Orange3::Generator'; 85 | isa_ok $generator->{config}, 'Orange3::Config'; 86 | 87 | can_ok $generator, 'run'; 88 | 89 | $generator->_init(); 90 | 91 | subtest '_generate_random_var' => sub { 92 | my $number = 0; 93 | my $var = $generator->_generate_random_var($number); 94 | 95 | is $var->{name_type}, 'x', "name_type: $var->{name_type}"; 96 | is $var->{name_num}, $number, "name_num: $var->{name_num}"; 97 | ok !defined $var->{ival}; 98 | ok !defined $var->{val}; 99 | ok any { $_ eq $var->{type} } @{$test_config->{types}}, "type: $var->{type}"; 100 | ok any { $_ eq $var->{class} } @{$test_config->{classes}}, "class: $var->{class}"; 101 | ok any { $_ eq $var->{modifier} } @{$test_config->{modifiers}}, "modifier: $var->{modifier}"; 102 | ok any { $_ eq $var->{scope} } @{$test_config->{scopes}}, "scope: $var->{scope}"; 103 | is $var->{used}, 1, "used: $var->{used}"; 104 | }; 105 | 106 | subtest 'generate_t_var' => sub { 107 | my $type = 'signed int'; 108 | my $value = 0; 109 | my $count = 0; 110 | my $var = $generator->generate_t_var( 111 | $type, $value, $count 112 | ); 113 | 114 | is $var->{name_type}, 't', "name_type: $var->{name_type}"; 115 | is $var->{name_num}, $count, "name_num: $var->{name_num}"; 116 | is $var->{val}, $value; 117 | is $var->{type}, $type, "type: $var->{type}"; 118 | ok any { $_ eq $var->{class} } @{$test_config->{classes}}, "class: $var->{class}"; 119 | ok any { $_ eq $var->{modifier} } @{$test_config->{tmodifiers}}, "modifier: $var->{modifier}"; 120 | is $var->{scope}, 'GLOBAL', "scope: $var->{scope}"; 121 | is $var->{used}, 1, "used: $var->{used}"; 122 | }; 123 | 124 | subtest 'generate_expression' => sub { 125 | subtest 'minimal expression' => sub { 126 | my $node = 0; 127 | my $depth = 0; 128 | $generator->{var_max} = 4; 129 | $generator->generate_random_vars(); 130 | my $expression = $generator->generate_expression($node, $depth, undef); 131 | 132 | ok $expression; 133 | is $expression->{ntype}, 'op', 'ok expression type'; 134 | ok any { $_ eq $expression->{otype} } @{$test_config->{operators}}, "ok operator"; 135 | }; 136 | 137 | subtest 'deeply expression' => sub { 138 | my $node = 10; 139 | my $depth = 10; 140 | $generator->{var_max} = 4; 141 | $generator->generate_random_vars(); 142 | my $expression = $generator->generate_expression($node, $depth, undef); 143 | 144 | ok $expression; 145 | }; 146 | }; 147 | 148 | subtest '_generate_value' => sub { 149 | subtest 'bit is 0' => sub { 150 | isa_ok Orange3::Generator::_generate_value(0), 'Math::BigInt'; 151 | }; 152 | 153 | subtest 'bit is not 0' => sub { 154 | isa_ok Orange3::Generator::_generate_value(1), 'Math::BigInt'; 155 | }; 156 | }; 157 | 158 | subtest '_select_varnode' => sub { 159 | $generator->{var_max} = 5; 160 | $generator->generate_random_vars(); 161 | my $var = $generator->_select_varnode(); 162 | 163 | is $var->{ntype}, 'var'; 164 | }; 165 | 166 | subtest 'define_value' => sub { 167 | subtest 'type is float' => sub { 168 | my $value = $generator->define_value('float'); 169 | ok $value; 170 | }; 171 | 172 | # subtest 'type is signed int' => sub { 173 | # my $value = $generator->define_value('signed int'); 174 | # ok $value; 175 | # }; 176 | }; 177 | 178 | subtest 'integral_promotion' => sub { 179 | subtest 'smaller' => sub { 180 | my $type = 'unsigned char'; 181 | my $got = $generator->integral_promotion($type); 182 | is $got, 'signed int'; 183 | }; 184 | }; 185 | }; 186 | 187 | done_testing; 188 | -------------------------------------------------------------------------------- /t/300_config/01_basic.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | 6 | use Orange3::Config; 7 | use t::Util qw/create_configfile/; 8 | 9 | my $test_config = { 10 | e_size_num => 3001, 11 | options => ["-O3"], 12 | source_file => 'test.c', 13 | exec_file => 'a.out', 14 | macro_ok => 'printf("@OK@\n")', 15 | macro_ng => 'printf("@NG@ (test = " fmt ")\n",val)', 16 | }; 17 | 18 | my $config_file = create_configfile($test_config); 19 | 20 | subtest 'basic' => sub { 21 | my $config = Orange3::Config->new($config_file->filename); 22 | 23 | isa_ok $config, 'Orange3::Config'; 24 | can_ok $config, 'get'; 25 | 26 | subtest 'load config' => sub { 27 | for my $key ( keys %{$test_config}) { 28 | my $got = $config->get($key); 29 | my $expected = $test_config->{$key}; 30 | if (ref $got) { 31 | is_deeply $got, $expected, "set param $key"; 32 | } 33 | else { 34 | is $got, $expected, "set param $key"; 35 | } 36 | } 37 | }; 38 | }; 39 | 40 | done_testing; 41 | -------------------------------------------------------------------------------- /t/400_log/01_basic.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use File::Spec (); 6 | use File::Temp (); 7 | 8 | use Orange3::Log; 9 | 10 | my $testdir = File::Temp::tempdir( CLEANUP => 1 ); 11 | $testdir =~ s{/$}{}; 12 | 13 | subtest 'basic' => sub { 14 | my $log = Orange3::Log->new( 15 | dir => $testdir, 16 | name => 'test.log' 17 | ); 18 | 19 | isa_ok $log, 'Orange3::Log'; 20 | can_ok $log, 'print'; 21 | 22 | ok(-e File::Spec->catfile($testdir, 'test.log'), 'create log file'); 23 | }; 24 | 25 | subtest 'dies ok' => sub { 26 | eval { 27 | my $log = Orange3::Log->new( 28 | name => 'test.log' 29 | ); 30 | }; 31 | like $@, qr/Missing mandatory parameter: dir/, 'no directory'; 32 | 33 | eval { 34 | my $log = Orange3::Log->new( 35 | dir => $testdir, 36 | name => 'test.log', 37 | encoding => 'I_AM_ILLEGAL' 38 | ); 39 | }; 40 | like $@, qr/Not found encoding 'I_AM_ILLEGAL'/, 'illegal parameter'; 41 | 42 | }; 43 | 44 | done_testing; 45 | -------------------------------------------------------------------------------- /t/500_dumper/01_basic.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | 6 | use Math::BigInt; 7 | 8 | use Orange3::Dumper; 9 | 10 | subtest 'basic' => sub { 11 | my $dumper = Orange3::Dumper->new( 12 | vars => undef, 13 | roots => undef, 14 | ); 15 | isa_ok $dumper, 'Orange3::Dumper'; 16 | can_ok $dumper, 'vars_and_roots'; 17 | can_ok $dumper, 'all'; 18 | }; 19 | 20 | subtest 'dies ok' => sub { 21 | eval { 22 | Orange3::Dumper->new(); 23 | }; 24 | like $@, qr/^Missing mandatory parameter:/, 'none both of parameters'; 25 | 26 | eval { 27 | Orange3::Dumper->new( 28 | vars => undef, 29 | ); 30 | }; 31 | like $@, qr/Missing mandatory parameter: roots/, 'vars only'; 32 | 33 | eval { 34 | Orange3::Dumper->new( 35 | roots => undef, 36 | ); 37 | }; 38 | like $@, qr/Missing mandatory parameter: vars/, 'roots only'; 39 | }; 40 | 41 | subtest 'bigint' => sub { 42 | my $num = '1234'; 43 | 44 | my $value = Math::BigInt->new($num); 45 | my $got = Orange3::Dumper::_bigint_dumper($value); 46 | my $expected = "'1234'"; 47 | is $got, $expected, '+ is ok'; 48 | 49 | my $value2 = Math::BigInt->new(-$num); 50 | my $got2 = Orange3::Dumper::_bigint_dumper($value2); 51 | my $expected2 = "'-1234'"; 52 | is $got2, $expected2, '- is ok'; 53 | }; 54 | 55 | done_testing; 56 | -------------------------------------------------------------------------------- /t/600_mini/01_basic.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | 6 | use Orange3::Mini; 7 | 8 | subtest 'basic' => sub { 9 | my $mini = Orange3::Mini->new(); 10 | 11 | ok $mini, 'constructor'; 12 | isa_ok $mini, 'Orange3::Mini'; 13 | 14 | can_ok $mini, 'parse_options'; 15 | can_ok $mini, 'run'; 16 | }; 17 | 18 | subtest 'parse_options' => sub { 19 | my $mini = Orange3::Mini->new(); 20 | 21 | subtest 'argv' => sub { 22 | eval { 23 | $mini->parse_options(qw/aaa bbb ccc/); 24 | }; 25 | is_deeply $mini->{argv}, [qw/aaa bbb ccc/], 'set argv'; 26 | }; 27 | 28 | subtest 'option: help' => sub { 29 | subtest 'short option' => sub { 30 | eval { 31 | $mini->parse_options(qw/-h/); 32 | }; 33 | like $@, qr/^Usage/, 'show usage'; 34 | }; 35 | 36 | subtest 'long option' => sub { 37 | eval { 38 | $mini->parse_options(qw/--help/); 39 | }; 40 | like $@, qr/^Usage/, 'show usage'; 41 | }; 42 | }; 43 | }; 44 | 45 | done_testing; 46 | -------------------------------------------------------------------------------- /t/Util.pm: -------------------------------------------------------------------------------- 1 | package t::Util; 2 | use strict; 3 | use warnings; 4 | 5 | use base qw/Exporter/; 6 | use Data::Dumper; 7 | use File::Temp; 8 | 9 | our @EXPORT = qw/create_configfile/; 10 | 11 | sub create_configfile { 12 | my $config = shift; 13 | 14 | my $tmp = File::Temp->new( UNLINK => 1 ); 15 | print {$tmp} Data::Dumper::Dumper($config); 16 | $tmp->autoflush(1); 17 | 18 | return $tmp; 19 | } 20 | 21 | 1; 22 | --------------------------------------------------------------------------------