[Stacomir-commits] r598 - in pkg: stacomir/tests/testthat stacomirtools/tests/testthat

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Nov 12 08:39:10 CET 2021


Author: briand
Date: 2021-11-12 08:39:10 +0100 (Fri, 12 Nov 2021)
New Revision: 598

Added:
   pkg/stacomir/tests/testthat/.gitignore
   pkg/stacomir/tests/testthat/helper.R
   pkg/stacomirtools/tests/testthat/_snaps/
Modified:
   pkg/stacomir/tests/testthat/test-00-stacomir.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
Log:
rewrote all tests using withr and helper

Added: pkg/stacomir/tests/testthat/.gitignore
===================================================================
--- pkg/stacomir/tests/testthat/.gitignore	                        (rev 0)
+++ pkg/stacomir/tests/testthat/.gitignore	2021-11-12 07:39:10 UTC (rev 598)
@@ -0,0 +1 @@
+/hs_err_pid12972.log

Added: pkg/stacomir/tests/testthat/helper.R
===================================================================
--- pkg/stacomir/tests/testthat/helper.R	                        (rev 0)
+++ pkg/stacomir/tests/testthat/helper.R	2021-11-12 07:39:10 UTC (rev 598)
@@ -0,0 +1,24 @@
+# Global variables for test
+
+# this file is called before testhat so funcion will be available in all test
+# https://testthat.r-lib.org/articles/test-fixtures.html#withr-defer-
+# could have used with_envvar and local_envvar but had to set them each time
+
+env_set_test_stacomi <- function(env = parent.frame()) {
+	o <- options()
+	withr::defer(options(					
+			stacomiR.dbname = "bd_contmig_nat",
+			stacomiR.host ="localhost",
+			stacomiR.port = "5432",
+			stacomiR.user = "postgres",
+			stacomiR.password = "postgres"					
+	),	env)
+assign("user","postgres",envir=env)
+assign("password","postgres",envir=env)
+assign("host", "localhost", envir=env)
+assign("schema", "iav", envir=env)
+# test for foreign keys in the database ? set TRUE to test FALSE to avoid tests
+# if set to TRUE be sure that user and password correspond to superuser
+assign("test_foreign_keys", TRUE, envir=env)
+
+}

Modified: pkg/stacomir/tests/testthat/test-00-stacomir.R
===================================================================
--- pkg/stacomir/tests/testthat/test-00-stacomir.R	2021-11-10 10:31:58 UTC (rev 597)
+++ pkg/stacomir/tests/testthat/test-00-stacomir.R	2021-11-12 07:39:10 UTC (rev 598)
@@ -1,68 +1,72 @@
 context("stacomi base connection")
 
-if (interactive()){
-	user <- readline(prompt="Enter user: ")
-	password <- readline(prompt="Enter password: ")	
 
-}
-
 # 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",{
-		skip_on_cran()
-	  if(Sys.info()["sysname"] == "Linux")
-		  expect_equal(Sys.getlocale(category = "LC_TIME"),"fr_FR.UTF-8")
-	  else
-	      expect_equal(Sys.getlocale(category = "LC_TIME"),"French_France.1252")	
-	  
-	}
+			skip_on_cran()
+			if(Sys.info()["sysname"] == "Linux")
+				expect_equal(Sys.getlocale(category = "LC_TIME"),"fr_FR.UTF-8")
+			else
+				expect_equal(Sys.getlocale(category = "LC_TIME"),"French_France.1252")	
+			
+		}
 )
 
