Commit 37009e75 authored by Matias's avatar Matias
Browse files

Portfolio. Le falta para estar terminado

parent 0ebdec7b
!classDefinition: #PortfolioTest category: #'Portfolio-Ejercicio'!
TestCase subclass: #PortfolioTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Portfolio-Ejercicio'!
!PortfolioTest methodsFor: 'tests' stamp: 'MEV 5/26/2019 20:15:41'!
test01NewPortfolioHasZeroBalance
|portfolio|
portfolio := Portfolio new.
self assert:(portfolio balance) equals:0.! !
!PortfolioTest methodsFor: 'tests' stamp: 'MEV 5/26/2019 20:23:17'!
test02AddingAccountsWithPositiveBalanceToPortfolioIncreasesItsBalance
|portfolio account|
account := ReceptiveAccount new.
Deposit register: 100 on: account.
portfolio := Portfolio new.
portfolio addToPortfolio:account.
self assert:(portfolio balance) equals:100.! !
!PortfolioTest methodsFor: 'tests' stamp: 'MEV 5/26/2019 20:27:02'!
test03PortfolioBalanceItsEqualToItsAccountsBalance
|portfolio anAccount anotherAccount|
anAccount := ReceptiveAccount new.
Deposit register: 100 on: anAccount.
anotherAccount := ReceptiveAccount new.
Deposit register: 200 on: anotherAccount.
portfolio := Portfolio new.
portfolio addToPortfolio:anAccount.
portfolio addToPortfolio: anotherAccount .
self assert:(portfolio balance) equals:300.! !
!PortfolioTest methodsFor: 'tests' stamp: 'MEV 5/26/2019 20:42:50'!
test04PortfolioKnowsIfItHasRegisteredTransactionsOfAnAccount
|portfolio anAccount aDeposit anotherDeposit|
anAccount := ReceptiveAccount new.
aDeposit := Deposit register: 100 on: anAccount.
anotherDeposit := Deposit register: 200 on: anAccount .
portfolio := Portfolio new.
portfolio addToPortfolio:anAccount.
self assert:(portfolio hasRegistered: aDeposit ).
self assert:(portfolio hasRegistered: anotherDeposit).! !
!PortfolioTest methodsFor: 'tests' stamp: 'MEV 5/26/2019 20:46:22'!
test05PortfolioKnowsIfItHasRegisteredTransactionsOfMoreThanOneAccount
|portfolio anAccount aDeposit anotherDeposit aWithdraw anotherAccount|
anAccount := ReceptiveAccount new.
aDeposit := Deposit register: 100 on: anAccount.
anotherAccount := ReceptiveAccount new.
anotherDeposit := Deposit register: 200 on: anotherAccount.
aWithdraw := Withdraw register: 50 on: anotherAccount .
portfolio := Portfolio new.
portfolio addToPortfolio:anAccount.
portfolio addToPortfolio:anotherAccount .
self assert:(portfolio hasRegistered: aDeposit ).
self assert:(portfolio hasRegistered: anotherDeposit).
self assert:(portfolio hasRegistered: aWithdraw).! !
!PortfolioTest methodsFor: 'tests' stamp: 'MEV 5/26/2019 21:21:24'!
test06PortfolioWhichIncludesAnEmptyPortfolioHasZeroBalance
|portfolio anotherPortfolio|
portfolio := Portfolio new.
anotherPortfolio := Portfolio new.
portfolio addToPortfolio: anotherPortfolio .
self assert:(portfolio balance )equals:0
! !
!classDefinition: #ReceptiveAccountTest category: #'Portfolio-Ejercicio'!
TestCase subclass: #ReceptiveAccountTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Portfolio-Ejercicio'!
!ReceptiveAccountTest methodsFor: 'tests' stamp: 'MEV 5/26/2019 16:53:57'!
test01ReceptiveAccountHaveZeroAsBalanceWhenCreated
| account |
account := ReceptiveAccount new.
self assert: 0 equals: account balance .
! !
!ReceptiveAccountTest methodsFor: 'tests' stamp: 'MEV 5/26/2019 16:54:00'!
test02DepositIncreasesBalanceOnTransactionValue
| account |
account := ReceptiveAccount new.
Deposit register: 100 on: account.
self assert: 100 equals: account balance .
! !
!ReceptiveAccountTest methodsFor: 'tests' stamp: 'MEV 5/26/2019 16:54:02'!
test03WithdrawDecreasesBalanceOnTransactionValue
| account |
account := ReceptiveAccount new.
Deposit register: 100 on: account.
Withdraw register: 50 on: account.
self assert: 50 equals: account balance .
! !
!ReceptiveAccountTest methodsFor: 'tests' stamp: 'MEV 5/26/2019 16:54:05'!
test04WithdrawValueMustBePositive
| account withdrawValue |
account := ReceptiveAccount new.
withdrawValue := 50.
self assert: withdrawValue equals: (Withdraw register: withdrawValue on: account) value
! !
!ReceptiveAccountTest methodsFor: 'tests' stamp: 'MEV 5/26/2019 16:54:07'!
test05ReceptiveAccountKnowsRegisteredTransactions
| account deposit withdraw |
account := ReceptiveAccount new.
deposit := Deposit register: 100 on: account.
withdraw := Withdraw register: 50 on: account.
self assert: (account hasRegistered: deposit).
self assert: (account hasRegistered: withdraw).
! !
!ReceptiveAccountTest methodsFor: 'tests' stamp: 'MEV 5/26/2019 16:54:09'!
test06ReceptiveAccountDoNotKnowNotRegisteredTransactions
| account deposit withdraw |
account := ReceptiveAccount new.
deposit := Deposit for: 100.
withdraw := Withdraw for: 50.
self deny: (account hasRegistered: deposit).
self deny: (account hasRegistered:withdraw).
! !
!ReceptiveAccountTest methodsFor: 'tests' stamp: 'MEV 5/26/2019 16:54:11'!
test07AccountKnowsItsTransactions
| account1 deposit1 |
account1 := ReceptiveAccount new.
deposit1 := Deposit register: 100 on: account1.
self assert: 1 equals: account1 transactions size .
self assert: (account1 transactions includes: deposit1).
! !
!classDefinition: #AccountTransaction category: #'Portfolio-Ejercicio'!
Object subclass: #AccountTransaction
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Portfolio-Ejercicio'!
!AccountTransaction methodsFor: 'balance' stamp: 'MEV 5/26/2019 17:14:36'!
balance
self subclassResponsibility ! !
!AccountTransaction methodsFor: 'value' stamp: 'MEV 5/26/2019 17:14:31'!
value
self subclassResponsibility ! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
!classDefinition: 'AccountTransaction class' category: #'Portfolio-Ejercicio'!
AccountTransaction class
instanceVariableNames: ''!
!AccountTransaction class methodsFor: 'instance creation' stamp: 'MEV 5/26/2019 16:55:21'!
register: aValue on: account
| withdraw |
withdraw := self for: aValue.
account register: withdraw.
^ withdraw! !
!classDefinition: #Deposit category: #'Portfolio-Ejercicio'!
AccountTransaction subclass: #Deposit
instanceVariableNames: 'value'
classVariableNames: ''
poolDictionaries: ''
category: 'Portfolio-Ejercicio'!
!Deposit methodsFor: 'initialization' stamp: 'HernanWilkinson 7/13/2011 18:45'!
initializeFor: aValue
value := aValue ! !
!Deposit methodsFor: 'balance' stamp: 'MEV 5/26/2019 17:14:51'!
balance
^ value! !
!Deposit methodsFor: 'value' stamp: 'MEV 5/26/2019 17:14:47'!
value
^ value! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
!classDefinition: 'Deposit class' category: #'Portfolio-Ejercicio'!
Deposit class
instanceVariableNames: ''!
!Deposit class methodsFor: 'instance creation' stamp: 'HernanWilkinson 7/13/2011 18:38'!
for: aValue
^ self new initializeFor: aValue ! !
!classDefinition: #Withdraw category: #'Portfolio-Ejercicio'!
AccountTransaction subclass: #Withdraw
instanceVariableNames: 'value'
classVariableNames: ''
poolDictionaries: ''
category: 'Portfolio-Ejercicio'!
!Withdraw methodsFor: 'initialization' stamp: 'HernanWilkinson 7/13/2011 18:46'!
initializeFor: aValue
value := aValue ! !
!Withdraw methodsFor: 'value' stamp: 'MEV 5/26/2019 17:14:59'!
value
^ value! !
!Withdraw methodsFor: 'balance' stamp: 'MEV 5/26/2019 17:15:05'!
balance
^ value negated.! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
!classDefinition: 'Withdraw class' category: #'Portfolio-Ejercicio'!
Withdraw class
instanceVariableNames: ''!
!Withdraw class methodsFor: 'instance creation' stamp: 'HernanWilkinson 7/13/2011 18:33'!
for: aValue
^ self new initializeFor: aValue ! !
!classDefinition: #Portfolio category: #'Portfolio-Ejercicio'!
Object subclass: #Portfolio
instanceVariableNames: 'portfolio transactions'
classVariableNames: ''
poolDictionaries: ''
category: 'Portfolio-Ejercicio'!
!Portfolio methodsFor: 'initialize' stamp: 'MEV 5/26/2019 21:07:51'!
initialize
portfolio := OrderedCollection new.
transactions := OrderedCollection new.! !
!Portfolio methodsFor: 'balance' stamp: 'MEV 5/26/2019 20:20:53'!
balance
^portfolio sum: [:anAccountOrPortfolio | anAccountOrPortfolio balance] ifEmpty:[0]. ! !
!Portfolio methodsFor: 'adding to portfolio' stamp: 'MEV 5/26/2019 21:18:15'!
addToPortfolio: anAccountOrPortfolio
portfolio add:anAccountOrPortfolio .
(anAccountOrPortfolio transactions) do:[:aTransaction | transactions add:aTransaction ].
! !
!Portfolio methodsFor: 'testing' stamp: 'MEV 5/26/2019 21:13:38'!
hasRegistered: aTransaction
^transactions includes: aTransaction.! !
!Portfolio methodsFor: 'transactions' stamp: 'MEV 5/26/2019 21:22:25'!
transactions
^transactions copy.! !
!classDefinition: #ReceptiveAccount category: #'Portfolio-Ejercicio'!
Object subclass: #ReceptiveAccount
instanceVariableNames: 'transactions'
classVariableNames: ''
poolDictionaries: ''
category: 'Portfolio-Ejercicio'!
!ReceptiveAccount methodsFor: 'initialization' stamp: 'MEV 5/26/2019 17:19:51'!
initialize
super initialize.
transactions := OrderedCollection new.! !
!ReceptiveAccount methodsFor: 'transactions' stamp: 'MEV 5/26/2019 16:56:03'!
register: aTransaction
transactions add: aTransaction
! !
!ReceptiveAccount methodsFor: 'transactions' stamp: 'MEV 5/26/2019 21:15:03'!
transactions
^ transactions copy! !
!ReceptiveAccount methodsFor: 'balance' stamp: 'MEV 5/26/2019 17:19:30'!
balance
^transactions sum: [ :aTransaction | aTransaction balance] ifEmpty: [ 0 ]! !
!ReceptiveAccount methodsFor: 'testing' stamp: 'MEV 5/26/2019 16:56:34'!
hasRegistered: aTtransaction
^ transactions includes: aTtransaction
! !
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment