VM Maker: FileAttributesPlugin.oscog-AlistairGrant.32.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: FileAttributesPlugin.oscog-AlistairGrant.32.mcz

commits-2
 
Eliot Miranda uploaded a new version of FileAttributesPlugin to project VM Maker:
http://source.squeak.org/VMMaker/FileAttributesPlugin.oscog-AlistairGrant.32.mcz

==================== Summary ====================

Name: FileAttributesPlugin.oscog-AlistairGrant.32
Author: AlistairGrant
Time: 12 August 2018, 10:54:23.895172 pm
UUID: 1d7a551c-3693-4180-8701-f2cac782d518
Ancestors: FileAttributesPlugin.oscog-AlistairGrant.31

1.3.3: Add path encoding / decoding

MacOS uses custom decomposed UTF8 encoded strings for path names (while precomposed Unicode strings are typically used within the image).  Encode and decode path names using the existing VM routines (ux2sqPath() and sq2uxPath()).

=============== Diff against FileAttributesPlugin.oscog-AlistairGrant.30 ===============

Item was changed:
  ----- Method: FileAttributesPlugin class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: cg
 
  self declareC:  #('sCLPfn' 'sCOFfn')
  as: #'void *'
  in: cg.
  "Assume the security plugin can be loaded until proven otherwise"
  cg var: 'hasSecurityPlugin' declareC: 'int hasSecurityPlugin = 1'.
 
  cg addHeaderFile: '<limits.h>'.
  cg addHeaderFile: '<sys/types.h>'.
  cg addHeaderFile: '<dirent.h>
  #ifdef _WIN32
  #include <windows.h>
  #include <winbase.h>
  #define FAIL() { return -1; }
  #include "sqWin32File.h"
  #else
+ #include "sqUnixCharConv.h"
- #include "sqMemoryAccess.h"
- extern sqLong convertToLongSqueakTime(time_t unixTime);
  #endif
  typedef struct dirptrstruct {
      DIR *dp;
  int path_len;
      char *path_file;
      char path[PATH_MAX+4];
      } osdir;'.
  cg addHeaderFile: '<sys/stat.h>
  #if !!defined(HAVE_LSTAT) && !!defined(_WIN32)
  #define HAVE_LSTAT 1
  #endif'.
  cg addHeaderFile: '<unistd.h>
  /* AKG 2017 - ', self moduleName, '.c translated from class ', self name, ' */'!

Item was removed:
- ----- Method: FileAttributesPlugin>>checkAccess:mode:to: (in category 'private - file') -----
- checkAccess: pathString mode: mode to: flag
- "Check access to pathString."
-
- | cString len sPtr |
- <export: true>
- <var: 'cString' declareC: 'char cString[PATH_MAX]'>
- <var: 'sPtr' type: 'char *'>
- <var: 'flag' type: 'sqInt *'>
- len := interpreterProxy stSizeOf: pathString.
- "Note: The static sized string buffer is faster than using a Smalltalk allocated
- string as the buffer, and is unlikely to fail in practice. In the event that
- the buffer turns out to be too small, write an error message to stdout before
- failing."
- len >= #PATH_MAX ifTrue: [^self stringTooLong].
- "Copy pathString to the new string"
- sPtr := interpreterProxy arrayValueOf: pathString.
- ((self canStatFilePath: sPtr length: len) = 0) ifTrue: [^self cantStatPath].
- self mem: cString cp: sPtr y: len.
- cString at: len put: 0.
- flag at: 0 put: (self acc: cString ess: mode).
- ^0
- !

