Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Extract returns from conditionals for packages starting by n
This makes the code more readable since we can directly know that the conditional will necessarily return something and the execution can be stoped.
  • Loading branch information
jecisc committed May 29, 2020
1 parent 9123795 commit 76c6220
Show file tree
Hide file tree
Showing 5 changed files with 31 additions and 42 deletions.
10 changes: 4 additions & 6 deletions src/Network-Kernel/NetNameResolver.class.st
Expand Up @@ -473,12 +473,10 @@ NetNameResolver class >> waitForCompletionUntil: deadline [

| status |
status := self waitForResolverNonBusyUntil: deadline.
status = ResolverReady
ifTrue: [^ true]
ifFalse: [
status = ResolverBusy ifTrue: [self primAbortLookup].
^ false].

^ status = ResolverReady
ifTrue: [ true ]
ifFalse: [ status = ResolverBusy ifTrue: [ self primAbortLookup ].
false ]
]

{ #category : #private }
Expand Down
29 changes: 12 additions & 17 deletions src/Network-Kernel/Socket.class.st
Expand Up @@ -1269,10 +1269,10 @@ Socket >> receiveDataInto: aStringOrByteArray fromHost: hostAddress port: portNu
"Receive a UDP packet from the given hostAddress/portNumber, storing the data in the given buffer, and return the number of bytes received. Note the given buffer may be only partially filled by the received data."

[ | datagram |
datagram := self receiveUDPDataInto: aStringOrByteArray.
((datagram at: 2) = hostAddress and: [ (datagram at: 3) = portNumber ])
ifTrue: [ ^ datagram at: 1 ]
ifFalse: [ ^0 ] ] repeat
datagram := self receiveUDPDataInto: aStringOrByteArray.
^ ((datagram at: 2) = hostAddress and: [ (datagram at: 3) = portNumber ])
ifTrue: [ datagram at: 1 ]
ifFalse: [ 0 ] ] repeat
]

{ #category : #receiving }
Expand Down Expand Up @@ -1765,24 +1765,19 @@ Socket >> waitForDataFor: timeout [
{ #category : #waiting }
Socket >> waitForDataFor: timeout ifClosed: closedBlock ifTimedOut: timedOutBlock [
"Wait for the given nr of seconds for data to arrive."

| startTime msecsDelta |
startTime := Time millisecondClockValue.
msecsDelta := (timeout * 1000) truncated.
[(Time millisecondsSince: startTime) < msecsDelta] whileTrue: [
(self primSocketReceiveDataAvailable: socketHandle)
ifTrue: [^self].
self isConnected
ifFalse: [^closedBlock value].
self readSemaphore waitTimeoutMSecs:
(msecsDelta - (Time millisecondsSince: startTime) max: 0).
].
[ (Time millisecondsSince: startTime) < msecsDelta ]
whileTrue: [ (self primSocketReceiveDataAvailable: socketHandle) ifTrue: [ ^ self ].
self isConnected ifFalse: [ ^ closedBlock value ].
self readSemaphore waitTimeoutMSecs: (msecsDelta - (Time millisecondsSince: startTime) max: 0) ].

(self primSocketReceiveDataAvailable: socketHandle)
ifFalse: [
self isConnected
ifTrue: [^timedOutBlock value]
ifFalse: [^closedBlock value]].
ifFalse: [ ^ (self isConnected
ifTrue: [ timedOutBlock ]
ifFalse: [ closedBlock ]) value ]
]

{ #category : #waiting }
Expand Down
4 changes: 2 additions & 2 deletions src/Network-Kernel/SocketStream.class.st
Expand Up @@ -437,8 +437,8 @@ SocketStream >> next: requestedCount into: collection startingAt: startIndex [
| readCount |
readCount := self readInto: collection startingAt: startIndex count: requestedCount.
^ readCount = requestedCount
ifTrue: [ ^ collection ]
ifFalse: [ ^ collection copyFrom: 1 to: startIndex + readCount - 1 ]
ifTrue: [ collection ]
ifFalse: [ collection copyFrom: 1 to: startIndex + readCount - 1 ]
]

{ #category : #'stream out' }
Expand Down
10 changes: 4 additions & 6 deletions src/Network-Protocols/ProtocolClient.class.st
Expand Up @@ -43,14 +43,12 @@ ProtocolClient class >> openOnHostNamed: hostName [

| i |
i := hostName indexOf: $:.
i = 0 ifTrue: [
^self openOnHostNamed: hostName port: self defaultPortNumber]
ifFalse: [
| s p |
^ i = 0
ifTrue: [ self openOnHostNamed: hostName port: self defaultPortNumber ]
ifFalse: [ | s p |
s := hostName truncateTo: i - 1.
p := (hostName copyFrom: i + 1 to: hostName size) asInteger.
^self openOnHostNamed: s port: p]

self openOnHostNamed: s port: p ]
]

{ #category : #'instance creation' }
Expand Down
20 changes: 9 additions & 11 deletions src/NumberParser/NumberParser.class.st
Expand Up @@ -537,19 +537,17 @@ NumberParser >> readScaleWithDefaultNumberOfDigits: anInteger [
A letter s followed by another letter is not considered as a scale specification, because it could be part of a message."

scale := 0.
sourceStream atEnd
ifTrue: [ ^ false ].
(sourceStream peekFor: $s)
ifFalse: [ ^ false ].
sourceStream atEnd ifTrue: [ ^ false ].
(sourceStream peekFor: $s) ifFalse: [ ^ false ].
scale := self nextUnsignedIntegerOrNilBase: 10.
scale
ifNil: [
scale := anInteger.
(sourceStream peek ifNil: [ false ] ifNotNil: [ :nextChar | nextChar isLetter ])
ifTrue: [
sourceStream skip: -1. "ungobble the s"
^ false ]
ifFalse: [ ^ true ] ].
ifNil: [ scale := anInteger.
^ (sourceStream peek
ifNil: [ false ]
ifNotNil: [ :nextChar | nextChar isLetter ])
ifTrue: [ sourceStream skip: -1. "ungobble the s"
false ]
ifFalse: [ true ] ].
^ true
]

Expand Down

0 comments on commit 76c6220

Please sign in to comment.