Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
vecs
FIJI Public
Commits
5707ffb8
Commit
5707ffb8
authored
Sep 03, 2015
by
Christian Fibich
Committed by
Stefan Tauner
May 04, 2018
Browse files
Added GUI for FIJI Download
Removed FIJI::Settings reference from FIJI::Tests Object
parent
169bdd0c
Changes
8
Hide whitespace changes
Inline
Side-by-side
FIJI.pm
View file @
5707ffb8
...
...
@@ -490,12 +490,17 @@ my %testconstmap;
BEGIN
{
%testconstmap
=
(
FIJI_CFG
=>
{
description
=>
"
FIJI Settings File
",
ini_name
=>
"
FIJI_CFG
",
default
=>
"
fiji.cfg
"
default
=>
"
fiji.cfg
",
phases_opt
=>
[
qw (manual
auto
random
)],
#gui_modes => [qw (manual auto random)],
},
UART
=>
{
description
=>
"
UART for Downloading
",
ini_name
=>
"
UART
",
default
=>
"
/dev/ttyUSB0
"
default
=>
"
/dev/ttyUSB0
",
gui_modes
=>
[
qw (manual
auto
random
)],
},
NUM_TESTS
=>
{
ini_name
=>
"
NUM_TESTS
",
...
...
@@ -503,22 +508,28 @@ BEGIN {
phases_opt
=>
[
qw(manual)
],
},
REPEAT
=>
{
description
=>
"
Repeat Injection?
",
ini_name
=>
"
REPEAT
",
default
=>
0
,
type
=>
'
boolean
',
phases_opt
=>
[
qw(manual)
],
gui_modes
=>
[
qw (auto)],
},
REPEAT_OFFSET
=>
{
description
=>
"
Repetition start pattern
",
ini_name
=>
"
REPEAT_OFFSET
",
default
=>
0
,
type
=>
'
natural
',
phases_opt
=>
[
qw(manual)
],
gui_modes
=>
[
qw (auto)],
},
HALT_ON_FAULT_DETECT
=>
{
description
=>
"
Halt on detected fault
",
ini_name
=>
"
HALT_ON_FAULT_DETECT
",
default
=>
1
,
type
=>
'
boolean
',
phases_opt
=>
[
qw(manual)
],
gui_modes
=>
[
qw (auto
random
)],
},
HALT_ON_UART_ERROR
=>
{
ini_name
=>
"
HALT_ON_UART_ERROR
",
...
...
@@ -540,16 +551,109 @@ BEGIN {
},
HALT_ON_UNDERRUN
=>
{
ini_name
=>
"
HALT_ON_UNDERRUN
",
default
=>
1
,
default
=>
0
,
type
=>
'
boolean
',
phases_opt
=>
[
qw(manual)
],
},
MULTIFAULT
=>
{
description
=>
"
Generate multiple faults per pattern?
",
ini_name
=>
"
MULTIFAULT
",
default
=>
1
,
type
=>
'
boolean
',
phases_opt
=>
[
qw(manual auto)
],
gui_modes
=>
[
qw (random)],
},
MIN_DURATION_T1
=>
{
description
=>
"
Minimum Duration T1
",
ini_name
=>
"
MIN_DURATION_T1
",
phases_opt
=>
[
qw(manual auto)
],
gui_modes
=>
[
qw (random)],
},
MIN_DURATION_T2
=>
{
description
=>
"
Minimum Duration T2
",
ini_name
=>
"
MIN_DURATION_T2
",
phases_opt
=>
[
qw(manual auto)
],
gui_modes
=>
[
qw (random)],
},
MAX_DURATION_T1
=>
{
description
=>
"
Maximum Duration T1
",
ini_name
=>
"
MAX_DURATION_T1
",
phases_opt
=>
[
qw(manual auto)
],
gui_modes
=>
[
qw (random)],
},
MAX_DURATION_T2
=>
{
description
=>
"
Maximum Duration T2
",
ini_name
=>
"
MAX_DURATION_T2
",
phases_opt
=>
[
qw(manual auto)
],
gui_modes
=>
[
qw (random)],
},
PROB_STUCK_AT_0
=>
{
description
=>
"
Probability of stuck-at-0 fault
",
ini_name
=>
"
PROB_STUCK_AT_0
",
type
=>
'
prob
',
phases_opt
=>
[
qw(manual auto)
],
gui_modes
=>
[
qw (random)],
fault
=>
"
STUCK_AT_0
",
},
PROB_STUCK_AT_1
=>
{
description
=>
"
Probability of stuck-at-1 fault
",
ini_name
=>
"
PROB_STUCK_AT_1
",
type
=>
'
prob
',
phases_opt
=>
[
qw(manual auto)
],
gui_modes
=>
[
qw (random)],
fault
=>
"
STUCK_AT_1
",
},
PROB_DELAY
=>
{
description
=>
"
Probability of delay fault
",
ini_name
=>
"
PROB_DELAY
",
type
=>
'
prob
',
phases_opt
=>
[
qw(manual auto)
],
gui_modes
=>
[
qw (random)],
fault
=>
"
DELAY
",
},
PROB_SEU
=>
{
description
=>
"
Probability of single event upset
",
ini_name
=>
"
PROB_SEU
",
type
=>
'
prob
',
phases_opt
=>
[
qw(manual auto)
],
gui_modes
=>
[
qw (random)],
fault
=>
"
SEU
",
},
PROB_STUCK_OPEN
=>
{
description
=>
"
Probability of stuck-open fault
",
ini_name
=>
"
PROB_STUCK_OPEN
",
type
=>
'
prob
',
phases_opt
=>
[
qw(manual auto)
],
gui_modes
=>
[
qw (random)],
fault
=>
"
STUCK_OPEN
",
},
);
}
use
constant
\
%testconstmap
;
use
constant
TESTCONSTMAP
=>
\
%testconstmap
;
my
%testguimodes
;
BEGIN
{
%testguimodes
=
(
manual
=>
{
title
=>
"
Manual
",
description
=>
"
Download faults one pattern at a time
",
},
auto
=>
{
title
=>
"
Auto
",
description
=>
"
Download predefined sequence of fault patterns
",
},
random
=>
{
title
=>
"
Random
",
description
=>
"
Download predefined random fault patterns
",
},
);
}
use
constant
\
%testguimodes
;
use
constant
TESTGUIMODES
=>
\
%testguimodes
;
my
%testpatmap
;
BEGIN
{
%testpatmap
=
(
...
...
@@ -613,9 +717,11 @@ sub ini2constkey {
use
base
'
Exporter
';
our
@EXPORT
=
(
keys
(
%designmap
),
keys
(
%fiumap
),
keys
(
%testpatmap
),
keys
(
%testconstmap
),
keys
(
%fiuenum
),
keys
(
%displaygroups
));
our
@EXPORT
=
(
keys
(
%designmap
),
keys
(
%fiumap
),
keys
(
%testpatmap
),
keys
(
%testconstmap
),
keys
(
%fiuenum
),
keys
(
%displaygroups
)
,
keys
(
%testguimodes
)
);
our
@EXPORT_OK
=
(
keys
(
%designmap
),
'
DESIGNMAP
',
keys
(
%fiumap
),
'
FIUMAP
',
keys
(
%testpatmap
),
'
TESTPATMAP
',
keys
(
%testconstmap
),
'
TESTCONSTMAP
',
keys
(
%fiuenum
),
'
FIUENUM
',
'
REVERSE_FIU_ENUM
','
DISPLAYGROUPS
',
keys
(
%displaygroups
));
'
TESTPATMAP
',
keys
(
%testconstmap
),
'
TESTCONSTMAP
',
keys
(
%fiuenum
),
'
FIUENUM
',
'
REVERSE_FIU_ENUM
','
DISPLAYGROUPS
',
keys
(
%displaygroups
),
'
TESTGUIMODES
',
keys
(
%testguimodes
));
## @var @EXPORT_TAGS Export Tags
#
...
...
FIJI/Downloader.pm
View file @
5707ffb8
...
...
@@ -28,21 +28,78 @@ use FIJI::Settings;
use
FIJI::
Connection
;
use
FIJI
qw(:all)
;
use
Data::
Dumper
;
use
Clone
'
clone
';
sub
new
($)
{
my
(
$class
,
$cfgname
)
=
@_
;
sub
new
(;$$) {
my
$logger
=
get_logger
();
my
(
$class
,
$testsname
,
$existing_tests
,
$cfgname
,
$existing_cfg
)
=
@_
;
my
$self
=
{};
my
$rv
=
"
Constructor has no means of obtaining a FIJI::Tests/Settings object
"
.
bless
$self
,
$class
;
my
$fiji_tests
=
FIJI::
Tests
->
new
(
"
automatic
",
$cfgname
);
if
(
!
ref
(
$fiji_tests
)
)
{
logger
->
error
(
$fiji_tests
.
"
Aborting.
\n
"
);
return
1
;
if
(
defined
$existing_cfg
)
{
$rv
=
$self
->
existing_settings
(
$existing_cfg
);
}
elsif
(
defined
$cfgname
)
{
$rv
=
$self
->
settings_from_file
(
$cfgname
);
}
if
(
defined
$existing_tests
)
{
$rv
=
$self
->
existing_tests
(
$existing_tests
);
}
elsif
(
defined
$testsname
)
{
$rv
=
$self
->
tests_from_file
(
$self
->
{'
fiji_settings
'}
->
{'
design
'}
->
{'
CFGS_PER_MSG
'},
$self
->
{'
fiji_settings
'}
->
{'
design
'}
->
{'
FIU_NUM
'},
$testsname
);
}
$self
->
{'
fiji_tests
'}
=
$fiji_tests
;
$logger
->
error
(
$rv
)
if
(
!
ref
$rv
);
return
$self
;
}
sub
settings_from_file
{
my
$rv
;
my
(
$self
,
$cfgname
)
=
@_
;
my
$fiji_settings
=
FIJI::
Settings
->
new
(
"
download
",
$cfgname
);
if
(
!
ref
(
$fiji_settings
)
)
{
$rv
=
$fiji_settings
.
"
Aborting.
\n
";
}
else
{
$rv
=
$self
->
{'
fiji_settings
'}
=
$fiji_settings
;
}
return
$rv
;
}
sub
existing_settings
{
my
$rv
;
my
(
$self
,
$existing_cfg
)
=
@_
;
if
(
ref
(
$existing_cfg
)
eq
"
FIJI::Settings
")
{
$rv
=
$self
->
{'
fiji_settings
'}
=
$existing_cfg
;
}
else
{
$rv
=
"
Given Settings are not of type FIJI::Settings
";
}
}
sub
tests_from_file
{
my
$rv
;
my
(
$self
,
$msgs_per_cfg
,
$fiu_num
,
$cfgname
)
=
@_
;
my
$fiji_tests
=
FIJI::
Tests
->
new
(
"
automatic
",
$msgs_per_cfg
,
$fiu_num
,
$cfgname
);
if
(
!
ref
(
$fiji_tests
)
)
{
$rv
=
$fiji_tests
.
"
Aborting.
\n
";
}
else
{
$rv
=
$self
->
{'
fiji_tests
'}
=
$fiji_tests
;
}
return
$rv
;
}
sub
existing_tests
{
my
$rv
;
my
(
$self
,
$existing_tests
)
=
@_
;
if
(
ref
(
$existing_tests
)
eq
"
FIJI::Tests
")
{
$rv
=
$self
->
{'
fiji_tests
'}
=
$existing_tests
;
}
else
{
$rv
=
"
Given Tests are not of type FIJI::Tests
";
}
}
## Wrapper for port->send_config
# Generates a configuration hash from discrete parameters
#
...
...
@@ -86,13 +143,11 @@ sub download_auto ($) {
my
(
$self
,
$portname
)
=
@_
;
my
$fiji_tests
=
$self
->
{'
fiji_tests
'};
my
$fiji_design_consts
=
$self
->
{'
fiji_settings
'}
->
{'
design
'};
my
$fiji_design_consts
=
$fiji_tests
->
{'
ext
'}
->
{'
global_settings
'}
->
{'
design
'};
$portname
=
$self
->
{'
fiji_tests
'}
->
{'
design
'}
->
{'
UART
'}
if
(
!
defined
$portname
);
$portname
=
$fiji_tests
->
{'
design
'}
->
{'
UART
'}
if
(
!
defined
$portname
);
my
$port
=
FIJI::
Connection
->
init
(
$portname
,
$fiji_
t
es
ts
->
{'
ext
'}
->
{'
global_settings
'}
->
{'
design
'}
->
{'
BAUDRATE
'}
)
FIJI::
Connection
->
init
(
$portname
,
$fiji_
d
es
ign_consts
->
{'
BAUDRATE
'}
)
or
$logger
->
fatal
("
Could not init UART.
")
and
return
"
Could not init UART.
";
...
...
@@ -108,7 +163,7 @@ sub download_auto ($) {
$logger
->
info
("
Downloading test
$ti
.
");
my
$recv_msg
=
$self
->
download_test
(
@
{
$fiji_tests
->
{'
tests
'}
}[
$ti
],
$port
);
my
$recv_msg
=
$self
->
_
download_test
(
@
{
$fiji_tests
->
{'
tests
'}
}[
$ti
],
$port
);
if
(
ref
(
$recv_msg
)
ne
"
HASH
")
{
$msg
=
"
UART transaction failed.
";
...
...
@@ -116,10 +171,10 @@ sub download_auto ($) {
}
if
(
$self
->
_check_halt
(
$recv_msg
)
==
1
)
{
$msg
=
"
Halt because of HALT_ON_xxx. Failed test:
$ti
, rep
et
i
ti
on
$ri
.
"
;
my
$rv
=
$fiji_tests
->
export_as_sim_script
("
sim.script
",
$ti
,
$ri
);
my
$rv
=
$fiji_tests
->
export_as_sim_script
("
sim.script
",
$ti
,
$ri
,
$self
->
{'
fiji_s
etti
ngs
'})
;
$logger
->
error
("
Halt because of HALT_ON_xxx. Failed test:
$ti
, repetition
$ri
.
"
);
$logger
->
error
(
$rv
)
if
defined
(
$rv
);
return
$msg
;
return
$
recv_
msg
;
}
}
...
...
@@ -132,7 +187,6 @@ sub download_auto ($) {
$ri
++
;
}
}
return
$msg
;
}
## Download randomly generated tests
...
...
@@ -151,13 +205,20 @@ sub download_auto ($) {
# portname Optional serial port to use
sub
download_random
($$$;$) {
my
$logger
=
get_logger
();
my
(
$self
,
$cfg
,
$testref
,
$portname
)
=
@_
;
my
$fiji_design_consts
=
$self
->
{'
fiji_tests
'}
->
{'
ext
'}
->
{'
global_settings
'}
->
{'
design
'};
my
(
$self
,
$testref
,
$portname
,
$rmsg_ref
)
=
@_
;
my
$fiji_design_consts
=
$self
->
{'
fiji_settings
'}
->
{'
design
'};
print
$rmsg_ref
;
$testref
=
clone
(
$self
->
{'
fiji_tests
'});
print
$portname
.
"
"
.
$fiji_design_consts
->
{'
BAUDRATE
'}
.
"
\n
";
$portname
=
$testref
->
{'
design
'}
->
{'
UART
'}
if
(
!
defined
$portname
);
$portname
=
$self
->
{'
fiji_tests
'}
->
{'
design
'}
->
{'
UART
'}
if
(
!
defined
$portname
)
;
print
$portname
.
"
"
.
$fiji_design_consts
->
{'
BAUDRATE
'}
.
"
\n
"
;
my
$port
=
FIJI::
Connection
->
init
(
$portname
,
$
self
->
{'
fiji_
t
es
ts
'}
->
{'
ext
'}
->
{'
global_settings
'}
->
{'
design
'}
->
{'
BAUDRATE
'}
)
FIJI::
Connection
->
init
(
$portname
,
$fiji_
d
es
ign_consts
->
{'
BAUDRATE
'}
)
or
$logger
->
fatal
("
Could not init UART.
")
and
return
"
Could not init UART.
";
...
...
@@ -167,24 +228,22 @@ sub download_random ($$$;$) {
my
$recv_msg
;
do
{
@tests
[
$ti
]
=
$
self
->
{'
fiji_
test
s
'}
->
make_random_test
(
$
cfg
);
@tests
[
$ti
]
=
$test
ref
->
make_random_test
(
$
self
->
{'
fiji_settings
'}
);
$logger
->
info
("
=== Test
$ti
===
");
$recv_msg
=
$self
->
download_test
(
$tests
[
$ti
++
],
$port
);
$recv_msg
=
$self
->
_download_test
(
$tests
[
$ti
++
],
$port
);
$$rmsg_ref
=
5
;
}
while
(
$self
->
_check_halt
(
$recv_msg
)
!=
1
);
my
$msg
=
"
Halt because of HALT_ON_xxx. Failed test:
"
.
(
$ti
-
1
);
$logger
->
error
(
"
Halt because of HALT_ON_xxx. Failed test:
"
.
(
$ti
-
1
)
)
;
$self
->
{'
fiji_tests
'}
->
{'
design
'}
->
{'
NUM_TESTS
'}
=
$ti
;
$self
->
{'
fiji_tests
'}
->
{'
design
'}
->
{'
REPEAT
'}
=
0
;
$self
->
{'
fiji_tests
'}
->
{'
design
'}
->
{'
REPEAT_OFFSET
'}
=
0
;
$self
->
{'
fiji_tests
'}
->
{'
tests
'}
=
\
@tests
;
$self
->
{'
fiji_tests
'}
->
export_as_sim_script
("
sim.script
",
$ti
-
1
,
0
);
$testref
->
{'
design
'}
->
{'
NUM_TESTS
'}
=
$ti
;
$testref
->
{'
design
'}
->
{'
REPEAT
'}
=
0
;
$testref
->
{'
design
'}
->
{'
REPEAT_OFFSET
'}
=
0
;
$testref
->
{'
tests
'}
=
\
@tests
;
$testref
->
export_as_sim_script
("
sim.script
",
$ti
-
1
,
0
,
$self
->
{'
fiji_settings
'});
$testref
->
save
("
fiji_tests_random.cfg
");
$testref
=
$self
->
{'
fiji_tests
'};
$self
->
{'
fiji_tests
'}
->
save
("
fiji_tests_random.cfg
");
return
$msg
;
return
$recv_msg
;
}
## Download manually defined tests prompted from <STDIN>
...
...
@@ -196,13 +255,13 @@ sub download_manual ($;$) {
my
(
$self
,
$portname
)
=
@_
;
my
$fiji_tests
=
$self
->
{'
fiji_tests
'};
my
$fiji_design_consts
=
$
fiji_tests
->
{'
ext
'}
->
{'
global
_settings
'}
->
{'
design
'};
my
$fiji_design_consts
=
$
self
->
{'
fiji
_settings
'}
->
{'
design
'};
# FIXME UART information can be defined in tests config file. OK?
$portname
=
$
self
->
{'
fiji_tests
'}
->
{'
design
'}
->
{'
UART
'}
if
(
!
defined
$portname
);
$portname
=
$
fiji_design_consts
->
{'
UART
'}
if
(
!
defined
$portname
);
my
$port
=
FIJI::
Connection
->
init
(
$portname
,
$fiji_
t
es
ts
->
{'
ext
'}
->
{'
global_settings
'}
->
{'
design
'}
->
{'
BAUDRATE
'}
)
FIJI::
Connection
->
init
(
$portname
,
$fiji_
d
es
ign_consts
->
{'
BAUDRATE
'}
)
or
$logger
->
fatal
("
Could not init UART.
")
and
return
"
Could not init UART.
";
...
...
@@ -213,7 +272,7 @@ sub download_manual ($;$) {
while
(
1
)
{
my
$test
=
$self
->
_get_test_from_stdin
();
my
$recv_msg
=
$self
->
download_test
(
$test
,
$port
);
my
$recv_msg
=
$self
->
_
download_test
(
$test
,
$port
);
push
@$tests
,
$test
;
...
...
@@ -239,7 +298,7 @@ sub _get_test_from_stdin {
my
$logger
=
get_logger
();
my
(
$self
)
=
@_
;
my
$fiji_design_consts
=
$self
->
{'
fiji_
tests
'}
->
{'
ext
'}
->
{'
global_
settings
'}
->
{'
design
'};
my
$fiji_design_consts
=
$self
->
{'
fiji_settings
'}
->
{'
design
'};
my
$test
=
{};
my
$cfg_mask
=
2
**$fiji_design_consts
->
{'
FIU_CFG_BITS
'}
-
1
;
...
...
@@ -342,6 +401,25 @@ sub _get_test_from_stdin {
return
$test
;
}
sub
download_test
($$)
{
my
$logger
=
get_logger
();
my
(
$self
,
$test
,
$portname
)
=
@_
;
my
$port
=
FIJI::
Connection
->
init
(
$portname
,
$self
->
{'
fiji_settings
'}
->
{'
design
'}
->
{'
BAUDRATE
'}
)
or
$logger
->
fatal
("
Could not init UART.
")
and
return
"
Could not init UART.
";
return
$self
->
_download_test
(
$test
,
$port
);
}
sub
update_rnd
($)
{
my
(
$self
,
$rnd
)
=
@_
;
for
my
$k
(
keys
(
%
{
$rnd
}))
{
$self
->
{'
fiji_tests
'}
->
{'
design
'}
->
{
$k
}
=
$rnd
->
{
$k
};
}
}
## Download a single test defined by a test hash
# Params
# test The hash defining the test
...
...
@@ -350,13 +428,13 @@ sub _get_test_from_stdin {
# test->{"FIU_[0..FIU_NUM]_FAULT_[0..CFGS_PER_MSG]"}
# test->{'RESET_DUT_AFTER_CONFIG'}
# test->{'TRIGGER'}
# port
name Optional
serial port to use
sub
download_test
($$)
{
# port serial port to use
sub
_
download_test
($$)
{
my
$logger
=
get_logger
();
my
(
$self
,
$test
,
$port
)
=
@_
;
my
$fiji_tests
=
$self
->
{'
fiji_tests
'};
my
$fiji_design_consts
=
$
fiji_tests
->
{'
ext
'}
->
{'
global
_settings
'}
->
{'
design
'};
my
$fiji_design_consts
=
$
self
->
{'
fiji
_settings
'}
->
{'
design
'};
my
@payload
;
# first generate FIU configuration payload
...
...
FIJI/Tests.pm
View file @
5707ffb8
...
...
@@ -37,7 +37,6 @@ use Clone qw(clone);
use
FIJI::
Settings
;
use
FIJI
qw(:all)
;
use
File::
Spec
;
use
Excel::Writer::
XLSX
;
# FIXME rather similar to Settings.pm
# Can we generalize this?
...
...
@@ -55,10 +54,13 @@ use Excel::Writer::XLSX;
# why it could not be created.
sub
new
($;$$) {
my
$logger
=
get_logger
();
my
(
$class
,
$phase
,
$fiji_ini_file
,
$existing_settings
,
$fiji_cfg
,
$num_tests
)
=
@_
;
my
(
$class
,
$phase
,
$cfgs_per_msg
,
$fiu_num
,
$fiji_ini_file
,
$existing_settings
,
$num_tests
)
=
@_
;
my
$fiji_settings_ref
=
{};
$fiji_settings_ref
->
{'
ext
'}
->
{'
CFGS_PER_MSG
'}
=
$cfgs_per_msg
;
$fiji_settings_ref
->
{'
ext
'}
->
{'
FIU_NUM
'}
=
$fiu_num
;
# if there is no existing settings instance yet, create one
if
(
!
defined
(
$existing_settings
))
{
$fiji_settings_ref
=
bless
(
$fiji_settings_ref
,
$class
);
...
...
@@ -78,41 +80,36 @@ sub new ($;$$) {
# If there is a file given, try to read it. Else just create a default instance.
if
(
defined
(
$fiji_ini_file
))
{
$fiji_settings_ref
=
read_settingsfile
(
$phase
,
$fiji_ini_file
,
$fiji_settings_ref
);
$fiji_settings_ref
=
read_settingsfile
(
$phase
,
$fiji_ini_file
,
$fiji_settings_ref
,
$cfgs_per_msg
,
$fiu_num
);
if
(
!
ref
(
$fiji_settings_ref
))
{
return
$fiji_settings_ref
;
# actually an error message
}
}
elsif
(
defined
(
$fiji_cfg
)
&&
defined
(
$num_tests
))
{
}
else
{
# create a default instance
$fiji_settings_ref
->
{'
design
'}
=
{};
for
my
$k
(
keys
(
TESTCONSTMAP
))
{
my
$tkm_ref
=
TESTCONSTMAP
;
for
my
$k
(
keys
(
%
{
$tkm_ref
}))
{
$fiji_settings_ref
->
{'
design
'}
->
{
$k
}
=
TESTCONSTMAP
->
{
$k
}
->
{'
default
'};
}
_set_defaults
(
TESTCONSTMAP
,
$fiji_settings_ref
->
{'
design
'},
$phase
);
$fiji_settings_ref
->
{'
design
'}
->
{'
NUM_TESTS
'}
=
$num_tests
;
$fiji_settings_ref
->
{'
design
'}
->
{'
FIJI_CFG
'}
=
$fiji_cfg
;
$fiji_settings_ref
->
{'
ext
'}
->
{'
global_settings
'}
=
_read_fiji_cfg
(
$fiji_cfg
);
$fiji_settings_ref
->
{'
ext
'}
->
{'
TESTPATMAP
'}
=
_generate_testpatmap
(
$fiji_settings_ref
);
$fiji_settings_ref
->
{'
ext
'}
->
{'
TESTPATMAP
'}
=
_generate_testpatmap
(
$fiji_settings_ref
);
$fiji_settings_ref
->
{'
tests
'}
=
[]
;
for
(
my
$i
=
0
;
$i
<
$num_tests
;
$i
++
)
{
my
$thistest
=
{};
for
my
$k
(
keys
(
%
{
$fiji_settings_ref
->
{'
ext
'}
->
{'
TESTPATMAP
'}}))
{
$thistest
->
{
$k
}
=
$fiji_settings_ref
->
{'
ext
'}
->
{'
TESTPATMAP
'}
->
{
$k
}
->
{'
default
'};
if
(
defined
(
$num_tests
))
{
for
(
my
$i
=
0
;
$i
<
$num_tests
;
$i
++
)
{
my
$thistest
=
{};
for
my
$k
(
keys
(
%
{
$fiji_settings_ref
->
{'
ext
'}
->
{'
TESTPATMAP
'}}))
{
$thistest
->
{
$k
}
=
$fiji_settings_ref
->
{'
ext
'}
->
{'
TESTPATMAP
'}
->
{
$k
}
->
{'
default
'};
}
push
@
{
$fiji_settings_ref
->
{'
tests
'}},
$thistest
;
}
push
@
{
$fiji_settings_ref
->
{'
tests
'}},
$thistest
;
}
}
else
{
my
$msg
=
"
FIJI::Config is required (either in Tests-settings file or as a parameter).
";
$logger
->
error
(
$msg
);
}
return
$fiji_settings_ref
;
}
...
...
@@ -221,136 +218,6 @@ sub save ($) {
return
undef
;
}
sub
new_from_xlsx
{
}
# Exports the content of a FIJI::Test Object to an XLSX file.
# For each test, a new sheet is created. This function also adds validation
# parameters where applicable
# params:
# xlsxname the name of the XLSX file
sub
mkxlsx
($)
{
my
$logger
=
get_logger
();
my
(
$self
,
$xlsxname
)
=
@_
;
my
$xlsx
=
Excel::Writer::
XLSX
->
new
(
$xlsxname
);
if
(
!
defined
$xlsx
)
{
print
"
Could not create workbook with name
$xlsxname
";
return
1
;
}
my
$gensheet
=
$xlsx
->
add_worksheet
("
General Settings
");
my
$test_cnt
=
0
;
my
$rowidx
;
my
$design_ref
;
foreach
my
$key
(
keys
%
{
$self
})
{
my
$val
=
$self
->
{
$key
};
if
(
ref
(
\
$val
)
eq
"
REF
")
{
if
(
ref
(
$val
)
eq
"
HASH
")
{
if
(
$key
eq
"
design
")
{
$design_ref
=
$val
;
next
;
}
elsif
(
$key
eq
"
ext
")
{
next
;
}
}
elsif
(
ref
(
$val
)
eq
"
ARRAY
")
{
if
(
$key
eq
"
tests
")
{
foreach
my
$test
(
@
{
$val
})
{
my
$testsheet
=
$xlsx
->
add_worksheet
("
Test
$test_cnt
");
$rowidx
=
0
;
foreach
my
$k
(
keys
(
%
{
$test
}))
{
my
$ini_name
=
$self
->
{'
ext
'}
->
{'
TESTPATMAP
'}
->
{
$k
}
->
{'
ini_name
'};
if
(
!
defined
(
$test
->
{
$k
}))
{
$logger
->
debug
("
Skip saving undefined value of TEST constant with key
$ini_name
.
");
next
;
}
# Copy value to new hash with external naming.
$testsheet
->
set_column
(
0
,
0
,
25
);
$testsheet
->
set_column
(
1
,
1
,
25
);
$testsheet
->
write
(
$rowidx
,
0
,
$ini_name
);
$testsheet
->
write
(
$rowidx
,
1
,
$test
->
{
$k
});
_xlsxvalidate
(
$testsheet
,[
$rowidx
,
1
],
$self
->
{'
ext
'}
->
{'
TESTPATMAP
'}
->
{
$k
});
$rowidx
++
;
# Convert value to external representation
# _export_value($self->{'ext'}->{'TESTPATMAP'}, $k, \$ini_test->{$ini_name});
$logger
->
trace
(
sprintf
("
Exporting TEST%d setting %s -> %s.
",
$test_cnt
,
$k
,
$ini_name
),
);
}
$test_cnt
++
;
}
next
;
}
}
}
my
$err
=
"
Unknown element found in FIJI Settings:
\"
$val
\"
";
$logger
->
error
(
$err
);
#return $err;
}
$design_ref
->
{'
NUM_TESTS
'}
=
$test_cnt
;
my
$ini_design
;
$rowidx
=
0
;
foreach
my
$k
(
keys
(
%
{
$design_ref
}))
{
my
$ini_name
=
TESTCONSTMAP
->
{
$k
}
->
{'
ini_name
'};
if
(
!
defined
(
$design_ref
->
{
$k
}))
{
$logger
->
debug
("
Skip saving undefined value of design constant with key
$ini_name
.
");
next
;
}
# Copy value to new hash with external naming.
$gensheet
->
set_column
(
0
,
0
,
25
,
undef
);
$gensheet
->
set_column
(
1
,
1
,
25
,
undef
);
$gensheet
->
write
(
$rowidx
,
0
,
$ini_name
);
$gensheet
->
write
(
$rowidx
,
1
,
$design_ref
->
{
$k
});
_xlsxvalidate
(
$gensheet
,[
$rowidx
,
1
],
TESTCONSTMAP
->
{
$k
});
$rowidx
++
;