Item was added:
+ ----- Method: FileAttributesPlugin>>faConvertUnixToLongSqueakTime: (in category 'private - posix') -----
+ faConvertUnixToLongSqueakTime: unixTime
+ "Convert the supplied Unix (UTC) time to Squeak time.
+
+ Squeak time has an epoch of 1901 and uses local time
+ i.e. timezone + daylight savings
+
+ Answer an sqLong which is guaranteed to be 64 bits on all platforms."
+
+ | squeakTime |
+
+ <returnTypeC: #'sqLong'>
+ <var: 'unixTime' type: #'time_t'>
+ <var: 'squeakTime' type: #'sqLong'>
+
+ self cppIf: #_WIN32 defined ifTrue:
+ [squeakTime := 0]
+ ifFalse: [
+ squeakTime := unixTime.
+ self cppIf: (self defined: #HAVE_TM_GMTOFF) ifTrue:
+ [ squeakTime := squeakTime + (self cCode: 'localtime(&unixTime)->tm_gmtoff')]
+ ifFalse: [ self cppIf: (self defined: #HAVE_TIMEZONE) ifTrue:
+ [ squeakTime := squeakTime + (self cCode: '(daylight*60*60) - timezone')]
+ ifFalse: [ self cPreprocessorDirective: '#error: cannot determine timezone correction']].
+ "Squeak epoch is Jan 1, 1901.  Unix epoch is Jan 1, 1970: 17 leap years
+ and 52 non-leap years later than Squeak."
+ squeakTime := squeakTime +
+ (self cCode: '(52*365UL + 17*366UL) * 24*60*60UL'
+ inSmalltalk: [((52*365) + (17*366)) * 24*60*60]) ].
+ ^squeakTime
+
+
+ !

Item was changed:
  ----- Method: FileAttributesPlugin>>openDirectoryStream:ptr: (in category 'private - directory') -----
+ openDirectoryStream: cPathName ptr: osdirPtr
- openDirectoryStream: pathOOP ptr: osdirPtr
  "Open a new directory stream. Answer a pointer to the directory stream or NULL."
 
+ | len dir |
- | sPtr len dir |
  <var: 'osdirPtr' type: #'osdir **'>
- <var: 'sPtr' type: #'char *'>
  <var: 'dir' type: #'osdir *'>
+ <var: 'cPathName' type: 'char *'>
  <returnTypeC: #'int'>
+
+ len := self strlen: cPathName.
- sPtr := interpreterProxy arrayValueOf: pathOOP.
- len := interpreterProxy sizeOfSTArrayFromCPrimitive: sPtr.
  "The path buffer needs room for a trailing slash and the file name, so subtracting 2 is conservative"
  len > (#PATH_MAX - 2) ifTrue: [^self stringTooLong].
+ (self canOpenDirectoryStreamFor: cPathName length: len)
- (self canOpenDirectoryStreamFor: sPtr length: len)
  ifTrue:
  [
  dir := self cCode: '(osdir *) malloc(sizeof(osdir))'.
  dir = nil ifTrue: [^self cantAllocateMemory].
+ self mem: dir path cp: cPathName y: len.
- self mem: dir path cp: sPtr y: len.
  "Ensure path has a trailing slash"
  self cCode: 'if (dir->path[len-1] !!= ''/'') {
  dir->path[len++] = ''/'';
  }'.
  self cCode: 'dir->path_file = dir->path + len'.
  self cCode: 'dir->path_file[0] = ''\0'''.
  self cCode: 'dir->path_len = len'.
  self cCode: 'dir->dp =  opendir(dir->path)'.
  dir dp ifNil:
  [self free: dir.
  ^self cantOpenDir].
  osdirPtr at: 0 put: dir.
  ^0
  ].
  "If we get here, we can't open the directory"
  ^self cantOpenDir
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>posixFileTimesFrom:to: (in category 'private - posix') -----
  posixFileTimesFrom: statBufPointer to: attributeArray
  "Populate attributeArray with the file times from statBufPointer"
 
  | attributeDate |
 
  <var: 'statBufPointer' type: #'struct stat *'>
  <var: 'attributeDate' type: #'sqLong'>
 
  self cppIf: #_WIN32 defined ifTrue: [] ifFalse: [
+ attributeDate := self faConvertUnixToLongSqueakTime: statBufPointer st_atime.
- attributeDate := self convertToLongSqueakTime: statBufPointer st_atime.
  interpreterProxy
  storePointer: 8
  ofObject: attributeArray
  withValue: (interpreterProxy signed64BitIntegerFor: attributeDate).
+ attributeDate := self faConvertUnixToLongSqueakTime: statBufPointer st_mtime.
- attributeDate := self convertToLongSqueakTime: statBufPointer st_mtime.
  interpreterProxy
  storePointer: 9
  ofObject: attributeArray
  withValue: (interpreterProxy signed64BitIntegerFor: attributeDate).
+ attributeDate := self faConvertUnixToLongSqueakTime: statBufPointer st_ctime.
- attributeDate := self convertToLongSqueakTime: statBufPointer st_ctime.
  interpreterProxy
  storePointer: 10
  ofObject: attributeArray
  withValue: (interpreterProxy signed64BitIntegerFor: attributeDate);
  storePointer: 11
  ofObject: attributeArray
  withValue: interpreterProxy nilObject ].
  ^0!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveFileAttribute (in category 'file primitives') -----
  primitiveFileAttribute
  "Answer a single file attribute.
  primFileAttributes: aString attributeNumber: attributeNumber
  aString is the path to the file
  attributeNumber identifies which attribute to return:
  1 - 12: stat(): name, mode, ino, dev, nlink, uid, gid, size, accessDate, modifiedDate, changeDate, creationDate
  13 - 15: access(): R_OK, W_OK, X_OK
  16: isSymlink
  On error, answer a single element array containing the appropriate error code."
 
  | fileName attributeNumber resultOop fileNameOop statBuf cPathName sizeIfFile mode attributeDate status |
  <export: true>
  <var: 'statBuf' type: #'struct stat'>
+ <var: 'cPathName' declareC: 'char cPathName[PATH_MAX+1]'>
- <var: 'cPathName' declareC: 'char cPathName[PATH_MAX]'>
  <var: 'attributeDate' type: #'sqLong'>
 
  fileName := interpreterProxy stackObjectValue: 1.
  attributeNumber := interpreterProxy stackIntegerValue: 0.
  (interpreterProxy failed
+ or: [(attributeNumber between: 1 and: 16) not
+ or: [(interpreterProxy is: fileName KindOf: 'String') not]]) ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ self squeakPath: fileName toUnix: cPathName maxLen: #PATH_MAX.
+ interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailureCode].
- or: [(attributeNumber between: 1 and: 16) not
- or: [(interpreterProxy is: fileName KindOf: 'String') not]]) ifTrue:
- [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- status := self pathOop: fileName toBuffer: cPathName maxLen: #PATH_MAX.
- status ~= 0 ifTrue:
- [^interpreterProxy primitiveFailForOSError: status].
  resultOop := 0.
 
  attributeNumber < 12 ifTrue:
  "Get requested stat entry"
  [
  status := self
  putStatFor: cPathName
  intoBuffer: (self addressOf: statBuf)
  targetName: (self addressOf: fileNameOop).
  status ~= 0 ifTrue:
  [^interpreterProxy primitiveFailForOSError: status].
  "In C, this would naturally be a switch statement,
  but I don't know to mix in the smalltalk code"
  attributeNumber = 1 ifTrue: [resultOop := fileNameOop].
  attributeNumber = 2 ifTrue:
  [resultOop := interpreterProxy positiveMachineIntegerFor: statBuf st_mode].
  attributeNumber = 3 ifTrue:
  [resultOop := interpreterProxy positive64BitIntegerFor: statBuf st_ino].
  attributeNumber = 4 ifTrue:
  [resultOop := interpreterProxy positive64BitIntegerFor: statBuf st_dev].
  attributeNumber = 5 ifTrue:
  [resultOop := interpreterProxy positive64BitIntegerFor: statBuf st_nlink].
  attributeNumber = 6 ifTrue:
  [resultOop := interpreterProxy positiveMachineIntegerFor: statBuf st_uid].
  attributeNumber = 7 ifTrue:
  [resultOop := interpreterProxy positiveMachineIntegerFor: statBuf st_gid].
  attributeNumber = 8 ifTrue:
  [
  sizeIfFile := ((self S_ISDIR: statBuf st_mode) = 0)
  ifTrue: [statBuf st_size]
  ifFalse: [0].
  resultOop := interpreterProxy positiveMachineIntegerFor: sizeIfFile
  ].
  attributeNumber = 9 ifTrue: [ "Access Time"
  self cppIf: #_WIN32 defined ifTrue: [
  status := self fileLastAccessTimeFor: cPathName
  length: cPathName strlen
  to: (self addressOf: attributeDate put: [:val| attributeDate := val]).
  status ~= 0 ifTrue:
  [^interpreterProxy primitiveFailForOSError: status].
  resultOop := interpreterProxy signed64BitIntegerFor: attributeDate ]
  ifFalse: [
+ attributeDate := self faConvertUnixToLongSqueakTime: statBuf st_atime.
- attributeDate := self convertToLongSqueakTime: statBuf st_atime.
  resultOop := interpreterProxy signed64BitIntegerFor: attributeDate]].
  attributeNumber = 10 ifTrue: [ "Modified Time"
  self cppIf: #_WIN32 defined ifTrue: [
  status := self fileLastWriteTimeFor: cPathName
  length: cPathName strlen
  to: (self addressOf: attributeDate put: [:val| attributeDate := val]).
  status ~= 0 ifTrue:
  [^interpreterProxy primitiveFailForOSError: status].
  resultOop := interpreterProxy signed64BitIntegerFor: attributeDate ]
  ifFalse: [
+ attributeDate := self faConvertUnixToLongSqueakTime: statBuf st_mtime.
- attributeDate := self convertToLongSqueakTime: statBuf st_mtime.
  resultOop := interpreterProxy signed64BitIntegerFor: attributeDate]].
  attributeNumber = 11 ifTrue: [ "Change Time"
  self cppIf: #_WIN32 defined ifTrue:
  [resultOop := interpreterProxy nilObject]
  ifFalse: [
+ attributeDate := self faConvertUnixToLongSqueakTime: statBuf st_ctime.
- attributeDate := self convertToLongSqueakTime: statBuf st_ctime.
  resultOop := interpreterProxy signed64BitIntegerFor: attributeDate]].
  ]
  ifFalse: [attributeNumber = 12  ifTrue: [ "Creation Time"
  self cppIf: #_WIN32 defined ifTrue: [
  status := self fileCreationTimeFor: cPathName
  length: cPathName strlen
  to: (self addressOf: attributeDate put: [:val| attributeDate := val]).
  status ~= 0 ifTrue:
  [^interpreterProxy primitiveFailForOSError: status].
  resultOop := interpreterProxy signed64BitIntegerFor: attributeDate ]
  ifFalse: [
  resultOop := interpreterProxy nilObject ]
  ]
  ifFalse: [attributeNumber < 16 ifTrue:
  "Get requested access entry"
  [
  attributeNumber = 13 ifTrue: [mode := self fileReadableFlag].
  attributeNumber = 14 ifTrue: [mode := self fileWriteableFlag].
  attributeNumber = 15 ifTrue: [mode := self fileExecutableFlag].
  resultOop := ((self acc: cPathName ess: mode) = 0)
  ifTrue: [interpreterProxy trueObject]
  ifFalse: [interpreterProxy falseObject].
  ]
  ifFalse: "attributeNumber = 16, #isSymlink"
  [
  status := self isSymlink: cPathName boolean: (self addressOf: resultOop put: [:val| resultOop := val]).
  status ~= 0 ifTrue:
  [^interpreterProxy primitiveFailForOSError: status].
  ]]].
 
  resultOop = 0
  ifTrue: ["It shouldn't be possible to get here"
  interpreterProxy primitiveFail]
  ifFalse: [interpreterProxy pop: 3 thenPush: resultOop]!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveFileAttributes (in category 'file primitives') -----
  primitiveFileAttributes
  "Answer an array of file attributes.
  primFileAttributes: aString mask: attributeMask
  aString is the path to the file
  attributeMask indicates which attributes to retrieve:
  bit 0 - get stat() attributes
  bit 1 - get access() attributes
  bit 2 - use lstat() instead of stat()
  On error answer the appropriate error code (Integer)"
 
  | fileName attributeMask attributeArray cPathName status |
  <export: true>