+test_that("Test that user host and password are set for test",{
+			skip_on_cran()
+			env_set_test_stacomi()
+			expect_true(exists("user"))
+			expect_true(exists("password"))
+		})
 
 
 context("Database connection")
 
 test_that("Test that stacomirtools connects",{
-		skip_on_cran()
-    envir_stacomi <- new.env(parent = asNamespace("stacomiR"))
-	  con <- new("ConnectionDB")
-		con at user <- user
-		con at password <- password
-		con <- connect(con)
-		expect_is(connect(con),'ConnectionDB')
-	  expect_equal(con at status,"Connection OK")
-	  pool::poolClose(con at connection)
-	  rm("envir_stacomi")
-	})
+			skip_on_cran()
+			env_set_test_stacomi()
+			envir_stacomi <- new.env(parent = asNamespace("stacomiR"))
+			con <- new("ConnectionDB")
+			con at user <- user
+			con at password <- password
+			con <- connect(con)
+			expect_is(connect(con),'ConnectionDB')
+			expect_equal(con at status,"Connection OK")
+			pool::poolClose(con at connection)
+			rm("envir_stacomi")
+		})
 
 
 test_that("Test that positive count for nrow(ref.tr_taxon_tax)",{
- 		skip_on_cran()
-    envir_stacomi <- new.env(parent = asNamespace("stacomiR"))
-		base <- c("bd_contmig_nat","localhost","5432",user,password)	  
-	  requete=new("RequeteDB")
-		requete <- connect(requete,base)
-	  requete at sql="select count(*) from ref.tr_taxon_tax"
-	  requete <- stacomirtools::query(requete)
-	  expect_true(as.numeric(requete at query)>0)
-	  rm("envir_stacomi")
-	})
+			skip_on_cran()
+			envir_stacomi <- new.env(parent = asNamespace("stacomiR"))
+			env_set_test_stacomi()
+			base <- c("bd_contmig_nat","localhost","5432",user,password)	  
+			requete=new("RequeteDB")
+			requete <- connect(requete,base)
+			requete at sql="select count(*) from ref.tr_taxon_tax"
+			requete <- stacomirtools::query(requete)
+			expect_true(as.numeric(requete at query)>0)
+			rm("envir_stacomi")
+		})
 
 
 test_that("Tests positive count for sch.t_operation_ope",{
-		skip_on_cran()
-    envir_stacomi <- new.env(parent = asNamespace("stacomiR"))
-		base <- c("bd_contmig_nat","localhost","5432",user,password)	  
-		requete=new("RequeteDB")
-		requete <- connect(requete,base)
-		sch <- paste("iav",".",sep="")	  
-	  requete at sql=paste("select count(*) from ",sch,"t_operation_ope",sep="")
-	  requete <- stacomirtools::query(requete)
-	  	
-	  expect_true(as.numeric(requete at query)>0)	
-	  rm("envir_stacomi")
-	})
+			skip_on_cran()
+			envir_stacomi <- new.env(parent = asNamespace("stacomiR"))
+			env_set_test_stacomi()		
+			base <- c("bd_contmig_nat","localhost","5432",user,password)	  
+			requete=new("RequeteDB")
+			requete <- connect(requete,base)
+			sch <- paste("iav",".",sep="")	  
+			requete at sql=paste("select count(*) from ",sch,"t_operation_ope",sep="")
+			requete <- stacomirtools::query(requete)
+			
+			expect_true(as.numeric(requete at query)>0)	
+			rm("envir_stacomi")
+		})
 
 context("Loading program")
 
@@ -69,18 +73,11 @@
 
 test_that("Test that working environment is created",{
 			skip_on_cran()
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.password = password					
-			)	
-	  stacomi(database_expected=TRUE)
-	  expect_true(exists("envir_stacomi"))
-		options(o)
-	})
+			env_set_test_stacomi()
+			stacomi(database_expected=TRUE)
+			expect_true(exists("envir_stacomi"))
+			
+		})
 
 
 # pour schema rlang::env_get(envir_stacomi, "sch")
