"======================================================================
|
|   Test special objects
|
|   $Revision: 1.7.5$
|   $Date: 2000/05/28 16:56:52$
|   $Author: pb$
|
 ======================================================================"


"======================================================================
|
| Copyright (C) 1999  Free Software Foundation.
| Written by Paolo Bonzini
|
| This file is part of GNU Smalltalk.
|
| GNU Smalltalk is free software; you can redistribute it and/or modify it
| under the terms of the GNU General Public License as published by the Free
| Software Foundation; either version 2, or (at your option) any later version.
| 
| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
| FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
| details.
| 
| You should have received a copy of the GNU General Public License along with
| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
|
 ======================================================================"

Object subclass: #ObjectsTest
	 instanceVariableNames: 'name survive'
	 classVariableNames: ''
	 poolDictionaries: ''
	 category: nil
!

!ObjectsTest class methodsFor: 'test'!

testFinalize
    | test |
    self new name: 'a' survive: false.
    self new name: 'b' survive: true.
    Smalltalk compact.
    self new name: 'c' survive: false.
    Smalltalk compact.
    Smalltalk compact
!

testWeak
    | a |
    a := Array new: 1.
    a makeWeak.
    a at: 1 put: Object new.
    Smalltalk compact.
    ^(a at: 1) isNil
! !

!ObjectsTest methodsFor: 'finalization'!

name: aString survive: aBoolean
    name := aString.
    survive := aBoolean.
    self addToBeFinalized
!

finalize
    Transcript nextPutAll: name, ' finalized'.
    survive ifTrue: [
        Transcript nextPutAll: ', surviving'.
        survive := false.
        self addToBeFinalized
    ].
    Transcript nl.
! !

ObjectsTest testFinalize!
^ObjectsTest testWeak!


    | a b |
    a := WeakArray new: 5.
    a at: 1 put: 'abc'.
    a at: 2 put: Object new.
    a at: 4 put: nil.
    a at: 5 put: 1.
    b := a copy.
    a printNl.
    b printNl.
    Smalltalk compact.
    a printNl.
    b printNl.
    ((1 to: 5) collect: [ :each | a isAlive: each ]) printNl.
    1 to: 5 do: [ :index | a clearGCFlag: index ].
    ((1 to: 5) collect: [ :each | a isAlive: each ]) printNl.
    ((1 to: 5) collect: [ :each | b isAlive: each ]) printNl!


"Test lightweight class"

	| Test methodString t |
 	Test := Behavior new.
	Transcript nextPutAll: 'New instance of Behavior created'; nl.

 	Test superclass: Object.
	Transcript nextPutAll: 'Superclass assigned'; nl.

 	Test compile: 'new			^super new'.
	Transcript nextPutAll: 'First method compiled'; nl.

 	Test compile: 'printTestMessage	''test message'' printNl.'.
	Transcript nextPutAll: 'Second method compiled'; nl.
	Test inspect.

 	t := Test new.
	Transcript nextPutAll: 'Instance created'; nl.

 	t printTestMessage.
 	t printNl.
	Transcript nextPutAll: 'Well it seems to work fine'; nl.
!