+ <var: 'cPathName' declareC: 'char cPathName[PATH_MAX+1]'>
+
- <var: 'cPathName' declareC: 'char cPathName[PATH_MAX]'>
  fileName := interpreterProxy stackObjectValue: 1.
  attributeMask := interpreterProxy stackIntegerValue: 0.
  (interpreterProxy failed
  or: [(interpreterProxy is: fileName KindOf: 'String') not]) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ self squeakPath: fileName toUnix: cPathName maxLen: #PATH_MAX.
+ interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailureCode].
- status := self pathOop: fileName toBuffer: cPathName maxLen: #PATH_MAX.
- status ~= 0 ifTrue:
- [^interpreterProxy primitiveFailForOSError: status].
 
  status := self fileToAttributeArray: cPathName
  mask: attributeMask
  array: (self addressOf: attributeArray put: [:val| attributeArray := val]).
  status ~= 0
  ifTrue: [interpreterProxy primitiveFailForOSError: status]
  ifFalse: [interpreterProxy pop: 3 thenPush: attributeArray]!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveFileExists (in category 'file primitives') -----
  primitiveFileExists
  "Check for existence of a file with a call to access()."
 
+ | fileNameOop accessFlag cString |
- | pathString status accessFlag |
  <export: true>
  <var: 'accessFlag' type: #'sqInt'>
