[Stacomir-commits] r512 - in pkg/stacomir: . inst inst/config tests tests/testthat
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Sep 24 17:54:01 CEST 2018
Author: legrand
Date: 2018-09-24 17:54:01 +0200 (Mon, 24 Sep 2018)
New Revision: 512
Added:
pkg/stacomir/tests/
pkg/stacomir/tests/testthat.R
pkg/stacomir/tests/testthat/
pkg/stacomir/tests/testthat/test-00-stacomir.R
pkg/stacomir/tests/testthat/test-00-zrefclasses.R
pkg/stacomir/tests/testthat/test-01-report_mig_mult.R
pkg/stacomir/tests/testthat/test-02-report_mig.R
pkg/stacomir/tests/testthat/test-03-report_df.R
pkg/stacomir/tests/testthat/test-04-report_dc.R
pkg/stacomir/tests/testthat/test-05-report_sample_char.R
pkg/stacomir/tests/testthat/test-06-report_mig_interannual.R
pkg/stacomir/tests/testthat/test-07-report_sea_age.R
pkg/stacomir/tests/testthat/test-08-report_silver_eel.R
pkg/stacomir/tests/testthat/test-09-report_annual.R
pkg/stacomir/tests/testthat/test-10-report_env.R
pkg/stacomir/tests/testthat/test-11-report_mig_env.R
pkg/stacomir/tests/testthat/test-12-report_mig_char.R
pkg/stacomir/tests/testthat/test-13-report_species.R
pkg/stacomir/tests/testthat/test-50-spell_checking.R
Removed:
pkg/stacomir/inst/config/testthat.R
pkg/stacomir/inst/tests/
Modified:
pkg/stacomir/DESCRIPTION
Log:
* moving test folder
* update Description file for the date
* skip_on_cran() for test files when test call the database
Modified: pkg/stacomir/DESCRIPTION
===================================================================
--- pkg/stacomir/DESCRIPTION 2018-09-23 12:43:41 UTC (rev 511)
+++ pkg/stacomir/DESCRIPTION 2018-09-24 15:54:01 UTC (rev 512)
@@ -1,6 +1,6 @@
Package: stacomiR
Version: 0.5.4.0
-Date: 2018-06-19
+Date: 2018-09-24
Title: Fish Migration Monitoring
Authors at R: c(person("Cedric", "Briand", role = c("aut", "cre"), email = "cedric.briand00 at gmail.com"),
person("Marion", "Legrand", role = "aut", email="tableau-salt-loire at logrami.fr"),
Deleted: pkg/stacomir/inst/config/testthat.R
===================================================================
--- pkg/stacomir/inst/config/testthat.R 2018-09-23 12:43:41 UTC (rev 511)
+++ pkg/stacomir/inst/config/testthat.R 2018-09-24 15:54:01 UTC (rev 512)
@@ -1,52 +0,0 @@
-#install.packages("testthat",dependencies=c("Depends", "Imports"))
-#install.packages("relax")
-require(testthat)
-
-
-getUsername <- function(){
- name <- Sys.info()[["user"]]
- return(name)
-}
-if(getUsername() == 'cedric.briand')
-{
- setwd("C:/workspace/stacomir/pkg/stacomir/")
-}
-if(getUsername() == 'marion.legrand')
-{
- setwd("C:/Users/logrami/workspace/stacomir/")
-}
-
-
-# to launch all
-
-
-if(getUsername() == 'cedric.briand')
-{
- test_dir("C:/workspace/stacomir/pkg/stacomir/inst/tests/testthat")
-}
-if(getUsername() == 'marion.legrand')
-{
- test_dir("C:/Users/logrami/workspace/stacomir/pkg/stacomir/inst/tests/testthat")
-}
-
-test_file(str_c(getwd(),"/inst/tests/testthat/test-00-stacomir.R"))
-test_file(str_c(getwd(),"/inst/tests/testthat/test-00-zrefclasses.R"))
-test_file(str_c(getwd(),"/inst/tests/testthat/test-01-report_mig_mult.R"))
-# warning we don't need to be worried about
-#Quoted identifiers should have class SQL, use DBI::SQL() if the caller performs the quoting.
-# this comes from incompatibility between RSQLite 1.1-1 and sqldf
-# we don't really use RSQLite and this is only a warning not a problem
-test_file(str_c(getwd(),"//tests/testthat/test-02-report_mig.R"))
-# if errors check existence of dbname test and grants to test on dbname test
-test_file(str_c(getwd(),"//tests/testthat/test-03-report_df.R"))
-x11()
-test_file(str_c(getwd(),"//tests/testthat/test-04-report_dc.R"))
-test_file(str_c(getwd(),"//tests/testthat/test-05-report_sample_char.R"))
-test_file(str_c(getwd(),"//tests/testthat/test-06-report_mig_interannual.R"))
-test_file(str_c(getwd(),"//tests/testthat/test-07-report_sea_age.R"))
-test_file(str_c(getwd(),"//tests/testthat/test-08-report_silver_eel.R"))
-test_file(str_c(getwd(),"//tests/testthat/test-09-report_annual.R"))
-test_file(str_c(getwd(),"//tests/testthat/test-10-report_env.R"))
-test_file(str_c(getwd(),"//tests/testthat/test-11-report_mig_env.R"))
-test_file(str_c(getwd(),"//tests/testthat/test-12-report_mig_char.R"))
-test_file(str_c(getwd(),"//tests/testthat/test-13-report_species.R"))
Added: pkg/stacomir/tests/testthat/test-00-stacomir.R
===================================================================
--- pkg/stacomir/tests/testthat/test-00-stacomir.R (rev 0)
+++ pkg/stacomir/tests/testthat/test-00-stacomir.R 2018-09-24 15:54:01 UTC (rev 512)
@@ -0,0 +1,252 @@
+context("stacomi base connection")
+
+test_that("Test existence of csv file",{
+ filecsv<-"C:/Program Files/stacomi/calcmig.csv";
+ expect_equivalent(file.access(filecsv,0),0)
+ }
+
+)
+# while crashing in some test for reportFonctionnement DF or report_dc,
+#the program will set time to GMT, this will cause some errors hard to understand in some of
+# the classes (report_mig, report_mig_mult), with the following you can check this problem
+test_that("Test that the program is running under the right locale",{
+ expect_equal(Sys.getlocale(category = "LC_TIME"),"French_France.1252")
+ }
+)
+
+# some bugs due to sys.timezone=
+test_that("Test existence calcmig data within package",{
+ data("calcmig",package = "stacomiR")
+ calcmig<-calcmig
+ expect_equal(length(calcmig),9)
+ }
+)
+
+test_that("Test that ODBC link exists and has the right length",{
+ require(stacomiR)
+ result<-chargecsv(database_expected=TRUE);
+ expect_equal(length(result),4)
+ expect_equal(length(result$baseODBC),3)
+ expect_equal(length(result$sqldf),5)
+ })
+
+
+context("Database connection")
+
+test_that("Test that stacomirtools connects",{
+ require(stacomiR)
+ envir_stacomi <- new.env(parent = asNamespace("stacomiR"))
+ mylinks=chargecsv(database_expected=TRUE)
+ baseODBC=mylinks[["baseODBC"]]
+ con=new("ConnectionODBC")
+ con at baseODBC=baseODBC
+ con<-connect(con)
+ expect_is(connect(con),'ConnectionODBC')
+ expect_equal(con at etat,"Connection in progress")
+ odbcCloseAll()
+ rm("envir_stacomi")
+ })
+
+
+test_that("Test that positive count for nrow(ref.tr_taxon_tax)",{
+ skip_on_cran()
+ require(stacomiR)
+ envir_stacomi <- new.env(parent = asNamespace("stacomiR"))
+ mylinks=chargecsv(database_expected=TRUE)
+ baseODBC=mylinks[["baseODBC"]]
+ requete=new("RequeteODBC")
+ requete at baseODBC<-baseODBC
+ requete at sql="select count(*) from ref.tr_taxon_tax"
+ requete<-stacomirtools::connect(requete)
+ expect_true(as.numeric(requete at query)>0)
+ odbcCloseAll()
+ rm("envir_stacomi")
+ })
+
+test_that("Tests positive count for sch.t_operation_ope",{
+ skip_on_cran()
+ require(stacomiR)
+ envir_stacomi <- new.env(parent = asNamespace("stacomiR"))
+ mylinks=chargecsv(database_expected=TRUE)
+ baseODBC=mylinks[["baseODBC"]]
+ sch<-paste(baseODBC[2],".",sep="")
+ requete=new("RequeteODBC")
+ requete at baseODBC<-baseODBC
+ requete at sql=paste("select count(*) from ",sch,"t_operation_ope",sep="")
+ requete<-stacomirtools::connect(requete)
+ expect_true(as.numeric(requete at query)>0)
+ odbcCloseAll()
+ rm("envir_stacomi")
+ })
+
+context("Loading program")
+
+
+test_that("Test that working environment is created",{
+ require(stacomiR)
+ stacomi(gr_interface=TRUE,login_window=TRUE,database_expected=TRUE)
+ expect_true(exists("envir_stacomi"))
+ dispose(get("logw",envir_stacomi))
+ })
+
+test_that("Test that gWidget loginwindow is loaded ",{
+ require(stacomiR)
+ stacomi(gr_interface=TRUE,login_window=TRUE,database_expected=TRUE)
+ expect_true(exists("logw",envir_stacomi))
+ dispose(get("logw",envir_stacomi))
+ })
+
+test_that("Test that gWidget gr_interface is loaded, without database_expected, nor login window",{
+ require(stacomiR)
+ stacomi(gr_interface=TRUE,login_window=FALSE,database_expected=FALSE)
+ expect_true(exists("win",envir_stacomi))
+ dispose(get("win",envir_stacomi))
+ })
+
+test_that("gWidget gr_interface is loaded, with pre launch_test, but without login window",{
+ require(stacomiR)
+ stacomi(gr_interface=TRUE,login_window=FALSE,database_expected=TRUE)
+ expect_true(exists("win",envir_stacomi))
+ dispose(get("win",envir_stacomi))
+ })
+
+
+# pour schema get("sch",envir=envir_stacomi)
+context(stringr::str_c("Database integrity"))
+
+
+test_that("Test that tickets have been launched",
+ {
+ skip_on_cran()
+ require(stacomiR)
+ stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=FALSE)
+ req<-new("RequeteODBC")
+ req at baseODBC<-get("baseODBC", envir=envir_stacomi)
+ sch=get("sch",envir=envir_stacomi)
+ req at sql=paste("select * from ",sch," ts_maintenance_main")
+ req<-stacomirtools::connect(req)
+ result<-req at query
+ # using dput(ticket)
+ tickets<-structure(list(
+ main_ticket = c(59L,
+ 40L,
+ 42L,
+ 67L,
+ 72L,
+ 121L,
+ 122L,
+ 81L,
+ 61L,
+ 152L,
+ 147L), main_description = c("creation de la table de maintenance",
+ "ajout des clé étrangères manquantes",
+ "modification des propriétaires sur les tables à séquence et grant select sur ref.tr_typedf_tdf oublié",
+ "org code rajouté dans les tables t_operationmarquage_omq, tj_coefficientconversion_coe,tj_prelevementlot_prl",
+ "creation d'une tableref.ts_messager_msr pour l'internationalisation",
+ "ajout de la notion de cohorte pour les saumons passant très précocément",
+ "Mise à jour des localisations anatomiques",
+ "Mise à jour vers la version 0.4 alpha, mise à jour des référentiels du SANDRE, script ticjet81_mise_en_conformite_sandre, révision 98",
+ "Mise à jour vers la version 0.4 alpha, mise à jour ds constraintes stationmesure modification limites coordonnées géographiques",
+ "Mise à jour vers la version 0.4 alpha, problèmes de clé étrangères, script total",
+ "Mise à jour vers la version 0.4 alpha, creation des masques"
+ )),
+ .Names = c("main_ticket", "main_description"),
+ class = "data.frame",
+ row.names = c(NA,
+ 11L))
+ check_exist_tickets=tickets$main_ticket%in%result$main_ticket
+ for (i in 1:nrow(tickets)){
+ expect_true(check_exist_tickets[i],label=paste('Missing ticket :',tickets$main_ticket[i]))
+ }
+ })
+# test on current schema
+test_that("All foreign keys are present",
+ {
+ skip_on_cran()
+ require(stacomiR)
+ stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=FALSE)
+ req<-new("RequeteODBC")
+ baseODBC<-get("baseODBC", envir=envir_stacomi)
+ options(warn=-1)
+ #warning : Coercing LHS to a list
+ options(warn=0)
+ req at baseODBC<-baseODBC
+ req at sql=paste(stringr::str_c("SELECT
+ distinct on (tc.constraint_name) tc.constraint_name, tc.table_name
+ FROM
+ information_schema.table_constraints AS tc
+ JOIN information_schema.key_column_usage AS kcu
+ ON tc.constraint_name = kcu.constraint_name
+ JOIN information_schema.constraint_column_usage AS ccu
+ ON ccu.constraint_name = tc.constraint_name
+ WHERE constraint_type = 'FOREIGN KEY' and tc.constraint_schema='",gsub("\\.","",get("sch",envir=envir_stacomi)),"';"))
+ req<-stacomirtools::connect(req)
+ result<-req at query
+ fk<-structure(list(constraint_name = c("c_fk_act_lot_identifiant",
+ "c_fk_act_mqe_reference", "c_fk_act_org_code", "c_fk_bjo_org_code",
+ "c_fk_bjo_std_code", "c_fk_bjo_tax_code", "c_fk_bme_std_code",
+ "c_fk_bme_tax_code", "c_fk_car_lot_identifiant", "c_fk_car_org_code",
+ "c_fk_car_par_code", "c_fk_car_val_identifiant", "c_fk_coe_org_code",
+ "c_fk_coe_qte_code", "c_fk_coe_std_code", "c_fk_coe_tax_code",
+ "c_fk_dft_df_identifiant", "c_fk_dft_org_code", "c_fk_dft_tdf_code",
+ "c_fk_dic_dif_identifiant", "c_fk_dic_dis_identifiant", "c_fk_dic_org_code",
+ "c_fk_dic_tdc_code", "c_fk_dif_dis_identifiant", "c_fk_dif_org_code",
+ "c_fk_dif_ouv_identifiant", "c_fk_dtx_dif_identifiant", "c_fk_dtx_org_code",
+ "c_fk_dtx_tax_code", "c_fk_env_org_code", "c_fk_env_stm_identifiant",
+ "c_fk_env_val_identifiant", "c_fk_lot_dev_code", "c_fk_lot_lot_identifiant",
+ "c_fk_lot_ope_identifiant", "c_fk_lot_org_code", "c_fk_lot_qte_code",
+ "c_fk_lot_std_code", "c_fk_lot_tax_code", "c_fk_maa_mal_id",
+ "c_fk_mac_valeurqualitatifdefaut", "c_fk_mae_mao_id", "c_fk_mae_stm_identifiant",
+ "c_fk_mal_mas_id", "c_fk_mao_mas_id", "c_fk_mqe_loc_code", "c_fk_mqe_nmq_code",
+ "c_fk_mqe_omq_reference", "c_fk_mqe_org_code", "c_fk_omq_org_code",
+ "c_fk_ope_dic_identifiant", "c_fk_ope_org_code", "c_fk_ouv_nov_code",
+ "c_fk_ouv_org_code", "c_fk_ouv_sta_code", "c_fk_pco_imp_code",
+ "c_fk_pco_loc_code", "c_fk_pco_lot_identifiant", "c_fk_pco_org_code",
+ "c_fk_pco_pat_code", "c_fk_per_dis_identifiant", "c_fk_per_org_code",
+ "c_fk_per_tar_code", "c_fk_prl_loc_code", "c_fk_prl_lot_identifiant",
+ "c_fk_prl_org_code", "c_fk_prl_pre_nom", "c_fk_prl_typeprelevement",
+ "c_fk_sta_org_code", "c_fk_std_code", "c_fk_stm_org_code", "c_fk_stm_par_code",
+ "c_fk_stm_sta_code", "c_fk_tav_dic_identifiant", "c_fk_tav_org_code",
+ "c_fk_txe_ech_code", "c_fk_txe_org_code", "c_fk_txe_sta_code",
+ "c_fk_txe_std_code", "c_fk_txe_tax_code", "c_fk_txv_org_code",
+ "c_fk_txv_std_code", "c_fk_txv_tax_code"), table_name = c("tj_actionmarquage_act",
+ "tj_actionmarquage_act", "tj_actionmarquage_act", "t_bilanmigrationjournalier_bjo",
+ "t_bilanmigrationjournalier_bjo", "t_bilanmigrationjournalier_bjo",
+ "t_reportmigrationmensuel_bme", "t_reportmigrationmensuel_bme",
+ "tj_caracteristiquelot_car", "tj_caracteristiquelot_car", "tj_caracteristiquelot_car",
+ "tj_caracteristiquelot_car", "tj_coefficientconversion_coe",
+ "tj_coefficientconversion_coe", "tj_coefficientconversion_coe",
+ "tj_coefficientconversion_coe", "tj_dfesttype_dft", "tj_dfesttype_dft",
+ "tj_dfesttype_dft", "t_dispositifcomptage_dic", "t_dispositifcomptage_dic",
+ "t_dispositifcomptage_dic", "t_dispositifcomptage_dic", "t_dispositiffranchissement_dif",
+ "t_dispositiffranchissement_dif", "t_dispositiffranchissement_dif",
+ "tj_dfestdestinea_dtx", "tj_dfestdestinea_dtx", "tj_dfestdestinea_dtx",
+ "tj_conditionenvironnementale_env", "tj_conditionenvironnementale_env",
+ "tj_conditionenvironnementale_env", "t_lot_lot", "t_lot_lot",
+ "t_lot_lot", "t_lot_lot", "t_lot_lot", "t_lot_lot", "t_lot_lot",
+ "ts_masqueordreaffichage_maa", "ts_masquecaracteristiquelot_mac",
+ "ts_masqueconditionsenvironnementales_mae", "ts_masqueconditionsenvironnementales_mae",
+ "ts_masquelot_mal", "ts_masqueope_mao", "t_marque_mqe", "t_marque_mqe",
+ "t_marque_mqe", "t_marque_mqe", "t_operationmarquage_omq", "t_operation_ope",
+ "t_operation_ope", "t_ouvrage_ouv", "t_ouvrage_ouv", "t_ouvrage_ouv",
+ "tj_pathologieconstatee_pco", "tj_pathologieconstatee_pco", "tj_pathologieconstatee_pco",
+ "tj_pathologieconstatee_pco", "tj_pathologieconstatee_pco", "t_periodefonctdispositif_per",
+ "t_periodefonctdispositif_per", "t_periodefonctdispositif_per",
+ "tj_prelevementlot_prl", "tj_prelevementlot_prl", "tj_prelevementlot_prl",
+ "tj_prelevementlot_prl", "tj_prelevementlot_prl", "t_station_sta",
+ "ts_taxavideo_txv", "tj_stationmesure_stm", "tj_stationmesure_stm",
+ "tj_stationmesure_stm", "ts_taillevideo_tav", "ts_taillevideo_tav",
+ "tj_tauxechappement_txe", "tj_tauxechappement_txe", "tj_tauxechappement_txe",
+ "tj_tauxechappement_txe", "tj_tauxechappement_txe", "ts_taxavideo_txv",
+ "ts_taxavideo_txv", "ts_taxavideo_txv")), .Names = c("constraint_name",
+ "table_name"), row.names = c(NA, 83L), class = "data.frame")
+ check_exist_fk=fk$constraint_name%in%result$constraint_name
+ for (i in 1:nrow(fk)){
+ expect_true(check_exist_fk[i],label=paste("Missing foreign key :",fk$constraint_name[i],"table :",fk$table_name[i]))
+ }
+ rm(list=ls(all=TRUE))
+ })
+
+
+
+
Added: pkg/stacomir/tests/testthat/test-00-zrefclasses.R
===================================================================
--- pkg/stacomir/tests/testthat/test-00-zrefclasses.R (rev 0)
+++ pkg/stacomir/tests/testthat/test-00-zrefclasses.R 2018-09-24 15:54:01 UTC (rev 512)
@@ -0,0 +1,46 @@
+context("ref_horodate")
+test_that("Test that the parsing of many kind of dates works",
+ {
+ require(stacomiR)
+ ref_horodate<-new("ref_horodate")
+ # regular expression to test string "1] nous avons le choix dans la date\n"
+ # default string returned by the method
+ expect_that(ref_horodate<-choice_c(ref_horodate,
+ horodate="01/01/2013 00:00:00"),prints_text("^\\[1\\].+date.+"))
+ expect_that(ref_horodate<-choice_c(ref_horodate,
+ horodate="01/01/2013 00:00"),prints_text("^\\[1\\].+date.+"))
+ expect_that(ref_horodate<-choice_c(ref_horodate,
+ horodate="01-01-2013 00:00"),prints_text("^\\[1\\].+date.+"))
+ expect_that(ref_horodate<-choice_c(ref_horodate,
+ horodate="2013-01-01 00:00"),prints_text("^\\[1\\].+date.+"))
+ expect_that(ref_horodate<-choice_c(ref_horodate,
+ horodate="01-01-2013"),prints_text("^\\[1\\].+date.+"))
+ expect_error(ref_horodate<-choice_c(ref_horodate,
+ horodate="2013/01/01 00:00:00"))
+ })
+
+
+
+test_that("Test that the parsing of wrong character formats gets an error",
+ {
+ require(stacomiR)
+ ref_horodate<-new("ref_horodate")
+ options(warn = -1)
+ expect_error(ref_horodate<-choice_c(ref_horodate,
+ horodate="2013 01 01"))
+ options(warn = 1)
+
+ })
+
+context("ref_df")
+
+test_that("Test that ref_df choice_c method loads character, numeric, but not rubbish",
+ {
+ require(stacomiR)
+ stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=FALSE)
+ ref_df<-new("ref_df")
+ ref_df<-charge(ref_df)
+ expect_silent(ref_df<-choice_c(ref_df, 2))
+ expect_silent(ref_df<-choice_c(ref_df, "2"))
+ expect_error(ref_df<-suppressWarnings(choice_c(ref_df, "semoule")))
+ })
Added: pkg/stacomir/tests/testthat/test-01-report_mig_mult.R
===================================================================
--- pkg/stacomir/tests/testthat/test-01-report_mig_mult.R (rev 0)
+++ pkg/stacomir/tests/testthat/test-01-report_mig_mult.R 2018-09-24 15:54:01 UTC (rev 512)
@@ -0,0 +1,115 @@
+context("report_mig_mult")
+test_that("Test an instance of report_mig_mult",{
+ require(stacomiR)
+ stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=FALSE)
+ report_mig_mult<-new("report_mig_mult")
+ #options(warn = -1)
+ report_mig_mult<-suppressWarnings(choice_c(report_mig_mult,
+ dc=c(6,7),
+ taxa=c("Anguilla anguilla","Salmo salar"),
+ stage=c("AGG","AGJ","CIV"),
+ datedebut="2012-01-01",
+ datefin="2012-12-31",
+ silent=TRUE))
+ #options(warn = 0)
+ expect_s4_class(report_mig_mult,
+ "report_mig_mult")
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+## This test check that the code above works with numeric and a different formating for date
+test_that("Test another instance of report_mig_mult",{
+ require(stacomiR)
+ stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=FALSE)
+ report_mig_mult<-new("report_mig_mult")
+ #options(warn = -1)
+ report_mig_mult<-suppressWarnings(choice_c(report_mig_mult,
+ dc=c(6,7),
+ taxa=c(2038,2220),
+ stage=c("AGG","AGJ","CIV"),
+ datedebut="2012-01-01",
+ datefin="31/12/2012",
+ silent=TRUE))
+ #options(warn = 0)
+ expect_s4_class(report_mig_mult,
+ "report_mig_mult")
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+test_that("Tests one instance with error (dc does not exist)",
+ {
+ require(stacomiR)
+ stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=FALSE)
+ report_mig_mult<-new("report_mig_mult")
+ options(warn = -1)
+ expect_error(choice_c(report_mig_mult,
+ dc=c(6,7000),
+ taxa=c("Anguilla anguilla","Salmo salar"),
+ stage=c("AGG","AGJ","CIV"),
+ datedebut="2012-01-01",
+ datefin="31/12/2012",
+ silent=TRUE))
+ options(warn = 0)
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+test_that("Test charge method for report_mig_mult",
+ {
+ require(stacomiR)
+ stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=FALSE)
+ report_mig_mult<-new("report_mig_mult")
+ options(warn = -1)
+ report_mig_mult<-choice_c(report_mig_mult,
+ dc=c(6,7),
+ taxa=c(2038),
+ stage=c("AGG","AGJ","CIV"),
+ datedebut="2012-01-01",
+ datefin="31/12/2012",
+ silent=TRUE)
+ options(warn = 0)
+ report_mig_mult<-charge(report_mig_mult,silent=TRUE)
+ expect_is(get("report_df",envir=envir_stacomi),"report_df")
+ expect_is(get("report_dc",envir=envir_stacomi),"report_dc")
+ expect_is(get("report_ope",envir=envir_stacomi),"report_ope")
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+test_that("Test connect method for report_mig_mult",
+ {
+ require(stacomiR)
+ stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=FALSE)
+ report_mig_mult<-new("report_mig_mult")
+ options(warn = -1)
+ report_mig_mult<-choice_c(report_mig_mult,
+ dc=c(6,7),
+ taxa=c(2038),
+ stage=c("AGG","AGJ","CIV"),
+ datedebut="2012-01-01",
+ datefin="31/12/2012",
+ silent=TRUE)
+ options(warn = 0)
+ report_mig_mult<-charge(report_mig_mult,silent=TRUE)
+ report_mig_mult<-connect(report_mig_mult,silent=TRUE)
+ expect_gt(nrow(report_mig_mult at data),0)
+ report_ope<-get("report_ope",envir=envir_stacomi)
+ expect_gt(nrow(report_ope at data),0)
+ report_df<-get("report_df",envir=envir_stacomi)
+ expect_gt(nrow(report_df at data),0)
+ report_dc<-get("report_dc",envir=envir_stacomi)
+ expect_gt(nrow(report_dc at data),0)
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+test_that("Test example 01_report_mig_mult",
+ {
+ # check if built with examples (Rtools install --example
+ example_path<-file.path(.libPaths()[1],"stacomiR","R-ex","report_mig_mult-class.R")
+ test<-file.access(example_path,0)
+ if (test[1]!=0) warnings("Package example dir not created ?") else
+ options(warn = -1)
+ source(example_path)
+ options(warn = 0)
+ expect_output(summary(r_mig_mult,silent=FALSE))
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+
Added: pkg/stacomir/tests/testthat/test-02-report_mig.R
===================================================================
--- pkg/stacomir/tests/testthat/test-02-report_mig.R (rev 0)
+++ pkg/stacomir/tests/testthat/test-02-report_mig.R 2018-09-24 15:54:01 UTC (rev 512)
@@ -0,0 +1,326 @@
+context("report_mig")
+test_that("Test an instance of report_mig",{
+ require(stacomiR)
+ stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=FALSE)
+ # overriding user schema to point to iav
+ baseODBC<-get("baseODBC",envir=envir_stacomi)
+ baseODBC[c(2,3)]<-rep("iav",2)
+ assign("baseODBC",baseODBC,envir_stacomi)
+ sch<-get("sch",envir=envir_stacomi) # "iav."
+ assign("sch","iav.",envir_stacomi)
+ report_mig<-new("report_mig")
+ options(warn = -1)
+ report_mig<-choice_c(report_mig,
+ dc=c(6),
+ taxa=c("Anguilla anguilla"),
+ stage=c("AGJ"),
+ datedebut="2013-01-01",
+ datefin="2013-12-31")
+ options(warn = 0)
+ expect_s4_class(report_mig,
+ "report_mig")
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+
+test_that("Test an instance of report_mig, check that operations accross two years are split correcly",{
+ require(stacomiR)
+ stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=FALSE)
+ # overriding user schema to point to iav
+ baseODBC<-get("baseODBC",envir=envir_stacomi)
+ baseODBC[c(2,3)]<-rep("iav",2)
+ assign("baseODBC",baseODBC,envir_stacomi)
+ sch<-get("sch",envir=envir_stacomi) # "iav."
+ assign("sch","iav.",envir_stacomi)
+
+ report_mig<-new("report_mig")
+ options(warn = -1)
+ report_mig<-choice_c(report_mig,
+ dc=c(6),
+ taxa=c("Anguilla anguilla"),
+ stage=c("AGJ"),
+ datedebut="1997-01-01",
+ datefin="1997-12-31")
+ options(warn = 0)
+ report_mig<-charge(report_mig,silent=TRUE)
+ report_mig<-connect(report_mig,silent=TRUE)
+ report_mig<-calcule(report_mig,silent=TRUE)
+ # before doing the split per year the sum was 8617
+ # now it is less, only one third of the 7 eel belong to 1997
+ # the rest are in 1998
+ expect_equal(round(sum(report_mig at calcdata[["dc_6"]][["data"]]$Effectif_total)),
+ 8614)
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+test_that("Test another instance of report_mig, check that operations accross two years are split correcly",{
+ require(stacomiR)
+ stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=FALSE)
+ # overriding user schema to point to iav
+ baseODBC<-get("baseODBC",envir=envir_stacomi)
+ baseODBC[c(2,3)]<-rep("iav",2)
+ assign("baseODBC",baseODBC,envir_stacomi)
+ sch<-get("sch",envir=envir_stacomi) # "iav."
+ assign("sch","iav.",envir_stacomi)
+
+ report_mig<-new("report_mig")
+ options(warn = -1)
+ report_mig<-choice_c(report_mig,
+ dc=c(6),
+ taxa=c("Anguilla anguilla"),
+ stage=c("AGJ"),
+ datedebut="2015-01-01",
+ datefin="2015-12-31")
+ options(warn = 0)
+ report_mig<-charge(report_mig,silent=TRUE)
+ report_mig<-connect(report_mig,silent=TRUE)
+ report_mig<-calcule(report_mig,silent=TRUE)
+ # before doing the split per year the sum was 8617
+ # now it is less, only one third of the 7 eel belong to 1997
+ # the rest are in 1998
+ expect_equal(round(sum(report_mig at calcdata[["dc_6"]][["data"]]$Effectif_total)),
+ 26454)
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+test_that("Test connect method",{
+ stacomi(gr_interface=FALSE,
+ login_window=FALSE,
+ database_expected=FALSE)
+ # overriding user schema
+ baseODBC<-get("baseODBC",envir=envir_stacomi)
+ baseODBC[c(2,3)]<-rep("iav",2)
+ assign("baseODBC",baseODBC,envir_stacomi)
+ sch<-get("sch",envir=envir_stacomi) # "iav."
+ assign("sch","iav.",envir_stacomi)
+ # this chunk is not launched from examples but loads the r_mig dataset if connection works
+ r_mig=new("report_mig")
+ r_mig=choice_c(r_mig,
+ dc=5,
+ taxa=c("Liza ramada"),
+ stage=c("IND"),
+ datedebut="2015-01-01",
+ datefin="2015-12-31")
+ r_mig<-charge(r_mig,silent=TRUE)
+ r_mig<-connect(r_mig,silent=TRUE)
+
+ expect_length(r_mig at data,11)
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+test_that("Test example 02_report_mig",
+ {
+ # check if built with examples (Rtools install --example)
+ # the file is generate it examples but later loaded to examples from the class using @example
+ # be sure you have built Roxygen documentation before running
+ example_path<-file.path(.libPaths(),"stacomiR","R-ex","report_mig-class.R")
+ test<-file.access(example_path,0)
+ if (test[1]!=0) warnings("Package example dir not created ?") else
+ source(example_path)
+ })
+
+
+test_that("Summary method works",
+ {
+ stacomi(gr_interface=FALSE,
+ login_window=FALSE,
+ database_expected=TRUE)
+ # overriding user schema
+ baseODBC<-get("baseODBC",envir=envir_stacomi)
+ baseODBC[c(2,3)]<-rep("iav",2)
+ assign("baseODBC",baseODBC,envir_stacomi)
+ sch<-get("sch",envir=envir_stacomi) # "iav."
+ assign("sch","iav.",envir_stacomi)
+ # this chunk is not launched from examples but loads the r_mig dataset if connection works
+ data("r_mig")
+ r_mig<-calcule(r_mig,silent=TRUE)
+ summary(r_mig,silent=TRUE)
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+test_that("Test writing an example to the database",
+ {
+ stacomi(gr_interface=FALSE,
+ login_window=FALSE,
+ database_expected=TRUE)
+ # overriding user schema
+ baseODBC<-get("baseODBC",envir=envir_stacomi)
+ baseODBC[c(2,3)]<-rep("iav",2)
+ assign("baseODBC",baseODBC,envir_stacomi)
+ sch<-get("sch",envir=envir_stacomi) # "iav."
+ assign("sch","iav.",envir_stacomi)
+ # this chunk is not launched from examples but loads the r_mig dataset if connection works
+ data("r_mig")
+ r_mig<-calcule(r_mig,silent=TRUE)
+ write_database(object=r_mig,silent=TRUE)
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+test_that("Test that different sums are the same, for report_mig, report_mig_interannual, report_annual",
+ {
+ stacomi(gr_interface=FALSE,
+ login_window=FALSE,
+ database_expected=TRUE)
+ # overriding user schema
+ baseODBC<-get("baseODBC",envir=envir_stacomi)
+ baseODBC[c(2,3)]<-rep("iav",2)
+ assign("baseODBC",baseODBC,envir_stacomi)
+ sch<-get("sch",envir=envir_stacomi) # "iav."
+ assign("sch","iav.",envir_stacomi)
+ # this chunk is not launched from examples but loads the r_mig dataset if connection works
+ data("r_mig")
+ r_mig<-calcule(r_mig,silent=TRUE)
+ expect_equal(
+ sum(r_mig at calcdata$dc_5$data$Effectif_total),
+ sum(r_mig at data[r_mig at data$ope_dic_identifiant==5,"value"]))
+ write_database(object=r_mig,silent=TRUE)
+ # using setAs to transform the report_mig into report_mig_interannual
+ bili=as(r_mig,"report_mig_interannual")
+ bila=as(bili,"report_annual")
+ bila<-connect(bila,silent=TRUE)
+ # we test that the report_annual has the same number as
+ # report_mig
+ expect_equal(
+ sum(r_mig at calcdata$dc_5$data$Effectif_total),
+ bila at data$effectif,
+ label="The sum of number in the report_mig are different to the
+ number in the report_annual class"
+ )
+
+ bili<-connect(bili,check=TRUE,silent=TRUE)
+ expect_equal(
+ sum(r_mig at calcdata$dc_5$data$Effectif_total),
+ sum(bili at data$bjo_valeur[bili at data$bjo_labelquantite=="Effectif_total"]),
+ label="The sum of number in the report_mig are different to the
+ number in the report_mig_interannual")
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+
+test_that("print method works",
+ {
+ stacomi(gr_interface=FALSE,
+ login_window=FALSE,
+ database_expected=TRUE)
+ # overriding user schema
+ baseODBC<-get("baseODBC",envir=envir_stacomi)
+ baseODBC[c(2,3)]<-rep("iav",2)
+ assign("baseODBC",baseODBC,envir_stacomi)
+ sch<-get("sch",envir=envir_stacomi) # "iav."
+ assign("sch","iav.",envir_stacomi)
+ # this chunk is not launched from examples but loads the r_mig dataset if connection works
+ data("r_mig")
+ expect_output(print(r_mig), "report_mig=choice_c",info = NULL)
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+
+
+test_that("test example for fd80",
+ {
+ stacomi(gr_interface=FALSE,
+ login_window=FALSE,
+ database_expected=TRUE)
+ # overriding user schema
+ baseODBC<-get("baseODBC",envir=envir_stacomi)
+ baseODBC[c(2,3)]<-rep("fd80",2)
+ assign("baseODBC",baseODBC,envir_stacomi)
+ sch<-get("sch",envir=envir_stacomi) # "iav."
+ assign("sch","fd80.",envir_stacomi)
+ # this chunk is not launched from examples but loads the r_mig dataset if connection works
+ bM_EclusierVaux=new("report_mig")
+ bM_EclusierVaux=choice_c(bM_EclusierVaux,
+ dc=6,
+ taxa=c("Anguilla anguilla"),
+ stage=c("AGG"),
+ datedebut="2016-01-01",
+ datefin="2016-12-31")
+ bM_EclusierVaux<-charge(bM_EclusierVaux,silent=TRUE)
+ bM_EclusierVaux<-connect(bM_EclusierVaux,silent=TRUE)
+ bM_EclusierVaux<-calcule(bM_EclusierVaux,silent=TRUE)
+ plot(bM_EclusierVaux,silent=TRUE)
+ summary(bM_EclusierVaux,silent=TRUE)
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+
+
+test_that("test example with glass eel",
+ {
+ stacomi(gr_interface=FALSE,
+ login_window=FALSE,
+ database_expected=TRUE)
+ # overriding user schema
+ baseODBC<-get("baseODBC",envir=envir_stacomi)
+ baseODBC[c(2,3)]<-rep("iav",2)
+ assign("baseODBC",baseODBC,envir_stacomi)
+ sch<-get("sch",envir=envir_stacomi) # "iav."
+ assign("sch","iav.",envir_stacomi)
+ # this chunk is not launched from examples but loads the r_mig dataset if connection works
+ bM_Arzal_civ=new("report_mig")
+ bM_Arzal_civ=choice_c(bM_Arzal_civ,
+ dc=6,
+ taxa=c("Anguilla anguilla"),
+ stage=c("CIV"),
+ datedebut="2003-01-01",
+ datefin="2003-12-31")
+ bM_Arzal_civ<-charge(bM_Arzal_civ,silent=TRUE)
+ bM_Arzal_civ<-connect(bM_Arzal_civ,silent=TRUE)
+ bM_Arzal_civ<-calcule(bM_Arzal_civ,silent=TRUE)
+ plot(bM_Arzal_civ,silent=TRUE)
+ # some additional arguments passed to plot via ...
+ plot(bM_Arzal_civ,silent=TRUE,bty="n")
+ summary(bM_Arzal_civ,silent=TRUE)
+ rm(list=ls(envir=envir_stacomi),envir=envir_stacomi)
+ })
+# here require setting a connection to logrami server under the name BD_CONTMIG_NAT_SERVEUR
+#test_that("test connexion to logrami server",
+# {
+# require(stacomiR)
+# stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=TRUE)
+# baseODBC<-get("baseODBC",envir=envir_stacomi)
+# baseODBC[1]<- "BD_CONTMIG_SERVEUR"
+# baseODBC[c(2,3)]<-rep('logrami',2)
+# assign("baseODBC",baseODBC,envir_stacomi)
+# sch<-get("sch",envir=envir_stacomi)
+# assign("sch",paste('logrami',".", sep=""),envir_stacomi)
+# sqldf.options<-get("sqldf.options",envir=envir_stacomi)
+# getpassword<-function(){
+# require(tcltk);
+# wnd<-tktoplevel();tclVar("")->passVar;
+# #Label
+# tkgrid(tklabel(wnd,text="Enter password:"));
+# #Password box
+# tkgrid(tkentry(wnd,textvariable=passVar,show="*")->passBox);
+# #Hitting return will also submit password
+# tkbind(passBox,"<Return>",function() tkdestroy(wnd));
+# #OK button
+# tkgrid(tkbutton(wnd,text="OK",command=function() tkdestroy(wnd)));
+# #Wait for user to click OK
+# tkwait.window(wnd);
+# password<-tclvalue(passVar);
+# return(password);
+# }
+# sqldf.options["sqldf.RPostgreSQL.host"]<-getpassword()
+# sqldf.options["sqldf.RPostgreSQL.port"]<-5432
+# assign("sqldf.options",sqldf.options,envir_stacomi)
+# report_mig=new('report_mig')
+# report_mig=choice_c(report_mig,
+# dc=23,
+# taxa=c("Petromyzon marinus"),
+# stage=c(5),
+# datedebut="2015-01-01",
+# datefin="2015-12-31")
+# report_mig<-charge(report_mig, silent=TRUE)
+# report_mig=connect(report_mig, silent=TRUE)
+# report_mig=calcule(report_mig, silent=TRUE)
+#
+# r_mig_interannual<-new("report_mig_interannual")
+# r_mig_interannual<-choice_c(r_mig_interannual,
+# dc=c(101,107),
+# taxa=c("Silurus glanis"),
+# stage=c(5),
+# anneedebut="2014",
+# anneefin="2016",
+# silent=TRUE)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/stacomir -r 512
More information about the Stacomir-commits
mailing list