R Under development (unstable) (2024-08-23 r87049 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> ################################################################################
> ##
> ## $Id: classes.test.R 346 2006-10-01 05:08:55Z enos $
> ##
> ## Tests explicitly declared validity functions in AllClasses.R
> ##
> ################################################################################
> 
> library(portfolio)
Loading required package: grid
Loading required package: lattice
> 
> ## constructs lists that break the validity functions of objects of
> ## class "objectHistory" and objects of class "portfolio"
> 
> list.0 <- list(data.frame(), new("portfolio"))
> list.1 <- list(new("contribution"), new("contribution"))
> list.2 <- list(new("performance"), new("performance"))
> list.3 <- list(new("exposure"), new("exposure"))
> 
> ## constucts a data.frame to test the validity function of "portfolio"
> 
> data.0 <- data.frame(id = 1:20, in.var = 1:20, ret.var = 1:20, price.var = 1:20)
> p <- new("portfolio", data = data.0, id.var = "id",
+               in.var = "in.var", price.var = "price.var",
+               ret.var = "ret.var", sides = c("long", "short"), equity = 10000)
> 
> ## directly modify "shares" data.frame so validity function returns
> ## false
> 
> p@shares <- p@shares[1,]
> 
> ## tests validity functions of forementioned classes
> 
> trial.0 <- try(
+                new("objectHistory", data = list.0), silent = TRUE
+                )
> 
> trial.1 <- try(
+                new("performanceHistory", data = list.1), silent = TRUE
+                )
> 
> trial.2 <- try(
+                new("exposureHistory", data = list.2), silent = TRUE
+                )
> 
> trial.3 <- try(
+                new("contributionHistory", data = list.3), silent = TRUE
+                )
> 
> trial.4 <- try(
+                validObject(p), silent = TRUE
+                )
> 
> if(class(trial.0) == "try-error"){
+   stopifnot(
+             as.logical(grep("Error.*validObject.*objectHistory",trial.0[1]))
+             )
+ }
> 
> if(class(trial.1) == "try-error"){
+   stopifnot(
+             as.logical(grep("Error.*validObject.*performanceHistory",
+                             trial.1[1]))
+             )
+ }
> 
> if(class(trial.2) == "try-error"){
+   stopifnot(
+             as.logical(grep("Error.*validObject.*exposureHistory",trial.2[1]))
+             )
+ }
> 
> if(class(trial.3) == "try-error"){
+   stopifnot(
+             as.logical(grep("Error.*validObject.*contributionHistory",
+                             trial.3[1]))
+             )
+ }
> 
> if(class(trial.4) == "try-error"){
+   stopifnot(
+             as.logical(grep("Error.*validObject.*portfolio",
+                 trial.4[1]))
+             )
+ }
> 
> ## Tests the 'validity' method of 'matchedPortfolio'
> 
> test <- try(
+             new("matchedPortfolio", formula = y ~ x + z, original = p),
+             silent = TRUE
+             )
> 
> stopifnot(
+           as.logical(grep("Error.*validObject.*does not contain columns",
+                           test[1]))
+           )
> 
> proc.time()
   user  system elapsed 
   0.54    0.12    0.62