+ <var: 'cString' declareC: 'char cString[PATH_MAX+1]'>
+
+ fileNameOop := interpreterProxy stackObjectValue: 0.
+ (interpreterProxy is: fileNameOop KindOf: 'String') ifFalse:
- pathString := interpreterProxy stackObjectValue: 0.
- (interpreterProxy is: pathString KindOf: 'String') ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ self squeakPath: fileNameOop toUnix: cString maxLen: #PATH_MAX.
+ interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailureCode].
+ accessFlag := (self acc: cString ess: (self fileOKFlag)).
- status := self checkAccess: pathString mode: self fileOKFlag to: (self addressOf: accessFlag).
- status = 0 ifFalse: [^interpreterProxy primitiveFailForOSError: status].
  interpreterProxy pop: 2 thenPush: (accessFlag = 0
  ifTrue: [interpreterProxy trueObject]
  ifFalse: [interpreterProxy falseObject])!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveOpendir (in category 'file primitives') -----
  primitiveOpendir
 
  "self primOpendir: '/etc'"
 
+ | dirName dir dirOop status cPathName |
- | dirName dir dirOop status |
  <export: true>
  <var: 'dir' type: #'osdir *'>
+ <var: 'cPathName' declareC: 'char cPathName[PATH_MAX+1]'>
+
  dirName := interpreterProxy stackObjectValue: 0.
  (interpreterProxy is: dirName KindOf: 'String') ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+