@@ -88,149 +85,132 @@
 
 
 test_that("Test that tickets have been launched",
-	{
-	  skip_on_cran()
-	  envir_stacomi <- new.env(parent = asNamespace("stacomiR"))
-		o <- options()
-		options(					
-				stacomiR.dbname = "bd_contmig_nat",
-				stacomiR.host ="localhost",
-				stacomiR.port = "5432",
-				stacomiR.user = user,
-				stacomiR.user = password						
-		)		  
-	  req=new("RequeteDB")
-	  sch <- "iav."
-	  req at sql <- paste("select * from ",sch," ts_maintenance_main")
-	  req <- stacomirtools::query(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 des 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]))
-	  }					
-		options(o)
-	})
+		{
+			skip_on_cran()
+			envir_stacomi <- new.env(parent = asNamespace("stacomiR"))
+			env_set_test_stacomi()	  
+			req=new("RequeteDB")
+			sch <- "iav."
+			req at sql <- paste("select * from ",sch," ts_maintenance_main")
+			req <- stacomirtools::query(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 des 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
 #  attention your may need superuser rights for that test 
-if (interactive()){
-	user <- readline(prompt="Enter user (superuser): ")
-	password <- readline(prompt="Enter password (superuser): ")	
-	schema <- readline(prompt="Enter schema")
 
+
 test_that("All foreign keys are present",
-	{
-		skip_on_cran()
-#	  skip_if_not(stacomi_installed(),"skipping as the program is not installed on this computer")
-		req=new("RequeteDB")
-		o <- options()
-		options(					
-				stacomiR.dbname = "bd_contmig_nat",
-				stacomiR.host ="localhost",
-				stacomiR.port = "5432",
-				stacomiR.user = "postgres",
-				stacomiR.password = "postgres"					
-		)		 
-	  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='",paste(schema),"';"))
-	  req <- query(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_par_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))	
-	})
-}
\ No newline at end of file
+		{
+			env_set_test_stacomi()	
+			skip_on_cran()
+			skip_if_not(test_foreign_keys,"skipping foreign key test, set options in test/helper to change this")
+  		req=new("RequeteDB")
+			env_set_test_stacomi()	 
+			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='",paste(schema),"';"))
+			req <- query(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_par_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))	
+		})

Modified: pkg/stacomir/tests/testthat/test-01-report_mig_mult.R
===================================================================
--- pkg/stacomir/tests/testthat/test-01-report_mig_mult.R	2021-11-10 10:31:58 UTC (rev 597)
+++ pkg/stacomir/tests/testthat/test-01-report_mig_mult.R	2021-11-12 07:39:10 UTC (rev 598)
@@ -1,22 +1,10 @@
 context("report_mig_mult")
 
-if (interactive()){
-	if (!exists("user")){
-		user <- readline(prompt="Enter user: ")
-		password <- readline(prompt="Enter password: ")	
-	}	
-}
 
+
 test_that("Test an instance of report_mig_mult", {
 			skip_on_cran()
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.password = password					
-			)	
+			env_set_test_stacomi()
 			stacomi(database_expected=TRUE)		
 
 			report_mig_mult <- new("report_mig_mult")
@@ -35,7 +23,6 @@
 			#options(warn = 0)
 			expect_s4_class(report_mig_mult,
 					"report_mig_mult")
-			options(o)
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
 		})
 
@@ -43,14 +30,7 @@
 test_that("Test another instance of report_mig_mult", {
 			
 			skip_on_cran()
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.password = password					
-			)	
+			env_set_test_stacomi()
 			stacomi(database_expected=TRUE)	
 
 			
@@ -70,7 +50,7 @@
 			#options(warn = 0)
 			expect_s4_class(report_mig_mult,
 					"report_mig_mult")
-			options(o)
+			
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
 		})
 
@@ -79,14 +59,7 @@
 		{			
 			skip_on_cran()
 			stacomi(database_expected=TRUE)	
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.password = password					
-			)	
+			env_set_test_stacomi()
 			
 			report_mig_mult <- new("report_mig_mult")
 			options(warn = -1)
@@ -101,7 +74,7 @@
 							silent = TRUE
 					)
 			)
-			options(o)
+			
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
 		})
 
@@ -108,14 +81,7 @@
 test_that("Test charge method for report_mig_mult",
 		{
 			skip_on_cran()
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.password = password					
-			)	
+			env_set_test_stacomi()
 			stacomi(database_expected=TRUE)	
 
 			
@@ -135,7 +101,7 @@
 			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")
-			options(o)
+			
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
 		})
 
