Skip to content

Commit

Permalink
- fix Slot>>isRefefenced
Browse files Browse the repository at this point in the history
- workaround in #definingnode for vars defined by Primitives (to be improved)
  • Loading branch information
MarcusDenker committed Jul 19, 2020
1 parent ca15031 commit 058f503
Show file tree
Hide file tree
Showing 2 changed files with 10 additions and 2 deletions.
2 changes: 1 addition & 1 deletion src/Kernel/Slot.class.st
Expand Up @@ -233,7 +233,7 @@ Slot >> isReferenced [
^ self owningClass
ifNil: [ false ]
ifNotNil: [ :class |
class withAllSubclasses anySatisfy: [ :behavior | class hasMethodsAccessingSlot: self ] ]
class withAllSubclasses anySatisfy: [ :subclass | subclass hasMethodsAccessingSlot: self ] ]
]

{ #category : #testing }
Expand Down
10 changes: 9 additions & 1 deletion src/OpalCompiler-Core/TemporaryVariable.class.st
Expand Up @@ -20,7 +20,15 @@ TemporaryVariable >> copiedVarClass [

{ #category : #queries }
TemporaryVariable >> definingNode [
^ scope node temporaries detect: [ :each | each name = name ]
^ scope node temporaries
detect: [ :each | each name = name ]
ifNone: [
" ugly workaround to support temps defined by primitives"
| pragma |
pragma := scope node methodNode pragmas detect: [ :each | each isPrimitiveError ].
pragma ifNil: [ ^nil ].
^ RBVariableNode named: (pragma argumentAt: #error:) value asString
]
]

{ #category : #testing }
Expand Down

0 comments on commit 058f503

Please sign in to comment.