+ self squeakPath: dirName toUnix: cPathName maxLen: #PATH_MAX.
+ interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailureCode].
+ status := self openDirectoryStream: cPathName ptr: (self addressOf: dir).
- status := self openDirectoryStream: dirName ptr: (self addressOf: dir).
  status ~= 0 ifTrue: [^interpreterProxy primitiveFailForOSError: status].
  dirOop := self addressObjectFor: dir.
  interpreterProxy pop: 2 thenPush: dirOop!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveReaddir (in category 'file primitives') -----
  primitiveReaddir
  "Get the next entry in the directory stream. Answer the name of the entry, or
+ nil for the end of the directory stream.
+ Arguments:
+ - directoryPointer (ByteArray)"
- nil for the end of the directory stream."
 
  | dirPointerOop dirStream ent entryName attributeArray resultArray haveEntry entry_len status |
  <export: true>
  <var: 'ent' type: #'struct dirent *'>
  <var: 'dirStream' type: #'osdir *'>
  <var: 'haveEntry' type: #int>
 
  dirPointerOop := interpreterProxy stackValue: 0.
  dirStream := self pointerFrom: dirPointerOop.
  dirStream ifNil:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  haveEntry := 0.
  [ent := self readdir: dirStream dp.
  self cCode: 'if (ent == NULL ||
                    ((!! (ent->d_name[0] == ''.'' && strlen(ent->d_name) == 1)) && strcmp(ent->d_name, "..")))
                        haveEntry = 1'.
  haveEntry = 0] whileTrue.
  ent ifNil: "This is the normal case for the end of a directory stream,
  although it may indicate other error conditions for which errno would be updated.
  Assume the normal case here."
  [^interpreterProxy pop: 2 thenPush: interpreterProxy nilObject].
