RegressionTests__CompilerTest.st
author Claus Gittinger <cg@exept.de>
Mon, 22 Nov 1999 18:48:58 +0100
changeset 49 71e76d770856
parent 48 022fba2b5917
child 50 b2444db55fd2
permissions -rw-r--r--
checkin from browser
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
47
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
Object subclass:#CompilerTest
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
	instanceVariableNames:''
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
	classVariableNames:''
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
	poolDictionaries:''
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
	category:'Tests - Compiler'
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
48
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
     9
!CompilerTest methodsFor:'tests - booleans'!
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    10
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    11
testNot1:arg
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    12
    ^ arg not
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    13
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    14
    "
49
71e76d770856 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 48
diff changeset
    15
     self new testNot1:true.   
48
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    16
     self new testNot1:false.
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    17
     self new testNot1:1234.
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    18
    "
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    19
!
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    20
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    21
testNot2:arg1 _:arg2
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    22
    ^ arg1 not & arg2 not
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    23
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    24
    "
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    25
     self new testNot2:true  _:true.   
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    26
     self new testNot2:false _:true.
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    27
     self new testNot2:true  _:false.
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    28
     self new testNot2:false _:false.
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    29
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    30
     self new testNot2:false _:1234.
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    31
     self new testNot2:true  _:1234.
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    32
     self new testNot2:1234  _:true.
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    33
     self new testNot2:1234  _:false.
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    34
     self new testNot2:1234  _:2345.
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    35
    "
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    36
! !
022fba2b5917 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 47
diff changeset
    37
47
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
!CompilerTest methodsFor:'tests - constant folding'!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
testFloat_pi
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
    ^ Float pi
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
testFloat_unity
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
    ^ Float unity
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
testFloat_zero
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
    ^ Float zero
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
testSmalltalk_if_else_isSmalltalkX
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
    Smalltalk isSmalltalkX ifTrue:[
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
        ^ 'yes'
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
    ] ifFalse:[
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
        ^ 'no'
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
    ]
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
testSmalltalk_if_else_isVisualWorks
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
    Smalltalk isVisualWorks ifTrue:[
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
        ^ 'yes'
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
    ] ifFalse:[
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
        ^ 'no'
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
    ]
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
testSmalltalk_if_isSmalltalkX
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
    Smalltalk isSmalltalkX ifTrue:[
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
        ^ 'yes'
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
    ].
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
    ^ 'no'
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
testSmalltalk_if_isSqueak
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
    Smalltalk isSqueak ifTrue:[
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
        ^ 'yes'
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
    ].
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
    ^ 'no'
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
testSmalltalk_if_isVisualWorks
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
    Smalltalk isVisualWorks ifTrue:[
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
        ^ 'yes'
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
    ].
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
    ^ 'no'
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
testSmalltalk_isSmalltalkX
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
    ^ Smalltalk isSmalltalkX
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
testSmalltalk_isSqueak
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
    ^ Smalltalk isSqueak
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
testSmalltalk_isVisualAge
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
    ^ Smalltalk isVisualAge
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
testSmalltalk_isVisualWorks
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
    ^ Smalltalk isVisualWorks
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
testUnaryFolding
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
    self testFloat_pi ~= (Float perform:#pi) ifTrue:[self halt].
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
    self testFloat_unity ~= (Float perform:#unity) ifTrue:[self halt].
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
    self testFloat_zero ~= (Float perform:#zero) ifTrue:[self halt].
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
    self testSmalltalk_isSmalltalkX ~= (Smalltalk perform:#isSmalltalkX) ifTrue:[self halt].
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
    self testSmalltalk_isSqueak ~= (Smalltalk perform:#isSqueak) ifTrue:[self halt].
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
    self testSmalltalk_isVisualWorks ~= (Smalltalk perform:#isVisualWorks) ifTrue:[self halt].
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
    self testSmalltalk_isVisualAge ~= (Smalltalk perform:#isVisualAge) ifTrue:[self halt].
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
    "
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
     self basicNew testUnaryFolding
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
    "
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
! !
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
!CompilerTest class methodsFor:'documentation'!
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
version
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
    ^ '$Header$'
3258d44978a0 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
! !