@@ -142,14 +108,7 @@
 test_that("Test connect method for report_mig_mult",
 		{
 			skip_on_cran()
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.password = password					
-			)	
+			env_set_test_stacomi()
 			stacomi(database_expected=TRUE)	
 			
 			report_mig_mult <- new("report_mig_mult")
@@ -173,7 +132,7 @@
 			expect_gt(nrow(report_df at data), 0)
 			report_dc <- get("report_dc", envir = envir_stacomi)
 			expect_gt(nrow(report_dc at data), 0)
-			options(o)
+			
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
 		})
 

Modified: pkg/stacomir/tests/testthat/test-02-report_mig.R
===================================================================
--- pkg/stacomir/tests/testthat/test-02-report_mig.R	2021-11-10 10:31:58 UTC (rev 597)
+++ pkg/stacomir/tests/testthat/test-02-report_mig.R	2021-11-12 07:39:10 UTC (rev 598)
@@ -1,20 +1,8 @@
 context("report_mig")
-if (interactive()){
-	if (!exists("user")){
-		user <- readline(prompt="Enter user: ")
-		password <- readline(prompt="Enter password: ")	
-	}	
-}
+
 test_that("Test an instance of report_mig", {
 			skip_on_cran()
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.user = password						
-			)	
+			env_set_test_stacomi()
 			stacomi(database_expected = TRUE, sch ='iav')
 			report_mig <- new("report_mig")
 			options(warn = -1)
@@ -29,6 +17,7 @@
 			options(warn = 0)
 			expect_s4_class(report_mig,
 					"report_mig")
+			
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
 		})
 
@@ -37,14 +26,7 @@
 		"Test an instance of report_mig, check that operations accross two years are split correcly",
 		{
 			skip_on_cran()
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.user = password						
-			)	
+			env_set_test_stacomi()
 			stacomi(database_expected = TRUE, sch = 'iav')   
 			report_mig <- new("report_mig")
 			options(warn = -1)
@@ -65,7 +47,7 @@
 			# the rest are in 1998
 			expect_equal(round(sum(report_mig at calcdata[["dc_6"]][["data"]]$Effectif_total)),
 					8613)
-			options(o)
+			
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
 		}
 )
@@ -74,14 +56,7 @@
 		"Test another instance of report_mig, check that operations accross two years are split correcly",
 		{
 			skip_on_cran()
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.user = password					
-			)	
+			env_set_test_stacomi()
 			stacomi(database_expected = TRUE, sch ='iav')			
 			report_mig <- new("report_mig")
 			options(warn = -1)
@@ -103,20 +78,13 @@
 			expect_equal(round(sum(report_mig at calcdata[["dc_6"]][["data"]]$Effectif_total)),
 					26454)
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
-			options(o)
+			
 		}
 )
 
 test_that("Test connect method", {
 			skip_on_cran()
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.user = password					
-			)	
+			env_set_test_stacomi()
 			stacomi(database_expected = TRUE)
 			# overriding user schema
 
@@ -135,7 +103,7 @@
 			
 			expect_length(r_mig at data, 11)
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
-			options(o)
+			
 		})
 
 #test_that("Test example 02_report_mig",