+ entryName := self unixPathToOop: ent d_name.
- status := self byteArrayFromCString: ent d_name to: (self addressOf: entryName put: [:val| entryName := val]).
- status ~= 0 ifTrue:
- [^interpreterProxy primitiveFailForOSError: status].
-
  "Build the path name (append the entry name to the path name)"
  entry_len := self strlen: ent d_name.
  [dirStream path_len + entry_len > (#PATH_MAX - 1)] ifTrue:
  [^interpreterProxy primitiveFailForOSError: self stringTooLong].
  self mem: dirStream path_file cp: ent d_name y: entry_len.
  dirStream path_file at: entry_len put: 0.
 
  status := self fileToAttributeArray: dirStream path mask: 1 array: (self addressOf: attributeArray put: [:val| attributeArray := val]).
  "If the stat() fails, still return the filename, just no attributes"
  status ~= 0 ifTrue: [attributeArray := interpreterProxy nilObject].
 
  self remapOop: #(entryName attributeArray)
  in: [resultArray := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2].
  resultArray ifNil:
  [^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  interpreterProxy
  storePointer: 0 ofObject: resultArray withValue: entryName;
  storePointer: 1 ofObject: resultArray withValue: attributeArray;
  pop: 2 thenPush: resultArray!

Item was added:
+ ----- Method: FileAttributesPlugin>>squeakPath:toUnix:maxLen: (in category 'private - posix') -----
+ squeakPath: pathOop toUnix: cPathString maxLen: maxLength
+ "Convert the supplied path string oop to a unix c path string.
+ Parameter checking is done in the main primitive, so pathOop is assumed to be valid.
+ pathOop is supplied as a precomposed UTF8 string.
+ cPathString must be encoded using the host OS conventions, e.g. decomposed UTF8 on MacOS.
+ Signal primitive failure on error."
+
+ | status uxName |
+ <var: 'cPathString' type: 'char *'>
+ <var: 'uxName' declareC: 'char uxName[PATH_MAX+1]'>
+
+ (maxLength > (self cCode: 'PATH_MAX+1' inSmalltalk: [4097])) ifTrue:
+ [^interpreterProxy primitiveFailForOSError: self invalidArguments].
+ self cppIf: #_WIN32 ifTrue: [
+ status := self pathOop: pathOop toBuffer: cPathString maxLen: maxLength.
+ status ~= 0 ifTrue:
+ [^interpreterProxy primitiveFailForOSError: status]]
+ ifFalse: [
+ status := self pathOop: pathOop toBuffer: uxName maxLen: #PATH_MAX.
+ status ~= 0 ifTrue:
+ [^interpreterProxy primitiveFailForOSError: status].
+ status := self sq2: uxName u: (self strlen: uxName) x: cPathString Pa: maxLength th: 1.
+ status = 0 ifTrue:
+ [^interpreterProxy primitiveFailForOSError: self invalidArguments]. ].
+ ^0!

Item was added:
+ ----- Method: FileAttributesPlugin>>unixPathToOop: (in category 'private - posix') -----
+ unixPathToOop: cPathString
+ "Convert the supplied cPathString to a ByteArray.
+ cPathString is encoded using the host OS conventions, e.g. decomposed UTF8 on MacOS."
+
+ | pathOop status uxName |
+ <var: 'uxName' declareC: 'char uxName[PATH_MAX+1]'>
+
+ (self strlen: cPathString) > (self cCode: 'PATH_MAX+1' inSmalltalk: [4097]) ifTrue:
+ [^interpreterProxy primitiveFailForOSError: self stringTooLong].
+ pathOop := 0.
+ self cppIf: #_WIN32 ifTrue:
+ [status := self byteArrayFromCString: cPathString to: (self addressOf: pathOop put: [:val| pathOop := val]).]
+ ifFalse: [
+ status := self ux2: cPathString s: (self strlen: cPathString) q: uxName Pa: #PATH_MAX th: 1.
+ status = 0 ifTrue:
+ [^interpreterProxy primitiveFailForOSError: self invalidArguments].
+ status := self byteArrayFromCString: uxName to: (self addressOf: pathOop put: [:val| pathOop := val]). ].
+ status ~= 0 ifTrue:
+ [^interpreterProxy primitiveFailForOSError: status].
+ ^pathOop
+ !

Item was changed:
  ----- Method: FileAttributesPlugin>>versionString (in category 'version string') -----
  versionString
  "Answer a string containing the version string for this plugin."
  <inline: #always>
+ ^'1.3.3'!
- ^'1.3.1'!