@@ -155,14 +123,7 @@
 test_that("Summary method works",
 		{
 			skip_on_cran()
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.user = password						
-			)	
+			env_set_test_stacomi()
 			stacomi(database_expected = TRUE)			
 			# overriding user schema
 			data("r_mig")
@@ -171,20 +132,13 @@
 			expect_silent(summary(r_mig, silent = TRUE))		
 
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
-			options(o)
+			
 		})
 
 test_that("Test writing an example to the database",
 		{
 			skip_on_cran()
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.user = password					
-			)	
+			env_set_test_stacomi()
 			stacomi(database_expected = TRUE)
 			data("r_mig")
 			r_mig <- calcule(r_mig, silent = TRUE)
@@ -192,7 +146,7 @@
 			# by default in r_mig we don't want to check for multiannual bilan
 			# it is written again in the database
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
-			options(o)
+			
 		})
 
 test_that(
@@ -199,15 +153,7 @@
 		"Test that different sums are the same, for report_mig, report_mig_interannual, report_annual",
 		{
 			skip_on_cran()
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.user = password,
-					stacomiR.printquery=TRUE
-			)	
+			env_set_test_stacomi()	
 			stacomi(database_expected = TRUE)
 			data("r_mig")
 			r_mig <- calcule(r_mig, silent = TRUE)
@@ -235,7 +181,7 @@
 							number in the report_mig_interannual"
 			)
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
-			options(o)
+			
 		}
 )
 
@@ -254,14 +200,7 @@
 test_that("test example for fd80",
 		{
 			skip_on_cran()
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.user = password					
-			)	
+			env_set_test_stacomi()
 			stacomi(database_expected = TRUE, sch ='fd80')
 			bM_EclusierVaux = new("report_mig")
 			bM_EclusierVaux = choice_c(
@@ -278,7 +217,7 @@
 			expect_output(plot(bM_EclusierVaux, silent = FALSE))
 			expect_output(summary(bM_EclusierVaux, silent = FALSE))
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
-			options(o)
+			
 		})
 
 
@@ -286,15 +225,8 @@
 		{
 			skip_on_cran()
 			stacomi(database_expected = TRUE)
-			o <- options()
-			options(					
-					stacomiR.dbname = "bd_contmig_nat",
-					stacomiR.host ="localhost",
-					stacomiR.port = "5432",
-					stacomiR.user = user,
-					stacomiR.user = password						
-			)	
-					bM_Arzal_civ = new("report_mig")
+			env_set_test_stacomi()		
+			bM_Arzal_civ = new("report_mig")
 			bM_Arzal_civ = choice_c(
 					bM_Arzal_civ,
 					dc = 6,
@@ -311,5 +243,5 @@
 			expect_silent(plot(bM_Arzal_civ, silent = TRUE, bty = "n"))
 			expect_output(summary(bM_Arzal_civ, silent = FALSE))
 			rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
-			options(o)
+			
 		})

Modified: pkg/stacomir/tests/testthat/test-03-report_df.R
===================================================================
--- pkg/stacomir/tests/testthat/test-03-report_df.R	2021-11-10 10:31:58 UTC (rev 597)
+++ pkg/stacomir/tests/testthat/test-03-report_df.R	2021-11-12 07:39:10 UTC (rev 598)
@@ -1,111 +1,92 @@
 context("report_df")
-if (interactive()){
-	if (!exists("user")){
-		user <- readline(prompt="Enter user: ")
-		password <- readline(prompt="Enter password: ")	
-	}	
-}
+
 test_that("Test an instance of report_df", {
 			skip_on_cran()
-  stacomi(database_expected = FALSE)
-	o <- options()
-	options(					
-			stacomiR.dbname = "bd_contmig_nat",
-			stacomiR.host ="localhost",
-			stacomiR.port = "5432",
-			stacomiR.user = user,
-			stacomiR.user = password					
-	)	  
-  r_df <- new("report_df")
-  r_df <- choice_c(
-    r_df,
-    2,
-    horodatedebut = "2013-01-01",
-    horodatefin = "2013-12-31",
-    silent = TRUE
-  )
-  expect_gt(nrow(r_df at df@data),
-            0,
-            label = "There should be data loaded by the choice_c method in the data slot of
-              the ref_df slot,nrow(r_df at df@data)")
-  expect_s4_class(r_df,
-                  "report_df")
-  expect_error(
-    BfDF <- choice_c(
-      r_df,
-      2,
-      horodatedebut = "2013 01 011",
-      horodatefin = "2013-12-31",
-      silent = TRUE
-    )
-  )
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/stacomir -r 598


More information about the Stacomir-commits mailing list