├── .gitignore ├── LICENSE ├── Package.swift ├── README.md ├── Sources ├── CPerl │ ├── Package.swift │ ├── custom.h │ ├── func.h │ ├── macro.h │ ├── macro.in │ ├── shim.h │ └── update-headers ├── Perl │ ├── Any.swift │ ├── Array.swift │ ├── CString.swift │ ├── Call.swift.gyb │ ├── Embed.swift │ ├── Error.swift │ ├── Hash.swift │ ├── Interpreter.swift │ ├── Object.swift │ ├── Scalar.swift │ ├── Stack.swift │ ├── Subroutine.swift.gyb │ ├── SvConvertible.swift │ ├── UnsafeAV.swift │ ├── UnsafeCV.swift │ ├── UnsafeHV.swift │ ├── UnsafeSV.swift │ ├── UnsafeValue.swift │ ├── Util.swift │ └── Value.swift └── swiftperl-benchmark │ └── main.swift ├── Tests ├── LinuxMain.swift └── PerlTests │ ├── Benchmark.swift │ ├── Call.swift │ ├── ConvertFromPerl.swift │ ├── ConvertToPerl.swift │ ├── Embed.swift │ ├── EmbeddedTestCase.swift │ ├── Internal.swift │ └── Object.swift ├── prepare └── swiftperl.spec /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | /.build 3 | /.vscode 4 | /Packages 5 | /*.xcodeproj 6 | /Sources/CPerl/module.modulemap 7 | /Sources/Perl/Call.swift 8 | /Sources/Perl/Subroutine.swift 9 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 Mail.Ru Group 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in all 11 | copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 19 | SOFTWARE. 20 | -------------------------------------------------------------------------------- /Package.swift: -------------------------------------------------------------------------------- 1 | // swift-tools-version:5.0 2 | import PackageDescription 3 | 4 | #if os(Linux) || os(FreeBSD) || os(PS4) || os(Android) || CYGWIN 5 | import Glibc 6 | let pkgConfig = false 7 | #elseif os(macOS) || os(iOS) || os(watchOS) || os(tvOS) 8 | import Darwin 9 | let pkgConfig = true 10 | #endif 11 | 12 | let buildBenchmark = false 13 | 14 | let package = Package( 15 | name: "Perl", 16 | products: [ 17 | .library(name: "CPerl", targets: ["CPerl"]), 18 | .library(name: "Perl", targets: ["Perl"]), 19 | ], 20 | targets: [ 21 | .systemLibrary(name: "CPerl", pkgConfig: pkgConfig ? "perl" : nil), 22 | .target(name: "Perl", dependencies: ["CPerl"]), 23 | .testTarget(name: "PerlTests", dependencies: ["Perl"]), 24 | ] 25 | ) 26 | 27 | if buildBenchmark { 28 | package.targets.append(.target(name: "swiftperl-benchmark", dependencies: ["Perl", "Benchmark"])) 29 | package.dependencies.append(.package(url: "https://github.com/my-mail-ru/swift-Benchmark.git", from: "0.3.1")) 30 | } 31 | 32 | 33 | func env(_ name: String) -> String? { 34 | guard let value = getenv(name) else { return nil } 35 | return String(cString: value) 36 | } 37 | 38 | let tmpdir = env("TMPDIR") ?? env("TEMP") ?? env("TMP") ?? "/tmp/" 39 | 40 | let me = CommandLine.arguments[0] 41 | if me[me.startIndex..=5.10) 15 | 16 | ## Getting Started 17 | 18 | ### Linux 19 | 20 | ```sh 21 | swift test 22 | ``` 23 | 24 | ### macOS 25 | 26 | ```sh 27 | PKG_CONFIG_PATH=$PWD/.build/pkgconfig swift test --disable-sandbox 28 | ``` 29 | 30 | ## Documentation 31 | 32 | For information on using *swiftperl*, see [Reference](https://my-mail-ru.github.io/swiftperl/). 33 | 34 | ## Stability 35 | 36 | The API stability is guaranteed in accordance with [Semantic Versioning](http://semver.org/). 37 | 38 | The module is used in [production](https://my.mail.ru/) helping to serve thousands 39 | requests per second. 40 | -------------------------------------------------------------------------------- /Sources/CPerl/Package.swift: -------------------------------------------------------------------------------- 1 | // swift-tools-version:4.0 2 | import PackageDescription 3 | 4 | #if os(Linux) || os(FreeBSD) || os(PS4) || os(Android) || CYGWIN 5 | import Glibc 6 | #if os(Linux) 7 | var environ: UnsafeMutablePointer?> { return __environ } 8 | #endif 9 | #elseif os(macOS) || os(iOS) || os(watchOS) || os(tvOS) 10 | import Darwin 11 | @_silgen_name("_NSGetEnviron") 12 | func _NSGetEnviron() -> UnsafeMutablePointer?>> 13 | var environ: UnsafeMutablePointer?> { return _NSGetEnviron().pointee } 14 | #endif 15 | 16 | let packageDir: String = { 17 | let me = CommandLine.arguments[0] 18 | var parts = me.split(separator: "/", omittingEmptySubsequences: false).map(String.init) 19 | parts[parts.endIndex - 1] = "" 20 | return parts.joined(separator: "/") 21 | }() 22 | 23 | let package = Package( 24 | name: "CPerl", 25 | pkgConfig: "perl" 26 | ) 27 | 28 | func env(_ name: String) -> String? { 29 | guard let value = getenv(name) else { return nil } 30 | return String(cString: value) 31 | } 32 | 33 | let tmpdir = env("TMPDIR") ?? env("TEMP") ?? env("TMP") ?? "/tmp/" 34 | 35 | if packageDir[packageDir.startIndex.. 2 | 3 | #ifndef PERL_STATIC_INLINE 4 | # define PERL_STATIC_INLINE static inline 5 | #endif 6 | 7 | #define SWIFT_NAME(X) __attribute__((swift_name(#X))) 8 | 9 | #undef tTHX 10 | #define tTHX PerlInterpreter *_Nonnull 11 | 12 | typedef void (*XSINIT_t) (pTHX); 13 | typedef void (*XSUBADDR_t) (pTHX_ CV *_Nonnull); 14 | 15 | // Custom 16 | 17 | SWIFT_NAME(PerlInterpreter.SvHASH(self:_:)) 18 | PERL_STATIC_INLINE U32 CPerlCustom_SvHASH(pTHX_ SV *_Nonnull sv) { 19 | U32 hash; 20 | STRLEN len; 21 | char *str = SvPV(sv, len); 22 | PERL_HASH(hash, str, len); 23 | return hash; 24 | } 25 | 26 | // Backward compatibility 27 | 28 | /// This is an XS interface to Perl's @c die function. 29 | /// 30 | /// @c baseex is the error message or object. If it is a reference, it 31 | /// will be used as-is. Otherwise it is used as a string, and if it does 32 | /// not end with a newline then it will be extended with some indication of 33 | /// the current location in the code, as described for mess_sv. 34 | /// 35 | /// The error message or object will be used as an exception, by default 36 | /// returning control to the nearest enclosing @c eval, but subject to 37 | /// modification by a @c $SIG{__DIE__} handler. In any case, the @c croak_sv 38 | /// function never returns normally. 39 | /// 40 | /// To die with a simple string message, the croak function may be 41 | /// more convenient. 42 | SWIFT_NAME(PerlInterpreter.croak_sv(self:_:)) 43 | PERL_STATIC_INLINE void CPerl_croak_sv(pTHX_ SV *_Nonnull baseex) { 44 | #if PERL_SUBVERSION > 12 45 | croak_sv(baseex); 46 | #else 47 | sv_setsv(ERRSV, baseex); 48 | croak(NULL); 49 | #endif 50 | } 51 | 52 | /// Finds the magic pointer of @c type with the given @c vtbl for the @c SV. See 53 | /// @c sv_magicext. 54 | SWIFT_NAME(PerlInterpreter.mg_findext(self:_:_:_:)) 55 | PERL_STATIC_INLINE MAGIC *_Nullable CPerl_mg_findext(pTHX_ SV *_Nullable sv, int type, const MGVTBL *_Nullable vtbl) { 56 | #if PERL_SUBVERSION > 12 57 | mg_findext(sv, type, vtbl) 58 | #else 59 | if (sv) { 60 | MAGIC *mg; 61 | #ifdef AvPAD_NAMELIST 62 | assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv))); 63 | #endif 64 | for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) { 65 | if (mg->mg_type == type && mg->mg_virtual == vtbl) 66 | return mg; 67 | } 68 | } 69 | return NULL; 70 | #endif 71 | } 72 | 73 | // DynaLoader 74 | 75 | EXTERN_C void boot_DynaLoader(pTHX_ CV *_Nonnull cv); 76 | 77 | EXTERN_C void xs_init(pTHX) { 78 | newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); 79 | } 80 | -------------------------------------------------------------------------------- /Sources/CPerl/macro.h: -------------------------------------------------------------------------------- 1 | // !!!!!!! DO NOT EDIT THIS FILE !!!!!!! 2 | // This file is built by update-headers from data in macro.in. 3 | // Any changes made here will be lost! 4 | // 5 | // Edit macro.in and run update-headers to effect changes. 6 | 7 | // Interpreter 8 | 9 | /// Provides system-specific tune up of the C runtime environment necessary to 10 | /// run Perl interpreters. This should be called only once, before creating 11 | /// any Perl interpreters. 12 | SWIFT_NAME(PERL_SYS_INIT3(_:_:_:)) 13 | PERL_STATIC_INLINE void CPerlMacro_PERL_SYS_INIT3(int *_Nonnull argc, char *_Nullable *_Nonnull *_Nonnull argv, char *_Nullable *_Nonnull *_Nonnull env) { 14 | PERL_SYS_INIT3(argc, argv, env); 15 | } 16 | 17 | /// Provides system-specific clean up of the C runtime environment after 18 | /// running Perl interpreters. This should be called only once, after 19 | /// freeing any remaining Perl interpreters. 20 | SWIFT_NAME(PERL_SYS_TERM()) 21 | PERL_STATIC_INLINE void CPerlMacro_PERL_SYS_TERM(void) { 22 | PERL_SYS_TERM(); 23 | } 24 | 25 | SWIFT_NAME(PERL_GET_INTERP()) 26 | PERL_STATIC_INLINE PerlInterpreter *_Nonnull CPerlMacro_PERL_GET_INTERP(void) { 27 | return PERL_GET_INTERP; 28 | } 29 | 30 | SWIFT_NAME(PERL_SET_INTERP(_:)) 31 | PERL_STATIC_INLINE void CPerlMacro_PERL_SET_INTERP(PerlInterpreter *_Nonnull p) { 32 | PERL_SET_INTERP(p); 33 | } 34 | 35 | SWIFT_NAME(PERL_GET_THX()) 36 | PERL_STATIC_INLINE PerlInterpreter *_Nonnull CPerlMacro_PERL_GET_THX(void) { 37 | return PERL_GET_THX; 38 | } 39 | 40 | SWIFT_NAME(PERL_SET_THX(_:)) 41 | PERL_STATIC_INLINE void CPerlMacro_PERL_SET_THX(PerlInterpreter *_Nonnull p) { 42 | PERL_SET_THX(p); 43 | } 44 | 45 | SWIFT_NAME(getter:PerlInterpreter.ERRSV(self:)) 46 | PERL_STATIC_INLINE SV *_Nonnull CPerlMacro_ERRSV(pTHX) { 47 | return ERRSV; 48 | } 49 | 50 | /// Returns a true SV if @c b is a true value, or a false SV if @c b is 0. 51 | /// 52 | /// See also @c PL_sv_yes and @c PL_sv_no. 53 | SWIFT_NAME(PerlInterpreter.boolSV(self:_:)) 54 | PERL_STATIC_INLINE SV *_Nonnull CPerlMacro_boolSV(pTHX_ bool b) { 55 | return boolSV(b); 56 | } 57 | 58 | 59 | // Stack Manipulation Macros 60 | 61 | SWIFT_NAME(getter:PerlInterpreter.PL_stack_base(self:)) 62 | PERL_STATIC_INLINE SV *_Nonnull *_Nonnull CPerlMacro_PL_stack_base(pTHX) { 63 | return PL_stack_base; 64 | } 65 | 66 | SWIFT_NAME(getter:PerlInterpreter.PL_stack_sp(self:)) 67 | PERL_STATIC_INLINE SV *_Nonnull *_Nonnull CPerlMacro_PL_stack_sp(pTHX) { 68 | return PL_stack_sp; 69 | } 70 | 71 | SWIFT_NAME(setter:PerlInterpreter.PL_stack_sp(self:_:)) 72 | PERL_STATIC_INLINE void CPerlMacro_PL_stack_sp_set(pTHX_ SV *_Nonnull *_Nonnull sp) { 73 | PL_stack_sp = sp; 74 | } 75 | 76 | /// Used to extend the argument stack for an XSUB's return values. Once 77 | /// used, guarantees that there is room for at least @c nitems to be pushed 78 | /// onto the stack. 79 | SWIFT_NAME(PerlInterpreter.EXTEND(self:_:_:)) 80 | PERL_STATIC_INLINE SV *_Nonnull *_Nonnull CPerlMacro_EXTEND(pTHX_ SV *_Nonnull *_Nonnull sp, SSize_t nitems) { 81 | EXTEND(sp, nitems); 82 | return sp; 83 | } 84 | 85 | /// Opening bracket for arguments on a callback. See @c PUTBACK and 86 | /// perlcall. 87 | SWIFT_NAME(PerlInterpreter.PUSHMARK(self:_:)) 88 | PERL_STATIC_INLINE void CPerlMacro_PUSHMARK(pTHX_ SV *_Nonnull *_Nonnull sp) { 89 | PUSHMARK(sp); 90 | } 91 | 92 | SWIFT_NAME(PerlInterpreter.POPMARK(self:)) 93 | PERL_STATIC_INLINE I32 CPerlMacro_POPMARK(pTHX) { 94 | return POPMARK; 95 | } 96 | 97 | SWIFT_NAME(getter:PerlInterpreter.TOPMARK(self:)) 98 | PERL_STATIC_INLINE I32 CPerlMacro_TOPMARK(pTHX) { 99 | return TOPMARK; 100 | } 101 | 102 | 103 | // Callback Functions 104 | 105 | /// Opening bracket for temporaries on a callback. See @c FREETMPS and 106 | /// perlcall. 107 | SWIFT_NAME(PerlInterpreter.SAVETMPS(self:)) 108 | PERL_STATIC_INLINE void CPerlMacro_SAVETMPS(pTHX) { 109 | SAVETMPS; 110 | } 111 | 112 | /// Closing bracket for temporaries on a callback. See @c SAVETMPS and 113 | /// perlcall. 114 | SWIFT_NAME(PerlInterpreter.FREETMPS(self:)) 115 | PERL_STATIC_INLINE void CPerlMacro_FREETMPS(pTHX) { 116 | FREETMPS; 117 | } 118 | 119 | /// Opening bracket on a callback. See @c LEAVE and perlcall. 120 | SWIFT_NAME(PerlInterpreter.ENTER(self:)) 121 | PERL_STATIC_INLINE void CPerlMacro_ENTER(pTHX) { 122 | ENTER; 123 | } 124 | 125 | /// Closing bracket on a callback. See @c ENTER and perlcall. 126 | SWIFT_NAME(PerlInterpreter.LEAVE(self:)) 127 | PERL_STATIC_INLINE void CPerlMacro_LEAVE(pTHX) { 128 | LEAVE; 129 | } 130 | 131 | 132 | // SV Reference Counting 133 | 134 | /// Returns the value of the object's reference count. Exposed 135 | /// to perl code via Internals::SvREFCNT(). 136 | SWIFT_NAME(SvREFCNT(_:)) 137 | PERL_STATIC_INLINE U32 CPerlMacro_SvREFCNT(SV *_Nonnull sv) { 138 | return SvREFCNT(sv); 139 | } 140 | 141 | /// Increments the reference count of the given SV, returning the SV. 142 | /// 143 | /// All of the following @c SvREFCNT_inc* macros are optimized versions of 144 | /// @c SvREFCNT_inc, and can be replaced with @c SvREFCNT_inc. 145 | SWIFT_NAME(SvREFCNT_inc(_:)) 146 | PERL_STATIC_INLINE SV *_Nullable CPerlMacro_SvREFCNT_inc(SV *_Nullable sv) { 147 | return SvREFCNT_inc(sv); 148 | } 149 | 150 | /// Same as @c SvREFCNT_inc, but can only be used if you know @c sv 151 | /// is not @c NULL. Since we don't have to check the NULLness, it's faster 152 | /// and smaller. 153 | SWIFT_NAME(SvREFCNT_inc_NN(_:)) 154 | PERL_STATIC_INLINE SV *_Nonnull CPerlMacro_SvREFCNT_inc_NN(SV *_Nonnull sv) { 155 | return SvREFCNT_inc_NN(sv); 156 | } 157 | 158 | /// Decrements the reference count of the given SV. @c sv may be @c NULL. 159 | SWIFT_NAME(PerlInterpreter.SvREFCNT_dec(self:_:)) 160 | PERL_STATIC_INLINE void CPerlMacro_SvREFCNT_dec(pTHX_ SV *_Nullable sv) { 161 | SvREFCNT_dec(sv); 162 | } 163 | 164 | /// Same as @c SvREFCNT_dec, but can only be used if you know @c sv 165 | /// is not @c NULL. Since we don't have to check the NULLness, it's faster 166 | /// and smaller. 167 | SWIFT_NAME(PerlInterpreter.SvREFCNT_dec_NN(self:_:)) 168 | PERL_STATIC_INLINE void CPerlMacro_SvREFCNT_dec_NN(pTHX_ SV *_Nonnull sv) { 169 | #ifdef SvREFCNT_dec_NN 170 | return SvREFCNT_dec_NN(sv); 171 | #else 172 | return SvREFCNT_dec(sv); 173 | #endif 174 | } 175 | 176 | 177 | // SV 178 | 179 | /// Creates an RV wrapper for an SV. The reference count for the original SV is 180 | /// incremented. 181 | SWIFT_NAME(PerlInterpreter.newRV_inc(self:_:)) 182 | PERL_STATIC_INLINE SV *_Nonnull CPerlMacro_newRV_inc(pTHX_ SV *_Nonnull const sv) { 183 | return newRV_inc(sv); 184 | } 185 | 186 | /// Returns the type of the SV. See @c svtype. 187 | SWIFT_NAME(SvTYPE(_:)) 188 | PERL_STATIC_INLINE svtype CPerlMacro_SvTYPE(SV *_Nonnull sv) { 189 | return SvTYPE(sv); 190 | } 191 | 192 | /// Returns a U32 value indicating whether the value is defined. This is 193 | /// only meaningful for scalars. 194 | SWIFT_NAME(SvOK(_:)) 195 | PERL_STATIC_INLINE bool CPerlMacro_SvOK(SV *_Nonnull sv) { 196 | return SvOK(sv); 197 | } 198 | 199 | /// Returns a U32 value indicating whether the SV contains an integer. 200 | SWIFT_NAME(SvIOK(_:)) 201 | PERL_STATIC_INLINE bool CPerlMacro_SvIOK(SV *_Nonnull sv) { 202 | return SvIOK(sv); 203 | } 204 | 205 | /// Returns a boolean indicating whether the SV contains an integer that must be 206 | /// interpreted as unsigned. A non-negative integer whose value is within the 207 | /// range of both an IV and a UV may be be flagged as either @c SvUOK or @c SVIOK. 208 | SWIFT_NAME(SvIOK_UV(_:)) 209 | PERL_STATIC_INLINE bool CPerlMacro_SvIOK_UV(SV *_Nonnull sv) { 210 | return SvIOK_UV(sv); 211 | } 212 | 213 | /// Returns a boolean indicating whether the SV contains a signed integer. 214 | SWIFT_NAME(SvIOK_notUV(_:)) 215 | PERL_STATIC_INLINE bool CPerlMacro_SvIOK_notUV(SV *_Nonnull sv) { 216 | return SvIOK_notUV(sv); 217 | } 218 | 219 | SWIFT_NAME(SvIsUV(_:)) 220 | PERL_STATIC_INLINE bool CPerlMacro_SvIsUV(SV *_Nonnull sv) { 221 | return SvIsUV(sv); 222 | } 223 | 224 | /// Returns a U32 value indicating whether the SV contains a double. 225 | SWIFT_NAME(SvNOK(_:)) 226 | PERL_STATIC_INLINE bool CPerlMacro_SvNOK(SV *_Nonnull sv) { 227 | return SvNOK(sv); 228 | } 229 | 230 | /// Returns a U32 value indicating whether the SV contains a number, integer or 231 | /// double. 232 | SWIFT_NAME(SvNIOK(_:)) 233 | PERL_STATIC_INLINE bool CPerlMacro_SvNIOK(SV *_Nonnull sv) { 234 | return SvNIOK(sv); 235 | } 236 | 237 | /// Tests if the SV is an RV. 238 | SWIFT_NAME(SvROK(_:)) 239 | PERL_STATIC_INLINE bool CPerlMacro_SvROK(SV *_Nonnull sv) { 240 | return SvROK(sv); 241 | } 242 | 243 | /// Returns a U32 value indicating whether the SV contains a character 244 | /// string. 245 | SWIFT_NAME(SvPOK(_:)) 246 | PERL_STATIC_INLINE bool CPerlMacro_SvPOK(SV *_Nonnull sv) { 247 | return SvPOK(sv); 248 | } 249 | 250 | /// Returns a U32 value indicating the UTF-8 status of an SV. If things are set-up 251 | /// properly, this indicates whether or not the SV contains UTF-8 encoded data. 252 | /// You should use this @i after a call to @c SvPV() or one of its variants, in 253 | /// case any call to string overloading updates the internal flag. 254 | /// 255 | /// If you want to take into account the bytes pragma, use @c DO_UTF8 256 | /// instead. 257 | SWIFT_NAME(SvUTF8(_:)) 258 | PERL_STATIC_INLINE bool CPerlMacro_SvUTF8(SV *_Nonnull sv) { 259 | return SvUTF8(sv); 260 | } 261 | 262 | /// Turn on the UTF-8 status of an SV (the data is not changed, just the flag). 263 | /// Do not use frivolously. 264 | SWIFT_NAME(SvUTF8_on(_:)) 265 | PERL_STATIC_INLINE void CPerlMacro_SvUTF8_on(SV *_Nonnull sv) { 266 | SvUTF8_on(sv); 267 | } 268 | 269 | /// Unsets the UTF-8 status of an SV (the data is not changed, just the flag). 270 | /// Do not use frivolously. 271 | SWIFT_NAME(SvUTF8_off(_:)) 272 | PERL_STATIC_INLINE void CPerlMacro_SvUTF8_off(SV *_Nonnull sv) { 273 | SvUTF8_off(sv); 274 | } 275 | 276 | /// Dereferences an RV to return the SV. 277 | SWIFT_NAME(SvRV(_:)) 278 | PERL_STATIC_INLINE SV *_Nullable CPerlMacro_SvRV(SV *_Nonnull sv) { 279 | return SvRV(sv); 280 | } 281 | 282 | /// Returns a boolean indicating whether Perl would evaluate the SV as true or 283 | /// false. See @c SvOK for a defined/undefined test. Handles 'get' magic 284 | /// unless the scalar is already @c SvPOK, @c SvIOK or @c SvNOK (the public, not the 285 | /// private flags). 286 | SWIFT_NAME(PerlInterpreter.SvTRUE(self:_:)) 287 | PERL_STATIC_INLINE bool CPerlMacro_SvTRUE(pTHX_ SV *_Nullable sv) { 288 | return SvTRUE(sv); 289 | } 290 | 291 | /// Coerces the given SV to IV and returns it. The returned value in many 292 | /// circumstances will get stored in @c sv's IV slot, but not in all cases. (Use 293 | /// @c sv_setiv to make sure it does). 294 | /// 295 | /// See @c SvIVx for a version which guarantees to evaluate @c sv only once. 296 | SWIFT_NAME(PerlInterpreter.SvIV(self:_:)) 297 | PERL_STATIC_INLINE IV CPerlMacro_SvIV(pTHX_ SV *_Nonnull sv) { 298 | return SvIV(sv); 299 | } 300 | 301 | /// Coerces the given SV to UV and returns it. The returned value in many 302 | /// circumstances will get stored in @c sv's UV slot, but not in all cases. (Use 303 | /// @c sv_setuv to make sure it does). 304 | /// 305 | /// See @c SvUVx for a version which guarantees to evaluate @c sv only once. 306 | SWIFT_NAME(PerlInterpreter.SvUV(self:_:)) 307 | PERL_STATIC_INLINE UV CPerlMacro_SvUV(pTHX_ SV *_Nonnull sv) { 308 | return SvUV(sv); 309 | } 310 | 311 | /// Coerces the given SV to NV and returns it. The returned value in many 312 | /// circumstances will get stored in @c sv's NV slot, but not in all cases. (Use 313 | /// @c sv_setnv to make sure it does). 314 | /// 315 | /// See @c SvNVx for a version which guarantees to evaluate @c sv only once. 316 | SWIFT_NAME(PerlInterpreter.SvNV(self:_:)) 317 | PERL_STATIC_INLINE NV CPerlMacro_SvNV(pTHX_ SV *_Nonnull sv) { 318 | return SvNV(sv); 319 | } 320 | 321 | /// Returns a pointer to the string in the SV, or a stringified form of 322 | /// the SV if the SV does not contain a string. The SV may cache the 323 | /// stringified version becoming @c SvPOK. Handles 'get' magic. The 324 | /// @c len variable will be set to the length of the string (this is a macro, so 325 | /// don't use @c &len). See also @c SvPVx for a version which guarantees to 326 | /// evaluate @c sv only once. 327 | /// 328 | /// Note that there is no guarantee that the return value of @c SvPV() is 329 | /// equal to @c SvPVX(sv), or that @c SvPVX(sv) contains valid data, or that 330 | /// successive calls to @c SvPV(sv) will return the same pointer value each 331 | /// time. This is due to the way that things like overloading and 332 | /// Copy-On-Write are handled. In these cases, the return value may point to 333 | /// a temporary buffer or similar. If you absolutely need the @c SvPVX field to 334 | /// be valid (for example, if you intend to write to it), then see 335 | /// @c SvPV_force. 336 | SWIFT_NAME(PerlInterpreter.SvPV(self:_:_:)) 337 | PERL_STATIC_INLINE char *_Nullable CPerlMacro_SvPV(pTHX_ SV *_Nonnull sv, STRLEN *_Nonnull len) { 338 | return SvPV(sv, *len); 339 | } 340 | 341 | 342 | // AV 343 | 344 | // HV 345 | 346 | /// Returns the key slot of the hash entry as a @c char* value, doing any 347 | /// necessary dereferencing of possibly @c SV* keys. The length of the string 348 | /// is placed in @c len (this is a macro, so do @i not use @c &len). If you do 349 | /// not care about what the length of the key is, you may use the global 350 | /// variable @c PL_na, though this is rather less efficient than using a local 351 | /// variable. Remember though, that hash keys in perl are free to contain 352 | /// embedded nulls, so using @c strlen() or similar is not a good way to find 353 | /// the length of hash keys. This is very similar to the @c SvPV() macro 354 | /// described elsewhere in this document. See also @c HeUTF8. 355 | /// 356 | /// If you are using @c HePV to get values to pass to @c newSVpvn() to create a 357 | /// new SV, you should consider using @c newSVhek(HeKEY_hek(he)) as it is more 358 | /// efficient. 359 | SWIFT_NAME(PerlInterpreter.HePV(self:_:_:)) 360 | PERL_STATIC_INLINE char *_Nonnull CPerlMacro_HePV(pTHX_ HE *_Nonnull he, STRLEN *_Nonnull len) { 361 | return HePV(he, *len); 362 | } 363 | 364 | /// Returns the value slot (type @c SV*) 365 | /// stored in the hash entry. Can be assigned 366 | /// to. 367 | /// 368 | /// @code 369 | /// SV *foo= HeVAL(hv); 370 | /// HeVAL(hv)= sv; 371 | /// @endcode 372 | /// 373 | SWIFT_NAME(HeVAL(_:)) 374 | PERL_STATIC_INLINE SV *_Nonnull CPerlMacro_HeVAL(HE *_Nonnull he) { 375 | return HeVAL(he); 376 | } 377 | 378 | /// Returns the package name of a stash, or @c NULL if @c stash isn't a stash. 379 | /// See @c SvSTASH, @c CvSTASH. 380 | SWIFT_NAME(HvNAME(_:)) 381 | PERL_STATIC_INLINE char *_Nullable CPerlMacro_HvNAME(HV *_Nonnull stash) { 382 | return HvNAME(stash); 383 | } 384 | 385 | 386 | // CV 387 | 388 | SWIFT_NAME(CvXSUBANY(_:)) 389 | PERL_STATIC_INLINE ANY *_Nonnull CPerlMacro_CvXSUBANY(CV *_Nonnull cv) { 390 | return &CvXSUBANY(cv); 391 | } 392 | 393 | SWIFT_NAME(PerlInterpreter.CvGV(self:_:)) 394 | PERL_STATIC_INLINE GV *_Nullable CPerlMacro_CvGV(pTHX_ CV *_Nonnull cv) { 395 | return CvGV(cv); 396 | } 397 | 398 | SWIFT_NAME(CvFILE(_:)) 399 | PERL_STATIC_INLINE char *_Nullable CPerlMacro_CvFILE(CV *_Nonnull cv) { 400 | return CvFILE(cv); 401 | } 402 | 403 | 404 | // GV 405 | 406 | SWIFT_NAME(GvSTASH(_:)) 407 | PERL_STATIC_INLINE HV *_Nullable CPerlMacro_GvSTASH(GV *_Nonnull gv) { 408 | return GvSTASH(gv); 409 | } 410 | 411 | SWIFT_NAME(GvNAME(_:)) 412 | PERL_STATIC_INLINE char *_Nonnull CPerlMacro_GvNAME(GV *_Nonnull gv) { 413 | return GvNAME(gv); 414 | } 415 | 416 | -------------------------------------------------------------------------------- /Sources/CPerl/macro.in: -------------------------------------------------------------------------------- 1 | // Interpreter 2 | 3 | n|void|PERL_SYS_INIT3|int *_Nonnull argc|char *_Nullable *_Nonnull *_Nonnull argv|char *_Nullable *_Nonnull *_Nonnull env 4 | n|void|PERL_SYS_TERM| 5 | nP|PerlInterpreter *_Nonnull|PERL_GET_INTERP| 6 | n|void|PERL_SET_INTERP|PerlInterpreter *_Nonnull p 7 | nP|PerlInterpreter *_Nonnull|PERL_GET_THX| 8 | n|void|PERL_SET_THX|PerlInterpreter *_Nonnull p 9 | g|SV *_Nonnull|ERRSV| 10 | |SV *_Nonnull|boolSV|bool b 11 | 12 | // Stack Manipulation Macros 13 | 14 | g|SV *_Nonnull *_Nonnull|PL_stack_base| 15 | g|SV *_Nonnull *_Nonnull|PL_stack_sp| 16 | s|void|PL_stack_sp|SV *_Nonnull *_Nonnull sp 17 | C|SV *_Nonnull *_Nonnull|EXTEND|SV *_Nonnull *_Nonnull sp|SSize_t nitems 18 | EXTEND(sp, nitems); 19 | return sp; 20 | } 21 | |void|PUSHMARK|SV *_Nonnull *_Nonnull sp 22 | P|I32|POPMARK| 23 | g|I32|TOPMARK| 24 | 25 | // Callback Functions 26 | 27 | P|void|SAVETMPS| 28 | P|void|FREETMPS| 29 | P|void|ENTER| 30 | P|void|LEAVE| 31 | 32 | // SV Reference Counting 33 | 34 | n|U32|SvREFCNT|SV *_Nonnull sv 35 | n|SV *_Nullable|SvREFCNT_inc|SV *_Nullable sv 36 | n|SV *_Nonnull|SvREFCNT_inc_NN|SV *_Nonnull sv 37 | |void|SvREFCNT_dec|SV *_Nullable sv 38 | C|void|SvREFCNT_dec_NN|SV *_Nonnull sv 39 | #ifdef SvREFCNT_dec_NN 40 | return SvREFCNT_dec_NN(sv); 41 | #else 42 | return SvREFCNT_dec(sv); 43 | #endif 44 | } 45 | 46 | // SV 47 | 48 | |SV *_Nonnull|newRV_inc|SV *_Nonnull const sv 49 | n|svtype|SvTYPE|SV *_Nonnull sv 50 | n|bool|SvOK|SV *_Nonnull sv 51 | n|bool|SvIOK|SV *_Nonnull sv 52 | n|bool|SvIOK_UV|SV *_Nonnull sv 53 | n|bool|SvIOK_notUV|SV *_Nonnull sv 54 | n|bool|SvIsUV|SV *_Nonnull sv 55 | n|bool|SvNOK|SV *_Nonnull sv 56 | n|bool|SvNIOK|SV *_Nonnull sv 57 | n|bool|SvROK|SV *_Nonnull sv 58 | n|bool|SvPOK|SV *_Nonnull sv 59 | n|bool|SvUTF8|SV *_Nonnull sv 60 | n|void|SvUTF8_on|SV *_Nonnull sv 61 | n|void|SvUTF8_off|SV *_Nonnull sv 62 | n|SV *_Nullable|SvRV|SV *_Nonnull sv 63 | |bool|SvTRUE|SV *_Nullable sv 64 | |IV|SvIV|SV *_Nonnull sv 65 | |UV|SvUV|SV *_Nonnull sv 66 | |NV|SvNV|SV *_Nonnull sv 67 | C|char *_Nullable|SvPV|SV *_Nonnull sv|STRLEN *_Nonnull len 68 | return SvPV(sv, *len); 69 | } 70 | 71 | // AV 72 | 73 | // HV 74 | 75 | C|char *_Nonnull|HePV|HE *_Nonnull he|STRLEN *_Nonnull len 76 | return HePV(he, *len); 77 | } 78 | n|SV *_Nonnull|HeVAL|HE *_Nonnull he 79 | n|char *_Nullable|HvNAME|HV *_Nonnull stash 80 | 81 | // CV 82 | 83 | nC|ANY *_Nonnull|CvXSUBANY|CV *_Nonnull cv 84 | return &CvXSUBANY(cv); 85 | } 86 | |GV *_Nullable|CvGV|CV *_Nonnull cv 87 | n|char *_Nullable|CvFILE|CV *_Nonnull cv 88 | 89 | // GV 90 | 91 | n|HV *_Nullable|GvSTASH|GV *_Nonnull gv 92 | n|char *_Nonnull|GvNAME|GV *_Nonnull gv 93 | -------------------------------------------------------------------------------- /Sources/CPerl/shim.h: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #define PERL_NO_GET_CONTEXT 5 | 6 | // workaround for "-Xcc -D_GNU_SOURCE" on Linux 7 | #if defined(__linux__) && !defined(_GNU_SOURCE) 8 | typedef __off64_t off64_t; 9 | #endif 10 | -------------------------------------------------------------------------------- /Sources/CPerl/update-headers: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use Cwd; 6 | 7 | my $path = $ARGV[0] 8 | or die "Path to Perl sources is required"; 9 | 10 | require "$path/regen/embed_lib.pl"; 11 | 12 | my $wrapall = 1; 13 | 14 | # Unstable functions used by swiftperl 15 | my %unstable_ok = map { $_ => 1 } qw/ 16 | newXS_flags 17 | sv_dump 18 | sv_utf8_decode 19 | /; 20 | 21 | # Backported to older versions of Perl (see macro.h) 22 | my @compat = qw/ 23 | croak_sv 24 | mg_findext 25 | /; 26 | 27 | # Backward incompatible functions 28 | my %skip = map { $_ => 1 } qw/ 29 | blockhook_register 30 | cv_get_call_checker 31 | cv_set_call_checker 32 | cv_set_call_checker_flags 33 | newFOROP 34 | newUNOP_AUX 35 | newWHILEOP 36 | pad_add_anon 37 | sv_nolocking 38 | sv_vcatpvfn 39 | sv_vsetpvfn 40 | /, @compat; 41 | 42 | # embed.fnc has no nullability info for retval 43 | my %retval_nullable = ( 44 | av_delete => 1, 45 | av_fetch => 1, 46 | av_make => 0, 47 | av_pop => 0, 48 | av_shift => 0, 49 | av_store => 1, 50 | cv_name => 0, 51 | get_av => 1, 52 | get_cv => 1, 53 | get_hv => 1, 54 | get_sv => 1, 55 | hv_delete => 1, 56 | hv_delete_ent => 1, 57 | hv_fetch => 1, 58 | hv_fetch_ent => 1, 59 | hv_iternext => 1, 60 | hv_scalar => 0, 61 | hv_store => 1, 62 | hv_store_ent => 1, 63 | newAV => 0, 64 | newHV => 0, 65 | newRV_noinc => 0, 66 | newSV => 0, 67 | newSV_type => 0, 68 | newSVhek => 0, 69 | newSViv => 0, 70 | newSVnv => 0, 71 | newSVpvn => 0, 72 | newSVpvn_flags => 0, 73 | newSVpvn_share => 0, 74 | newSVrv => 0, 75 | newSVsv => 1, 76 | newSVuv => 0, 77 | newXS => 0, 78 | newXS_flags => 0, 79 | perl_alloc => 1, 80 | sv_2mortal => 1, 81 | sv_magicext => 0, 82 | sv_reftype => 0, 83 | sv_setref_iv => 0, 84 | sv_setref_nv => 0, 85 | sv_setref_pv => 0, 86 | sv_setref_pvn => 0, 87 | sv_setref_uv => 0, 88 | vmess => 0, 89 | ); 90 | 91 | # Backward compatibility fix 92 | my %force_context = map { $_ => 1 } qw/ 93 | croak_xs_usage 94 | croak_no_modify 95 | cv_const_sv 96 | is_utf8_string 97 | is_utf8_string_loc 98 | is_utf8_string_loclen 99 | mg_find 100 | mg_magical 101 | sv_backoff 102 | utf8_hop 103 | /; 104 | 105 | # To simplify usage from Swift 106 | my %force_bool = ( 107 | av_fetch => [2], 108 | foldEQ => ["return"], 109 | foldEQ_locale => ["return"], 110 | gv_init => [4], 111 | hv_fetch => [3], 112 | hv_fetch_ent => [2], 113 | sv_eq => ["return"], 114 | sv_eq_flags => ["return"], 115 | sv_isa => ["return"], 116 | sv_isobject => ["return"], 117 | sv_ref => [2], 118 | sv_reftype => [1], 119 | sv_true => ["return"], 120 | ); 121 | 122 | my %fix = ( 123 | perl_parse => sub { $_[2][1] =~ s/^/NULLOK / }, 124 | sv_dump => sub { $_[2][0] =~ s/NULLOK/NN/ }, 125 | ); 126 | 127 | my ($embed, $core, $ext, $api) = setup_embed("$path/"); 128 | 129 | my $apidocs = apidocs(); 130 | my %docs = map %$_, values %$apidocs; 131 | 132 | open my $min, '<', 'macro.in' or die $!; 133 | open my $m, '>', 'macro.h' or die $!; 134 | print $m <) { 143 | chomp; 144 | if (/^(?:\/\/.*|)$/) { 145 | print $m "$_\n"; 146 | next; 147 | } 148 | my ($flags, $retval, $func, @args) = split /\|/, $_; 149 | my $no_context = $flags =~ /n/; 150 | my $plain_call = $flags =~ /P/; 151 | my $getter = $flags =~ /g/; 152 | my $setter = $flags =~ /s/; 153 | my $custom = $flags =~ /C/; 154 | my $argnames = join ', ', map { /([\w_]+)$/ && $1 } @args; 155 | if ($setter) { 156 | $argnames = " = $argnames"; 157 | } elsif (!$getter && !$plain_call) { 158 | $argnames = "($argnames)"; 159 | } 160 | my $args = @args ? join ', ', @args : 'void'; 161 | my $swname = $func; 162 | my $swproto = join "", map "_:", @args; 163 | unless ($no_context) { 164 | $swname = "PerlInterpreter.$swname"; 165 | $swname = "getter:$swname" if $getter; 166 | $swname = "setter:$swname" if $setter; 167 | $swproto = "self:$swproto"; 168 | $args = @args ? "pTHX_ $args" : "pTHX"; 169 | } 170 | print $m format_doc($docs{$func}); 171 | my $set = $setter ? "_set" : ""; 172 | my $return = $retval eq 'void' ? "" : "return "; 173 | my $body; 174 | if ($custom) { 175 | while (<$min>) { 176 | last if /^\}$/; 177 | $body .= $_; 178 | } 179 | } else { 180 | $body = "\t$return$func$argnames;\n"; 181 | } 182 | print $m "SWIFT_NAME($swname($swproto))\nPERL_STATIC_INLINE $retval CPerlMacro_$func$set($args) {\n$body}\n"; 183 | print $m "\n"; 184 | } 185 | close $m; 186 | close $min; 187 | 188 | open my $f, '>', 'func.h' or die "Cannot write to func.h: $!"; 189 | print $f <[0]\n"; 201 | next; 202 | } 203 | my ($flags, $retval, $func, @args) = @$_; 204 | $fix{$func}($flags, $retval, \@args) if $fix{$func}; 205 | next if $skip{$func}; 206 | next if $flags =~ /D/; # Function is deprecated 207 | unless ($unstable_ok{$func}) { 208 | next if $flags =~ /M/; # May change 209 | next unless $flags =~ /d/; # Function has documentation (somewhere) in the source 210 | } 211 | my $no_context = $flags =~ /n/; # Has no implicit interpreter/thread context argument 212 | my $perl_prefix = $flags =~ /p/; # Function in source code has a Perl_ prefix 213 | my $macro = $flags =~ /m/; # Implemented as a macro 214 | my $inline = $flags =~ /i/; # Static inline: function in source code has a S_ prefix 215 | my $no_prefix = $flags =~ /o/; # Has no Perl_foo or S_foo compatibility macro 216 | next if $no_prefix && $func !~ /perl_/; 217 | next if grep { $_ eq "..." } @args; 218 | my $argnames = join ', ', map { /([\w_]+)$/ && $1 } @args; 219 | foreach (@args) { 220 | if (s/NULLOK //) { 221 | s/(\* ?|\S+_t )/$1_Nullable /g; 222 | } elsif (s/NN //) { 223 | s/(\* ?|\S+_t )/$1_Nonnull /g; 224 | } 225 | } 226 | my $fix = $wrapall; 227 | if (defined(my $nullable = $retval_nullable{$func})) { 228 | my $attr = $nullable ? '_Nullable' : '_Nonnull'; 229 | $retval =~ s/\*/ *$attr/g; 230 | $fix = 1; 231 | } elsif ($retval =~ /\*/) { 232 | next; 233 | } 234 | if (my $where = $force_bool{$func}) { 235 | $fix = 1; 236 | foreach my $w (@$where) { 237 | if ($w eq "return") { 238 | $retval = "bool"; 239 | } else { 240 | $args[$w] =~ s/^.* /bool /; 241 | } 242 | } 243 | } 244 | my $args = @args ? join ', ', @args : 'void'; 245 | my $swname = $func; 246 | $swname =~ s/^perl_// if $no_prefix && !$no_context; 247 | my $swproto = join "", map "_:", @args; 248 | if ($no_context && !$force_context{$func}) { 249 | if ($no_prefix && $swname =~ s/^perl_/PerlInterpreter./) { 250 | $swproto =~ s/^_:/self:/ if @args && $args[0] =~ /PerlInterpreter/; 251 | } 252 | } else { 253 | $swname = "PerlInterpreter.$swname"; 254 | $swproto = "self:$swproto"; 255 | $args = @args ? "pTHX_ $args" : "pTHX"; 256 | $fix = 1 if $force_context{$func}; 257 | } 258 | print $f "#ifdef $func\n" unless $no_prefix; 259 | print $f format_doc($docs{$func}); 260 | if ($macro || $fix) { 261 | my $return = $retval eq 'void' ? "" : "return "; 262 | print $f "SWIFT_NAME($swname($swproto))\nPERL_STATIC_INLINE $retval CPerl_$func($args) {\n\t$return$func($argnames);\n}\n"; 263 | } elsif ($inline) { 264 | print $f "SWIFT_NAME($swname($swproto))\nPERL_STATIC_INLINE $retval S_$func($args);\n"; 265 | } elsif ($perl_prefix || $no_prefix) { 266 | my $prefix = $perl_prefix ? "Perl_" : ""; 267 | print $f "SWIFT_NAME($swname($swproto))\nPERL_CALLCONV $retval $prefix$func($args);\n"; 268 | } else { 269 | die "Wanna one of [mpio] flags"; 270 | } 271 | print $f "#endif\n" unless $no_prefix; 272 | 273 | print $f "\n"; 274 | } 275 | 276 | close $f; 277 | 278 | sub apidocs { 279 | my $cwd = Cwd::cwd(); 280 | my $autodoc; 281 | open my $af, '<', "$path/autodoc.pl" or die $!; 282 | while (<$af>) { 283 | last if /^my \@missing_api/; 284 | $autodoc .= $_; 285 | } 286 | close $af; 287 | $autodoc .= "\$docs{api}\n"; 288 | 289 | my $docs = eval $autodoc; 290 | chdir $cwd; 291 | return $docs; 292 | } 293 | 294 | sub format_doc { 295 | my ($doc) = @_; 296 | return unless $doc; 297 | my $text = $doc->[1]; 298 | $text =~ s#([\@\\])#$1$1#g; 299 | $text =~ s#^\n##; 300 | $text =~ s#\n$##; 301 | $text =~ s#((?:^[ \t]+.*?\n)+)#my $x = $1; my ($s) = $x =~ /^([ \t]+)/; $x =~ s/^$s//mg; "\@code\n$x\@endcode\n"#mge; 302 | $text =~ s#E]*?)>#<$1#; 303 | $text =~ s#E]*?)>#>$1#; 304 | $text =~ s#C<([^<>]+?)>#my $c = $1; $c =~ s/ / \@c /g; "\@c $c"#sge; 305 | $text =~ s#B<([^<>]+?)>#my $c = $1; $c =~ s/ / \@b /g; "\@b $c"#sge; 306 | $text =~ s#I<([^<>]+?)>#my $c = $1; $c =~ s/ / \@i /g; "\@i $c"#sge; 307 | $text =~ s#L<([^<>]+?)/([^<>]+?)>#$2 in $1#sg; 308 | $text =~ s#L]+?)>#$1#sg; 309 | $text =~ s#L<([^<>]+?)>#$1#sg; 310 | $text =~ s#F<([^<>]+?)>#$1#sg; 311 | $text =~ s#S<([^<>]+?)>#$1#sg; 312 | $text =~ s#C<(.+?)>#my $c = $1; $c =~ s/ / \@c /g; "\@c $c"#sge; 313 | $text =~ s#^#/// #mg; 314 | $text =~ s# +$##mg; 315 | return $text; 316 | } 317 | -------------------------------------------------------------------------------- /Sources/Perl/Any.swift: -------------------------------------------------------------------------------- 1 | /// A type that represents any Perl variable. 2 | /// 3 | /// There are two major cases when some class conforms to this protocol: 4 | /// 5 | /// - An instance of a class contains a native Perl variable (some `SV`). 6 | /// In this case it is derived from `PerlObject`. 7 | /// - A class conforms to `PerlBridgedObject` and its instance contains 8 | /// a native Swift object which can be passed to Perl. 9 | /// 10 | /// Making your own custom types conforming to `AnyPerl` protocol is undesirable. 11 | public protocol AnyPerl : class {} 12 | 13 | func fromUnsafeSvContext(inc svc: UnsafeSvContext) -> AnyPerl { 14 | return svc.swiftObject ?? PerlValue.initDerived(inc: svc) 15 | } 16 | 17 | func fromUnsafeSvContext(noinc svc: UnsafeSvContext) -> AnyPerl { 18 | if let obj = svc.swiftObject { 19 | svc.refcntDec() 20 | return obj 21 | } else { 22 | return PerlValue.initDerived(noinc: svc) 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /Sources/Perl/Array.swift: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | /// Provides a safe wrapper for Perl array (`AV`). 4 | /// Performs reference counting on initialization and deinitialization. 5 | /// 6 | /// ## Cheat Sheet 7 | /// 8 | /// ### Array of strings 9 | /// 10 | /// ```perl 11 | /// my @list = ("one", "two", "three"); 12 | /// ``` 13 | /// 14 | /// ```swift 15 | /// let list: PerlArray = ["one", "two", "three"] 16 | /// ``` 17 | /// 18 | /// ### Array of mixed type data (PSGI response) 19 | /// 20 | /// ```perl 21 | /// my @response = (200, ["Content-Type" => "application/json"], ["{}"]); 22 | /// ``` 23 | /// 24 | /// ```swift 25 | /// let response: PerlArray = [200, ["Content-Type", "application/json"], ["{}"]] 26 | /// ``` 27 | /// 28 | /// ### Accessing elements of the array 29 | /// 30 | /// ```perl 31 | /// my @list; 32 | /// $list[0] = 10 33 | /// push @list, 20; 34 | /// my $first = shift @list; 35 | /// my $second = $list[0] 36 | /// ``` 37 | /// 38 | /// ```swift 39 | /// let list: PerlArray = [] 40 | /// list[0] = 10 41 | /// list.append(20) 42 | /// let first = list.removeFirst() 43 | /// let second = list[0] 44 | /// ``` 45 | public final class PerlArray : PerlValue { 46 | convenience init(noinc avc: UnsafeAvContext) { 47 | self.init(noincUnchecked: UnsafeSvContext(rebind: avc)) 48 | } 49 | 50 | convenience init(inc avc: UnsafeAvContext) { 51 | self.init(incUnchecked: UnsafeSvContext(rebind: avc)) 52 | } 53 | 54 | required convenience init(noinc svc: UnsafeSvContext) throws { 55 | guard svc.type == SVt_PVAV else { 56 | throw PerlError.unexpectedValueType(fromUnsafeSvContext(noinc: svc), want: PerlArray.self) 57 | } 58 | self.init(noincUnchecked: svc) 59 | } 60 | 61 | /// Creates an empty Perl array. 62 | public convenience init() { 63 | self.init(perl: .current) 64 | } 65 | 66 | /// Creates an empty Perl array. 67 | public convenience init(perl: PerlInterpreter = .current) { 68 | self.init(noinc: UnsafeAvContext.new(perl: perl)) 69 | } 70 | 71 | /// Initializes Perl array with elements of collection `c`. 72 | public convenience init(_ c: C, perl: PerlInterpreter = .current) 73 | where C.Iterator.Element : PerlScalarConvertible { 74 | self.init(perl: perl) 75 | reserveCapacity(numericCast(c.count)) 76 | for (i, v) in c.enumerated() { 77 | self[i] = v as? PerlScalar ?? PerlScalar(v, perl: perl) 78 | } 79 | } 80 | 81 | /// Short form of `init(dereferencing:)`. 82 | public convenience init(_ ref: PerlScalar) throws { 83 | try self.init(dereferencing: ref) 84 | } 85 | 86 | /// Returns the specified Perl global or package array with the given name (so it won't work on lexical variables). 87 | /// If the variable does not exist then `nil` is returned. 88 | public convenience init?(get name: String, perl: PerlInterpreter = .current) { 89 | guard let av = perl.getAV(name) else { return nil } 90 | self.init(inc: UnsafeAvContext(av: av, perl: perl)) 91 | } 92 | 93 | /// Returns the specified Perl global or package array with the given name (so it won't work on lexical variables). 94 | /// If the variable does not exist then it will be created. 95 | public convenience init(getCreating name: String, perl: PerlInterpreter = .current) { 96 | let av = perl.getAV(name, flags: GV_ADD)! 97 | self.init(inc: UnsafeAvContext(av: av, perl: perl)) 98 | } 99 | 100 | func withUnsafeAvContext(_ body: (UnsafeAvContext) throws -> R) rethrows -> R { 101 | defer { _fixLifetime(self) } 102 | return try unsafeSvContext.sv.withMemoryRebound(to: AV.self, capacity: 1) { 103 | return try body(UnsafeAvContext(av: $0, perl: unsafeSvContext.perl)) 104 | } 105 | } 106 | 107 | /// A textual representation of the AV, suitable for debugging. 108 | public override var debugDescription: String { 109 | let values = withUnsafeAvContext { c in 110 | c.map { $0.map { try! PerlScalar(inc: $0).debugDescription } ?? "nil" } 111 | .joined(separator: ", ") 112 | } 113 | return "PerlArray([\(values)])" 114 | } 115 | } 116 | 117 | extension PerlArray { 118 | /// Fetches the element at the specified position. 119 | /// 120 | /// - Parameter index: The position of the element to fetch. 121 | /// - Returns: `nil` if the element not exists or is undefined. 122 | /// 123 | /// - Complexity: O(1). 124 | public func fetch(_ index: Int) throws -> T? { 125 | return try withUnsafeAvContext { c in 126 | try c.fetch(index).flatMap { 127 | try T?(_fromUnsafeSvContextInc: $0) 128 | } 129 | } 130 | } 131 | 132 | /// Stores the element at the specified position. 133 | /// 134 | /// - Parameter index: The position of the element to fetch. 135 | /// - Parameter value: The value to store in the array. 136 | /// 137 | /// - Complexity: O(1). 138 | public func store(_ index: Int, value: T) { 139 | withUnsafeAvContext { 140 | $0.store(index, value: value._toUnsafeSvPointer(perl: $0.perl)) 141 | } 142 | } 143 | 144 | /// Deletes the element at the specified position. 145 | /// 146 | /// - Parameter index: The position of the element to fetch. 147 | /// - Returns: Deleted element or `nil` if the element not exists or is undefined. 148 | public func delete(_ index: Int) throws -> T? { 149 | return try withUnsafeAvContext { c in 150 | try c.delete(index).flatMap { 151 | try T?(_fromUnsafeSvContextInc: $0) 152 | } 153 | } 154 | } 155 | 156 | /// Deletes the element at the specified position. 157 | public func delete(_ index: Int) { 158 | withUnsafeAvContext { $0.delete(discarding: index) } 159 | } 160 | 161 | /// Returns true if the element at the specified position is initialized. 162 | public func exists(_ index: Int) -> Bool { 163 | return withUnsafeAvContext { $0.exists(index) } 164 | } 165 | 166 | /// Frees the all the elements of an array, leaving it empty. 167 | public func clear() { 168 | withUnsafeAvContext { $0.clear() } 169 | } 170 | } 171 | 172 | //struct PerlArray: MutableCollection { 173 | extension PerlArray : RandomAccessCollection { 174 | public typealias Element = PerlScalar 175 | 176 | /// The position of the first element in a nonempty array. 177 | /// It is always 0 and does not respect Perl variable `$[`. 178 | /// 179 | /// If the array is empty, `startIndex` is equal to `endIndex`. 180 | public var startIndex: Int { return 0 } 181 | 182 | /// The array's "past the end" position---that is, the position one greater 183 | /// than the last valid subscript argument. 184 | /// 185 | /// If the array is empty, `endIndex` is equal to `startIndex`. 186 | public var endIndex: Int { return withUnsafeAvContext { $0.endIndex } } 187 | 188 | /// Accesses the element at the specified position. 189 | /// 190 | /// - Parameter index: The position of the element to access. 191 | /// 192 | /// If the element not exists then an undefined scalar is returned. 193 | /// Setting a value to the nonexistent element creates that element. 194 | /// 195 | /// - Complexity: Reading an element from an array is O(1). Writing is O(1), too. 196 | public subscript(index: Int) -> PerlScalar { 197 | get { 198 | return withUnsafeAvContext { c in 199 | c.fetch(index).map { try! PerlScalar(inc: $0) } ?? PerlScalar(perl: c.perl) 200 | } 201 | } 202 | set { 203 | withUnsafeAvContext { c in 204 | newValue.withUnsafeSvContext { 205 | $0.refcntInc() 206 | c.store(index, value: $0.sv) 207 | } 208 | } 209 | } 210 | } 211 | } 212 | 213 | extension PerlArray { 214 | /// Creates a Perl array from a Swift array of `PerlScalar`s. 215 | public convenience init(_ array: [Element]) { 216 | self.init() 217 | for (i, v) in array.enumerated() { 218 | self[i] = v 219 | } 220 | } 221 | } 222 | 223 | extension PerlArray { 224 | func extend(to count: Int) { 225 | withUnsafeAvContext { $0.extend(to: count) } 226 | } 227 | 228 | func extend(by count: Int) { 229 | extend(to: self.count + count) 230 | } 231 | 232 | /// Reserves enough space to store the specified number of elements. 233 | /// 234 | /// If you are adding a known number of elements to an array, use this method 235 | /// to avoid multiple reallocations. For performance reasons, the newly allocated 236 | /// storage may be larger than the requested capacity. 237 | /// 238 | /// - Parameter minimumCapacity: The requested number of elements to store. 239 | /// 240 | /// - Complexity: O(*n*), where *n* is the count of the array. 241 | public func reserveCapacity(_ minimumCapacity: Int) { 242 | extend(to: minimumCapacity) 243 | } 244 | 245 | /// Adds a new element at the end of the array. 246 | /// 247 | /// Use this method to append a single element to the end of an array. 248 | /// 249 | /// Because arrays increase their allocated capacity using an exponential 250 | /// strategy, appending a single element to an array is an O(1) operation 251 | /// when averaged over many calls to the `append(_:)` method. When an array 252 | /// has additional capacity, appending an element is O(1). When an array 253 | /// needs to reallocate storage before appending, appending is O(*n*), 254 | /// where *n* is the length of the array. 255 | /// 256 | /// - Parameter sv: The element to append to the array. 257 | /// 258 | /// - Complexity: Amortized O(1) over many additions. 259 | public func append(_ sv: Element) { 260 | withUnsafeAvContext { c in 261 | sv.withUnsafeSvContext { 262 | $0.refcntInc() 263 | c.append($0) 264 | } 265 | } 266 | } 267 | 268 | // TODO - SeeAlso: `popFirst()` 269 | /// Removes and returns the first element of the array. 270 | /// 271 | /// The array can be empty. In this case undefined `PerlScalar` is returned. 272 | /// 273 | /// - Returns: The first element of the array. 274 | /// 275 | /// - Complexity: O(1) 276 | public func removeFirst() -> Element { 277 | return withUnsafeAvContext { try! PerlScalar(noinc: $0.removeFirst()) } 278 | } 279 | } 280 | 281 | extension PerlArray: ExpressibleByArrayLiteral { 282 | /// Creates Perl array from the given array literal. 283 | /// 284 | /// Do not call this initializer directly. It is used by the compiler 285 | /// when you use an array literal. Instead, create a new array by using an 286 | /// array literal as its value. To do this, enclose a comma-separated list of 287 | /// values in square brackets. For example: 288 | /// 289 | /// ```swift 290 | /// let array: PerlArray = [200, "OK"] 291 | /// ``` 292 | /// 293 | /// - Parameter elements: A variadic list of elements of the new array. 294 | public convenience init (arrayLiteral elements: Element...) { 295 | self.init(elements) 296 | } 297 | } 298 | 299 | extension Array where Element : PerlScalarConvertible { 300 | /// Creates an array from the Perl array. 301 | /// 302 | /// - Parameter av: The Perl array with the elements compatible with `Element`. 303 | /// - Throws: If some of the elements not exist or cannot be converted to `Element`. 304 | /// 305 | /// - Complexity: O(*n*), where *n* is the count of the array. 306 | public init(_ av: PerlArray) throws { 307 | self = try av.withUnsafeAvContext { uc in 308 | try uc.enumerated().map { 309 | guard let svc = $1 else { throw PerlError.elementNotExists(av, at: $0) } 310 | return try Element(_fromUnsafeSvContextInc: svc) 311 | } 312 | } 313 | } 314 | 315 | /// Creates an array from the reference to the Perl array. 316 | /// 317 | /// - Parameter ref: The reference to the Perl array with the elements 318 | /// compatible with `Element`. 319 | /// - Throws: If `ref` is not a reference to a Perl array or 320 | /// some of the elements not exist or cannot be converted to `Element`. 321 | /// 322 | /// - Complexity: O(*n*), where *n* is the count of the array. 323 | public init(_ ref: PerlScalar) throws { 324 | self = try ref.withUnsafeSvContext { 325 | guard let svc = $0.referent else { 326 | throw PerlError.notReference(fromUnsafeSvContext(inc: $0)) 327 | } 328 | return try svc.withUnsafeAvContext { avc in 329 | try avc.enumerated().map { 330 | guard let svc = $1 else { throw PerlError.elementNotExists(PerlArray(inc: avc), at: $0) } 331 | return try Element(_fromUnsafeSvContextInc: svc) 332 | } 333 | } 334 | } 335 | } 336 | } 337 | -------------------------------------------------------------------------------- /Sources/Perl/CString.swift: -------------------------------------------------------------------------------- 1 | extension String { 2 | init(cString: UnsafePointer, withLength length: Int) { 3 | let utf8buffer = UnsafeBufferPointer(start: UnsafeRawPointer(cString).assumingMemoryBound(to: UInt8.self), count: length) 4 | self = String(decoding: utf8buffer, as: UTF8.self) 5 | } 6 | 7 | func withCStringWithLength(_ body: (UnsafePointer, Int) throws -> Result) rethrows -> Result { 8 | let length = utf8.count 9 | return try withCString { try body($0, length) } 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /Sources/Perl/Call.swift.gyb: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | extension PerlSub { 4 | public enum VoidContext { 5 | case void 6 | var rawValue: Int32 { return G_VOID } 7 | } 8 | 9 | public enum ScalarContext { 10 | case scalar 11 | var rawValue: Int32 { return G_SCALAR } 12 | } 13 | 14 | public enum ArrayContext { 15 | case array 16 | var rawValue: Int32 { return G_ARRAY } 17 | } 18 | } 19 | 20 | extension PerlInterpreter { 21 | func unsafeCall(sv: UnsafeSvPointer, args: C, flags: Int32) throws -> UnsafeStackBufferPointer 22 | where C.Iterator.Element == UnsafeSvPointer { 23 | let stack = UnsafeCallStack(perl: self, args: args) 24 | let count = pointee.call_sv(sv, G_EVAL|flags) 25 | let result = stack.popReturned(count: Int(count)) 26 | if Bool(error) { 27 | throw PerlError.died(try PerlScalar(copy: error)) 28 | } 29 | return result 30 | } 31 | 32 | func unsafeEval(sv: UnsafeSvPointer, flags: Int32) throws -> UnsafeStackBufferPointer { 33 | let count = pointee.eval_sv(sv, flags) 34 | let result = popFromStack(count: Int(count)) 35 | if Bool(error) { 36 | throw PerlError.died(try PerlScalar(copy: error)) 37 | } 38 | return result 39 | } 40 | 41 | func enterScope() { 42 | pointee.ENTER() 43 | pointee.SAVETMPS() 44 | } 45 | 46 | func leaveScope() { 47 | pointee.FREETMPS() 48 | pointee.LEAVE() 49 | } 50 | } 51 | 52 | %{ 53 | import re 54 | 55 | allReturnVariants = ["Void", "R", "R?", "(R0, R1)", "PerlSub.ReturnValues"] 56 | 57 | def contextFlags(r): 58 | if r == "Void": 59 | return "G_VOID" 60 | elif ',' in r or r == "PerlSub.ReturnValues": 61 | return "G_ARRAY" 62 | else: 63 | return "G_SCALAR" 64 | 65 | def generic(r): 66 | return ", ".join(map(lambda r: r + " : PerlScalarConvertible", re.findall("\\bR\\d*\\b", r))) 67 | 68 | def fqGeneric(r): 69 | g = generic(r) 70 | return "" if g == "" else "<" + g + ">" 71 | 72 | def moreGeneric(r): 73 | g = generic(r) 74 | return "" if g == "" else ", " + g 75 | 76 | def result(ret): 77 | if ret == "PerlSub.ReturnValues": 78 | return "PerlSub.ReturnValues(svResult, perl: self)" 79 | else: 80 | return "try " + re.sub("(R(\\d*)\\??)", lambda m: m.group(1) + "(_fromUnsafeSvContextCopy: UnsafeSvContext(sv: svResult[" + (m.group(2) or "0") + "], perl: self))", ret) 81 | 82 | contextVariants = ["void", "scalar", "array"] 83 | 84 | dispatchVariants = ["sub", "method"] 85 | 86 | argsVariants = ["args: [PerlScalarConvertible?]", "_ args: PerlScalarConvertible?..."] 87 | 88 | def returnVariants(context): 89 | if context == "void": 90 | return ["Void"] 91 | elif context == "scalar": 92 | return ["R", "R?"] 93 | else: 94 | return ["R", "R?", "(R0, R1)", "PerlSub.ReturnValues"] 95 | 96 | def contextType(context, ret): 97 | c = "PerlSub." + context.title() + "Context" 98 | if context == "void" and ret == "Void" or context == "scalar" and ret[0] == "R" or context == "array" and "," in ret: 99 | c += " = ." + context 100 | return c 101 | 102 | # swift 3.1 does not support partial specialization 103 | def subVariants(dispatch): 104 | if dispatch == "method": 105 | return ["String", "PerlScalar"] 106 | else: 107 | return ["String", "PerlScalar", "PerlSub"] 108 | }% 109 | 110 | extension PerlInterpreter { 111 | % for ret in allReturnVariants: 112 | func call${fqGeneric(ret)}(sv: UnsafeSvPointer, args: [PerlScalarConvertible?], flags: Int32 = ${contextFlags(ret)}) throws -> ${ret} { 113 | let svArgs: [UnsafeSvPointer] = args.map { $0?._toUnsafeSvPointer(perl: self) ?? pointee.newSV(0) } 114 | % if ret == "Void": 115 | _ = try unsafeCall(sv: sv, args: svArgs, flags: flags) 116 | % else: 117 | let svResult = try unsafeCall(sv: sv, args: svArgs, flags: flags) 118 | return ${result(ret)} 119 | % end 120 | } 121 | % end 122 | } 123 | 124 | extension PerlInterpreter { 125 | % for dispatch in dispatchVariants: 126 | % for context in contextVariants: 127 | % for ret in returnVariants(context): 128 | % for args in argsVariants: 129 | % for subType in subVariants(dispatch): 130 | /// Calls the Perl ${"method" if dispatch == "method" else "subroutine"}. 131 | /// 132 | /// The arguments of the call will be automagically converted to mortalized Perl scalar 133 | /// values with the lifetime of the scope of this call. The similar thing will 134 | /// happen to the Perl return values: they will be destroyed before the call 135 | /// returns (but after conversion to Swift values was done). 136 | /// 137 | /// - Parameter ${dispatch}: The name of the ${"method" if dispatch == "method" else "subroutine"}. 138 | /// - Parameter args: Arguments to pass to the Perl ${dispatch}. 139 | /// - Parameter context: Context of the call. 140 | /// - Returns: Values returned by the Perl ${dispatch} converted to requested Swift types. 141 | public func call${fqGeneric(ret)}(${dispatch}: ${subType}, ${args}, context: ${contextType(context, ret)}) throws -> ${ret} { 142 | enterScope() 143 | defer { leaveScope() } 144 | % if subType == "String": 145 | return try call(sv: newSV(${dispatch}, mortal: true), args: args, flags: ${"G_METHOD|" if dispatch == "method" else ""}context.rawValue) 146 | % else: 147 | return try ${dispatch}.withUnsafeSvContext { try call(sv: $0.sv, args: args, flags: ${"G_METHOD|" if dispatch == "method" else ""}context.rawValue) } 148 | % end 149 | } 150 | % end 151 | % end 152 | % end 153 | % end 154 | % end 155 | } 156 | 157 | extension PerlSub { 158 | % for context in contextVariants: 159 | % for ret in returnVariants(context): 160 | % for args in argsVariants: 161 | % for subType in ("String", "PerlScalar"): 162 | /// Calls the Perl subroutine by its name. 163 | /// 164 | /// The arguments of the call will be automagically converted to mortalized Perl scalar 165 | /// values with the lifetime of the scope of this call. The similar thing will 166 | /// happen to the Perl return values: they will be destroyed before the call 167 | /// returns (but after conversion to Swift values was done). 168 | /// 169 | /// - Parameter name: The name of the subroutine. 170 | /// - Parameter args: Arguments to pass to the Perl subroutine. 171 | /// - Parameter context: Context of the call. 172 | /// - Returns: Values returned by the Perl subroutine converted to requested Swift types. 173 | % if subType == "String": 174 | public static func call${fqGeneric(ret)}(_ name: ${subType}, ${args}, context: ${contextType(context, ret)}, perl: PerlInterpreter = .current) throws -> ${ret} { 175 | return try perl.call(sub: name, args: args, context: context) 176 | } 177 | % else: 178 | public static func call${fqGeneric(ret)}(_ name: ${subType}, ${args}, context: ${contextType(context, ret)}) throws -> ${ret} { 179 | return try name.withUnsafeSvContext { try $0.perl.call(sub: name, args: args, context: context) } 180 | } 181 | % end 182 | % end 183 | % end 184 | % end 185 | % end 186 | 187 | % for context in contextVariants: 188 | % for ret in returnVariants(context): 189 | % for args in argsVariants: 190 | /// Calls the underlain Perl subroutine. 191 | /// 192 | /// The arguments of the call will be automagically converted to mortalized Perl scalar 193 | /// values with the lifetime of the scope of this call. The similar thing will 194 | /// happen to the Perl return values: they will be destroyed before the call 195 | /// returns (but after conversion to Swift values was done). 196 | /// 197 | /// - Parameter args: Arguments to pass to the Perl subroutine. 198 | /// - Parameter context: Context of the call. 199 | /// - Returns: Values returned by the Perl subroutine converted to requested Swift types. 200 | public func call${fqGeneric(ret)}(${args}, context: ${contextType(context, ret)}) throws -> ${ret} { 201 | return try withUnsafeSvContext { 202 | let perl = $0.perl 203 | perl.enterScope() 204 | defer { perl.leaveScope() } 205 | return try perl.call(sv: $0.sv, args: args, flags: context.rawValue) 206 | } 207 | } 208 | % end 209 | % end 210 | % end 211 | } 212 | 213 | extension PerlObject { 214 | % for context in contextVariants: 215 | % for ret in returnVariants(context): 216 | % for args in argsVariants: 217 | % for subType in subVariants("method"): 218 | /// Calls the Perl method on the current instance. 219 | /// 220 | /// The arguments of the call will be automagically converted to mortalized Perl scalar 221 | /// values with the lifetime of the scope of this call. The similar thing will 222 | /// happen to the Perl return values: they will be destroyed before the call 223 | /// returns (but after conversion to Swift values was done). 224 | /// 225 | /// - Parameter method: The name of the method to call. 226 | /// - Parameter args: Arguments to pass to the Perl method. 227 | /// - Parameter context: Context of the call. 228 | /// - Returns: Values returned by the Perl method converted to requested Swift types. 229 | public func call${fqGeneric(ret)}(method: ${subType}, ${args}, context: ${contextType(context, ret)}) throws -> ${ret} { 230 | return try unsafeSvContext.perl.call(method: method, args: [self] + args, context: context) 231 | } 232 | % end 233 | % end 234 | % end 235 | % end 236 | } 237 | 238 | extension PerlNamedClass { 239 | % for context in contextVariants: 240 | % for ret in returnVariants(context): 241 | % for args in argsVariants: 242 | % for subType in subVariants("method"): 243 | /// Calls the Perl method specified by `perlClassName` attribute on the current class. 244 | /// 245 | /// The arguments of the call will be automagically converted to mortalized Perl scalar 246 | /// values with the lifetime of the scope of this call. The similar thing will 247 | /// happen to the Perl return values: they will be destroyed before the call 248 | /// returns (but after conversion to Swift values was done). 249 | /// 250 | /// - Parameter method: The name of the method to call. 251 | /// - Parameter args: Arguments to pass to the Perl method. 252 | /// - Parameter context: Context of the call. 253 | /// - Returns: Values returned by the Perl method converted to requested Swift types. 254 | % if subType == "String": 255 | public static func call${fqGeneric(ret)}(method: ${subType}, ${args}, context: ${contextType(context, ret)}, perl: PerlInterpreter = .current) throws -> ${ret} { 256 | return try perl.call(method: method, args: [perlClassName] + args, context: context) 257 | } 258 | % else: 259 | public static func call${fqGeneric(ret)}(method: ${subType}, ${args}, context: ${contextType(context, ret)}) throws -> ${ret} { 260 | return try method.withUnsafeSvContext { try $0.perl.call(method: method, args: [perlClassName] + args, context: context) } 261 | } 262 | % end 263 | % end 264 | % end 265 | % end 266 | % end 267 | } 268 | 269 | extension PerlInterpreter { 270 | % for ret in allReturnVariants: 271 | func eval${fqGeneric(ret)}(sv: UnsafeSvPointer, flags: Int32 = ${contextFlags(ret)}) throws -> ${ret} { 272 | % if ret == "Void": 273 | _ = try unsafeEval(sv: sv, flags: flags) 274 | % else: 275 | let svResult = try unsafeEval(sv: sv, flags: flags) 276 | return ${result(ret)} 277 | % end 278 | } 279 | % end 280 | 281 | % for context in contextVariants: 282 | % for ret in returnVariants(context): 283 | /// Tells Perl to "eval" the string. 284 | public func eval${fqGeneric(ret)}(_ string: String, context: ${contextType(context, ret)}) throws -> ${ret} { 285 | enterScope() 286 | defer { leaveScope() } 287 | return try eval(sv: newSV(string, mortal: true), flags: context.rawValue) 288 | } 289 | 290 | /// Tells Perl to "eval" the string. 291 | public func eval${fqGeneric(ret)}(_ string: PerlScalar, context: ${contextType(context, ret)}) throws -> ${ret} { 292 | enterScope() 293 | defer { leaveScope() } 294 | return try string.withUnsafeSvContext { try eval(sv: $0.sv, flags: context.rawValue) } 295 | } 296 | % end 297 | % end 298 | } 299 | -------------------------------------------------------------------------------- /Sources/Perl/Embed.swift: -------------------------------------------------------------------------------- 1 | import CPerl 2 | #if os(Linux) || os(FreeBSD) || os(PS4) || os(Android) || CYGWIN 3 | import func Glibc.atexit 4 | #elseif os(macOS) || os(iOS) || os(watchOS) || os(tvOS) 5 | import func Darwin.atexit 6 | #endif 7 | 8 | private var perlInitialized: Bool = { 9 | PerlInterpreter.sysInit() 10 | atexit { PerlInterpreter.sysTerm() } 11 | return true 12 | }() 13 | 14 | extension PerlInterpreter { 15 | static func sysInit() { 16 | var argc = CommandLine.argc 17 | var argv = CommandLine.unsafeArgv 18 | var env = environ! 19 | PERL_SYS_INIT3(&argc, &argv, &env) 20 | } 21 | 22 | static func sysTerm() { 23 | PERL_SYS_TERM() 24 | } 25 | 26 | /// Creates a new embedded Perl interpreter. 27 | public static func new() -> PerlInterpreter { 28 | _ = perlInitialized 29 | let perl = PerlInterpreter(Pointee.alloc()!) 30 | perl.pointee.construct() 31 | perl.embed() 32 | return perl 33 | } 34 | 35 | /// Shuts down the Perl interpreter. 36 | public func destroy() { 37 | pointee.destruct() 38 | pointee.free() 39 | } 40 | 41 | func embed() { 42 | pointee.Iorigalen = 1 43 | pointee.Iperl_destruct_level = 2 44 | pointee.Iexit_flags |= UInt8(PERL_EXIT_DESTRUCT_END) 45 | let args: StaticString = "\0-e\00\0" 46 | args.withUTF8Buffer { 47 | $0.baseAddress!.withMemoryRebound(to: CChar.self, capacity: $0.count) { 48 | let start = UnsafeMutablePointer(mutating: $0) 49 | var cargs: [UnsafeMutablePointer?] = [start, start + 1, start + 4] 50 | let status = cargs.withUnsafeMutableBufferPointer { 51 | pointee.parse(xs_init, Int32($0.count), $0.baseAddress, nil) 52 | } 53 | assert(status == 0) 54 | } 55 | } 56 | } 57 | } 58 | -------------------------------------------------------------------------------- /Sources/Perl/Error.swift: -------------------------------------------------------------------------------- 1 | /// Enumeration of the possible errors. 2 | public enum PerlError : Error { 3 | /// A `die` occurred in Perl. Text of the error or a SV die was called with 4 | /// will be in an associated value. 5 | case died(_: PerlScalar) 6 | 7 | /// A stack count is lower then an `at`. 8 | case noArgumentOnStack(at: Int) 9 | 10 | /// An undefined value was received in place not supposed to. 11 | case unexpectedUndef(_: AnyPerl) 12 | 13 | /// SV of an unexpected type was recevied. 14 | case unexpectedValueType(_: AnyPerl, want: PerlValue.Type) 15 | 16 | /// SV is not a number (integer or double) of appropriate range. 17 | case notNumber(_: AnyPerl, want: Any.Type) 18 | 19 | /// SV is not a string or a number (integer or double). 20 | case notStringOrNumber(_: AnyPerl) 21 | 22 | /// SV is not a reference. 23 | case notReference(_: AnyPerl) 24 | 25 | /// SV is not an object, but we suppose it to be. 26 | case notObject(_: AnyPerl) 27 | 28 | /// SV is not a wrapped Swift object, but we suppose it to be. 29 | case notSwiftObject(_: AnyPerl) 30 | 31 | /// SV bridges to an object of an unexpected type. 32 | case unexpectedObjectType(_: AnyPerl, want: AnyPerl.Type) 33 | 34 | /// Element with the index `at` not exists in the array. 35 | case elementNotExists(_: PerlArray, at: Int) 36 | 37 | /// Odd number of elements in hash assignment. 38 | case oddElementsHash 39 | } 40 | -------------------------------------------------------------------------------- /Sources/Perl/Hash.swift: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | /// Provides a safe wrapper for Perl hash (`HV`). 4 | /// Performs reference counting on initialization and deinitialization. 5 | /// 6 | /// ## Cheat Sheet 7 | /// 8 | /// ### Creating of a hash 9 | /// 10 | /// ```perl 11 | /// my %hash = ( 12 | /// id => 42, 13 | /// name => "Иван", 14 | /// aliases => ["Ваня", "John"], 15 | /// ); 16 | /// ``` 17 | /// 18 | /// ```swift 19 | /// let hash: PerlHash = [ 20 | /// "id": 42, 21 | /// "name": "Иван", 22 | /// "aliases": ["Ваня", "John"], 23 | /// ] 24 | /// ``` 25 | /// 26 | /// ### Accessing a hash 27 | /// 28 | /// ```perl 29 | /// $hash{age} = 10; 30 | /// my $age = $hash{age}; 31 | /// delete $hash{age}; 32 | /// my $has_age = exists $hash{age}; 33 | /// $hash{age} = undef; 34 | /// ``` 35 | /// 36 | /// ```swift 37 | /// hash["age"] = 10 38 | /// let age = hash["age"] ?? PerlScalar() 39 | /// hash["age"] = nil 40 | /// let hasAge = hash["age"] != nil 41 | /// hash["age"] = PerlScalar() 42 | /// ``` 43 | /// 44 | /// The difference between Perl and Swift hash element access APIs is the result of 45 | /// Swiftification. It was done to make subscript behavior match behavior of 46 | /// subscripts in `Dictionary`. So, when a key does not exist subscript returns 47 | /// `nil` not an undefined SV as a Perl programmer could expect. 48 | public final class PerlHash : PerlValue { 49 | convenience init(noinc hvc: UnsafeHvContext) { 50 | self.init(noincUnchecked: UnsafeSvContext(rebind: hvc)) 51 | } 52 | 53 | convenience init(inc hvc: UnsafeHvContext) { 54 | self.init(incUnchecked: UnsafeSvContext(rebind: hvc)) 55 | } 56 | 57 | required convenience init(noinc svc: UnsafeSvContext) throws { 58 | guard svc.type == SVt_PVHV else { 59 | throw PerlError.unexpectedValueType(fromUnsafeSvContext(noinc: svc), want: PerlHash.self) 60 | } 61 | self.init(noincUnchecked: svc) 62 | } 63 | 64 | /// Creates an empty Perl hash. 65 | public convenience init() { 66 | self.init(perl: .current) 67 | } 68 | 69 | /// Creates an empty Perl hash. 70 | public convenience init(perl: PerlInterpreter = .current) { 71 | self.init(noinc: UnsafeHvContext.new(perl: perl)) 72 | } 73 | 74 | /// Initializes a new Perl hash with elements of dictionary `dict`, 75 | /// recursively converting them to Perl scalars. 76 | /// 77 | /// Values can be simple scalars: 78 | /// 79 | /// ```swift 80 | /// let dict = ["one": 1, "two": 2, "three": 3] 81 | /// let hv = PerlHash(dict) // my %hv = (one => 1, two => 2, three => 3); 82 | /// ``` 83 | /// 84 | /// More then that arrays, dictionaries, references and objects are also possible: 85 | /// 86 | /// ```swift 87 | /// let dict = ["odd": [1, 3], "even": [2, 4]] 88 | /// let hv = PerlHash(dict) // my %hv = (odd => [1, 3], even => [2, 4]); 89 | /// ``` 90 | /// 91 | /// - Parameter dict: a dictionary with `String` keys and values 92 | /// convertible to Perl scalars (conforming to `PerlScalarConvertible`). 93 | public convenience init(_ dict: [String: T]) { 94 | self.init() 95 | for (k, v) in dict { 96 | self[k] = v as? PerlScalar ?? PerlScalar(v) 97 | } 98 | } 99 | 100 | /// Short form of `init(dereferencing:)`. 101 | public convenience init(_ ref: PerlScalar) throws { 102 | try self.init(dereferencing: ref) 103 | } 104 | 105 | /// Returns the specified Perl global or package hash with the given name (so it won't work on lexical variables). 106 | /// If the variable does not exist then `nil` is returned. 107 | public convenience init?(get name: String, perl: PerlInterpreter = .current) { 108 | guard let hv = perl.getHV(name) else { return nil } 109 | self.init(inc: UnsafeHvContext(hv: hv, perl: perl)) 110 | } 111 | 112 | /// Returns the specified Perl global or package hash with the given name (so it won't work on lexical variables). 113 | /// If the variable does not exist then it will be created. 114 | public convenience init(getCreating name: String, perl: PerlInterpreter = .current) { 115 | let hv = perl.getHV(name, flags: GV_ADD)! 116 | self.init(inc: UnsafeHvContext(hv: hv, perl: perl)) 117 | } 118 | 119 | func withUnsafeHvContext(_ body: (UnsafeHvContext) throws -> R) rethrows -> R { 120 | defer { _fixLifetime(self) } 121 | return try unsafeSvContext.sv.withMemoryRebound(to: HV.self, capacity: 1) { 122 | return try body(UnsafeHvContext(hv: $0, perl: unsafeSvContext.perl)) 123 | } 124 | } 125 | 126 | /// A textual representation of the HV, suitable for debugging. 127 | public override var debugDescription: String { 128 | let values = map { "\($0.key.debugDescription): \($0.value.debugDescription)" } .joined(separator: ", ") 129 | return "PerlHash([\(values)])" 130 | } 131 | } 132 | 133 | extension PerlHash { 134 | /// Fetches the value associated with the given key. 135 | /// 136 | /// - Parameter key: The key to find in the hash. 137 | /// - Returns: The value associated with `key` if `key` is in the hash; 138 | /// otherwise, `nil`. 139 | public func fetch(_ key: String) throws -> T? { 140 | return try withUnsafeHvContext { c in 141 | try c.fetch(key).flatMap { try T?(_fromUnsafeSvContextInc: $0) } 142 | } 143 | } 144 | 145 | /// Stores the value in the hash for the given key. 146 | /// 147 | /// - Parameter key: The key to associate with `value`. 148 | /// - Parameter value: The value to store in the hash. 149 | public func store(key: String, value: T) { 150 | withUnsafeHvContext { c in 151 | c.store(key, value: value._toUnsafeSvPointer(perl: c.perl)) 152 | } 153 | } 154 | 155 | /// Deletes the given key and its associated value from the hash. 156 | /// 157 | /// - Parameter key: The key to remove along with its associated value. 158 | /// - Returns: The value that was removed, or `nil` if the key was not found in the hash. 159 | public func delete(_ key: String) throws -> T? { 160 | return try withUnsafeHvContext { c in 161 | try c.delete(key).flatMap { try T?(_fromUnsafeSvContextInc: $0) } 162 | } 163 | } 164 | 165 | /// Deletes the given key and its associated value from the hash. 166 | public func delete(_ key: String) { 167 | withUnsafeHvContext { $0.delete(discarding: key) } 168 | } 169 | 170 | /// Returns a boolean indicating whether the specified hash key exists. 171 | public func exists(_ key: String) -> Bool { 172 | return withUnsafeHvContext { $0.exists(key) } 173 | } 174 | 175 | /// Fetches the value associated with the given key. 176 | /// 177 | /// - Parameter key: The key to find in the hash. 178 | /// - Returns: The value associated with `key` if `key` is in the hash; 179 | /// otherwise, `nil`. 180 | public func fetch(_ key: PerlScalar) throws -> T? { 181 | return try withUnsafeHvContext { c in 182 | try key.withUnsafeSvContext { 183 | try c.fetch($0.sv).flatMap { try T?(_fromUnsafeSvContextInc: $0) } 184 | } 185 | } 186 | } 187 | 188 | /// Stores the value in the hash for the given key. 189 | /// 190 | /// - Parameter key: The key to associate with `value`. 191 | /// - Parameter value: The value to store in the hash. 192 | public func store(key: PerlScalar, value: T) { 193 | withUnsafeHvContext { c in 194 | key.withUnsafeSvContext { 195 | c.store($0.sv, value: value._toUnsafeSvPointer(perl: c.perl)) 196 | } 197 | } 198 | } 199 | 200 | /// Deletes the given key and its associated value from the hash. 201 | /// 202 | /// - Parameter key: The key to remove along with its associated value. 203 | /// - Returns: The value that was removed, or `nil` if the key was not found in the hash. 204 | public func delete(_ key: PerlScalar) throws -> T? { 205 | return try withUnsafeHvContext { c in 206 | try key.withUnsafeSvContext { 207 | try c.delete($0.sv).flatMap { try T?(_fromUnsafeSvContextInc: $0) } 208 | } 209 | } 210 | } 211 | 212 | /// Deletes the given key and its associated value from the hash. 213 | public func delete(_ key: PerlScalar) { 214 | withUnsafeHvContext { c in key.withUnsafeSvContext { c.delete(discarding: $0.sv) } } 215 | } 216 | 217 | /// Returns a boolean indicating whether the specified hash key exists. 218 | public func exists(_ key: PerlScalar) -> Bool { 219 | return withUnsafeHvContext { c in key.withUnsafeSvContext { c.exists($0.sv) } } 220 | } 221 | 222 | /// Frees the all the elements of a hash, leaving it empty. 223 | public func clear() { 224 | withUnsafeHvContext { $0.clear() } 225 | } 226 | } 227 | 228 | extension PerlHash: Sequence, IteratorProtocol { 229 | public typealias Key = String 230 | public typealias Value = PerlScalar 231 | public typealias Element = (key: Key, value: Value) 232 | 233 | /// Returns an iterator over the elements of this hash. 234 | /// 235 | /// `PerlHash` conforms to `IteratorProtocol` itself. So a returned value 236 | /// is always `self`. Behind the scenes it calls Perl macro `hv_iterinit` 237 | /// and prepares a starting point to traverse the hash table. 238 | /// 239 | /// - Returns: `self` 240 | /// - Attention: Only one iterator is possible at any time. 241 | /// - SeeAlso: `Sequence` 242 | public func makeIterator() -> PerlHash { 243 | withUnsafeHvContext { _ = $0.makeIterator() } 244 | return self 245 | } 246 | 247 | /// Advances to the next element and returns it, or `nil` if no next element 248 | /// exists. 249 | /// 250 | /// Once `nil` has been returned, all subsequent calls return `nil`. 251 | /// 252 | /// - SeeAlso: `IteratorProtocol` 253 | public func next() -> Element? { 254 | return withUnsafeHvContext { 255 | guard let u = $0.next() else { return nil } 256 | return (key: u.key, value: try! PerlScalar(inc: u.value)) 257 | } 258 | } 259 | 260 | /// Accesses the value associated with the given key for reading and writing. 261 | /// 262 | /// This *key-based* subscript returns the value for the given key if the key 263 | /// is found in the hash, or `nil` if the key is not found. 264 | /// 265 | /// When you assign a value for a key and that key already exists, the 266 | /// hash overwrites the existing value. If the hash doesn't 267 | /// contain the key, the key and value are added as a new key-value pair. 268 | /// 269 | /// If you assign `nil` as the value for the given key, the hash 270 | /// removes that key and its associated value. 271 | /// 272 | /// - Parameter key: The key to find in the hash. 273 | /// - Returns: The value associated with `key` if `key` is in the hash; 274 | /// otherwise, `nil`. 275 | /// 276 | /// - SeeAlso: `Dictionary` 277 | public subscript(key: Key) -> PerlScalar? { 278 | get { 279 | return withUnsafeHvContext { 280 | guard let svc = $0.fetch(key) else { return nil } 281 | return try! PerlScalar(inc: svc) 282 | } 283 | } 284 | set { 285 | withUnsafeHvContext { c in 286 | if let value = newValue { 287 | value.withUnsafeSvContext { 288 | $0.refcntInc() 289 | c.store(key, value: $0.sv) 290 | } 291 | } else { 292 | c.delete(discarding: key) 293 | } 294 | } 295 | } 296 | } 297 | 298 | /// Accesses the value associated with the given key for reading and writing. 299 | /// 300 | /// This *key-based* subscript returns the value for the given key if the key 301 | /// is found in the hash, or `nil` if the key is not found. 302 | /// 303 | /// When you assign a value for a key and that key already exists, the 304 | /// hash overwrites the existing value. If the hash doesn't 305 | /// contain the key, the key and value are added as a new key-value pair. 306 | /// 307 | /// If you assign `nil` as the value for the given key, the hash 308 | /// removes that key and its associated value. 309 | /// 310 | /// - Parameter key: The key to find in the hash. 311 | /// - Returns: The value associated with `key` if `key` is in the hash; 312 | /// otherwise, `nil`. 313 | /// 314 | /// - SeeAlso: `Dictionary` 315 | public subscript(key: PerlScalar) -> PerlScalar? { 316 | get { 317 | return withUnsafeHvContext { c in 318 | guard let svc = key.withUnsafeSvContext({ c.fetch($0.sv) }) else { return nil } 319 | return try! PerlScalar(inc: svc) 320 | } 321 | } 322 | set { 323 | withUnsafeHvContext { c in 324 | key.withUnsafeSvContext { key in 325 | if let value = newValue { 326 | value.withUnsafeSvContext { 327 | $0.refcntInc() 328 | c.store(key.sv, value: $0.sv) 329 | } 330 | } else { 331 | c.delete(discarding: key.sv) 332 | } 333 | } 334 | } 335 | } 336 | } 337 | } 338 | 339 | extension PerlHash { 340 | /// Creates a Perl hash from a Swift dictionary. 341 | public convenience init(_ dict: [Key: Value]) { 342 | self.init() 343 | for (k, v) in dict { 344 | self[k] = v 345 | } 346 | } 347 | 348 | /// Creates a Perl hash from a Swift array of key/value tuples. 349 | public convenience init(_ elements: [(Key, Value)]) { 350 | self.init() 351 | for (k, v) in elements { 352 | self[k] = v 353 | } 354 | } 355 | } 356 | 357 | extension PerlHash : ExpressibleByDictionaryLiteral { 358 | /// Creates a Perl hash initialized with a dictionary literal. 359 | /// 360 | /// Do not call this initializer directly. It is called by the compiler to 361 | /// handle dictionary literals. To use a dictionary literal as the initial 362 | /// value of a hash, enclose a comma-separated list of key-value pairs 363 | /// in square brackets. For example: 364 | /// 365 | /// ```swift 366 | /// let header: PerlHash = [ 367 | /// "Content-Length": 320, 368 | /// "Content-Type": "application/json" 369 | /// ] 370 | /// ``` 371 | /// 372 | /// - Parameter elements: The key-value pairs that will make up the new 373 | /// dictionary. Each key in `elements` must be unique. 374 | /// 375 | /// - SeeAlso: `ExpressibleByDictionaryLiteral` 376 | public convenience init(dictionaryLiteral elements: (Key, Value)...) { 377 | self.init(elements) 378 | } 379 | } 380 | 381 | // where Key == String, but it is unsupported 382 | extension Dictionary where Value : PerlScalarConvertible { 383 | /// Creates a dictionary from the Perl hash. 384 | /// 385 | /// - Parameter hv: The Perl hash with the values compatible with `Value`. 386 | /// - Throws: If some of the values cannot be converted to `Value`. 387 | /// 388 | /// - Complexity: O(*n*), where *n* is the count of the hash. 389 | public init(_ hv: PerlHash) throws { 390 | self.init() 391 | try hv.withUnsafeHvContext { hvc in 392 | for (k, v) in hvc { 393 | self[k as! Key] = try Value(_fromUnsafeSvContextInc: v) 394 | } 395 | } 396 | } 397 | 398 | /// Creates a dictionary from the reference to the Perl hash. 399 | /// 400 | /// - Parameter ref: The reference to the Perl hash with the values 401 | /// compatible with `Value`. 402 | /// - Throws: If `ref` is not a reference to a Perl hash or 403 | /// some of the values cannot be converted to `Value`. 404 | /// 405 | /// - Complexity: O(*n*), where *n* is the count of the hash. 406 | public init(_ ref: PerlScalar) throws { 407 | self.init() 408 | try ref.withUnsafeSvContext { 409 | guard let svc = $0.referent else { 410 | throw PerlError.notReference(fromUnsafeSvContext(inc: $0)) 411 | } 412 | try svc.withUnsafeHvContext { hvc in 413 | for (k, v) in hvc { 414 | self[k as! Key] = try Value(_fromUnsafeSvContextInc: v) 415 | } 416 | } 417 | } 418 | } 419 | } 420 | -------------------------------------------------------------------------------- /Sources/Perl/Interpreter.swift: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | /// A Perl interpreter. 4 | /// 5 | /// This type hides a pointer to the underlying C Perl interpreter and 6 | /// provides a clean Swifty interface to it. 7 | /// It doesn't provide any guarantees about a Perl interpreter 8 | /// instance aliveness and should be used only while they are provided 9 | /// by outer conditions. 10 | /// Generally it is not a problem because a Perl interpreter is only 11 | /// created once on startup and destroyed on shutdown of a process. 12 | /// In the case of an XS module an interpreter aliveness is guaranteed 13 | /// during the scope of an XSUB call. 14 | /// 15 | /// ## Embedding a Perl interpreter 16 | /// 17 | /// ```swift 18 | /// let perl = PerlInterpreter.new() 19 | /// try perl.eval("print qq/OK\\n/") // Do something interesting with Perl 20 | /// perl.destroy() 21 | /// ``` 22 | /// 23 | /// ## Writting an XS module 24 | /// 25 | /// ```swift 26 | /// @_cdecl("boot_Your__Module__Name") 27 | /// public func boot(_ perl: PerlInterpreter.Pointer) { 28 | /// let perl = PerlInterpreter(perl) 29 | /// // Create XSUBs 30 | /// PerlSub(name: "test", perl: perl) { () -> Void in 31 | /// print("OK") 32 | /// } 33 | /// } 34 | /// ``` 35 | public struct PerlInterpreter { 36 | typealias Pointee = CPerl.PerlInterpreter 37 | 38 | /// A type of the pointer to the underlying C `PerlInterpreter`. 39 | public typealias Pointer = UnsafeMutablePointer 40 | 41 | /// A pointer to the underlying C `PerlInterpreter` structure. 42 | public let pointer: Pointer 43 | 44 | var pointee: Pointee { 45 | unsafeAddress { 46 | return UnsafePointer(pointer) 47 | } 48 | nonmutating unsafeMutableAddress { 49 | return pointer 50 | } 51 | } 52 | 53 | /// Wrap a pointer to the C `PerlInterpreter` structure. 54 | public init(_ pointer: Pointer) { 55 | self.pointer = pointer 56 | } 57 | 58 | /// A Perl interpreter stored in the thread local storage. 59 | public static var current: PerlInterpreter { 60 | get { return PerlInterpreter(PERL_GET_THX()) } 61 | set { PERL_SET_THX(newValue.pointer) } 62 | } 63 | 64 | /// The main Perl interpreter of the process. 65 | public static var main: PerlInterpreter { 66 | get { return PerlInterpreter(PERL_GET_INTERP()) } 67 | set { PERL_SET_INTERP(newValue.pointer) } 68 | } 69 | 70 | var error: UnsafeSvContext { 71 | return UnsafeSvContext(sv: pointee.ERRSV, perl: self) 72 | } 73 | 74 | /// Loads the module by name. 75 | /// It is analogous to Perl code `eval "require $module"` and even implemented that way. 76 | public func require(_ module: String) throws { 77 | try eval("require \(module)") 78 | } 79 | 80 | /// Loads the module by its file name. 81 | /// It is analogous to Perl code `eval "require '$file'"` and even implemented that way. 82 | public func require(file: String) throws { 83 | try eval("require q\0\(file)\0") 84 | } 85 | 86 | func getSV(_ name: String, flags: Int32 = 0) -> UnsafeSvPointer? { 87 | return pointee.get_sv(name, SVf_UTF8|flags) 88 | } 89 | 90 | func getAV(_ name: String, flags: Int32 = 0) -> UnsafeAvPointer? { 91 | return pointee.get_av(name, SVf_UTF8|flags) 92 | } 93 | 94 | func getHV(_ name: String, flags: Int32 = 0) -> UnsafeHvPointer? { 95 | return pointee.get_hv(name, SVf_UTF8|flags) 96 | } 97 | 98 | func getCV(_ name: String, flags: Int32 = 0) -> UnsafeCvPointer? { 99 | return pointee.get_cv(name, SVf_UTF8|flags) 100 | } 101 | } 102 | -------------------------------------------------------------------------------- /Sources/Perl/Object.swift: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | /// Provides a safe wrapper for Perl objects (blessed references). 4 | /// Performs reference counting on initialization and deinitialization. 5 | /// 6 | /// Any Perl object of unregistered type will be imported to Swift 7 | /// as an instance of this class. To provide clean API to your 8 | /// Perl object implement class derived from `PerlObject`, make it 9 | /// conforming to `PerlNamedClass` and supply it with methods and 10 | /// calculated attributes providing access to Perl methods of your 11 | /// object. Use `register` method on startup to enable automatical 12 | /// conversion of Perl objects of class `perlClassName` to instances 13 | /// of your Swift class. 14 | /// 15 | /// For example: 16 | /// 17 | /// ```swift 18 | /// final class URI : PerlObject, PerlNamedClass { 19 | /// static let perlClassName = "URI" 20 | /// 21 | /// convenience init(_ str: String) throws { 22 | /// try self.init(method: "new", args: [str]) 23 | /// } 24 | /// 25 | /// convenience init(_ str: String, scheme: String) throws { 26 | /// try self.init(method: "new", args: [str, scheme]) 27 | /// } 28 | /// 29 | /// convenience init(copyOf uri: URI) { 30 | /// try! self.init(uri.call(method: "clone") as PerlScalar) 31 | /// } 32 | /// 33 | /// var scheme: String? { return try! call(method: "scheme") } 34 | /// func scheme(_ scheme: String) throws -> String? { return try call(method: "scheme", scheme) } 35 | /// 36 | /// var path: String { 37 | /// get { return try! call(method: "path") } 38 | /// set { try! call(method: "path", newValue) as Void } 39 | /// } 40 | /// 41 | /// var asString: String { return try! call(method: "as_string") } 42 | /// 43 | /// func abs(base: String) -> String { return try! call(method: "abs", base) } 44 | /// func rel(base: String) -> String { return try! call(method: "rel", base) } 45 | /// 46 | /// var secure: Bool { return try! call(method: "secure") } 47 | /// } 48 | /// ``` 49 | open class PerlObject : PerlValue, PerlScalarConvertible { 50 | public required convenience init(noinc svc: UnsafeSvContext) throws { 51 | guard svc.isObject else { 52 | throw PerlError.notObject(fromUnsafeSvContext(noinc: svc)) 53 | } 54 | if let named = Swift.type(of: self) as? PerlNamedClass.Type { 55 | guard svc.isDerived(from: named.perlClassName) else { 56 | throw PerlError.unexpectedObjectType(fromUnsafeSvContext(noinc: svc), want: Swift.type(of: self)) 57 | } 58 | } 59 | self.init(noincUnchecked: svc) 60 | } 61 | 62 | /// Creates a new object by calling its Perl constructor. 63 | /// 64 | /// Use this `init` only to construct instances of 65 | /// subclasses conforming to `PerlNamedClass`. 66 | /// 67 | /// The recomended way is to wrap this constructor 68 | /// invocations by implementing more concrete initializers 69 | /// which hide Perl method calling magic behind. 70 | /// 71 | /// Let's imagine a class: 72 | /// 73 | /// ```swift 74 | /// final class URI : PerlObject, PerlNamedClass { 75 | /// static let perlClassName = "URI" 76 | /// 77 | /// convenience init(_ str: String) throws { 78 | /// try self.init(method: "new", args: [str]) 79 | /// } 80 | /// } 81 | /// ``` 82 | /// 83 | /// Then Swift expression: 84 | /// 85 | /// ```swift 86 | /// let uri = URI("https://my.mail.ru/music") 87 | /// ``` 88 | /// 89 | /// will be equal to Perl: 90 | /// 91 | /// ```perl 92 | /// my $uri = URI->new("https://my.mail.ru/music") 93 | /// ``` 94 | /// 95 | /// - Parameter method: A name of the constuctor. Usually it is *new*. 96 | /// - Parameter args: Arguments to pass to the constructor. 97 | /// - Parameter perl: The Perl interpreter. 98 | public convenience init(method: String, args: [PerlScalarConvertible?], perl: PerlInterpreter = .current) throws { 99 | guard let named = Swift.type(of: self) as? PerlNamedClass.Type else { 100 | fatalError("PerlObject.init(method:args:perl) is only supported for subclasses conforming to PerlNamedClass") 101 | } 102 | perl.enterScope() 103 | defer { perl.leaveScope() } 104 | let classname = named.perlClassName 105 | let args = [classname as PerlScalarConvertible?] + args 106 | let svArgs: [UnsafeSvPointer] = args.map { $0?._toUnsafeSvPointer(perl: perl) ?? perl.pointee.newSV(0) } 107 | let sv = try perl.unsafeCall(sv: perl.newSV(method, mortal: true), args: svArgs, flags: G_METHOD|G_SCALAR)[0] 108 | let svc = UnsafeSvContext(sv: sv, perl: perl) 109 | guard svc.isObject else { 110 | throw PerlError.notObject(fromUnsafeSvContext(inc: svc)) 111 | } 112 | guard svc.isDerived(from: classname) else { 113 | throw PerlError.unexpectedObjectType(fromUnsafeSvContext(inc: svc), want: Swift.type(of: self)) 114 | } 115 | self.init(incUnchecked: svc) 116 | } 117 | 118 | /// Casts an instance of `PerlScalar` to `PerlObject`. 119 | /// 120 | /// - Throws: If underlying SV is not an object. 121 | public convenience init(_ scalar: PerlScalar) throws { 122 | defer { _fixLifetime(scalar) } 123 | try self.init(inc: scalar.unsafeSvContext) 124 | } 125 | 126 | /// Returns the specified Perl global or package object with the given name (so it won't work on lexical variables). 127 | /// If the variable does not exist then `nil` is returned. 128 | public convenience init?(get name: String, perl: PerlInterpreter = .current) throws { 129 | guard let sv = perl.getSV(name) else { return nil } 130 | try self.init(inc: UnsafeSvContext(sv: sv, perl: perl)) 131 | } 132 | 133 | var perlClassName: String { 134 | defer { _fixLifetime(self) } 135 | return unsafeSvContext.classname! 136 | } 137 | 138 | var referent: AnyPerl { 139 | defer { _fixLifetime(self) } 140 | return fromUnsafeSvContext(inc: unsafeSvContext.referent!) 141 | } 142 | 143 | /// A textual representation of the SV, suitable for debugging. 144 | public override var debugDescription: String { 145 | var rvDesc = "" 146 | debugPrint(referent, terminator: "", to: &rvDesc) 147 | return "\(Swift.type(of: self))(\(perlClassName), rv=\(rvDesc))" 148 | } 149 | 150 | static func derivedClass(for classname: String) -> PerlObject.Type { 151 | return classMapping[classname] ?? PerlObject.self 152 | } 153 | 154 | static var classMapping = [String: PerlObject.Type ]() 155 | 156 | /// Registers class `swiftClass` as a counterpart of Perl's class with name `classname`. 157 | public static func register(_ swiftClass: T.Type, as classname: String) where T : PerlObject, T : PerlNamedClass { 158 | classMapping[classname] = swiftClass 159 | } 160 | 161 | private convenience init(_fromUnsafeSvContextNoinc svc: UnsafeSvContext) throws { 162 | guard let classname = svc.classname else { 163 | throw PerlError.notObject(Perl.fromUnsafeSvContext(noinc: svc)) 164 | } 165 | if let nc = Swift.type(of: self) as? PerlNamedClass.Type, nc.perlClassName == classname { 166 | self.init(noincUnchecked: svc) 167 | } else { 168 | let derivedClass = PerlObject.derivedClass(for: classname) 169 | if derivedClass == Swift.type(of: self) { 170 | self.init(noincUnchecked: svc) 171 | } else { 172 | guard isStrictSubclass(derivedClass, of: Swift.type(of: self)) else { 173 | throw PerlError.unexpectedObjectType(Perl.fromUnsafeSvContext(noinc: svc), want: Swift.type(of: self)) 174 | } 175 | self.init(as: derivedClass, noinc: svc) 176 | } 177 | } 178 | } 179 | 180 | public required convenience init(_fromUnsafeSvContextInc svc: UnsafeSvContext) throws { 181 | svc.refcntInc() 182 | try self.init(_fromUnsafeSvContextNoinc: svc) 183 | } 184 | 185 | public required convenience init(_fromUnsafeSvContextCopy svc: UnsafeSvContext) throws { 186 | try self.init(_fromUnsafeSvContextNoinc: UnsafeSvContext.new(stealingCopy: svc)) 187 | } 188 | 189 | public func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { 190 | defer { _fixLifetime(self) } 191 | return unsafeSvContext.refcntInc() 192 | } 193 | } 194 | 195 | // Dirty hack to initialize instance of another class (subclass). 196 | extension PerlScalarConvertible where Self : PerlObject { 197 | init(as derivedClass: PerlObject.Type, noinc svc: UnsafeSvContext) { 198 | self = derivedClass.init(noincUnchecked: svc) as! Self 199 | } 200 | } 201 | 202 | /// A Swift class which instances can be passed to Perl as a blessed SV. 203 | /// 204 | /// Implementing an object that conforms to `PerlBridgedObject` is simple. 205 | /// Declare a `static var perlClassName` that contains a name of the Perl class 206 | /// your Swift class should be bridged to. Use `addPerlMethod` method on 207 | /// startup to provide ability to access your methods and attributes from Perl. 208 | public protocol PerlBridgedObject : AnyPerl, PerlNamedClass, PerlScalarConvertible {} 209 | 210 | /// A class having Perl representation. 211 | public protocol PerlNamedClass : class { 212 | /// A name of the class in Perl. 213 | static var perlClassName: String { get } 214 | } 215 | 216 | extension PerlNamedClass { 217 | /// Loads the module which name is in `perlClassName` attribute. 218 | public static func require(perl: PerlInterpreter = .current) throws { 219 | try perl.require(perlClassName) 220 | } 221 | } 222 | 223 | extension PerlNamedClass where Self : PerlObject { 224 | /// Registers this class as a counterpart of Perl class which name is provided in `perlClassName`. 225 | public static func register() { 226 | PerlObject.register(self, as: (self as PerlNamedClass.Type).perlClassName) 227 | } 228 | 229 | /// Assuming that the Perl class is in the module with the same name, loads it and registers. 230 | public static func initialize(perl: PerlInterpreter = .current) throws { 231 | try require(perl: perl) 232 | register() 233 | } 234 | } 235 | -------------------------------------------------------------------------------- /Sources/Perl/Scalar.swift: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | /// Provides a safe wrapper for Perl scalar (`SV`). 4 | /// Performs reference counting on initialization and deinitialization. 5 | /// 6 | /// Can contain any scalar SV with `SvTYPE(sv) < SVt_PVAV` such as: 7 | /// undefined values, integers (`IV`), numbers (`NV`), strings (`PV`), 8 | /// references (`RV`), objects and others. 9 | /// Objects as exception have their own type `PerlObject` which 10 | /// provides more specific methods to work with them. Nevertheless 11 | /// objects are compatible with and can be represented as `PerlScalar`. 12 | /// 13 | /// ## Cheat Sheet 14 | /// 15 | /// ### Creation of various scalars 16 | /// 17 | /// ```perl 18 | /// my $int = 10; 19 | /// my $str = "Строченька"; 20 | /// my $intref = \10; 21 | /// my $arrayref = [200, "OK"]; 22 | /// my $hashref = { type => "string", value => 10 }; 23 | /// ``` 24 | /// 25 | /// ```swift 26 | /// let int: PerlScalar = 10 27 | /// let str: PerlScalar = "Строченька" 28 | /// let intref = PerlScalar(referenceTo: PerlScalar(10)) 29 | /// let arrayref: PerlScalar = [200, "OK"]; 30 | /// let hashref: PerlScalar = ["type": "string", "value": 10] 31 | /// ``` 32 | public final class PerlScalar : PerlValue { 33 | required convenience init(noinc svc: UnsafeSvContext) throws { 34 | guard svc.type.rawValue < SVt_PVAV.rawValue else { 35 | throw PerlError.unexpectedValueType(fromUnsafeSvContext(noinc: svc), want: PerlScalar.self) 36 | } 37 | self.init(noincUnchecked: svc) 38 | } 39 | 40 | convenience init(copyUnchecked svc: UnsafeSvContext) { 41 | self.init(noincUnchecked: UnsafeSvContext.new(stealingCopy: svc)) 42 | } 43 | 44 | convenience init(copy svc: UnsafeSvContext) throws { 45 | guard svc.type.rawValue < SVt_PVAV.rawValue else { 46 | throw PerlError.unexpectedValueType(fromUnsafeSvContext(inc: svc), want: PerlScalar.self) 47 | } 48 | self.init(copyUnchecked: svc) 49 | } 50 | 51 | /// Creates a `SV` containing an undefined value. 52 | public convenience init() { 53 | self.init(perl: .current) 54 | } 55 | 56 | /// Creates a `SV` containing an undefined value. 57 | public convenience init(perl: PerlInterpreter = .current) { 58 | self.init(noincUnchecked: UnsafeSvContext.new(perl: perl)) 59 | } 60 | 61 | /// Creates a `SV` containig a `v`. 62 | public convenience init(_ v: T, perl: PerlInterpreter = .current) { 63 | self.init(noincUnchecked: UnsafeSvContext(sv: v._toUnsafeSvPointer(perl: perl), perl: perl)) 64 | } 65 | 66 | /// Semantics of a Perl string data. 67 | public enum StringUnits { 68 | /// A string contains bytes (octets) and interpreted as a binary buffer. 69 | case bytes 70 | /// A string contains characters and interpreted as a text. 71 | case characters 72 | } 73 | 74 | /// Creates a Perl string containing a copy of bytes or characters from `v`. 75 | public convenience init(_ v: UnsafeRawBufferPointer, containing: StringUnits = .bytes, perl: PerlInterpreter = .current) { 76 | self.init(noincUnchecked: UnsafeSvContext.new(v, utf8: containing == .characters, perl: perl)) 77 | } 78 | 79 | /// Creates a new SV which is an exact duplicate of the original SV. 80 | public convenience init(copy scalar: PerlScalar) { 81 | self.init(noincUnchecked: UnsafeSvContext.new(copy: scalar.unsafeSvContext)) 82 | _fixLifetime(scalar) 83 | } 84 | 85 | /// Creates a new reference pointing to `value`. 86 | public convenience init(referenceTo value: T) { 87 | self.init(noincUnchecked: UnsafeSvContext.new(rvInc: value.unsafeSvContext)) 88 | _fixLifetime(value) 89 | } 90 | 91 | /// Short form of `init(referenceTo:)`. 92 | public convenience init(_ value: PerlArray) { 93 | self.init(referenceTo: value) 94 | } 95 | 96 | /// Short form of `init(referenceTo:)`. 97 | public convenience init(_ value: PerlHash) { 98 | self.init(referenceTo: value) 99 | } 100 | 101 | /// Short form of `init(referenceTo:)`. 102 | public convenience init(_ value: PerlSub) { 103 | self.init(referenceTo: value) 104 | } 105 | 106 | /// Creates a `RV` pointing to a `AV` which contains `SV`s with elements of an `array`. 107 | public convenience init(_ array: [T], perl: PerlInterpreter = .current) { 108 | self.init(noincUnchecked: UnsafeSvContext(sv: array._toUnsafeSvPointer(perl: perl), perl: perl)) 109 | } 110 | 111 | /// Creates a `RV` pointing to a `HV` which contains `SV`s with elements of a `dict`. 112 | public convenience init(_ dict: [String: T], perl: PerlInterpreter = .current) { 113 | self.init(noincUnchecked: UnsafeSvContext(sv: dict._toUnsafeSvPointer(perl: perl), perl: perl)) 114 | } 115 | 116 | /// Creates a `SV` containig an unwrapped value of a `v` if `v != nil` or an `undef` in other case. 117 | public convenience init(_ v: T?, perl: PerlInterpreter = .current) { 118 | if let v = v { 119 | self.init(v, perl: perl) 120 | } else { 121 | self.init(perl: perl) 122 | } 123 | } 124 | 125 | /// Returns the specified Perl global or package scalar with the given name (so it won't work on lexical variables). 126 | /// If the variable does not exist then `nil` is returned. 127 | public convenience init?(get name: String, perl: PerlInterpreter = .current) { 128 | guard let sv = perl.getSV(name) else { return nil } 129 | self.init(incUnchecked: UnsafeSvContext(sv: sv, perl: perl)) 130 | } 131 | 132 | /// Returns the specified Perl global or package scalar with the given name (so it won't work on lexical variables). 133 | /// If the variable does not exist then it will be created. 134 | public convenience init(getCreating name: String, perl: PerlInterpreter = .current) { 135 | let sv = perl.getSV(name, flags: GV_ADD)! 136 | self.init(incUnchecked: UnsafeSvContext(sv: sv, perl: perl)) 137 | } 138 | 139 | /// A boolean value indicating whether the `SV` is defined. 140 | public var defined: Bool { 141 | return withUnsafeSvContext { $0.defined } 142 | } 143 | 144 | /// A boolean value indicating whether the `SV` contains an integer (signed or unsigned). 145 | public var isInteger: Bool { 146 | return withUnsafeSvContext { $0.isInteger } 147 | } 148 | 149 | /// A boolean value indicating whether the `SV` contains a double. 150 | public var isDouble: Bool { 151 | return withUnsafeSvContext { $0.isDouble } 152 | } 153 | 154 | /// A boolean value indicating whether the `SV` contains a character string. 155 | public var isString: Bool { 156 | return withUnsafeSvContext { $0.isString } 157 | } 158 | 159 | /// A boolean value indicating whether the `SV` is a reference. 160 | public var isReference: Bool { 161 | return withUnsafeSvContext { $0.isReference } 162 | } 163 | 164 | /// A boolean value indicating whether the `SV` is an object. 165 | public var isObject: Bool { 166 | return withUnsafeSvContext { $0.isObject } 167 | } 168 | 169 | /// Dereferences the `SV` if it is a reference. Returns `nil` if not. 170 | public var referent: AnyPerl? { 171 | return withUnsafeSvContext { 172 | guard let svc = $0.referent else { return nil } 173 | return fromUnsafeSvContext(inc: svc) 174 | } 175 | } 176 | 177 | /// Calls the closure with `UnsafeRawBufferPointer` to the string in the SV, 178 | /// or a stringified form of the SV if the SV does not contain a string. 179 | public func withUnsafeBytes(_ body: (UnsafeRawBufferPointer) throws -> R) rethrows -> R { 180 | return try withUnsafeSvContext { try $0.withUnsafeBytes(body) } 181 | } 182 | 183 | /// Evaluates the given closure when this `PerlScalar` instance is defined, 184 | /// passing `self` as a parameter. 185 | /// 186 | /// Use the `map` method with a closure that returns a nonoptional value. 187 | /// 188 | /// - Parameter transform: A closure that takes `self`. 189 | /// - Returns: The result of the given closure. If this instance is undefined, 190 | /// returns `nil`. 191 | public func map(_ transform: (PerlScalar) throws -> R) rethrows -> R? { 192 | return defined ? try transform(self) : nil 193 | } 194 | 195 | /// Evaluates the given closure when this `PerlScalar` instance is defined, 196 | /// passing `self` as a parameter. 197 | /// 198 | /// Use the `flatMap` method with a closure that returns an optional value. 199 | /// 200 | /// - Parameter transform: A closure that takes `self`. 201 | /// - Returns: The result of the given closure. If this instance is undefined, 202 | /// returns `nil`. 203 | public func flatMap(_ transform: (PerlScalar) throws -> R?) rethrows -> R? { 204 | return defined ? try transform(self) : nil 205 | } 206 | 207 | /// Performs an undef-coalescing operation, returning `self` when it is defined, 208 | /// or a default value. 209 | public static func ??(scalar: PerlScalar, defaultValue: @autoclosure () throws -> PerlScalar) rethrows -> PerlScalar { 210 | return scalar.defined ? scalar : try defaultValue() 211 | } 212 | 213 | /// Copies the contents of the source SV `value` into the destination SV `self`. 214 | /// Does not handle 'set' magic on destination SV. Calls 'get' magic on source SV. 215 | /// Loosely speaking, it performs a copy-by-value, obliterating any previous content of the destination. 216 | public func set(_ value: PerlScalar) { 217 | value.withUnsafeSvContext { s in 218 | withUnsafeSvContext { $0.set(s.sv) } 219 | } 220 | } 221 | 222 | /// Copies a boolean into `self`. 223 | /// Does not handle 'set' magic. 224 | public func set(_ value: Bool) { 225 | withUnsafeSvContext { $0.set(value) } 226 | } 227 | 228 | /// Copies a signed integer into `self`, upgrading first if necessary. 229 | /// Does not handle 'set' magic. 230 | public func set(_ value: Int) { 231 | withUnsafeSvContext { $0.set(value) } 232 | } 233 | 234 | /// Copies an unsigned integer into `self`, upgrading first if necessary. 235 | /// Does not handle 'set' magic. 236 | public func set(_ value: UInt) { 237 | withUnsafeSvContext { $0.set(value) } 238 | } 239 | 240 | /// Copies a double into `self`, upgrading first if necessary. 241 | /// Does not handle 'set' magic. 242 | public func set(_ value: Double) { 243 | withUnsafeSvContext { $0.set(value) } 244 | } 245 | 246 | /// Copies a string (possibly containing embedded `NUL` characters) into `self`. 247 | /// Does not handle 'set' magic. 248 | public func set(_ value: String) { 249 | withUnsafeSvContext { $0.set(value) } 250 | } 251 | 252 | /// Copies bytes or characters from `value` into `self`. 253 | /// Does not handle 'set' magic. 254 | public func set(_ value: UnsafeRawBufferPointer, containing: StringUnits = .bytes) { 255 | withUnsafeSvContext { $0.set(value, containing: containing) } 256 | } 257 | 258 | /// A textual representation of the SV, suitable for debugging. 259 | public override var debugDescription: String { 260 | var values = [String]() 261 | if defined { 262 | if isInteger { 263 | if withUnsafeSvContext({ SvIsUV($0.sv) }) { 264 | values.append("uv: \(UInt(unchecked: self))") 265 | } else { 266 | values.append("iv: \(Int(unchecked: self))") 267 | } 268 | } 269 | if isDouble { 270 | values.append("nv: \(Double(unchecked: self).debugDescription)") 271 | } 272 | if isString { 273 | values.append("pv: \(String(unchecked: self).debugDescription)") 274 | } 275 | if let ref = referent { 276 | var str = "rv: " 277 | debugPrint(ref, terminator: "", to: &str) 278 | values.append(str) 279 | } 280 | } else { 281 | values.append("undef") 282 | } 283 | return "PerlScalar(\(values.joined(separator: ", ")))" 284 | } 285 | } 286 | 287 | extension PerlScalar : Equatable, Hashable { 288 | /// Hashes the essential components of this value by feeding them into the 289 | /// given hasher. 290 | /// 291 | /// - Parameter hasher: The hasher to use when combining the components 292 | /// of this instance. 293 | public func hash(into hasher: inout Hasher) { 294 | withUnsafeSvContext { hasher.combine($0.hash) } 295 | } 296 | 297 | /// Returns a Boolean value indicating whether two scalars stringify to identical strings. 298 | public static func == (lhs: PerlScalar, rhs: PerlScalar) -> Bool { 299 | return lhs.withUnsafeSvContext { svc1 in 300 | rhs.withUnsafeSvContext { svc2 in 301 | UnsafeSvContext.eq(svc1, svc2) 302 | } 303 | } 304 | } 305 | } 306 | 307 | extension PerlScalar : ExpressibleByNilLiteral { 308 | /// Creates an instance which contains `undef`. 309 | /// 310 | /// Do not call this initializer directly. It is used by the compiler when 311 | /// you initialize an `PerlScalar` instance with a `nil` literal. For example: 312 | /// 313 | /// ```swift 314 | /// let sv: PerlScalar = nil 315 | /// ``` 316 | public convenience init(nilLiteral: ()) { 317 | self.init() 318 | } 319 | } 320 | 321 | extension PerlScalar: ExpressibleByBooleanLiteral { 322 | /// Creates an instance initialized to the specified boolean literal. 323 | /// 324 | /// Do not call this initializer directly. It is used by the compiler when 325 | /// you use a boolean literal. Instead, create a new `PerlScalar` instance by 326 | /// using one of the boolean literals `true` and `false`. 327 | /// 328 | /// ```swift 329 | /// let sv: PerlScalar = true 330 | /// ``` 331 | /// 332 | /// - Parameter value: The value of the new instance. 333 | public convenience init(booleanLiteral value: Bool) { 334 | self.init(value) 335 | } 336 | } 337 | 338 | extension PerlScalar : ExpressibleByIntegerLiteral { 339 | /// Creates an instance from the given integer literal. 340 | /// 341 | /// Do not call this initializer directly. It is used by the compiler when 342 | /// you create a new `PerlScalar` instance by using an integer literal. 343 | /// Instead, create a new value by using a literal: 344 | /// 345 | /// ```swift 346 | /// let x: PerlScalar = 100 347 | /// ``` 348 | /// 349 | /// - Parameter value: The new value. 350 | public convenience init(integerLiteral value: Int) { 351 | self.init(value) 352 | } 353 | } 354 | 355 | extension PerlScalar : ExpressibleByFloatLiteral { 356 | /// Creates an instance from the given floating-point literal. 357 | /// 358 | /// Do not call this initializer directly. It is used by the compiler when 359 | /// you create a new `PerlScalar` instance by using a floating-point literal. 360 | /// Instead, create a new value by using a literal: 361 | /// 362 | /// ```swift 363 | /// let x: PerlScalar = 1.1 364 | /// ``` 365 | /// 366 | /// - Parameter value: The new value. 367 | public convenience init(floatLiteral value: Double) { 368 | self.init(value) 369 | } 370 | } 371 | 372 | extension PerlScalar : ExpressibleByUnicodeScalarLiteral { 373 | /// Creates an instance initialized to the given Unicode scalar value. 374 | /// 375 | /// Don't call this initializer directly. It may be used by the compiler when 376 | /// you initialize a `PerlScalar` using a string literal that contains a single 377 | /// Unicode scalar value. 378 | public convenience init(unicodeScalarLiteral value: String) { 379 | self.init(value) 380 | } 381 | } 382 | 383 | extension PerlScalar : ExpressibleByExtendedGraphemeClusterLiteral { 384 | /// Creates an instance initialized to the given extended grapheme cluster 385 | /// literal. 386 | /// 387 | /// Don't call this initializer directly. It may be used by the compiler when 388 | /// you initialize a `PerlScalar` using a string literal containing a single 389 | /// extended grapheme cluster. 390 | public convenience init(extendedGraphemeClusterLiteral value: String) { 391 | self.init(value) 392 | } 393 | } 394 | 395 | extension PerlScalar : ExpressibleByStringLiteral { 396 | /// Creates an instance initialized to the given string value. 397 | /// 398 | /// Don't call this initializer directly. It is used by the compiler when you 399 | /// initialize a `PerlScalar` using a string literal. For example: 400 | /// 401 | /// ```swift 402 | /// let sv: PerlScalar = "My World" 403 | /// ``` 404 | /// 405 | /// This assignment to the `sv` calls this string literal 406 | /// initializer behind the scenes. 407 | public convenience init(stringLiteral value: String) { 408 | self.init(value) 409 | } 410 | } 411 | 412 | extension PerlScalar: ExpressibleByArrayLiteral { 413 | /// Creates a reference to array from the given array literal. 414 | /// 415 | /// Do not call this initializer directly. It is used by the compiler 416 | /// when you use an array literal. Instead, create a new `PerlScalar` by using an 417 | /// array literal as its value. To do this, enclose a comma-separated list of 418 | /// values in square brackets. For example: 419 | /// 420 | /// ```swift 421 | /// let mix: PerlScalar = [nil, 100, "use perl or die"] 422 | /// ``` 423 | /// 424 | /// - Parameter elements: A variadic list of elements of the new array. 425 | public convenience init (arrayLiteral elements: PerlScalar...) { 426 | self.init(PerlArray(elements)) 427 | } 428 | } 429 | 430 | extension PerlScalar : ExpressibleByDictionaryLiteral { 431 | /// Creates a reference to hash initialized with a dictionary literal. 432 | /// 433 | /// Do not call this initializer directly. It is called by the compiler to 434 | /// handle dictionary literals. To use a dictionary literal as the initial 435 | /// value of a `PerlScalar`, enclose a comma-separated list of key-value pairs 436 | /// in square brackets. For example: 437 | /// 438 | /// ```swift 439 | /// let header: PerlScalar = [ 440 | /// "Content-Length": 320, 441 | /// "Content-Type": "application/json", 442 | /// ] 443 | /// ``` 444 | /// 445 | /// - Parameter elements: The key-value pairs that will make up the new 446 | /// dictionary. Each key in `elements` must be unique. 447 | public convenience init(dictionaryLiteral elements: (String, PerlScalar)...) { 448 | self.init(PerlHash(elements)) 449 | } 450 | } 451 | 452 | extension Bool { 453 | /// Creates a boolean from `PerlScalar` using Perl macros `SvTRUE`. 454 | /// 455 | /// False in Perl is any value that would look like `""` or `"0"` if evaluated 456 | /// in a string context. Since undefined values evaluate to `""`, all undefined 457 | /// values are false, but not all false values are undefined. 458 | /// 459 | /// ```swift 460 | /// let b = Bool(PerlScalar()) // b == false 461 | /// let b = Bool(PerlScalar(0)) // b == false 462 | /// let b = Bool(PerlScalar("")) // b == false 463 | /// let b = Bool(PerlScalar("0")) // b == false 464 | /// let b = Bool(PerlScalar(1)) // b == true 465 | /// let b = Bool(PerlScalar(100)) // b == true 466 | /// let b = Bool(PerlScalar("100")) // b == true 467 | /// let b = Bool(PerlScalar("000")) // b == true 468 | /// let b = Bool(PerlScalar("any")) // b == true 469 | /// let b = Bool(PerlScalar("false")) // b == true 470 | /// ``` 471 | public init(_ scalar: PerlScalar) { 472 | self.init(scalar.unsafeSvContext) 473 | _fixLifetime(scalar) 474 | } 475 | } 476 | 477 | extension Int { 478 | /// Creates a signed integer from `PerlScalar`. 479 | /// Throws if `sv` does not contain a signed integer. 480 | /// 481 | /// ```swift 482 | /// let i = try Int(PerlScalar(100)) // i == 100 483 | /// let i = try Int(PerlScalar("100")) // i == 100 484 | /// let i = try Int(PerlScalar(42.5)) // i == 42 485 | /// let i = try Int(PerlScalar()) // throws 486 | /// let i = try Int(PerlScalar("")) // throws 487 | /// let i = try Int(PerlScalar("any")) // throws 488 | /// let i = try Int(PerlScalar("50sec")) // throws 489 | /// let i = try Int(PerlScalar("10000000000000000000")) // throws 490 | /// let i = try Int(PerlScalar("20000000000000000000")) // throws 491 | /// let i = try Int(PerlScalar("-10")) // i == -10 492 | /// let i = try Int(PerlScalar("-20000000000000000000")) // throws 493 | /// ``` 494 | public init(_ scalar: PerlScalar) throws { 495 | try self.init(scalar.unsafeSvContext) 496 | _fixLifetime(scalar) 497 | } 498 | 499 | /// Creates a signed integer from `PerlScalar` using Perl macros `SvIV`. 500 | /// Performs no additional checks. 501 | /// 502 | /// ```swift 503 | /// let i = Int(unchecked: PerlScalar(100)) // i == 100 504 | /// let i = Int(unchecked: PerlScalar("100")) // i == 100 505 | /// let i = Int(unchecked: PerlScalar(42.5)) // i == 42 506 | /// let i = Int(unchecked: PerlScalar()) // i == 0 507 | /// let i = Int(unchecked: PerlScalar("")) // i == 0 508 | /// let i = Int(unchecked: PerlScalar("any")) // i == 0 509 | /// let i = Int(unchecked: PerlScalar("50sec")) // i == 50 510 | /// let i = Int(unchecked: PerlScalar("10000000000000000000")) // i == Int(bitPattern: 10000000000000000000) 511 | /// let i = Int(unchecked: PerlScalar("20000000000000000000")) // i == Int(bitPattern: UInt.max) 512 | /// let i = Int(unchecked: PerlScalar("-10")) // i == -10 513 | /// let i = Int(unchecked: PerlScalar("-20000000000000000000")) // i == Int.min 514 | /// ``` 515 | public init(unchecked scalar: PerlScalar) { 516 | self.init(unchecked: scalar.unsafeSvContext) 517 | _fixLifetime(scalar) 518 | } 519 | } 520 | 521 | extension UInt { 522 | /// Creates an unsigned integer from `PerlScalar`. 523 | /// Throws if `sv` does not contain an unsigned integer. 524 | /// 525 | /// ```swift 526 | /// let u = try UInt(PerlScalar(100)) // u == 100 527 | /// let u = try UInt(PerlScalar("100")) // u == 100 528 | /// let u = try UInt(PerlScalar(42.5)) // u == 42 529 | /// let u = try UInt(PerlScalar()) // throws 530 | /// let u = try UInt(PerlScalar("")) // throws 531 | /// let u = try UInt(PerlScalar("any")) // throws 532 | /// let u = try UInt(PerlScalar("50sec")) // throws 533 | /// let u = try UInt(PerlScalar("10000000000000000000")) // u == 10000000000000000000 534 | /// let u = try UInt(PerlScalar("20000000000000000000")) // throws 535 | /// let u = try UInt(PerlScalar("-10")) // throws 536 | /// let u = try UInt(PerlScalar("-20000000000000000000")) // throws 537 | /// ``` 538 | public init(_ scalar: PerlScalar) throws { 539 | try self.init(scalar.unsafeSvContext) 540 | _fixLifetime(scalar) 541 | } 542 | 543 | /// Creates an unsigned integer from `PerlScalar` using Perl macros `SvUV`. 544 | /// Performs no additional checks. 545 | /// 546 | /// ```swift 547 | /// let u = UInt(unchecked: PerlScalar(100)) // u == 100 548 | /// let u = UInt(unchecked: PerlScalar("100")) // u == 100 549 | /// let u = UInt(unchecked: PerlScalar(42.5)) // u == 42 550 | /// let u = UInt(unchecked: PerlScalar()) // u == 0 551 | /// let u = UInt(unchecked: PerlScalar("")) // u == 0 552 | /// let u = UInt(unchecked: PerlScalar("any")) // u == 0 553 | /// let u = UInt(unchecked: PerlScalar("50sec")) // u == 50 554 | /// let u = UInt(unchecked: PerlScalar("10000000000000000000")) // u == 10000000000000000000 555 | /// let u = UInt(unchecked: PerlScalar("20000000000000000000")) // u == UInt.max 556 | /// let u = UInt(unchecked: PerlScalar("-10")) // u == UInt(bitPattern: -10) 557 | /// let u = UInt(unchecked: PerlScalar("-20000000000000000000")) // u == UInt(bitPattern: Int.min) 558 | /// ``` 559 | public init(unchecked scalar: PerlScalar) { 560 | self.init(unchecked: scalar.unsafeSvContext) 561 | _fixLifetime(scalar) 562 | } 563 | } 564 | 565 | extension Double { 566 | /// Creates a double from `PerlScalar`. 567 | /// Throws if `sv` contains something that not looks like a number. 568 | /// 569 | /// ```swift 570 | /// let i = try Double(PerlScalar(42.3)) // i == 42.3 571 | /// let i = try Double(PerlScalar("42.3")) // i == 42.3 572 | /// let i = try Double(PerlScalar()) // throws 573 | /// let i = try Double(PerlScalar("")) // throws 574 | /// let i = try Double(PerlScalar("any")) // throws 575 | /// let i = try Double(PerlScalar("50sec")) // throws 576 | /// ``` 577 | public init(_ scalar: PerlScalar) throws { 578 | try self.init(scalar.unsafeSvContext) 579 | _fixLifetime(scalar) 580 | } 581 | 582 | /// Creates a double from `PerlScalar` using Perl macros `SvNV`. 583 | /// Performs no additional checks. 584 | /// 585 | /// ```swift 586 | /// let i = Double(unchecked: PerlScalar(42.3)) // i == 42.3 587 | /// let i = Double(unchecked: PerlScalar("42.3")) // i == 42.3 588 | /// let i = Double(unchecked: PerlScalar()) // i == 0 589 | /// let i = Double(unchecked: PerlScalar("")) // i == 0 590 | /// let i = Double(unchecked: PerlScalar("any")) // i == 0 591 | /// let i = Double(unchecked: PerlScalar("50sec")) // i == 50 592 | /// let i = Double(unchecked: PerlScalar("50.3sec")) // i == 50.3 593 | /// ``` 594 | public init(unchecked scalar: PerlScalar) { 595 | self.init(unchecked: scalar.unsafeSvContext) 596 | _fixLifetime(scalar) 597 | } 598 | } 599 | 600 | extension String { 601 | /// Creates a string from `PerlScalar`. 602 | /// Throws if `sv` does not contain a string or a number. 603 | /// 604 | /// ```swift 605 | /// let s = try String(PerlScalar()) // throws 606 | /// let s = try String(PerlScalar(200)) // s == "200" 607 | /// let s = try String(PerlScalar("OK")) // s == "OK" 608 | /// let s = try String(PerlScalar(referenceTo: PerlScalar(10))) // throws 609 | /// ``` 610 | public init(_ scalar: PerlScalar) throws { 611 | try self.init(scalar.unsafeSvContext) 612 | _fixLifetime(scalar) 613 | } 614 | 615 | /// Creates a string from `PerlScalar` using Perl macros `SvPV`. 616 | /// Performs no additional checks. 617 | /// 618 | /// ```swift 619 | /// let s = String(PerlScalar()) // s == "" 620 | /// let s = String(PerlScalar(200)) // s == "200" 621 | /// let s = String(PerlScalar("OK")) // s == "OK" 622 | /// let s = String(PerlScalar(referenceTo: PerlScalar(10))) // s == "SCALAR(0x12345678)" 623 | /// ``` 624 | public init(unchecked scalar: PerlScalar) { 625 | self.init(unchecked: scalar.unsafeSvContext) 626 | _fixLifetime(scalar) 627 | } 628 | } 629 | -------------------------------------------------------------------------------- /Sources/Perl/Stack.swift: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | typealias UnsafeStackBufferPointer = UnsafeMutableBufferPointer 4 | 5 | protocol UnsafeStack { 6 | var perl: PerlInterpreter { get } 7 | } 8 | 9 | extension UnsafeStack { 10 | fileprivate func pushTo(sp: inout UnsafeMutablePointer, from source: C) 11 | where C.Iterator.Element == UnsafeSvPointer { 12 | if !source.isEmpty { 13 | sp = perl.pointee.EXTEND(sp, source.count) 14 | for sv in source { 15 | sp += 1 16 | sp.initialize(to: perl.pointee.sv_2mortal(sv)!) 17 | } 18 | } 19 | perl.pointee.PL_stack_sp = sp 20 | } 21 | } 22 | 23 | struct UnsafeXSubStack : UnsafeStack { 24 | let args: UnsafeStackBufferPointer 25 | let perl: PerlInterpreter 26 | let ax: Int32 27 | 28 | init(perl: PerlInterpreter) { 29 | self.perl = perl 30 | //SV **sp = (my_perl->Istack_sp); I32 ax = (*(my_perl->Imarkstack_ptr)--); SV **mark = (my_perl->Istack_base) + ax++; I32 items = (I32)(sp - mark); 31 | var sp = perl.pointee.PL_stack_sp 32 | ax = perl.pointee.POPMARK() 33 | let mark = perl.pointee.PL_stack_base + Int(ax) 34 | let items = sp - mark 35 | sp -= items 36 | args = UnsafeStackBufferPointer(start: UnsafeMutableRawPointer(sp + 1).assumingMemoryBound(to: UnsafeSvPointer.self), count: items) 37 | } 38 | 39 | func xsReturn(_ result: C) 40 | where C.Iterator.Element == UnsafeSvPointer { 41 | var sp = perl.pointee.PL_stack_base + Int(ax) 42 | pushTo(sp: &sp, from: result) 43 | } 44 | 45 | subscript(_ i: Int) -> UnsafeSvPointer { 46 | guard i < args.count else { 47 | return perl.pointee.sv_2mortal(perl.pointee.newSV(0))! 48 | } 49 | return args[i] 50 | } 51 | 52 | func fetch(at index: Int) throws -> T { 53 | guard index < args.count else { 54 | if T.self == PerlScalar.self { 55 | return PerlScalar() as! T 56 | } else { 57 | throw PerlError.noArgumentOnStack(at: index) 58 | } 59 | } 60 | return try T(_fromUnsafeSvContextCopy: UnsafeSvContext(sv: args[index], perl: perl)) 61 | } 62 | 63 | func fetch(at index: Int) throws -> T? { 64 | guard index < args.count else { return nil } 65 | return try Optional(_fromUnsafeSvContextCopy: UnsafeSvContext(sv: args[index], perl: perl)) 66 | } 67 | 68 | #if swift(>=3.2) 69 | @_specialize(where T == Bool) @_specialize(where T == Int) @_specialize(where T == UInt) 70 | @_specialize(where T == Double) @_specialize(where T == String) @_specialize(where T == PerlScalar) 71 | func fetchTail(startingAt index: Int) throws -> [T] { 72 | return try _fetchTail(startingAt: index) 73 | } 74 | #else 75 | @_specialize(Bool) @_specialize(Int) @_specialize(UInt) 76 | @_specialize(Double) @_specialize(String) @_specialize(PerlScalar) 77 | func fetchTail(startingAt index: Int) throws -> [T] { 78 | return try _fetchTail(startingAt: index) 79 | } 80 | #endif 81 | 82 | @_transparent 83 | func _fetchTail(startingAt index: Int) throws -> [T] { 84 | guard index < args.count else { return [] } 85 | var tail: [T] = [] 86 | tail.reserveCapacity(args.count - index) 87 | for value in args[index..=3.2) 94 | @_specialize(where T == Bool) @_specialize(where T == Int) @_specialize(where T == UInt) 95 | @_specialize(where T == Double) @_specialize(where T == String) @_specialize(where T == PerlScalar) 96 | func fetchTail(startingAt index: Int) throws -> [String: T] { 97 | return try _fetchTail(startingAt: index) 98 | } 99 | #else 100 | @_specialize(Bool) @_specialize(Int) @_specialize(UInt) 101 | @_specialize(Double) @_specialize(String) @_specialize(PerlScalar) 102 | func fetchTail(startingAt index: Int) throws -> [String: T] { 103 | return try _fetchTail(startingAt: index) 104 | } 105 | #endif 106 | 107 | @_transparent 108 | func _fetchTail(startingAt index: Int) throws -> [String: T] { 109 | guard index < args.count else { return [:] } 110 | var tail: [String: T] = [:] 111 | var i = args[index..(perl: PerlInterpreter, args: C) 124 | where C.Iterator.Element == UnsafeSvPointer { 125 | self.perl = perl 126 | var sp = perl.pointee.PL_stack_sp 127 | perl.pointee.PUSHMARK(sp) 128 | pushTo(sp: &sp, from: args) 129 | } 130 | 131 | func popReturned(count: Int) -> UnsafeStackBufferPointer { 132 | return perl.popFromStack(count: count) 133 | } 134 | } 135 | 136 | extension PerlInterpreter { 137 | func popFromStack(count: Int) -> UnsafeStackBufferPointer { 138 | var sp = pointee.PL_stack_sp 139 | sp -= count 140 | let result = UnsafeStackBufferPointer(start: UnsafeMutableRawPointer(sp + 1).assumingMemoryBound(to: UnsafeSvPointer.self), count: count) 141 | pointee.PL_stack_sp = sp 142 | return result 143 | } 144 | } 145 | -------------------------------------------------------------------------------- /Sources/Perl/Subroutine.swift.gyb: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | /// Provides a safe wrapper for Perl subroutine (`CV`). 4 | /// Performs reference counting on initialization and deinitialization. 5 | /// 6 | /// ## Cheat Sheet 7 | /// 8 | /// ### Creation of an anonymous subroutine 9 | /// 10 | /// ```perl 11 | /// my $summer = sub { 12 | /// my ($lv, $rv) = @_; 13 | /// return $lv + $rv; 14 | /// } 15 | /// ``` 16 | /// 17 | /// ```swift 18 | /// let summer = PerlSub { 19 | /// (lv: Int, rv: Int) -> Int in 20 | /// return lv + rv 21 | /// } 22 | /// ``` 23 | /// 24 | /// In fact, these examples are not fully equal. The Perl version returns a SV pointing to a CV, 25 | /// whereas the Swift version returns just a CV. 26 | /// 27 | /// ### Creation of a named subroutine 28 | /// 29 | /// ```perl 30 | /// sub strlen { 31 | /// return length $_[0]; 32 | /// } 33 | /// ``` 34 | /// 35 | /// ```swift 36 | /// PerlSub(name: "strlen") { (s: String) in 37 | /// return s.characters.count 38 | /// } 39 | /// ``` 40 | /// 41 | /// ### Calling a subroutine 42 | /// 43 | /// ```perl 44 | /// my $sum = $summer->(10, 20); 45 | /// ``` 46 | /// 47 | /// ```swift 48 | /// let sum = summer.call(10, 20) 49 | /// ``` 50 | public final class PerlSub : PerlValue { 51 | convenience init(noinc cvc: UnsafeCvContext) { 52 | self.init(noincUnchecked: UnsafeSvContext(rebind: cvc)) 53 | } 54 | 55 | convenience init(inc cvc: UnsafeCvContext) { 56 | self.init(incUnchecked: UnsafeSvContext(rebind: cvc)) 57 | } 58 | 59 | required convenience init(noinc svc: UnsafeSvContext) throws { 60 | guard svc.type == SVt_PVCV else { 61 | throw PerlError.unexpectedValueType(fromUnsafeSvContext(noinc: svc), want: PerlSub.self) 62 | } 63 | self.init(noincUnchecked: svc) 64 | } 65 | 66 | @discardableResult 67 | convenience init(name: String?, perl: PerlInterpreter = .current, file: StaticString = #file, body: @escaping CvBody) { 68 | self.init(noinc: UnsafeCvContext.new(name: name, file: file, body: body, perl: perl)) 69 | if name != nil { 70 | unsafeSvContext.refcntInc() 71 | _fixLifetime(self) 72 | } 73 | } 74 | 75 | /// Short form of `init(dereferencing:)`. 76 | public convenience init(_ ref: PerlScalar) throws { 77 | try self.init(dereferencing: ref) 78 | } 79 | 80 | /// Returns the specified Perl subroutine with the given name. 81 | /// If the subroutine does not exist then `nil` is returned. 82 | public convenience init?(get name: String, perl: PerlInterpreter = .current) { 83 | guard let cv = perl.getCV(name) else { return nil } 84 | self.init(inc: UnsafeCvContext(cv: cv, perl: perl)) 85 | } 86 | 87 | func withUnsafeCvContext(_ body: (UnsafeCvContext) throws -> R) rethrows -> R { 88 | defer { _fixLifetime(self) } 89 | return try unsafeSvContext.sv.withMemoryRebound(to: CV.self, capacity: 1) { 90 | return try body(UnsafeCvContext(cv: $0, perl: unsafeSvContext.perl)) 91 | } 92 | } 93 | 94 | var file: String? { 95 | return withUnsafeCvContext { $0.file } 96 | } 97 | 98 | /// A textual representation of the CV, suitable for debugging. 99 | public override var debugDescription: String { 100 | let deparse: PerlObject = try! unsafeSvContext.perl.eval("use B::Deparse; B::Deparse->new('-sCi0')") 101 | var text: String = try! deparse.call(method: "coderef2text", self) 102 | text = text.split { $0 == "\n" } .map(String.init).joined(separator: " ") 103 | if let file = file { 104 | text += " at \(file)" 105 | } 106 | return "PerlSub(\(text))" 107 | } 108 | 109 | % for Self in ("Args", "ReturnValues"): 110 | % rc = "copy" if Self == "Args" else "inc" 111 | % if Self == "Args": 112 | /// Arguments passed to a subroutine. 113 | public struct Args : RandomAccessCollection { 114 | let unsafeArgs: UnsafeStackBufferPointer 115 | let perl: PerlInterpreter 116 | 117 | init(_ args: UnsafeStackBufferPointer, perl: PerlInterpreter) { 118 | unsafeArgs = args 119 | self.perl = perl 120 | } 121 | % else: 122 | /// A copy of values returned from a Perl subroutine. 123 | public final class ReturnValues : RandomAccessCollection { 124 | let unsafeArgs: [UnsafeSvPointer] 125 | let perl: PerlInterpreter 126 | 127 | init(_ args: UnsafeStackBufferPointer, perl: PerlInterpreter) { 128 | unsafeArgs = args.map { 129 | // Copy SV: not `newSVsv` to enable TEMP buffers stealing 130 | let sv = perl.pointee.newSV(0) 131 | perl.pointee.sv_setsv(sv, $0) 132 | return sv 133 | } 134 | self.perl = perl 135 | } 136 | 137 | deinit { 138 | for sv in unsafeArgs { 139 | perl.pointee.SvREFCNT_dec_NN(sv) 140 | } 141 | } 142 | % end 143 | 144 | /// Fetches the argument at the specified position. 145 | /// 146 | /// - Parameter index: The position of the argument to fetch. 147 | /// - Throws: If the argument not exists, is undefined or not 148 | /// convertible to the desired type. 149 | /// 150 | /// - Complexity: O(1). 151 | public func get(_ index: Int) throws -> T { 152 | guard index >= startIndex && index < endIndex else { 153 | throw PerlError.noArgumentOnStack(at: index) 154 | } 155 | return try T(_fromUnsafeSvContext${rc.title()}: UnsafeSvContext(sv: unsafeArgs[index], perl: perl)) 156 | } 157 | 158 | /// Fetches the argument at the specified position. 159 | /// 160 | /// - Parameter index: The position of the argument to fetch. 161 | /// - Returns: `nil` if the argument not exists or is undefined. 162 | /// - Throws: If the argument is not convertible to the desired type. 163 | /// 164 | /// - Complexity: O(1). 165 | public func get(_ index: Int) throws -> T? { 166 | guard index >= startIndex && index < endIndex else { return nil } 167 | return try T?(_fromUnsafeSvContext${rc.title()}: UnsafeSvContext(sv: unsafeArgs[index], perl: perl)) 168 | } 169 | 170 | /// The position of the first argument. 171 | /// 172 | /// If the arguments are empty, `startIndex` is equal to `endIndex`. 173 | public var startIndex: Int { return unsafeArgs.startIndex } 174 | 175 | /// The arguments' "past the end" position---that is, the position one greater 176 | /// than the last valid subscript argument. 177 | /// 178 | /// If the arguments are empty, `endIndex` is equal to `startIndex`. 179 | public var endIndex: Int { return unsafeArgs.endIndex } 180 | 181 | /// Accesses the argument at the specified position. 182 | /// 183 | /// - Parameter index: The position of the argument to access. 184 | /// 185 | /// - Complexity: O(1). 186 | public subscript(index: Int) -> PerlScalar { 187 | guard index >= startIndex && index < endIndex else { return PerlScalar(perl: perl) } 188 | return PerlScalar(${rc}Unchecked: UnsafeSvContext(sv: unsafeArgs[index], perl: perl)) 189 | } 190 | } 191 | % end 192 | } 193 | 194 | %{ 195 | def generic(count, tail): 196 | list = map(lambda n: "P" + str(n) + ": PerlScalarConvertible", range(0, count)) 197 | if tail != "fixed": 198 | list.append("T: PerlScalarConvertible") 199 | g = ", ".join(list) 200 | return "" if g == "" else "<" + g + ">" 201 | 202 | def paramsRange(tail): 203 | if tail == "fixed": 204 | return range(0, 4) 205 | else: 206 | return range(0, 3) 207 | 208 | def paramsVariants(count, tail, method): 209 | vars = [] 210 | for optmask in range(0, 1 << count): 211 | if method and optmask & 1 != 0: 212 | continue 213 | params = map(lambda n: "P" + str(n) + ("?" if (1 << n) & optmask != 0 else ""), range(0, count)) 214 | if tail == "array": 215 | params.append("[T]") 216 | elif tail == "hash": 217 | params.append("[String: T]") 218 | vars.append("(" + ", ".join(params) + ")") 219 | return vars 220 | 221 | def result(count): 222 | list = map(lambda n: "PerlScalarConvertible?", range(0, count)) 223 | return "(" + ", ".join(list) + ")" 224 | 225 | def bodyArgs(count, tail): 226 | list = map(lambda n: "stack.fetch(at: " + str(n) + ")", range(0, p)) 227 | if tail != "fixed": 228 | list.append("stack.fetchTail(startingAt: " + str(p) + ")") 229 | return ", ".join(list) 230 | }% 231 | 232 | extension PerlSub { 233 | % for tail in ("fixed", "array", "hash"): 234 | % for p in paramsRange(tail): 235 | % args = bodyArgs(p, tail) 236 | % for r in range(0, 3): 237 | % for params in paramsVariants(p, tail, False): 238 | 239 | /// Creates a new Perl XSUB. 240 | /// 241 | /// A body of the XSUB requires a fully qualified prototype of function to correctly convert Perl values 242 | /// to their Swift counterparts. Arguments of the subroutine are copied. 243 | /// If a body throws then an error is propagated to Perl as a Perl exception (`die`). 244 | /// 245 | /// - Parameter name: A fully qualified name of the subroutine under which it will be accessible in Perl. 246 | /// If not specified (or `nil` passed) then anonymous subroutine will be created. 247 | /// - Parameter file: A name of a source file subroutine was declared in. Used for debug purposes only. 248 | /// - Parameter body: The body of the XSUB. 249 | @discardableResult 250 | public convenience init${generic(p, tail)}(name: String? = nil, file: StaticString = #file, body: @escaping ${params} throws -> ${result(r)}) { 251 | self.init(name: name, file: file) { 252 | (stack: UnsafeXSubStack) in 253 | % if r == 0: 254 | try body(${args}) 255 | stack.xsReturn(EmptyCollection()) 256 | % elif r == 1: 257 | let result = try body(${args}) 258 | stack.xsReturn(CollectionOfOne(result?._toUnsafeSvPointer(perl: stack.perl) ?? stack.perl.pointee.newSV(0))) 259 | % else: 260 | let result = try body(${args}) 261 | let svResult: ContiguousArray = [ ${", ".join(map(lambda n: "result." + str(n) + "?._toUnsafeSvPointer(perl: stack.perl) ?? stack.perl.pointee.newSV(0)", range(0, r)))} ] 262 | stack.xsReturn(svResult) 263 | % end 264 | } 265 | } 266 | 267 | % end 268 | % end 269 | % end 270 | % end 271 | } 272 | 273 | extension PerlSub { 274 | /// Creates a new Perl XSUB. 275 | /// 276 | /// This is the last resort variant of subroutine construction. A body of the subroutine will receive all 277 | /// subroutine's arguments as an array of `PerlScalar` values and should return collection of `PerlScalar`s as 278 | /// its result. All examinations of concrete values' types should be performed manually. 279 | /// Arguments of the subroutine are not copied. Any modification of them will be visible outside the call. 280 | /// 281 | /// - Parameter name: A fully qualified name of the subroutine under which it will be accessible in Perl. 282 | /// If not specified (or `nil` passed) then anonymous subroutine will be created. 283 | /// - Parameter file: A name of a source file subroutine was declared in. Used for debug purposes only. 284 | /// - Parameter body: The body of the XSUB. 285 | @discardableResult 286 | public convenience init(name: String? = nil, file: StaticString = #file, body: @escaping (Args) throws -> [PerlScalarConvertible?]) { 287 | self.init(name: name, file: file) { 288 | (stack: UnsafeXSubStack) in 289 | let result = try body(Args(stack.args, perl: stack.perl)) 290 | stack.xsReturn(result.map { $0?._toUnsafeSvPointer(perl: stack.perl) ?? stack.perl.pointee.newSV(0) }) 291 | } 292 | } 293 | } 294 | 295 | extension PerlNamedClass { 296 | % for tail in ("fixed", "array", "hash"): 297 | % for p in paramsRange(tail): 298 | % for r in range(0, 3): 299 | % for params in paramsVariants(p, tail, True): 300 | 301 | /// Creates a new method in the Perl class specified in `perlClassName` attribute. 302 | /// 303 | /// A body of the method requires a fully qualified prototype of function to correctly convert Perl values 304 | /// to their Swift counterparts. The first argument should follow Perl OOP conventions and contain 305 | /// object `$self` in case of an instance method or string `$class` in case of a class. 306 | /// Arguments of the subroutine are copied. 307 | /// If a body throws then an error is propagated to Perl as a Perl exception (`die`). 308 | /// 309 | /// - Parameter method: A name of the method under which it will be accessible in Perl. 310 | /// - Parameter file: A name of a source file subroutine was declared in. Used for debug purposes only. 311 | /// - Parameter body: The body of the XSUB. 312 | @discardableResult 313 | public static func createPerlMethod${generic(p, tail)}(_ method: String, file: StaticString = #file, body: @escaping ${params} throws -> ${result(r)}) -> PerlSub { 314 | return PerlSub(name: perlClassName + "::" + method, file: file, body: body) 315 | } 316 | 317 | % end 318 | % end 319 | % end 320 | % end 321 | 322 | /// Creates a new method in the Perl class specified in `perlClassName` attribute. 323 | /// 324 | /// This is the last resort variant of subroutine construction. A body of the subroutine will receive all 325 | /// subroutine arguments as an array of `PerlScalar` values and should return collection of `PerlScalar`s as 326 | /// its result. All examinations of concrete values types should be performed manually. 327 | /// Arguments of the subroutine are not copied. Any modification of them will be visible outside the call. 328 | /// 329 | /// - Parameter name: A name of the method under which it will be accessible in Perl. 330 | /// - Parameter file: A name of a source file subroutine was declared in. Used for debug purposes only. 331 | /// - Parameter body: The body of the XSUB. 332 | @discardableResult 333 | public static func createPerlMethod(_ method: String, file: StaticString = #file, body: @escaping (PerlSub.Args) throws -> [PerlScalarConvertible?]) -> PerlSub { 334 | return PerlSub(name: perlClassName + "::" + method, file: file, body: body) 335 | } 336 | } 337 | -------------------------------------------------------------------------------- /Sources/Perl/SvConvertible.swift: -------------------------------------------------------------------------------- 1 | public protocol PerlScalarConvertible { 2 | init(_fromUnsafeSvContextInc: UnsafeSvContext) throws 3 | init(_fromUnsafeSvContextCopy: UnsafeSvContext) throws 4 | func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer 5 | } 6 | 7 | extension PerlScalarConvertible { 8 | public init(_fromUnsafeSvContextCopy svc: UnsafeSvContext) throws { 9 | try self.init(_fromUnsafeSvContextInc: svc) 10 | } 11 | } 12 | 13 | extension Bool : PerlScalarConvertible { 14 | public init(_fromUnsafeSvContextInc svc: UnsafeSvContext) { self.init(svc) } 15 | public func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { return perl.newSV(self) } 16 | } 17 | 18 | extension Int : PerlScalarConvertible { 19 | public init(_fromUnsafeSvContextInc svc: UnsafeSvContext) throws { try self.init(svc) } 20 | public func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { return perl.pointee.newSViv(self) } 21 | } 22 | 23 | extension UInt : PerlScalarConvertible { 24 | public init(_fromUnsafeSvContextInc svc: UnsafeSvContext) throws { try self.init(svc) } 25 | public func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { return perl.pointee.newSVuv(self) } 26 | } 27 | 28 | extension Double : PerlScalarConvertible { 29 | public init(_fromUnsafeSvContextInc svc: UnsafeSvContext) throws { try self.init(svc) } 30 | public func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { return perl.pointee.newSVnv(self) } 31 | } 32 | 33 | extension String : PerlScalarConvertible { 34 | public init(_fromUnsafeSvContextInc svc: UnsafeSvContext) throws { try self.init(svc) } 35 | public func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { return perl.newSV(self) } 36 | } 37 | 38 | extension PerlScalar : PerlScalarConvertible { 39 | public convenience init(_fromUnsafeSvContextInc svc: UnsafeSvContext) throws { 40 | try self.init(inc: svc) 41 | } 42 | 43 | public convenience init(_fromUnsafeSvContextCopy svc: UnsafeSvContext) throws { 44 | try self.init(copy: svc) 45 | } 46 | 47 | public func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { 48 | defer { _fixLifetime(self) } 49 | return unsafeSvContext.refcntInc() 50 | } 51 | } 52 | 53 | extension PerlArray : PerlScalarConvertible { 54 | public convenience init(_fromUnsafeSvContextInc svc: UnsafeSvContext) throws { 55 | try self.init(inc: UnsafeAvContext(dereference: svc)) 56 | } 57 | 58 | public func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { 59 | return withUnsafeSvContext { $0.perl.pointee.newRV_inc($0.sv) } 60 | } 61 | } 62 | 63 | extension PerlHash : PerlScalarConvertible { 64 | public convenience init(_fromUnsafeSvContextInc svc: UnsafeSvContext) throws { 65 | try self.init(inc: UnsafeHvContext(dereference: svc)) 66 | } 67 | 68 | public func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { 69 | return withUnsafeSvContext { $0.perl.pointee.newRV_inc($0.sv) } 70 | } 71 | } 72 | 73 | extension PerlSub : PerlScalarConvertible { 74 | public convenience init(_fromUnsafeSvContextInc svc: UnsafeSvContext) throws { 75 | try self.init(inc: UnsafeCvContext(dereference: svc)) 76 | } 77 | 78 | public func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { 79 | return withUnsafeSvContext { $0.perl.pointee.newRV_inc($0.sv) } 80 | } 81 | } 82 | 83 | extension PerlScalarConvertible where Self : PerlBridgedObject { 84 | public init(_fromUnsafeSvContextInc svc: UnsafeSvContext) throws { 85 | guard let object = svc.swiftObject else { 86 | throw PerlError.notSwiftObject(Perl.fromUnsafeSvContext(inc: svc)) 87 | } 88 | guard let derivedObject = object as? Self else { 89 | throw PerlError.unexpectedObjectType(Perl.fromUnsafeSvContext(inc: svc), want: Self.self) 90 | } 91 | self = derivedObject 92 | } 93 | 94 | public func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { 95 | return perl.newSV(self) 96 | } 97 | } 98 | 99 | extension Optional where Wrapped : PerlScalarConvertible { 100 | public init(_fromUnsafeSvContextInc svc: UnsafeSvContext) throws { 101 | self = svc.defined ? .some(try Wrapped(_fromUnsafeSvContextInc: svc)) : .none 102 | } 103 | 104 | public init(_fromUnsafeSvContextCopy svc: UnsafeSvContext) throws { 105 | self = svc.defined ? .some(try Wrapped(_fromUnsafeSvContextCopy: svc)) : .none 106 | } 107 | 108 | public func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { 109 | switch self { 110 | case .some(let value): 111 | return value._toUnsafeSvPointer(perl: perl) 112 | case .none: 113 | return perl.pointee.newSV(0) 114 | } 115 | } 116 | } 117 | 118 | extension Array where Element : PerlScalarConvertible { 119 | func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { 120 | let avc = UnsafeAvContext.new(perl: perl) 121 | avc.reserveCapacity(numericCast(count)) 122 | for (i, v) in enumerated() { 123 | avc.store(i, value: v._toUnsafeSvPointer(perl: perl)) 124 | } 125 | return UnsafeSvContext.new(rvNoinc: avc).sv 126 | } 127 | } 128 | 129 | extension Dictionary where Value : PerlScalarConvertible { 130 | func _toUnsafeSvPointer(perl: PerlInterpreter) -> UnsafeSvPointer { 131 | let hvc = UnsafeHvContext.new(perl: perl) 132 | for (k, v) in self { 133 | hvc.store("\(k)", value: v._toUnsafeSvPointer(perl: perl)) 134 | } 135 | return UnsafeSvContext.new(rvNoinc: hvc).sv 136 | } 137 | } 138 | -------------------------------------------------------------------------------- /Sources/Perl/UnsafeAV.swift: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | public typealias UnsafeAvPointer = UnsafeMutablePointer 4 | 5 | struct UnsafeAvContext { 6 | let av: UnsafeAvPointer 7 | let perl: PerlInterpreter 8 | 9 | static func new(perl: PerlInterpreter) -> UnsafeAvContext { 10 | return UnsafeAvContext(av: perl.pointee.newAV(), perl: perl) 11 | } 12 | 13 | func fetch(_ i: Index, lval: Bool = false) -> UnsafeSvContext? { 14 | return perl.pointee.av_fetch(av, i, lval) 15 | .flatMap { $0.pointee.map { UnsafeSvContext(sv: $0, perl: perl) } } 16 | } 17 | 18 | func store(_ i: Index, value: UnsafeSvPointer) { 19 | if perl.pointee.av_store(av, i, value) == nil { 20 | UnsafeSvContext(sv: value, perl: perl).refcntDec() 21 | } 22 | } 23 | 24 | func delete(_ i: Index) -> UnsafeSvContext? { 25 | return perl.pointee.av_delete(av, i, 0) 26 | .map { UnsafeSvContext(sv: $0, perl: perl) } 27 | } 28 | 29 | func delete(discarding i: Index) { 30 | perl.pointee.av_delete(av, i, G_DISCARD) 31 | } 32 | 33 | func exists(_ i: Index) -> Bool { 34 | return perl.pointee.av_exists(av, i) 35 | } 36 | 37 | func clear() { 38 | perl.pointee.av_clear(av) 39 | } 40 | 41 | func extend(to count: Int) { 42 | perl.pointee.av_extend(av, count - 1) 43 | } 44 | 45 | func extend(by count: Int) { 46 | extend(to: self.count + count) 47 | } 48 | } 49 | 50 | extension UnsafeAvContext { 51 | init(dereference svc: UnsafeSvContext) throws { 52 | guard let rvc = svc.referent, rvc.type == SVt_PVAV else { 53 | throw PerlError.unexpectedValueType(fromUnsafeSvContext(inc: svc), want: PerlArray.self) 54 | } 55 | self.init(rebind: rvc) 56 | } 57 | 58 | init(rebind svc: UnsafeSvContext) { 59 | let av = UnsafeMutableRawPointer(svc.sv).bindMemory(to: AV.self, capacity: 1) 60 | self.init(av: av, perl: svc.perl) 61 | } 62 | } 63 | 64 | extension UnsafeAvContext : RandomAccessCollection { 65 | typealias Element = UnsafeSvContext? 66 | typealias Index = Int 67 | typealias Indices = CountableRange 68 | 69 | var startIndex: Index { return 0 } 70 | var endIndex: Index { return perl.pointee.av_len(av) + 1 } 71 | 72 | subscript(i: Index) -> UnsafeSvContext? { 73 | get { 74 | return fetch(i) 75 | } 76 | set { 77 | if let newValue = newValue { 78 | store(i, value: newValue.sv) 79 | } else { 80 | delete(discarding: i) 81 | } 82 | } 83 | } 84 | 85 | func reserveCapacity(_ capacity: Int) { 86 | extend(to: capacity) 87 | } 88 | 89 | func append(_ svc: UnsafeSvContext) { 90 | perl.pointee.av_push(av, svc.sv) 91 | } 92 | 93 | func removeFirst() -> UnsafeSvContext { 94 | return UnsafeSvContext(sv: perl.pointee.av_shift(av), perl: perl) 95 | } 96 | } 97 | -------------------------------------------------------------------------------- /Sources/Perl/UnsafeCV.swift: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | public typealias UnsafeCvPointer = UnsafeMutablePointer 4 | 5 | typealias CvBody = (UnsafeXSubStack) throws -> Void 6 | typealias UnsafeCvBodyPointer = UnsafeMutablePointer 7 | 8 | extension CV { 9 | fileprivate var bodyPointer: UnsafeCvBodyPointer { 10 | mutating get { return CvXSUBANY(&self).pointee.any_ptr.assumingMemoryBound(to: CvBody.self) } 11 | mutating set { CvXSUBANY(&self).pointee.any_ptr = UnsafeMutableRawPointer(newValue) } 12 | } 13 | } 14 | 15 | struct UnsafeCvContext { 16 | let cv: UnsafeCvPointer 17 | let perl: PerlInterpreter 18 | 19 | private static var mgvtbl = MGVTBL( 20 | svt_get: nil, 21 | svt_set: nil, 22 | svt_len: nil, 23 | svt_clear: nil, 24 | svt_free: { 25 | (perl, sv, magic) in 26 | let bodyPointer = UnsafeMutableRawPointer(sv!).assumingMemoryBound(to: CV.self).pointee.bodyPointer 27 | bodyPointer.deinitialize(count: 1) 28 | bodyPointer.deallocate() 29 | return 0 30 | }, 31 | svt_copy: nil, 32 | svt_dup: nil, 33 | svt_local: nil 34 | ) 35 | 36 | static func new(name: String? = nil, file: StaticString = #file, body: @escaping CvBody, perl: PerlInterpreter) -> UnsafeCvContext { 37 | func newXS(_ name: UnsafePointer?) -> UnsafeCvPointer { 38 | return perl.pointee.newXS_flags(name, cvResolver, file.description, nil, UInt32(XS_DYNAMIC_FILENAME)) 39 | } 40 | let cv = name?.withCString(newXS) ?? newXS(nil) 41 | cv.withMemoryRebound(to: SV.self, capacity: 1) { 42 | _ = perl.pointee.sv_magicext($0, nil, PERL_MAGIC_ext, &mgvtbl, nil, 0) 43 | } 44 | let bodyPointer = UnsafeCvBodyPointer.allocate(capacity: 1) 45 | bodyPointer.initialize(to: body) 46 | cv.pointee.bodyPointer = bodyPointer 47 | return UnsafeCvContext(cv: cv, perl: perl) 48 | } 49 | 50 | var name: String? { 51 | guard let gv = perl.pointee.CvGV(cv) else { return nil } 52 | return String(cString: GvNAME(gv)) 53 | } 54 | 55 | var fullname: String? { 56 | guard let name = name else { return nil } 57 | guard let gv = perl.pointee.CvGV(cv), let stash = GvSTASH(gv), let hvn = HvNAME(stash) else { return name } 58 | return "\(String(cString: hvn))::\(name)" 59 | } 60 | 61 | var file: String? { 62 | return CvFILE(cv).map { String(cString: $0) } 63 | } 64 | } 65 | 66 | extension UnsafeCvContext { 67 | init(dereference svc: UnsafeSvContext) throws { 68 | guard let rvc = svc.referent, rvc.type == SVt_PVCV else { 69 | throw PerlError.unexpectedValueType(fromUnsafeSvContext(inc: svc), want: PerlSub.self) 70 | } 71 | self.init(rebind: rvc) 72 | } 73 | 74 | init(rebind svc: UnsafeSvContext) { 75 | let cv = UnsafeMutableRawPointer(svc.sv).bindMemory(to: CV.self, capacity: 1) 76 | self.init(cv: cv, perl: svc.perl) 77 | } 78 | } 79 | 80 | let PERL_MAGIC_ext = Int32(UnicodeScalar("~").value) // mg_vtable.h 81 | 82 | private func cvResolver(perl: PerlInterpreter.Pointer, cv: UnsafeCvPointer) -> Void { 83 | let perl = PerlInterpreter(perl) 84 | let errsv: UnsafeSvPointer? 85 | do { 86 | let stack = UnsafeXSubStack(perl: perl) 87 | try cv.pointee.bodyPointer.pointee(stack) 88 | errsv = nil 89 | } catch PerlError.died(let scalar) { 90 | errsv = scalar.withUnsafeSvContext { UnsafeSvContext.new(copy: $0).mortal() } 91 | } catch let error as PerlScalarConvertible { 92 | let usv = error._toUnsafeSvPointer(perl: perl) 93 | errsv = perl.pointee.sv_2mortal(usv) 94 | } catch { 95 | errsv = "\(error)".withCString { error in 96 | let name = UnsafeCvContext(cv: cv, perl: perl).fullname ?? "__ANON__" 97 | return name.withCString { name in 98 | withVaList([name, error]) { perl.pointee.vmess("Exception in %s: %s", unsafeBitCast($0, to: UnsafeMutablePointer.self)) } 99 | } 100 | } 101 | } 102 | if let e = errsv { 103 | perl.pointee.croak_sv(e) 104 | // croak_sv() function never returns. It unwinds stack instead. 105 | // No memory managment SIL operations should exist after it. 106 | // Check it using --emit-sil if modification of this function required. 107 | } 108 | } 109 | -------------------------------------------------------------------------------- /Sources/Perl/UnsafeHV.swift: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | public typealias UnsafeHvPointer = UnsafeMutablePointer 4 | 5 | struct UnsafeHvContext { 6 | let hv: UnsafeHvPointer 7 | let perl: PerlInterpreter 8 | 9 | static func new(perl: PerlInterpreter) -> UnsafeHvContext { 10 | return UnsafeHvContext(hv: perl.pointee.newHV(), perl: perl) 11 | } 12 | 13 | func fetch(_ key: String, lval: Bool = false) -> UnsafeSvContext? { 14 | return key.withCStringWithLength { perl.pointee.hv_fetch(hv, $0, -Int32($1), lval) } 15 | .flatMap { $0.pointee.map { UnsafeSvContext(sv: $0, perl: perl) } } 16 | } 17 | 18 | func store(_ key: String, value: UnsafeSvPointer) { 19 | if key.withCStringWithLength({ perl.pointee.hv_store(hv, $0, -Int32($1), value, 0) }) == nil { 20 | UnsafeSvContext(sv: value, perl: perl).refcntDec() 21 | } 22 | } 23 | 24 | func delete(_ key: String) -> UnsafeSvContext? { 25 | return key.withCStringWithLength { perl.pointee.hv_delete(hv, $0, -Int32($1), 0) } 26 | .map { UnsafeSvContext(sv: $0, perl: perl) } 27 | } 28 | 29 | func delete(discarding key: String) { 30 | key.withCStringWithLength { _ = perl.pointee.hv_delete(hv, $0, -Int32($1), G_DISCARD) } 31 | } 32 | 33 | func exists(_ key: String) -> Bool { 34 | return key.withCStringWithLength { perl.pointee.hv_exists(hv, $0, -Int32($1)) } 35 | } 36 | 37 | func fetch(_ key: UnsafeSvPointer, lval: Bool = false) -> UnsafeSvContext? { 38 | return perl.pointee.hv_fetch_ent(hv, key, lval, 0) 39 | .map(HeVAL).map { UnsafeSvContext(sv: $0, perl: perl) } 40 | } 41 | 42 | func store(_ key: UnsafeSvPointer, value: UnsafeSvPointer) { 43 | if perl.pointee.hv_store_ent(hv, key, value, 0) == nil { 44 | UnsafeSvContext(sv: value, perl: perl).refcntDec() 45 | } 46 | } 47 | 48 | func delete(_ key: UnsafeSvPointer) -> UnsafeSvContext? { 49 | return perl.pointee.hv_delete_ent(hv, key, 0, 0) 50 | .map { UnsafeSvContext(sv: $0, perl: perl) } 51 | } 52 | 53 | func delete(discarding key: UnsafeSvPointer) { 54 | perl.pointee.hv_delete_ent(hv, key, G_DISCARD, 0) 55 | } 56 | 57 | func exists(_ key: UnsafeSvPointer) -> Bool { 58 | return perl.pointee.hv_exists_ent(hv, key, 0) 59 | } 60 | 61 | func clear() { 62 | perl.pointee.hv_clear(hv) 63 | } 64 | } 65 | 66 | extension UnsafeHvContext { 67 | init(dereference svc: UnsafeSvContext) throws { 68 | guard let rvc = svc.referent, rvc.type == SVt_PVHV else { 69 | throw PerlError.unexpectedValueType(fromUnsafeSvContext(inc: svc), want: PerlHash.self) 70 | } 71 | self.init(rebind: rvc) 72 | } 73 | 74 | init(rebind svc: UnsafeSvContext) { 75 | let hv = UnsafeMutableRawPointer(svc.sv).bindMemory(to: HV.self, capacity: 1) 76 | self.init(hv: hv, perl: svc.perl) 77 | } 78 | } 79 | 80 | extension UnsafeHvContext: Sequence, IteratorProtocol { 81 | typealias Key = String 82 | typealias Value = UnsafeSvContext 83 | typealias Element = (key: Key, value: Value) 84 | 85 | func makeIterator() -> UnsafeHvContext { 86 | perl.pointee.hv_iterinit(hv) 87 | return self 88 | } 89 | 90 | func next() -> Element? { 91 | guard let he = perl.pointee.hv_iternext(hv) else { return nil } 92 | var klen = 0 93 | let ckey = perl.pointee.HePV(he, &klen) 94 | let key = String(cString: ckey, withLength: klen) 95 | let value = UnsafeSvContext(sv: HeVAL(he), perl: perl) 96 | return (key: key, value: value) 97 | } 98 | 99 | subscript(key: Key) -> Value? { 100 | get { return fetch(key) } 101 | set { 102 | if let value = newValue { 103 | store(key, value: value.sv) 104 | } else { 105 | delete(discarding: key) 106 | } 107 | } 108 | } 109 | 110 | subscript(key: UnsafeSvPointer) -> Value? { 111 | get { return fetch(key) } 112 | set { 113 | if let value = newValue { 114 | store(key, value: value.sv) 115 | } else { 116 | delete(discarding: key) 117 | } 118 | } 119 | } 120 | } 121 | -------------------------------------------------------------------------------- /Sources/Perl/UnsafeSV.swift: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | public typealias UnsafeSvPointer = UnsafeMutablePointer 4 | 5 | public struct UnsafeSvContext { 6 | public let sv: UnsafeSvPointer 7 | public let perl: PerlInterpreter 8 | 9 | public init(sv: UnsafeSvPointer, perl: PerlInterpreter) { 10 | self.sv = sv 11 | self.perl = perl 12 | } 13 | 14 | @discardableResult 15 | func refcntInc() -> UnsafeSvPointer { 16 | return SvREFCNT_inc_NN(sv) 17 | } 18 | 19 | func refcntDec() { 20 | perl.pointee.SvREFCNT_dec_NN(sv) 21 | } 22 | 23 | @discardableResult 24 | func mortal() -> UnsafeSvPointer { 25 | return perl.pointee.sv_2mortal(sv)! 26 | } 27 | 28 | var type: svtype { return SvTYPE(sv) } 29 | var defined: Bool { return SvOK(sv) } 30 | var isInteger: Bool { return SvIOK(sv) } 31 | var isDouble: Bool { return SvNOK(sv) } 32 | var isString: Bool { return SvPOK(sv) } 33 | var isReference: Bool { return SvROK(sv) } 34 | 35 | var referent: UnsafeSvContext? { 36 | return SvROK(sv) ? UnsafeSvContext(sv: SvRV(sv)!, perl: perl) : nil 37 | } 38 | 39 | func withUnsafeBytes(_ body: (UnsafeRawBufferPointer) throws -> R) rethrows -> R { 40 | var clen = 0 41 | let cstr = perl.pointee.SvPV(sv, &clen)! 42 | let bytes = UnsafeRawBufferPointer(start: cstr, count: clen) 43 | return try body(bytes) 44 | } 45 | 46 | var isObject: Bool { return perl.pointee.sv_isobject(sv) } 47 | 48 | func isDerived(from: String) -> Bool { 49 | return from.withCString { perl.pointee.sv_derived_from(sv, $0) } 50 | } 51 | 52 | var classname: String? { 53 | guard isObject else { return nil } 54 | return String(cString: perl.pointee.sv_reftype(SvRV(sv)!, true)) 55 | } 56 | 57 | private var hasSwiftObjectMagic: Bool { 58 | return type == SVt_PVMG && perl.pointee.mg_findext(sv, PERL_MAGIC_ext, &objectMgvtbl) != nil 59 | } 60 | 61 | var swiftObject: PerlBridgedObject? { 62 | guard isObject else { return nil } 63 | let rvc = UnsafeSvContext(sv: SvRV(sv)!, perl: perl) 64 | guard rvc.hasSwiftObjectMagic else { return nil } 65 | let iv = perl.pointee.SvIV(rvc.sv) 66 | let u = Unmanaged.fromOpaque(UnsafeRawPointer(bitPattern: iv)!) 67 | return (u.takeUnretainedValue() as! PerlBridgedObject) 68 | } 69 | 70 | static func new(perl: PerlInterpreter) -> UnsafeSvContext { 71 | return UnsafeSvContext(sv: perl.pointee.newSV(0), perl: perl) 72 | } 73 | 74 | static func new(copy src: UnsafeSvContext) -> UnsafeSvContext { 75 | return UnsafeSvContext(sv: src.perl.pointee.newSVsv(src.sv)!, perl: src.perl) 76 | } 77 | 78 | // newSV() and sv_setsv() are used instead of newSVsv() to allow 79 | // stealing temporary buffers and enable COW-optimizations. 80 | static func new(stealingCopy src: UnsafeSvContext) -> UnsafeSvContext { 81 | let dst = UnsafeSvContext.new(perl: src.perl) 82 | dst.set(src.sv) 83 | return dst 84 | } 85 | 86 | static func new(rvInc vc: V) -> UnsafeSvContext { 87 | return vc.withUnsafeSvContext { UnsafeSvContext(sv: $0.perl.pointee.newRV_inc($0.sv), perl: $0.perl) } 88 | } 89 | 90 | static func new(rvNoinc vc: V) -> UnsafeSvContext { 91 | return vc.withUnsafeSvContext { UnsafeSvContext(sv: $0.perl.pointee.newRV_noinc($0.sv), perl: $0.perl) } 92 | } 93 | 94 | static func new(_ v: UnsafeRawBufferPointer, utf8: Bool = false, mortal: Bool = false, perl: PerlInterpreter) -> UnsafeSvContext { 95 | let sv = perl.pointee.newSVpvn_flags(v.baseAddress?.assumingMemoryBound(to: CChar.self), v.count, UInt32(mortal ? SVs_TEMP : 0)) 96 | if utf8 { 97 | perl.pointee.sv_utf8_decode(sv) 98 | } 99 | return UnsafeSvContext(sv: sv, perl: perl) 100 | } 101 | 102 | func set(_ ssv: UnsafeSvPointer) { 103 | perl.pointee.sv_setsv(sv, ssv) 104 | } 105 | 106 | func set(_ value: Bool) { 107 | set(perl.pointee.boolSV(value)) 108 | } 109 | 110 | func set(_ value: Int) { 111 | perl.pointee.sv_setiv(sv, value) 112 | } 113 | 114 | func set(_ value: UInt) { 115 | perl.pointee.sv_setuv(sv, value) 116 | } 117 | 118 | func set(_ value: Double) { 119 | perl.pointee.sv_setnv(sv, value) 120 | } 121 | 122 | func set(_ value: String) { 123 | let count = value.count 124 | value.withCStringWithLength { 125 | perl.pointee.sv_setpvn(sv, $0, $1) 126 | 127 | if $1 == count { 128 | SvUTF8_off(sv) 129 | } else { 130 | SvUTF8_on(sv) 131 | } 132 | } 133 | } 134 | 135 | func set(_ value: UnsafeRawBufferPointer, containing: PerlScalar.StringUnits = .bytes) { 136 | SvUTF8_off(sv) 137 | perl.pointee.sv_setpvn(sv, value.baseAddress?.assumingMemoryBound(to: CChar.self), value.count) 138 | if containing == .characters { 139 | perl.pointee.sv_utf8_decode(sv) 140 | } 141 | } 142 | 143 | var hash: UInt32 { 144 | return perl.pointee.SvHASH(sv) 145 | } 146 | 147 | func dump() { 148 | perl.pointee.sv_dump(sv) 149 | } 150 | 151 | static func eq(_ lhs: UnsafeSvContext, _ rhs: UnsafeSvContext) -> Bool { 152 | return lhs.perl.pointee.sv_eq(lhs.sv, rhs.sv) 153 | } 154 | } 155 | 156 | extension PerlInterpreter { 157 | func newSV(_ v: Bool) -> UnsafeSvPointer { 158 | return pointee.newSVsv(pointee.boolSV(v))! 159 | } 160 | 161 | func newSV(_ v: String, mortal: Bool = false) -> UnsafeSvPointer { 162 | let count = v.count 163 | return v.withCStringWithLength { 164 | let flags = ($1 == count ? 0 : SVf_UTF8) | (mortal ? SVs_TEMP : 0) 165 | return pointee.newSVpvn_flags($0, $1, UInt32(flags)) 166 | } 167 | } 168 | 169 | func newSV(_ v: AnyObject, isa: String) -> UnsafeSvPointer { 170 | let u = Unmanaged.passRetained(v) 171 | let iv = unsafeBitCast(u, to: Int.self) 172 | let sv = pointee.sv_setref_iv(pointee.newSV(0), isa, iv) 173 | pointee.sv_magicext(SvRV(sv)!, nil, PERL_MAGIC_ext, &objectMgvtbl, nil, 0) 174 | return sv 175 | } 176 | 177 | func newSV(_ v: PerlBridgedObject) -> UnsafeSvPointer { 178 | return newSV(v, isa: type(of: v).perlClassName) 179 | } 180 | } 181 | 182 | private var objectMgvtbl = MGVTBL( 183 | svt_get: nil, 184 | svt_set: nil, 185 | svt_len: nil, 186 | svt_clear: nil, 187 | svt_free: { 188 | (perl, sv, magic) in 189 | let iv = perl.unsafelyUnwrapped.pointee.SvIV(sv.unsafelyUnwrapped) 190 | let u = Unmanaged.fromOpaque(UnsafeRawPointer(bitPattern: iv)!) 191 | u.release() 192 | return 0 193 | }, 194 | svt_copy: nil, 195 | svt_dup: nil, 196 | svt_local: nil 197 | ) 198 | 199 | extension Bool { 200 | public init(_ svc: UnsafeSvContext) { 201 | self = svc.perl.pointee.SvTRUE(svc.sv) 202 | } 203 | } 204 | 205 | extension Int { 206 | public init(_ svc: UnsafeSvContext) throws { 207 | self.init(unchecked: svc) 208 | guard SvIOK(svc.sv) && (!SvIsUV(svc.sv) || UInt(bitPattern: self) <= UInt(Int.max)) 209 | || SvNOK(svc.sv) && (!SvIsUV(svc.sv) && self != Int.min || UInt(bitPattern: self) <= UInt(Int.max)) else { 210 | throw PerlError.notNumber(fromUnsafeSvContext(inc: svc), want: Int.self) 211 | } 212 | } 213 | 214 | public init(unchecked svc: UnsafeSvContext) { 215 | self = svc.perl.pointee.SvIV(svc.sv) 216 | } 217 | } 218 | 219 | extension UInt { 220 | public init(_ svc: UnsafeSvContext) throws { 221 | self.init(unchecked: svc) 222 | guard SvIOK(svc.sv) && (SvIsUV(svc.sv) || Int(bitPattern: self) >= Int(UInt.min)) 223 | || SvNOK(svc.sv) && (SvIsUV(svc.sv) && self != UInt.max || Int(bitPattern: self) >= Int(UInt.min)) else { 224 | throw PerlError.notNumber(fromUnsafeSvContext(inc: svc), want: UInt.self) 225 | } 226 | } 227 | 228 | public init(unchecked svc: UnsafeSvContext) { 229 | self = svc.perl.pointee.SvUV(svc.sv) 230 | } 231 | } 232 | 233 | extension Double { 234 | public init(_ svc: UnsafeSvContext) throws { 235 | self.init(unchecked: svc) 236 | guard SvNIOK(svc.sv) else { 237 | throw PerlError.notNumber(fromUnsafeSvContext(inc: svc), want: Double.self) 238 | } 239 | } 240 | 241 | public init(unchecked svc: UnsafeSvContext) { 242 | self = svc.perl.pointee.SvNV(svc.sv) 243 | } 244 | } 245 | 246 | extension String { 247 | public init(_ svc: UnsafeSvContext) throws { 248 | self.init(unchecked: svc) 249 | guard SvPOK(svc.sv) || SvNOK(svc.sv) else { 250 | throw PerlError.notStringOrNumber(fromUnsafeSvContext(inc: svc)) 251 | } 252 | } 253 | 254 | public init(unchecked svc: UnsafeSvContext) { 255 | var clen = 0 256 | let cstr = svc.perl.pointee.SvPV(svc.sv, &clen)! 257 | self = String(cString: cstr, withLength: clen) 258 | } 259 | } 260 | -------------------------------------------------------------------------------- /Sources/Perl/UnsafeValue.swift: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | protocol UnsafeValueContext { 4 | func withUnsafeSvContext(_ body: (UnsafeSvContext) throws -> R) rethrows -> R 5 | } 6 | 7 | extension UnsafeSvContext : UnsafeValueContext { 8 | func withUnsafeSvContext(_ body: (UnsafeSvContext) throws -> R) rethrows -> R { 9 | return try body(self) 10 | } 11 | } 12 | 13 | extension UnsafeAvContext : UnsafeValueContext { 14 | func withUnsafeSvContext(_ body: (UnsafeSvContext) throws -> R) rethrows -> R { 15 | return try av.withMemoryRebound(to: SV.self, capacity: 1) { sv in 16 | try body(UnsafeSvContext(sv: sv, perl: perl)) 17 | } 18 | } 19 | } 20 | 21 | extension UnsafeHvContext : UnsafeValueContext { 22 | func withUnsafeSvContext(_ body: (UnsafeSvContext) throws -> R) rethrows -> R { 23 | return try hv.withMemoryRebound(to: SV.self, capacity: 1) { sv in 24 | try body(UnsafeSvContext(sv: sv, perl: perl)) 25 | } 26 | } 27 | } 28 | 29 | extension UnsafeCvContext : UnsafeValueContext { 30 | func withUnsafeSvContext(_ body: (UnsafeSvContext) throws -> R) rethrows -> R { 31 | return try cv.withMemoryRebound(to: SV.self, capacity: 1) { sv in 32 | try body(UnsafeSvContext(sv: sv, perl: perl)) 33 | } 34 | } 35 | } 36 | 37 | extension UnsafeSvContext { 38 | func withUnsafeAvContext(_ body: (UnsafeAvContext) throws -> R) throws -> R { 39 | guard type == SVt_PVAV else { 40 | throw PerlError.unexpectedValueType(fromUnsafeSvContext(inc: self), want: PerlArray.self) 41 | } 42 | return try sv.withMemoryRebound(to: AV.self, capacity: 1) { av in 43 | try body(UnsafeAvContext(av: av, perl: perl)) 44 | } 45 | } 46 | 47 | func withUnsafeHvContext(_ body: (UnsafeHvContext) throws -> R) throws -> R { 48 | guard type == SVt_PVHV else { 49 | throw PerlError.unexpectedValueType(fromUnsafeSvContext(inc: self), want: PerlHash.self) 50 | } 51 | return try sv.withMemoryRebound(to: HV.self, capacity: 1) { hv in 52 | try body(UnsafeHvContext(hv: hv, perl: perl)) 53 | } 54 | } 55 | 56 | func withUnsafeCvContext(_ body: (UnsafeCvContext) throws -> R) throws -> R { 57 | guard type == SVt_PVCV else { 58 | throw PerlError.unexpectedValueType(fromUnsafeSvContext(inc: self), want: PerlSub.self) 59 | } 60 | return try sv.withMemoryRebound(to: CV.self, capacity: 1) { cv in 61 | try body(UnsafeCvContext(cv: cv, perl: perl)) 62 | } 63 | } 64 | 65 | init(rebind avc: UnsafeAvContext) { 66 | let sv = UnsafeMutableRawPointer(avc.av).bindMemory(to: SV.self, capacity: 1) 67 | self.init(sv: sv, perl: avc.perl) 68 | } 69 | 70 | init(rebind hvc: UnsafeHvContext) { 71 | let sv = UnsafeMutableRawPointer(hvc.hv).bindMemory(to: SV.self, capacity: 1) 72 | self.init(sv: sv, perl: hvc.perl) 73 | } 74 | 75 | init(rebind cvc: UnsafeCvContext) { 76 | let sv = UnsafeMutableRawPointer(cvc.cv).bindMemory(to: SV.self, capacity: 1) 77 | self.init(sv: sv, perl: cvc.perl) 78 | } 79 | } 80 | -------------------------------------------------------------------------------- /Sources/Perl/Util.swift: -------------------------------------------------------------------------------- 1 | func isStrictSubclass(_ child: AnyClass, of parent: AnyClass) -> Bool { 2 | var cur: AnyClass = child 3 | while let next = _getSuperclass(cur) { 4 | cur = next 5 | if cur == parent { 6 | return true 7 | } 8 | } 9 | return false 10 | } 11 | -------------------------------------------------------------------------------- /Sources/Perl/Value.swift: -------------------------------------------------------------------------------- 1 | import CPerl 2 | 3 | /// Provides a safe wrapper for any SV, which can contain any Perl value, 4 | /// not only scalars. Performs reference counting on initialization and 5 | /// deinitialization. 6 | open class PerlValue : AnyPerl, CustomDebugStringConvertible { 7 | let unsafeSvContext: UnsafeSvContext 8 | 9 | /// Unsafely creates an instance without incrementing a reference counter of a SV. 10 | /// Performs no type checks and should be used only if compatibility is known. 11 | public required init(noincUnchecked svc: UnsafeSvContext) { 12 | unsafeSvContext = svc 13 | } 14 | 15 | /// Unsafely creates an instance incrementing a reference counter of a SV. 16 | /// Performs no type checks and should be used only if compatibility is known. 17 | public required init(incUnchecked svc: UnsafeSvContext) { 18 | svc.refcntInc() 19 | unsafeSvContext = svc 20 | } 21 | 22 | /// Unsafely creates an instance without incrementing a reference counter of a SV. 23 | /// Performs type checks and throws an error unless compatible. 24 | public required convenience init(noinc svc: UnsafeSvContext) throws { 25 | self.init(noincUnchecked: svc) 26 | } 27 | 28 | /// Unsafely creates an instance incrementing a reference counter of a SV. 29 | /// Performs type checks and throws an error unless compatible. 30 | public required convenience init(inc svc: UnsafeSvContext) throws { 31 | svc.refcntInc() 32 | try self.init(noinc: svc) 33 | } 34 | 35 | /// Dereferences `ref`. 36 | public convenience init(dereferencing ref: PerlScalar) throws { 37 | guard let svc = ref.unsafeSvContext.referent else { 38 | throw PerlError.notReference(fromUnsafeSvContext(inc: ref.unsafeSvContext)) 39 | } 40 | try self.init(inc: svc) 41 | _fixLifetime(ref) 42 | } 43 | 44 | deinit { 45 | unsafeSvContext.refcntDec() 46 | } 47 | 48 | /// Invokes the given closure on the unsafe context containing pointers 49 | /// to the SV and the Perl interpreter. 50 | /// 51 | /// The `withUnsafeSvContext(_:)` method ensures that the SV's 52 | /// lifetime extends through the execution of `body`. 53 | /// 54 | /// - Parameter body: A closure that takes `UnsafeSvContext` as its argument. 55 | /// If the closure has a return value, it is used as the 56 | /// return value of the `withUnsafeSvContext(_:)` method. 57 | /// - Returns: The return value of the `body` closure, if any. 58 | public final func withUnsafeSvContext(_ body: (UnsafeSvContext) throws -> R) rethrows -> R { 59 | defer { _fixLifetime(self) } 60 | return try body(unsafeSvContext) 61 | } 62 | 63 | var type: svtype { 64 | defer { _fixLifetime(self) } 65 | return unsafeSvContext.type 66 | } 67 | 68 | static func derivedClass(for svc: UnsafeSvContext) -> PerlValue.Type { 69 | switch svc.type { 70 | case let t where t.rawValue < SVt_PVAV.rawValue: 71 | if let classname = svc.classname { 72 | return PerlObject.derivedClass(for: classname) 73 | } else { 74 | return PerlScalar.self 75 | } 76 | case SVt_PVAV: return PerlArray.self 77 | case SVt_PVHV: return PerlHash.self 78 | case SVt_PVCV: return PerlSub.self 79 | default: return PerlValue.self 80 | } 81 | } 82 | 83 | static func initDerived(noinc svc: UnsafeSvContext) -> PerlValue { 84 | let subclass = derivedClass(for: svc) 85 | return subclass.init(noincUnchecked: svc) 86 | } 87 | 88 | static func initDerived(inc svc: UnsafeSvContext) -> PerlValue { 89 | let subclass = derivedClass(for: svc) 90 | return subclass.init(incUnchecked: svc) 91 | } 92 | 93 | /// Dumps the contents of the underlying SV to the "STDERR" filehandle. 94 | public func dump() { 95 | withUnsafeSvContext { $0.dump() } 96 | } 97 | 98 | /// A textual representation of the SV, suitable for debugging. 99 | public var debugDescription: String { 100 | return "PerlValue(\(type))" 101 | } 102 | } 103 | -------------------------------------------------------------------------------- /Sources/swiftperl-benchmark/main.swift: -------------------------------------------------------------------------------- 1 | import Benchmark 2 | import Perl 3 | 4 | func run(_ code: String, count: Int = 1000000) { 5 | let sample = benchmark { try! perl.eval("\(code) for (1..\(count));") } 6 | print("\"\(code)\",\(sample.cpu)") 7 | } 8 | 9 | func run(_ name: String, count: Int = 1000000, body: () -> Void) { 10 | let sample = benchmark(count: count, body) 11 | print("\"\(name)\",\(sample.cpu)") 12 | } 13 | 14 | final class TestObject : PerlObject, PerlNamedClass { 15 | static let perlClassName = "TestObject" 16 | } 17 | 18 | final class TestBridgedObject : PerlBridgedObject { 19 | static let perlClassName = "TestBridgedObject" 20 | } 21 | 22 | let perl = PerlInterpreter.new() 23 | defer { perl.destroy() } 24 | 25 | TestObject.register() 26 | let obj: PerlObject = try! perl.eval("bless {}, 'TestAnyObject'") 27 | let subobj: TestObject = try! perl.eval("bless {}, 'TestObject'") 28 | 29 | PerlSub(name: "void") { () -> Void in } 30 | 31 | PerlSub(name: "in_int") { (_: Int) -> Void in } 32 | PerlSub(name: "in_string") { (_: String) -> Void in } 33 | PerlSub(name: "in_scalar") { (_: PerlScalar) -> Void in } 34 | PerlSub(name: "in_object") { (_: PerlObject) -> Void in } 35 | PerlSub(name: "in_subobject") { (_: TestObject) -> Void in } 36 | PerlSub(name: "in_bridged_object") { (_: TestBridgedObject) -> Void in } 37 | 38 | PerlSub(name: "in_arrint") { (_: [Int]) -> Void in } 39 | PerlSub(name: "in_arrstring") { (_: [String]) -> Void in } 40 | PerlSub(name: "in_arrscalar") { (_: [PerlScalar]) -> Void in } 41 | 42 | PerlSub(name: "in_dictint") { (_: [String: Int]) -> Void in } 43 | PerlSub(name: "in_dictstring") { (_: [String: String]) -> Void in } 44 | PerlSub(name: "in_dictscalar") { (_: [String: PerlScalar]) -> Void in } 45 | 46 | PerlSub(name: "out_int") { () -> Int in 10 } 47 | PerlSub(name: "out_string") { () -> String in "string" } 48 | PerlSub(name: "out_scalar") { () -> PerlScalar in PerlScalar() } 49 | PerlSub(name: "out_object") { () -> PerlObject in obj } 50 | PerlSub(name: "out_subobject") { () -> TestObject in subobj } 51 | PerlSub(name: "out_bridged_object") { () -> TestBridgedObject in TestBridgedObject() } 52 | 53 | PerlSub(name: "last_resort") { [try $0.get(0) as Int, try $0.get(1) as String] } 54 | 55 | PerlSub(name: "lr_void") { (_: PerlSub.Args) in [] } 56 | 57 | PerlSub(name: "lr_in_int") { (args: PerlSub.Args) in _ = try args.get(0) as Int; return [] } 58 | PerlSub(name: "lr_in_string") { (args: PerlSub.Args) in _ = try args.get(0) as String; return [] } 59 | PerlSub(name: "lr_in_scalar") { (args: PerlSub.Args) in _ = args[0]; return [] } 60 | PerlSub(name: "lr_in_object") { (args: PerlSub.Args) in _ = try args.get(0) as PerlObject; return [] } 61 | PerlSub(name: "lr_in_subobject") { (args: PerlSub.Args) in _ = try args.get(0) as TestObject; return [] } 62 | PerlSub(name: "lr_in_bridged_object") { (args: PerlSub.Args) in _ = try args.get(0) as TestBridgedObject; return [] } 63 | 64 | PerlSub(name: "lr_out_int") { _ in [10] } 65 | PerlSub(name: "lr_out_string") { _ in ["string"] } 66 | PerlSub(name: "lr_out_scalar") { _ in [PerlScalar()] } 67 | PerlSub(name: "lr_out_object") { _ in [obj] } 68 | PerlSub(name: "lr_out_subobject") { _ in [subobj] } 69 | PerlSub(name: "lr_out_bridged_object") { _ in [TestBridgedObject()] } 70 | 71 | run("void()") 72 | 73 | run("in_int(10)") 74 | run("in_string('строченька')") 75 | run("in_string('ascii-string')") 76 | run("in_scalar(undef)") 77 | run("in_object(bless {}, 'TestAnyObject')") 78 | run("in_subobject(bless {}, 'TestObject')") 79 | run("in_object(bless {}, 'TestObject')") 80 | try! perl.eval("$brobj = out_bridged_object()"); run("in_bridged_object($brobj)") 81 | 82 | run("in_arrint(10)") 83 | run("in_arrstring('строченька')") 84 | run("in_arrstring('ascii-string')") 85 | run("in_arrscalar(undef)") 86 | 87 | run("in_dictint(k => 10)") 88 | run("in_dictstring(k => 'строченька')") 89 | run("in_dictstring(k => 'ascii-string')") 90 | run("in_dictscalar(k => undef)") 91 | 92 | run("out_int()") 93 | run("out_string()") 94 | run("out_scalar()") 95 | run("out_object()") 96 | run("out_subobject()") 97 | run("out_bridged_object()") 98 | 99 | run("last_resort(10, 'string')") 100 | 101 | run("lr_void()") 102 | 103 | run("lr_in_int(10)") 104 | run("lr_in_string('ascii-string')") 105 | run("lr_in_scalar(undef)") 106 | run("lr_in_object(bless {}, 'TestAnyObject')") 107 | run("lr_in_subobject(bless {}, 'TestObject')") 108 | run("lr_in_object(bless {}, 'TestObject')") 109 | try! perl.eval("$brobj = out_bridged_object()"); run("lr_in_bridged_object($brobj)") 110 | 111 | run("lr_out_int()") 112 | run("lr_out_string()") 113 | run("lr_out_scalar()") 114 | run("lr_out_object()") 115 | run("lr_out_subobject()") 116 | run("lr_out_bridged_object()") 117 | 118 | try perl.eval("sub nop {}") 119 | run("nop()") { try! perl.call(sub: "nop") } 120 | 121 | let nop = PerlSub(get: "nop")! 122 | run("$nop->()") { try! nop.call() } 123 | 124 | try perl.eval("sub TestObject::nop {}") 125 | run("TestObject->nop()") { try! TestObject.call(method: "nop") } 126 | run("$obj->nop()") { try! subobj.call(method: "nop") } 127 | -------------------------------------------------------------------------------- /Tests/LinuxMain.swift: -------------------------------------------------------------------------------- 1 | import XCTest 2 | 3 | @testable import PerlTests 4 | 5 | var tests = [XCTestCaseEntry]() 6 | tests += [testCase(EmbedTests.allTests)] 7 | tests += [testCase(ConvertFromPerlTests.allTests)] 8 | tests += [testCase(ConvertToPerlTests.allTests)] 9 | tests += [testCase(ObjectTests.allTests)] 10 | tests += [testCase(CallTests.allTests)] 11 | tests += [testCase(InternalTests.allTests)] 12 | tests += [testCase(BenchmarkTests.allTests)] 13 | XCTMain(tests) 14 | -------------------------------------------------------------------------------- /Tests/PerlTests/Benchmark.swift: -------------------------------------------------------------------------------- 1 | import XCTest 2 | import Perl 3 | 4 | class BenchmarkTests : EmbeddedTestCase { 5 | static var allTests: [(String, (BenchmarkTests) -> () throws -> Void)] { 6 | return [ 7 | ("testBenchmarkPerlOnly", testBenchmarkPerlOnly), 8 | ("testBenchmarkCallPerl", testBenchmarkCallPerl), 9 | ("testBenchmarkCallFromPerl", testBenchmarkCallFromPerl), 10 | ] 11 | } 12 | 13 | func testBenchmarkPerlOnly() throws { 14 | _ = try perl.eval("sub test { my ($c, $d) = @_; return $c + $d }") 15 | let sv: PerlScalar = try perl.eval("my $s; for (1..100000) { $s = test(10, 15) } $s") 16 | XCTAssertEqual(try Int(sv), 25) 17 | } 18 | 19 | func testBenchmarkCallPerl() throws { 20 | let sv: PerlScalar = try perl.eval("sub test { my ($c, $d) = @_; return $c + $d } \\&test") 21 | let cv: PerlSub = try PerlSub(sv) 22 | var s: Int? 23 | for _ in 1...100000 { 24 | s = try cv.call(10, 15) 25 | } 26 | XCTAssertEqual(s, 25) 27 | } 28 | 29 | func testBenchmarkCallFromPerl() throws { 30 | _ = PerlSub(name: "test") { 31 | (c: Int, d: Int) -> Int in 32 | return c + d 33 | } 34 | let sv: PerlScalar = try perl.eval("my $s; for (1..100000) { $s = test(10, 15) } $s") 35 | XCTAssertEqual(try Int(sv), 25) 36 | } 37 | /* 38 | func testBenchmarkPerlOnly() { 39 | _ = perl.eval("sub test { my ($f, $c, $d) = @_; return $f . ($c + $d) }") 40 | let sv = perl.eval("my $str; for (1..100000) { $str = test('value: ', 10, 15) } $str") 41 | XCTAssertEqual(String(sv), "value: 25") 42 | } 43 | 44 | func testBenchmarkCallPerl() throws { 45 | // _ = perl.eval("sub test { my ($f, $c, $d) = @_; return $f . ($c + $d) }") 46 | let sv = perl.eval("sub test { my ($f, $c, $d) = @_; return $f . ($c + $d) } \\&test") 47 | let cv: PerlSub = try sv.value() 48 | var str: String? 49 | for _ in 1...100000 { 50 | // str = try PerlInterpreter.call(sub: "test", args: "value: ", 10, 15) 51 | str = try cv.call("value: ", 10, 15) 52 | } 53 | XCTAssertEqual(str, "value: 25") 54 | } 55 | 56 | func testBenchmarkCallFromPerl() { 57 | _ = PerlSub(name: "test") { 58 | (f: String, c: Int, d: Int) -> String in 59 | return f + String(c + d) 60 | } 61 | let sv = perl.eval("my $str; for (1..100000) { $str = test('value: ', 10, 15) } $str") 62 | XCTAssertEqual(String(sv), "value: 25") 63 | } 64 | 65 | func testBenchmarkPerlOnly() { 66 | _ = perl.eval("sub test { return }") 67 | _ = perl.eval("for (1..1000000) { test() }") 68 | } 69 | 70 | func testBenchmarkCallPerl() throws { 71 | // _ = perl.eval("sub test { return }") 72 | let sv = perl.eval("sub test { return }; \\&test") 73 | let cv: PerlSub = try sv.value() 74 | for _ in 1...1000000 { 75 | // try PerlInterpreter.call(sub: "test") as Void 76 | try cv.call() 77 | } 78 | } 79 | 80 | func testBenchmarkCallFromPerl() { 81 | _ = PerlSub(name: "test") { 82 | () throws -> () in () 83 | } 84 | _ = perl.eval("for (1..1000000) { test() }") 85 | } 86 | */ 87 | } 88 | -------------------------------------------------------------------------------- /Tests/PerlTests/Call.swift: -------------------------------------------------------------------------------- 1 | import XCTest 2 | @testable import Perl 3 | 4 | class CallTests : EmbeddedTestCase { 5 | static var allTests = [ 6 | ("testContext", testContext), 7 | ] 8 | 9 | func testContext() throws { 10 | try perl.eval("sub list1 { return qw/a b c/ }") 11 | let s1: String = try perl.call(sub: "list1") 12 | XCTAssertEqual(s1, "c") 13 | let l1: String = try perl.call(sub: "list1", context: .array) 14 | XCTAssertEqual(l1, "a") 15 | let a1 = try perl.call(sub: "list1", context: .array) 16 | XCTAssertEqual(try a1.map { try String($0) }, ["a", "b", "c"]) 17 | 18 | try perl.eval("sub list2 { my @l = qw/a b c/; return @l }") 19 | let s2: String = try perl.call(sub: "list2") 20 | XCTAssertEqual(s2, "3") 21 | let l2: String = try perl.call(sub: "list2", context: .array) 22 | XCTAssertEqual(l2, "a") 23 | let a2 = try perl.call(sub: "list2", context: .array) 24 | XCTAssertEqual(try a2.map { try String($0) }, ["a", "b", "c"]) 25 | 26 | let sub3 = PerlSub(name: "list3") { () -> (String, String) in 27 | return ("a", "b") 28 | } 29 | let s3: String = try sub3.call() 30 | XCTAssertEqual(s3, "b") 31 | let l3: String = try perl.call(sub: "list3", context: .array) 32 | XCTAssertEqual(l3, "a") 33 | let a3 = try perl.call(sub: "list3", context: .array) 34 | XCTAssertEqual(try a3.map { try String($0) }, ["a", "b"]) 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /Tests/PerlTests/ConvertFromPerl.swift: -------------------------------------------------------------------------------- 1 | import XCTest 2 | @testable import Perl 3 | 4 | class ConvertFromPerlTests : EmbeddedTestCase { 5 | static var allTests: [(String, (ConvertFromPerlTests) -> () throws -> Void)] { 6 | return [ 7 | ("testUndef", testUndef), 8 | ("testBool", testBool), 9 | ("testInt", testInt), 10 | ("testUInt", testUInt), 11 | ("testDouble", testDouble), 12 | ("testString", testString), 13 | ("testScalarRef", testScalarRef), 14 | ("testArrayRef", testArrayRef), 15 | ("testHashRef", testHashRef), 16 | ("testCodeRef", testCodeRef), 17 | ("testInterpreterMisc", testInterpreterMisc), 18 | ] 19 | } 20 | 21 | func testUndef() throws { 22 | let v: PerlScalar = try perl.eval("undef") 23 | XCTAssert(!v.defined) 24 | XCTAssert(!v.isInteger) 25 | XCTAssert(!v.isDouble) 26 | XCTAssert(!v.isString) 27 | XCTAssert(!v.isReference) 28 | XCTAssertNil(v.map { $0 }) 29 | XCTAssertNil(v.flatMap { $0 }) 30 | XCTAssertEqual(try Int(v ?? 10), 10) 31 | XCTAssertEqual(Int(unchecked: v), 0) 32 | XCTAssertEqual(Double(unchecked: v), 0) 33 | XCTAssertEqual(String(unchecked: v), "") 34 | } 35 | 36 | func testBool() throws { 37 | // Conversion directly from UnsafeSvPointer 38 | XCTAssertFalse(try perl.eval("undef")) 39 | XCTAssertFalse(try perl.eval("0")) 40 | XCTAssertFalse(try perl.eval("''")) 41 | XCTAssertFalse(try perl.eval("'0'")) 42 | XCTAssertTrue(try perl.eval("1")) 43 | XCTAssertTrue(try perl.eval("'1'")) 44 | XCTAssertTrue(try perl.eval("100")) 45 | XCTAssertTrue(try perl.eval("'100'")) 46 | XCTAssertTrue(try perl.eval("'000'")) 47 | XCTAssertTrue(try perl.eval("'anything'")) 48 | // Convertion from PerlScalar 49 | XCTAssertFalse(Bool(try perl.eval("undef") as PerlScalar)) 50 | XCTAssertFalse(Bool(try perl.eval("0") as PerlScalar)) 51 | XCTAssertFalse(Bool(try perl.eval("''") as PerlScalar)) 52 | XCTAssertFalse(Bool(try perl.eval("'0'") as PerlScalar)) 53 | XCTAssertTrue(Bool(try perl.eval("1") as PerlScalar)) 54 | XCTAssertTrue(Bool(try perl.eval("'1'") as PerlScalar)) 55 | XCTAssertTrue(Bool(try perl.eval("100") as PerlScalar)) 56 | XCTAssertTrue(Bool(try perl.eval("'100'") as PerlScalar)) 57 | XCTAssertTrue(Bool(try perl.eval("'000'") as PerlScalar)) 58 | XCTAssertTrue(Bool(try perl.eval("'anything'") as PerlScalar)) 59 | } 60 | 61 | func testInt() throws { 62 | let v: PerlScalar = try perl.eval("42") 63 | XCTAssert(v.defined) 64 | XCTAssert(v.isInteger) 65 | XCTAssert(!v.isDouble) 66 | XCTAssert(!v.isString) 67 | XCTAssert(!v.isReference) 68 | XCTAssertEqual(try Int(v), 42) 69 | XCTAssertEqual(try String(v), "42") 70 | // Implicit conversion from UnsafeSvPointer 71 | XCTAssertEqual(try perl.eval("42") as Int, 42) 72 | XCTAssertEqual(try perl.eval("'42'") as Int, 42) 73 | XCTAssertEqual(try perl.eval("42.5") as Int, 42) 74 | XCTAssertThrowsError(try perl.eval("undef") as Int) 75 | XCTAssertThrowsError(try perl.eval("''") as Int) 76 | XCTAssertThrowsError(try perl.eval("'ololo'") as Int) 77 | XCTAssertThrowsError(try perl.eval("'50sec'") as Int) 78 | XCTAssertThrowsError(try perl.eval("10000000000000000000") as Int) 79 | XCTAssertThrowsError(try perl.eval("20000000000000000000") as Int) 80 | XCTAssertEqual(try perl.eval("-10") as Int, -10) 81 | XCTAssertThrowsError(try perl.eval("-20000000000000000000") as Int) 82 | XCTAssertEqual(try perl.eval("\(Int.min)") as Int, Int.min) 83 | XCTAssertEqual(try perl.eval("\(Int.max)") as Int, Int.max) 84 | // Nilable implicit conversion from UnsafeSvPointer 85 | XCTAssertEqual(try perl.eval("42") as Int?, 42) 86 | XCTAssertEqual(try perl.eval("'42'") as Int?, 42) 87 | XCTAssertEqual(try perl.eval("42.0") as Int?, 42) 88 | XCTAssertEqual(try perl.eval("42.5") as Int?, 42) 89 | XCTAssertNil(try perl.eval("undef") as Int?) 90 | XCTAssertThrowsError(try perl.eval("''") as Int?) 91 | XCTAssertThrowsError(try perl.eval("'ololo'") as Int?) 92 | XCTAssertThrowsError(try perl.eval("'50sec'") as Int?) 93 | XCTAssertThrowsError(try perl.eval("10000000000000000000") as Int?) 94 | XCTAssertThrowsError(try perl.eval("20000000000000000000") as Int?) 95 | XCTAssertEqual(try perl.eval("-10") as Int?, -10) 96 | XCTAssertThrowsError(try perl.eval("-20000000000000000000") as Int?) 97 | // Conversion from PerlScalar 98 | XCTAssertEqual(try Int(try perl.eval("42") as PerlScalar), 42) 99 | XCTAssertEqual(try Int(try perl.eval("'42'") as PerlScalar), 42) 100 | XCTAssertEqual(try Int(try perl.eval("42.5") as PerlScalar), 42) 101 | XCTAssertThrowsError(try Int(try perl.eval("undef") as PerlScalar)) 102 | XCTAssertThrowsError(try Int(try perl.eval("''") as PerlScalar)) 103 | XCTAssertThrowsError(try Int(try perl.eval("'ololo'") as PerlScalar)) 104 | XCTAssertThrowsError(try Int(try perl.eval("'50sec'") as PerlScalar)) 105 | XCTAssertThrowsError(try Int(try perl.eval("10000000000000000000") as PerlScalar)) 106 | XCTAssertThrowsError(try Int(try perl.eval("20000000000000000000") as PerlScalar)) 107 | XCTAssertEqual(try Int(try perl.eval("-10") as PerlScalar), -10) 108 | XCTAssertThrowsError(try Int(try perl.eval("-20000000000000000000") as PerlScalar)) 109 | // Nilable conversion from PerlScalar 110 | XCTAssertEqual(try (perl.eval("42") as PerlScalar).map { try Int($0) }, 42) 111 | XCTAssertEqual(try (perl.eval("'42'") as PerlScalar).map { try Int($0) }, 42) 112 | XCTAssertEqual(try (perl.eval("42.5") as PerlScalar).map { try Int($0) }, 42) 113 | XCTAssertNil(try (perl.eval("undef") as PerlScalar).map { try Int($0) }) 114 | XCTAssertThrowsError(try (perl.eval("''") as PerlScalar).map { try Int($0) }) 115 | XCTAssertThrowsError(try (perl.eval("'ololo'") as PerlScalar).map { try Int($0) }) 116 | XCTAssertThrowsError(try (perl.eval("'50sec'") as PerlScalar).map { try Int($0) }) 117 | XCTAssertThrowsError(try (perl.eval("10000000000000000000") as PerlScalar).map { try Int($0) }) 118 | XCTAssertThrowsError(try (perl.eval("20000000000000000000") as PerlScalar).map { try Int($0) }) 119 | XCTAssertEqual(try (perl.eval("-10") as PerlScalar).map { try Int($0) }, -10) 120 | XCTAssertThrowsError(try (perl.eval("-20000000000000000000") as PerlScalar).map { try Int($0) }) 121 | // Unchecked conversion from PerlScalar 122 | XCTAssertEqual(Int(unchecked: try perl.eval("42") as PerlScalar), 42) 123 | XCTAssertEqual(Int(unchecked: try perl.eval("'42'") as PerlScalar), 42) 124 | XCTAssertEqual(Int(unchecked: try perl.eval("42.5") as PerlScalar), 42) 125 | XCTAssertEqual(Int(unchecked: try perl.eval("undef") as PerlScalar), 0) 126 | XCTAssertEqual(Int(unchecked: try perl.eval("''") as PerlScalar), 0) 127 | XCTAssertEqual(Int(unchecked: try perl.eval("'ololo'") as PerlScalar), 0) 128 | XCTAssertEqual(Int(unchecked: try perl.eval("'50sec'") as PerlScalar), 50) 129 | XCTAssertEqual(Int(unchecked: try perl.eval("10000000000000000000") as PerlScalar), Int(bitPattern: 10000000000000000000)) 130 | XCTAssertEqual(Int(unchecked: try perl.eval("20000000000000000000") as PerlScalar), Int(bitPattern: UInt.max)) 131 | XCTAssertEqual(Int(unchecked: try perl.eval("-10") as PerlScalar), -10) 132 | XCTAssertEqual(Int(unchecked: try perl.eval("-20000000000000000000") as PerlScalar), Int.min) 133 | } 134 | 135 | func testUInt() throws { 136 | let v: PerlScalar = try perl.eval("42") 137 | XCTAssert(v.defined) 138 | XCTAssert(v.isInteger) 139 | XCTAssert(!v.isDouble) 140 | XCTAssert(!v.isString) 141 | XCTAssert(!v.isReference) 142 | XCTAssertEqual(try UInt(v), 42) 143 | XCTAssertEqual(try String(v), "42") 144 | // Implicit conversion from UnsafeSvPointer 145 | XCTAssertEqual(try perl.eval("42") as UInt, 42) 146 | XCTAssertEqual(try perl.eval("'42'") as UInt, 42) 147 | XCTAssertEqual(try perl.eval("42.5") as UInt, 42) 148 | XCTAssertThrowsError(try perl.eval("undef") as UInt) 149 | XCTAssertThrowsError(try perl.eval("''") as UInt) 150 | XCTAssertThrowsError(try perl.eval("'ololo'") as UInt) 151 | XCTAssertThrowsError(try perl.eval("'50sec'") as UInt) 152 | XCTAssertEqual(try perl.eval("10000000000000000000") as UInt, 10000000000000000000) 153 | XCTAssertThrowsError(try perl.eval("20000000000000000000") as UInt) 154 | XCTAssertThrowsError(try perl.eval("-10") as UInt) 155 | XCTAssertThrowsError(try perl.eval("-20000000000000000000") as UInt) 156 | XCTAssertEqual(try perl.eval("\(UInt.min)") as UInt, UInt.min) 157 | XCTAssertEqual(try perl.eval("\(UInt.max)") as UInt, UInt.max) 158 | // Nilable implicit conversion from UnsafeSvPointer 159 | XCTAssertEqual(try perl.eval("42") as UInt?, 42) 160 | XCTAssertEqual(try perl.eval("'42'") as UInt?, 42) 161 | XCTAssertEqual(try perl.eval("42.5") as UInt?, 42) 162 | XCTAssertNil(try perl.eval("undef") as UInt?) 163 | XCTAssertThrowsError(try perl.eval("''") as UInt?) 164 | XCTAssertThrowsError(try perl.eval("'ololo'") as UInt?) 165 | XCTAssertThrowsError(try perl.eval("'50sec'") as UInt?) 166 | XCTAssertEqual(try perl.eval("10000000000000000000") as UInt?, 10000000000000000000) 167 | XCTAssertThrowsError(try perl.eval("20000000000000000000") as UInt?) 168 | XCTAssertThrowsError(try perl.eval("-10") as UInt?) 169 | XCTAssertThrowsError(try perl.eval("-20000000000000000000") as UInt?) 170 | // Conversion from PerlScalar 171 | XCTAssertEqual(try UInt(try perl.eval("42") as PerlScalar), 42) 172 | XCTAssertEqual(try UInt(try perl.eval("'42'") as PerlScalar), 42) 173 | XCTAssertEqual(try UInt(try perl.eval("42.5") as PerlScalar), 42) 174 | XCTAssertThrowsError(try UInt(try perl.eval("undef") as PerlScalar)) 175 | XCTAssertThrowsError(try UInt(try perl.eval("''") as PerlScalar)) 176 | XCTAssertThrowsError(try UInt(try perl.eval("'ololo'") as PerlScalar)) 177 | XCTAssertThrowsError(try UInt(try perl.eval("'50sec'") as PerlScalar)) 178 | XCTAssertEqual(try UInt(try perl.eval("10000000000000000000") as PerlScalar), 10000000000000000000) 179 | XCTAssertThrowsError(try UInt(try perl.eval("20000000000000000000") as PerlScalar)) 180 | XCTAssertThrowsError(try UInt(try perl.eval("-10") as PerlScalar)) 181 | XCTAssertThrowsError(try UInt(try perl.eval("-20000000000000000000") as PerlScalar)) 182 | // Nilable conversion from PerlScalar 183 | XCTAssertEqual(try (perl.eval("42") as PerlScalar).map { try UInt($0) }, 42) 184 | XCTAssertEqual(try (perl.eval("'42'") as PerlScalar).map { try UInt($0) }, 42) 185 | XCTAssertEqual(try (perl.eval("42.5") as PerlScalar).map { try UInt($0) }, 42) 186 | XCTAssertNil(try (perl.eval("undef") as PerlScalar).map { try UInt($0) }) 187 | XCTAssertThrowsError(try (perl.eval("''") as PerlScalar).map { try UInt($0) }) 188 | XCTAssertThrowsError(try (perl.eval("'ololo'") as PerlScalar).map { try UInt($0) }) 189 | XCTAssertThrowsError(try (perl.eval("'50sec'") as PerlScalar).map { try UInt($0) }) 190 | XCTAssertEqual(try (perl.eval("10000000000000000000") as PerlScalar).map { try UInt($0) }, 10000000000000000000) 191 | XCTAssertThrowsError(try (perl.eval("20000000000000000000") as PerlScalar).map { try UInt($0) }) 192 | XCTAssertThrowsError(try (perl.eval("-10") as PerlScalar).map { try UInt($0) }) 193 | XCTAssertThrowsError(try (perl.eval("-20000000000000000000") as PerlScalar).map { try UInt($0) }) 194 | // Unchecked conversion from PerlScalar 195 | XCTAssertEqual(UInt(unchecked: try perl.eval("42") as PerlScalar), 42) 196 | XCTAssertEqual(UInt(unchecked: try perl.eval("'42'") as PerlScalar), 42) 197 | XCTAssertEqual(UInt(unchecked: try perl.eval("42.5") as PerlScalar), 42) 198 | XCTAssertEqual(UInt(unchecked: try perl.eval("undef") as PerlScalar), 0) 199 | XCTAssertEqual(UInt(unchecked: try perl.eval("''") as PerlScalar), 0) 200 | XCTAssertEqual(UInt(unchecked: try perl.eval("'ololo'") as PerlScalar), 0) 201 | XCTAssertEqual(UInt(unchecked: try perl.eval("'50sec'") as PerlScalar), 50) 202 | XCTAssertEqual(UInt(unchecked: try perl.eval("10000000000000000000") as PerlScalar), 10000000000000000000) 203 | XCTAssertEqual(UInt(unchecked: try perl.eval("20000000000000000000") as PerlScalar), UInt.max) 204 | XCTAssertEqual(UInt(unchecked: try perl.eval("-10") as PerlScalar), UInt(bitPattern: -10)) 205 | XCTAssertEqual(UInt(unchecked: try perl.eval("-20000000000000000000") as PerlScalar), UInt(bitPattern: Int.min)) 206 | } 207 | 208 | func testDouble() throws { 209 | let v: PerlScalar = try perl.eval("42.3") 210 | XCTAssert(v.defined) 211 | XCTAssert(!v.isInteger) 212 | XCTAssert(v.isDouble) 213 | XCTAssert(!v.isString) 214 | XCTAssert(!v.isReference) 215 | XCTAssertEqual(try Double(v), 42.3) 216 | XCTAssertEqual(try String(v), "42.3") 217 | // Implicit conversion from UnsafeSvPointer 218 | XCTAssertEqual(try perl.eval("42.3") as Double, 42.3) 219 | XCTAssertEqual(try perl.eval("'42.3'") as Double, 42.3) 220 | XCTAssertEqual(try perl.eval("42") as Double, 42) 221 | XCTAssertThrowsError(try perl.eval("undef") as Double) 222 | XCTAssertThrowsError(try perl.eval("''") as Double) 223 | XCTAssertThrowsError(try perl.eval("'ololo'") as Double) 224 | XCTAssertThrowsError(try perl.eval("'50sec'") as Double) 225 | XCTAssertEqual(try perl.eval("10000000000000000001") as Double, 1e19) 226 | XCTAssertEqual(try perl.eval("'10000000000000000001'") as Double, 1e19) 227 | // Nilable implicit conversion from UnsafeSvPointer 228 | XCTAssertEqual(try perl.eval("42.3") as Double?, 42.3) 229 | XCTAssertEqual(try perl.eval("'42.3'") as Double?, 42.3) 230 | XCTAssertEqual(try perl.eval("42") as Double?, 42) 231 | XCTAssertNil(try perl.eval("undef") as Double?) 232 | XCTAssertThrowsError(try perl.eval("''") as Double?) 233 | XCTAssertThrowsError(try perl.eval("'ololo'") as Double?) 234 | XCTAssertThrowsError(try perl.eval("'50sec'") as Double?) 235 | XCTAssertEqual(try perl.eval("10000000000000000001") as Double?, 1e19) 236 | XCTAssertEqual(try perl.eval("'10000000000000000001'") as Double?, 1e19) 237 | // Conversion from PerlScalar 238 | XCTAssertEqual(try Double(try perl.eval("42.3") as PerlScalar), 42.3) 239 | XCTAssertEqual(try Double(try perl.eval("'42.3'") as PerlScalar), 42.3) 240 | XCTAssertEqual(try Double(try perl.eval("42") as PerlScalar), 42) 241 | XCTAssertThrowsError(try Double(try perl.eval("undef") as PerlScalar)) 242 | XCTAssertThrowsError(try Double(try perl.eval("''") as PerlScalar)) 243 | XCTAssertThrowsError(try Double(try perl.eval("'ololo'") as PerlScalar)) 244 | XCTAssertThrowsError(try Double(try perl.eval("'50sec'") as PerlScalar)) 245 | XCTAssertEqual(try Double(try perl.eval("10000000000000000001") as PerlScalar), 1e19) 246 | XCTAssertEqual(try Double(try perl.eval("'10000000000000000001'") as PerlScalar), 1e19) 247 | // Nilable conversion from PerlScalar 248 | XCTAssertEqual(try (perl.eval("42.3") as PerlScalar).map { try Double($0) }, 42.3) 249 | XCTAssertEqual(try (perl.eval("'42.3'") as PerlScalar).map { try Double($0) }, 42.3) 250 | XCTAssertEqual(try (perl.eval("42") as PerlScalar).map { try Double($0) }, 42) 251 | XCTAssertNil(try (perl.eval("undef") as PerlScalar).map { try Double($0) }) 252 | XCTAssertThrowsError(try (perl.eval("''") as PerlScalar).map { try Double($0) }) 253 | XCTAssertThrowsError(try (perl.eval("'ololo'") as PerlScalar).map { try Double($0) }) 254 | XCTAssertThrowsError(try (perl.eval("'50sec'") as PerlScalar).map { try Double($0) }) 255 | XCTAssertEqual(try (perl.eval("10000000000000000001") as PerlScalar).map { try Double($0) }, 1e19) 256 | XCTAssertEqual(try (perl.eval("'10000000000000000001'") as PerlScalar).map { try Double($0) }, 1e19) 257 | // Unchecked conversion from PerlScalar 258 | XCTAssertEqual(Double(unchecked: try perl.eval("42.3") as PerlScalar), 42.3) 259 | XCTAssertEqual(Double(unchecked: try perl.eval("'42.3'") as PerlScalar), 42.3) 260 | XCTAssertEqual(Double(unchecked: try perl.eval("42") as PerlScalar), 42) 261 | XCTAssertEqual(Double(unchecked: try perl.eval("undef") as PerlScalar), 0) 262 | XCTAssertEqual(Double(unchecked: try perl.eval("''") as PerlScalar), 0) 263 | XCTAssertEqual(Double(unchecked: try perl.eval("'ololo'") as PerlScalar), 0) 264 | XCTAssertEqual(Double(unchecked: try perl.eval("'50sec'") as PerlScalar), 50) 265 | XCTAssertEqual(Double(unchecked: try perl.eval("'50.3sec'") as PerlScalar), 50.3) 266 | XCTAssertEqual(Double(unchecked: try perl.eval("10000000000000000001") as PerlScalar), 1e19) 267 | XCTAssertEqual(Double(unchecked: try perl.eval("'10000000000000000001'") as PerlScalar), 1e19) 268 | } 269 | 270 | func testString() throws { 271 | let v: PerlScalar = try perl.eval("'test'") 272 | XCTAssert(v.defined) 273 | XCTAssert(!v.isInteger) 274 | XCTAssert(!v.isDouble) 275 | XCTAssert(v.isString) 276 | XCTAssert(!v.isReference) 277 | XCTAssertThrowsError(try Int(v)) 278 | XCTAssertThrowsError(try Double(v)) 279 | XCTAssertEqual(try String(v), "test") 280 | XCTAssertEqual(try String(v), "test") 281 | let u: PerlScalar = try perl.eval("'строченька'") 282 | XCTAssertEqual(try String(u), "строченька") 283 | let n: PerlScalar = try perl.eval("'null' . chr(0) . 'sepparated'") 284 | XCTAssertEqual(try String(n), "null\0sepparated") 285 | // Implicit conversion from UnsafeSvPointer 286 | XCTAssertEqual(try perl.eval("'anything'") as String, "anything") 287 | XCTAssertEqual(try perl.eval("42") as String, "42") 288 | XCTAssertEqual(try perl.eval("42.5") as String, "42.5") 289 | XCTAssertThrowsError(try perl.eval("undef") as String) 290 | XCTAssertThrowsError(try perl.eval("\\10") as String) 291 | // Nilable implicit conversion from UnsafeSvPointer 292 | XCTAssertEqual(try perl.eval("'anything'") as String?, "anything") 293 | XCTAssertEqual(try perl.eval("42") as String?, "42") 294 | XCTAssertEqual(try perl.eval("42.5") as String?, "42.5") 295 | XCTAssertNil(try perl.eval("undef") as String?) 296 | XCTAssertThrowsError(try perl.eval("\\10") as String?) 297 | // Conversion from PerlScalar 298 | XCTAssertEqual(try String(try perl.eval("'anything'") as PerlScalar), "anything") 299 | XCTAssertEqual(try String(try perl.eval("42") as PerlScalar), "42") 300 | XCTAssertEqual(try String(try perl.eval("42.5") as PerlScalar), "42.5") 301 | XCTAssertThrowsError(try String(try perl.eval("undef") as PerlScalar)) 302 | XCTAssertThrowsError(try String(try perl.eval("\\10") as PerlScalar)) 303 | // Nilable conversion from PerlScalar 304 | XCTAssertEqual(try (perl.eval("'anything'") as PerlScalar).map { try String($0) }, "anything") 305 | XCTAssertEqual(try (perl.eval("42") as PerlScalar).map { try String($0) }, "42") 306 | XCTAssertEqual(try (perl.eval("42.5") as PerlScalar).map { try String($0) }, "42.5") 307 | XCTAssertNil(try (perl.eval("undef") as PerlScalar).map { try String($0) }) 308 | XCTAssertThrowsError(try (perl.eval("\\10") as PerlScalar).map { try String($0) }) 309 | // Unchecked conversion from PerlScalar 310 | XCTAssertEqual(String(unchecked: try perl.eval("'anything'") as PerlScalar), "anything") 311 | XCTAssertEqual(String(unchecked: try perl.eval("42") as PerlScalar), "42") 312 | XCTAssertEqual(String(unchecked: try perl.eval("42.5") as PerlScalar), "42.5") 313 | XCTAssertEqual(String(unchecked: try perl.eval("undef") as PerlScalar), "") 314 | XCTAssert(String(unchecked: try perl.eval("\\10") as PerlScalar).hasPrefix("SCALAR")) 315 | } 316 | 317 | func testScalarRef() throws { 318 | let v: PerlScalar = try perl.eval("\\42") 319 | XCTAssert(v.defined) 320 | XCTAssert(!v.isInteger) 321 | XCTAssert(!v.isDouble) 322 | XCTAssert(!v.isString) 323 | XCTAssert(v.isReference) 324 | XCTAssertNotNil(v.referent) 325 | let r = v.referent! as! PerlScalar 326 | XCTAssert(r.isInteger) 327 | XCTAssertEqual(try Int(r), 42) 328 | XCTAssertEqual(try Int(PerlScalar(dereferencing: v)), 42) 329 | let x: PerlScalar = try perl.eval("[]") 330 | XCTAssertThrowsError(try PerlScalar(dereferencing: x)) 331 | } 332 | 333 | func testArrayRef() throws { 334 | let sv: PerlScalar = try perl.eval("[42, 'str']") 335 | XCTAssert(sv.defined) 336 | XCTAssert(!sv.isInteger) 337 | XCTAssert(!sv.isDouble) 338 | XCTAssert(!sv.isString) 339 | XCTAssert(sv.isReference) 340 | XCTAssertNotNil(sv.referent) 341 | let av: PerlArray = try PerlArray(sv) 342 | XCTAssertEqual(av.count, 2) 343 | XCTAssertEqual(try Int(av[0]), 42) 344 | XCTAssertEqual(try String(av[1]), "str") 345 | XCTAssertEqual(try av.fetch(0), 42) 346 | XCTAssertEqual(try av.fetch(1), "str") 347 | XCTAssertNil(try av.fetch(5) as Int?) 348 | XCTAssertFalse(av[7].defined) 349 | let strs: [String] = try [String](sv) 350 | XCTAssertEqual(strs, ["42", "str"]) 351 | XCTAssertEqual(try [String](av), ["42", "str"]) 352 | XCTAssertEqual(try [String](sv), ["42", "str"]) 353 | 354 | av[9] = 100 355 | XCTAssertEqual(try Int(av[9]), 100) 356 | av.store(11, value: 200) 357 | XCTAssertEqual(try av.fetch(11), 200) 358 | av.delete(11) 359 | XCTAssertNil(try av.fetch(11) as Int?) 360 | av.store(11, value: 200) 361 | XCTAssertEqual(try av.delete(11), 200) 362 | XCTAssertNil(try av.fetch(11) as Int?) 363 | 364 | let i: PerlScalar = try perl.eval("[42, 15, 10]") 365 | let ints: [Int] = try [Int](i) 366 | XCTAssertEqual(ints, [42, 15, 10]) 367 | 368 | let s: PerlScalar = try perl.eval("[qw/one two three/]") 369 | let strings: [String] = try [String](s) 370 | XCTAssertEqual(strings, ["one", "two", "three"]) 371 | 372 | let x: PerlScalar = try perl.eval("\\42") 373 | XCTAssertThrowsError(try PerlArray(dereferencing: x)) 374 | } 375 | 376 | func testHashRef() throws { 377 | let sv: PerlScalar = try perl.eval("{ one => 1, two => 2, три => 3 }") 378 | XCTAssert(sv.defined) 379 | XCTAssert(!sv.isInteger) 380 | XCTAssert(!sv.isDouble) 381 | XCTAssert(!sv.isString) 382 | XCTAssert(sv.isReference) 383 | XCTAssertNotNil(sv.referent) 384 | let hv: PerlHash = try PerlHash(sv) 385 | // XCTAssertEqual(hv.count, 2) 386 | XCTAssertEqual(try Int(hv["one"]!), 1) 387 | XCTAssertEqual(try Int(hv["two"]!), 2) 388 | XCTAssertEqual(try Int(hv["три"]!), 3) 389 | // let hd: [String: Int] = try [String: Int](hv) 390 | // XCTAssertEqual(hd, ["one": 1, "two": 2]) 391 | let sd: [String: Int] = try [String: Int](sv) 392 | XCTAssertEqual(sd, ["one": 1, "two": 2, "три": 3]) 393 | XCTAssertEqual(sd, ["one": 1, "two": 2, "три": 3]) 394 | XCTAssertEqual(try [String: Int](hv), ["one": 1, "two": 2, "три": 3]) 395 | XCTAssertEqual(try [String: Int](sv), ["one": 1, "two": 2, "три": 3]) 396 | 397 | let x: PerlScalar = try perl.eval("\\42") 398 | XCTAssertThrowsError(try PerlHash(dereferencing: x)) 399 | } 400 | 401 | func testCodeRef() throws { 402 | let sv: PerlScalar = try perl.eval("sub { my ($c, $d) = @_; return $c + $d }") 403 | XCTAssert(sv.defined) 404 | XCTAssert(!sv.isInteger) 405 | XCTAssert(!sv.isDouble) 406 | XCTAssert(!sv.isString) 407 | XCTAssert(sv.isReference) 408 | XCTAssertNotNil(sv.referent) 409 | let cv: PerlSub = try PerlSub(sv) 410 | XCTAssertEqual(try cv.call(10, 15) as Int?, 25) 411 | // XCTAssertEqual(try sv.call(10, 15) as Int, 25) 412 | 413 | let sub: PerlSub = try perl.eval("my $stored = 40; sub { $_[0] = 20; return $stored }") 414 | let arg: PerlScalar = 10 415 | let r1: PerlScalar = try sub.call(arg) 416 | XCTAssertEqual(try Int(arg), 20) 417 | XCTAssertEqual(try Int(r1), 40) 418 | r1.set(50) 419 | let r2: PerlScalar = try sub.call(arg) 420 | XCTAssertEqual(try Int(r2), 40) 421 | 422 | var origsv: UnsafeSvPointer? 423 | var origptr: UnsafeRawPointer? 424 | let ret: PerlScalar = try PerlSub { () -> PerlScalar in 425 | let s = PerlScalar("ololo") 426 | s.withUnsafeSvContext { origsv = $0.sv } 427 | s.withUnsafeBytes { origptr = $0.baseAddress } 428 | return s 429 | }.call() 430 | ret.withUnsafeSvContext { XCTAssertNotEqual($0.sv, origsv, "Returned SV is not copied") } 431 | ret.withUnsafeBytes { XCTAssertEqual($0.baseAddress, origptr, "String of returned SV is not stealed") } 432 | 433 | let x: PerlScalar = try perl.eval("\\42") 434 | XCTAssertThrowsError(try PerlSub(dereferencing: x)) 435 | } 436 | 437 | func testInterpreterMisc() throws { 438 | try perl.eval("use utf8; $тест = 'OK'") 439 | let sv = PerlScalar(get: "тест") 440 | XCTAssertNotNil(sv) 441 | XCTAssertEqual(try String(sv!), "OK") 442 | } 443 | } 444 | -------------------------------------------------------------------------------- /Tests/PerlTests/ConvertToPerl.swift: -------------------------------------------------------------------------------- 1 | import XCTest 2 | @testable import Perl 3 | 4 | class ConvertToPerlTests : EmbeddedTestCase { 5 | static var allTests: [(String, (ConvertToPerlTests) -> () throws -> Void)] { 6 | return [ 7 | ("testUndef", testUndef), 8 | ("testBool", testBool), 9 | ("testInt", testInt), 10 | ("testUInt", testUInt), 11 | ("testDouble", testDouble), 12 | ("testString", testString), 13 | ("testScalarRef", testScalarRef), 14 | ("testArrayRef", testArrayRef), 15 | ("testHashRef", testHashRef), 16 | ("testXSub", testXSub), 17 | ] 18 | } 19 | 20 | func testUndef() throws { 21 | let v = PerlScalar() 22 | XCTAssert(!v.defined) 23 | try perl.eval("sub is_defined { return defined $_[0] }") 24 | XCTAssert(try !perl.call(sub: "is_defined", v)) 25 | let s = PerlScalar(10) 26 | s.set(nil) 27 | XCTAssert(try !perl.call(sub: "is_defined", s)) 28 | } 29 | 30 | func testBool() throws { 31 | try perl.eval("sub is_true { return $_[0] eq '1' }") 32 | try perl.eval("sub is_false { return $_[0] eq '' }") 33 | XCTAssert(try perl.call(sub: "is_true", PerlScalar(true))) 34 | XCTAssert(try perl.call(sub: "is_false", PerlScalar(false))) 35 | let s = PerlScalar() 36 | s.set(true) 37 | XCTAssert(try perl.call(sub: "is_true", s)) 38 | s.set(false) 39 | XCTAssert(try perl.call(sub: "is_false", s)) 40 | } 41 | 42 | func testInt() throws { 43 | let v = PerlScalar(10) 44 | XCTAssert(v.isInteger) 45 | try perl.eval("sub is_10 { return $_[0] == 10 }") 46 | XCTAssert(try perl.call(sub: "is_10", v)) 47 | let s = PerlScalar() 48 | s.set(10) 49 | XCTAssert(try perl.call(sub: "is_10", s)) 50 | } 51 | 52 | func testUInt() throws { 53 | let v = PerlScalar(10 as UInt) 54 | XCTAssert(v.isInteger) 55 | try perl.eval("sub is_10 { return $_[0] == 10 }") 56 | XCTAssert(try perl.call(sub: "is_10", v)) 57 | let s = PerlScalar() 58 | s.set(10 as UInt) 59 | XCTAssert(try perl.call(sub: "is_10", s)) 60 | } 61 | 62 | func testDouble() throws { 63 | let v = PerlScalar(10.3) 64 | XCTAssert(v.isDouble) 65 | try perl.eval("sub is_10dot3 { return $_[0] == 10.3 }") 66 | XCTAssert(try perl.call(sub: "is_10dot3", v)) 67 | let s = PerlScalar() 68 | s.set(10.3) 69 | XCTAssert(try perl.call(sub: "is_10dot3", s)) 70 | } 71 | 72 | func testString() throws { 73 | let a = PerlScalar("ascii string") 74 | XCTAssert(a.isString) 75 | try perl.eval("sub is_ascii_string { return !utf8::is_utf8($_[0]) && $_[0] eq 'ascii string' }") 76 | XCTAssert(try perl.call(sub: "is_ascii_string", a)) 77 | let u = PerlScalar("строченька") 78 | XCTAssert(u.isString) 79 | try perl.eval("sub is_utf8_string { return utf8::is_utf8($_[0]) && $_[0] eq 'строченька' }") 80 | XCTAssert(try perl.call(sub: "is_utf8_string", u)) 81 | try perl.eval("sub is_byte_string { return !utf8::is_utf8($_[0]) && $_[0] eq pack('C256', 0..255) }") 82 | let b = [UInt8](0...255).withUnsafeBytes { PerlScalar($0) } 83 | XCTAssert(try perl.call(sub: "is_byte_string", b)) 84 | let ba = [UInt8]("ascii string".utf8).withUnsafeBytes { PerlScalar($0, containing: .characters) } 85 | XCTAssert(try perl.call(sub: "is_ascii_string", ba)) 86 | let bu = [UInt8]("строченька".utf8).withUnsafeBytes { PerlScalar($0, containing: .characters) } 87 | XCTAssert(try perl.call(sub: "is_utf8_string", bu)) 88 | let s = PerlScalar() 89 | s.set("ascii string") 90 | XCTAssert(try perl.call(sub: "is_ascii_string", s)) 91 | s.set("строченька") 92 | XCTAssert(try perl.call(sub: "is_utf8_string", s)) 93 | [UInt8](0...255).withUnsafeBytes { s.set($0) } 94 | XCTAssert(try perl.call(sub: "is_byte_string", s)) 95 | [UInt8]("ascii string".utf8).withUnsafeBytes { s.set($0, containing: .characters) } 96 | XCTAssert(try perl.call(sub: "is_ascii_string", s)) 97 | [UInt8]("строченька".utf8).withUnsafeBytes { s.set($0, containing: .characters) } 98 | XCTAssert(try perl.call(sub: "is_utf8_string", s)) 99 | } 100 | 101 | func testScalarRef() throws { 102 | let v = PerlScalar(referenceTo: PerlScalar(10 as Int)) 103 | XCTAssert(v.isReference) 104 | try perl.eval("sub is_ref_10 { return ${$_[0]} == 10 }") 105 | XCTAssert(try perl.call(sub: "is_ref_10", v)) 106 | } 107 | 108 | func testArrayRef() throws { 109 | let array = [10, 20] 110 | let v = PerlScalar(referenceTo: PerlArray(array)) 111 | XCTAssert(v.isReference) 112 | try perl.eval("sub is_array { return @{$_[0]} == 2 && $_[0][0] == 10 && $_[0][1] == 20 }") 113 | XCTAssert(try perl.call(sub: "is_array", v)) 114 | let v2 = PerlScalar(PerlArray(array)) 115 | XCTAssert(try perl.call(sub: "is_array", v2)) 116 | let v3 = PerlScalar(array) 117 | XCTAssert(try perl.call(sub: "is_array", v3)) 118 | } 119 | 120 | func testHashRef() throws { 121 | let dict = ["a": 10, "b": 20] 122 | let v = PerlScalar(referenceTo: PerlHash(dict)) 123 | XCTAssert(v.isReference) 124 | try perl.eval("sub is_hash { return keys(%{$_[0]}) == 2 && $_[0]{a} == 10 && $_[0]{b} == 20 }") 125 | XCTAssert(try perl.call(sub: "is_hash", v)) 126 | let v2 = PerlScalar(PerlHash(dict)) 127 | XCTAssert(try perl.call(sub: "is_hash", v2)) 128 | let v3 = PerlScalar(dict) 129 | XCTAssert(try perl.call(sub: "is_hash", v3)) 130 | } 131 | 132 | func testXSub() throws { 133 | PerlSub(name: "testxsub") { 134 | (a: Int, b: Int) -> Int in 135 | XCTAssertEqual(a, 10) 136 | XCTAssertEqual(b, 15) 137 | return a + b 138 | } 139 | XCTAssertEqual(try perl.eval("testxsub(10, 15) == 25 ? 'OK' : 'FAIL'"), "OK") 140 | PerlSub(name: "testxsub2") { 141 | (a: Int?, b: Int?) -> Int in 142 | XCTAssertEqual(a, 10) 143 | XCTAssertNil(b) 144 | return a! + (b ?? 15) 145 | } 146 | XCTAssertEqual(try perl.eval("testxsub2(10, undef) == 25 ? 'OK' : 'FAIL'"), "OK") 147 | 148 | PerlSub(name: "testarraytail") { 149 | (a: Int, b: Int, extra: [String]) -> Int in 150 | XCTAssertEqual(a, 10) 151 | XCTAssertEqual(b, 15) 152 | XCTAssertEqual(extra, ["uno", "dos", "tres"]) 153 | return a + b 154 | } 155 | XCTAssertEqual(try perl.eval("testarraytail(10, 15, qw/uno dos tres/) == 25 ? 'OK' : 'FAIL'"), "OK") 156 | 157 | PerlSub(name: "testhashtail") { 158 | (a: Int, b: Int, options: [String: String]) -> Int in 159 | XCTAssertEqual(a, 10) 160 | XCTAssertEqual(b, 15) 161 | XCTAssertEqual(options, ["from": "master", "timeout": "10"]) 162 | return a + b 163 | } 164 | XCTAssertEqual(try perl.eval("testhashtail(10, 15, from => 'master', timeout => 10) == 25 ? 'OK' : 'FAIL'"), "OK") 165 | 166 | PerlSub(name: "testplain") { 167 | (args: [PerlScalar]) -> Int in 168 | XCTAssertEqual(try Int(args[0]), 10) 169 | XCTAssertEqual(try Int(args[1]), 15) 170 | XCTAssertEqual(try String(args[2]), "extra") 171 | return try Int(args[0]) + Int(args[1]) 172 | } 173 | XCTAssertEqual(try perl.eval("testplain(10, 15, 'extra') == 25 ? 'OK' : 'FAIL'"), "OK") 174 | 175 | PerlSub(name: "testlast") { 176 | (args: PerlSub.Args) in 177 | XCTAssertEqual(try Int(args[0]), 10) 178 | XCTAssertEqual(try Int(args[1]), 15) 179 | XCTAssertEqual(try String(args[2]), "extra") 180 | return [try Int(args[0]) + Int(args[1])] 181 | } 182 | XCTAssertEqual(try perl.eval("testlast(10, 15, 'extra') == 25 ? 'OK' : 'FAIL'"), "OK") 183 | 184 | PerlSub(name: "testnoarg") { 185 | (a: Int, b: PerlScalar) -> Int in 186 | XCTAssertEqual(a, 10) 187 | XCTAssertTrue(!b.defined) 188 | return 25 189 | } 190 | XCTAssertEqual(try perl.eval("testnoarg(10) == 25 ? 'OK' : 'FAIL'"), "OK") 191 | 192 | let orig = PerlScalar("ololo") 193 | let origsv = orig.withUnsafeSvContext { $0.sv } 194 | try PerlSub { (arg: PerlScalar) -> Void in 195 | arg.withUnsafeSvContext { XCTAssertNotEqual($0.sv, origsv, "Argument SV is not copied") } 196 | }.call(orig) 197 | 198 | var storedIn: PerlScalar? 199 | let storedOut: PerlScalar = 40 200 | PerlSub(name: "teststored") { 201 | (arg: PerlScalar) -> PerlScalar in 202 | storedIn = arg 203 | return storedOut 204 | } 205 | try perl.eval("my $si = 10; my $so = teststored($si); $si = 20; $so = 50") 206 | XCTAssertEqual(try Int(storedIn!), 10) 207 | XCTAssertEqual(try Int(storedOut), 40) 208 | } 209 | } 210 | -------------------------------------------------------------------------------- /Tests/PerlTests/Embed.swift: -------------------------------------------------------------------------------- 1 | import XCTest 2 | import Perl 3 | 4 | class EmbedTests: XCTestCase { 5 | func testEmbedding() throws { 6 | let perl = PerlInterpreter.new() 7 | defer { perl.destroy() } 8 | PerlInterpreter.current = perl 9 | let ok: String = try perl.eval("'OK'") 10 | XCTAssertEqual(ok, "OK") 11 | } 12 | } 13 | 14 | extension EmbedTests { 15 | static var allTests: [(String, (EmbedTests) -> () throws -> Void)] { 16 | return [ 17 | ("testEmbedding", testEmbedding) 18 | ] 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /Tests/PerlTests/EmbeddedTestCase.swift: -------------------------------------------------------------------------------- 1 | import XCTest 2 | import Perl 3 | 4 | class EmbeddedTestCase : XCTestCase { 5 | var perl: PerlInterpreter! 6 | 7 | override func setUp() { 8 | perl = PerlInterpreter.new() 9 | PerlInterpreter.current = perl 10 | } 11 | 12 | override func tearDown() { 13 | perl.destroy() 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /Tests/PerlTests/Internal.swift: -------------------------------------------------------------------------------- 1 | import XCTest 2 | @testable import Perl 3 | 4 | class InternalTests : EmbeddedTestCase { 5 | static let allTests = [ 6 | ("testSubclass", testSubclass), 7 | ] 8 | 9 | func testSubclass() { 10 | XCTAssertFalse(isStrictSubclass(A.self, of: A.self)) 11 | XCTAssertTrue(isStrictSubclass(B.self, of: A.self)) 12 | XCTAssertTrue(isStrictSubclass(C.self, of: A.self)) 13 | XCTAssertTrue(isStrictSubclass(C.self, of: B.self)) 14 | XCTAssertFalse(isStrictSubclass(C.self, of: C.self)) 15 | XCTAssertFalse(isStrictSubclass(D.self, of: C.self)) 16 | XCTAssertFalse(isStrictSubclass(A.self, of: B.self)) 17 | XCTAssertFalse(isStrictSubclass(E.self, of: A.self)) 18 | XCTAssertFalse(isStrictSubclass(F.self, of: A.self)) 19 | } 20 | } 21 | 22 | class A {} 23 | class B : A {} 24 | class C : B {} 25 | class D : B {} 26 | 27 | class E {} 28 | class F : E {} 29 | -------------------------------------------------------------------------------- /Tests/PerlTests/Object.swift: -------------------------------------------------------------------------------- 1 | import XCTest 2 | import Foundation 3 | import Perl 4 | 5 | class ObjectTests : EmbeddedTestCase { 6 | static var allTests: [(String, (ObjectTests) -> () throws -> Void)] { 7 | return [ 8 | ("testPerlObject", testPerlObject), 9 | ("testSwiftObject", testSwiftObject), 10 | ("testRefCnt", testRefCnt), 11 | ] 12 | } 13 | 14 | func testPerlObject() throws { 15 | try URI.initialize() 16 | let uri = try URI("https://my.mail.ru/music") 17 | XCTAssertEqual(uri.path, "/music") 18 | uri.path = "/video" 19 | XCTAssertEqual(uri.asString, "https://my.mail.ru/video") 20 | XCTAssertNoThrow(try perl.eval("bless {}, 'XXX'") as PerlObject) 21 | XCTAssertThrowsError(try perl.eval("bless {}, 'XXX'") as URI) 22 | XCTAssert((try perl.eval("bless {}, 'URI'") as PerlObject) is URI) 23 | } 24 | 25 | func testSwiftObject() throws { 26 | let url = NSURL(string: "https://my.mail.ru/music")! 27 | XCTAssertEqual(url.host, "my.mail.ru") 28 | NSURL.createPerlMethod("new") { 29 | (cname: String, str: String) -> NSURL in 30 | return NSURL(string: str)! 31 | } 32 | NSURL.createPerlMethod("host") { 33 | (obj: NSURL) -> String in 34 | return obj.host! 35 | } 36 | let host: String = try perl.eval("my $url = NSURL->new('https://my.mail.ru/music'); $url->host()") 37 | XCTAssertEqual(host, "my.mail.ru") 38 | } 39 | 40 | func testRefCnt() throws { 41 | TestRefCnt.createPerlMethod("new") { (cname: String) -> TestRefCnt in return TestRefCnt() } 42 | try perl.eval("TestRefCnt->new(); undef") 43 | XCTAssertEqual(TestRefCnt.refcnt, 0) 44 | } 45 | } 46 | 47 | final class URI : PerlObject, PerlNamedClass { 48 | static let perlClassName = "URI" 49 | 50 | convenience init(_ str: String) throws { 51 | try self.init(method: "new", args: [str]) 52 | } 53 | 54 | convenience init(_ str: String, scheme: String) throws { 55 | try self.init(method: "new", args: [str, scheme]) 56 | } 57 | 58 | convenience init(copyOf uri: URI) { 59 | try! self.init(uri.call(method: "clone") as PerlScalar) 60 | } 61 | 62 | var scheme: String? { return try! call(method: "scheme") } 63 | func scheme(_ scheme: String) throws -> String? { return try call(method: "scheme", scheme) } 64 | 65 | var path: String { 66 | get { return try! call(method: "path") } 67 | set { try! call(method: "path", newValue) as Void } 68 | } 69 | 70 | var asString: String { return try! call(method: "as_string") } 71 | 72 | func abs(base: String) -> String { return try! call(method: "abs", base) } 73 | func rel(base: String) -> String { return try! call(method: "rel", base) } 74 | 75 | var secure: Bool { return try! call(method: "secure") } 76 | } 77 | 78 | extension NSURL : PerlBridgedObject { 79 | public static let perlClassName = "NSURL" 80 | } 81 | 82 | final class TestRefCnt : PerlBridgedObject { 83 | static let perlClassName = "TestRefCnt" 84 | static var refcnt = 0 85 | init() { TestRefCnt.refcnt += 1 } 86 | deinit { TestRefCnt.refcnt -= 1 } 87 | } 88 | -------------------------------------------------------------------------------- /prepare: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use Config; 6 | use FindBin; 7 | 8 | my $root = $FindBin::Bin; 9 | 10 | expand_gyb(); 11 | write_modulemap(); 12 | write_pkgconfig(); 13 | 14 | sub expand_gyb { 15 | unless (-d ".build/gyb") { 16 | system("mkdir -p .build/gyb") == 0 17 | or die "Cannot mdkir .build/gyb"; 18 | foreach my $f (qw/ gyb gyb.py /) { 19 | system("curl -f -s https://raw.githubusercontent.com/apple/swift/master/utils/$f -o .build/gyb/$f") == 0 20 | or die "Failed to download gyb"; 21 | } 22 | chmod 0755, ".build/gyb/gyb" or die $!; 23 | } 24 | 25 | foreach my $f (qw# Sources/Perl/Call.swift Sources/Perl/Subroutine.swift #) { 26 | my $filename = "$root/$f"; 27 | system(".build/gyb/gyb $filename.gyb > $filename.tmp") == 0 28 | or die "Failed to expand gyb template\n"; 29 | commit_file($filename); 30 | } 31 | } 32 | 33 | sub write_modulemap { 34 | my $archlib = $Config{archlib}; 35 | my $perl = 'perl'; 36 | if ($Config{osname} ne 'darwin' && system('swiftc -o /dev/null -Xlinker -lperl - /dev/null') != 0) { 37 | die "Cannot find libperl.so\n" unless -f "$archlib/CORE/libperl.so"; 38 | $perl = "perl -Xlinker -rpath=$archlib/CORE -Xlinker -L$archlib/CORE"; 39 | } 40 | 41 | if ($Config{osname} eq 'darwin' && ! -f "$archlib/CORE/perl.h") { 42 | my $sdk_path = `xcrun --show-sdk-path`; 43 | chomp $sdk_path; 44 | $archlib = $sdk_path . $archlib; 45 | } 46 | 47 | write_file("$root/Sources/CPerl/module.modulemap", <', "$filename.tmp" 90 | or die "Cannot write $filename.tmp\n"; 91 | print $file $content; 92 | close $file; 93 | commit_file($filename); 94 | } 95 | -------------------------------------------------------------------------------- /swiftperl.spec: -------------------------------------------------------------------------------- 1 | Name: swiftperl 2 | Version: %{__version} 3 | Release: %{!?__release:1}%{?__release}%{?dist} 4 | Summary: Swift and Perl Interoperability library 5 | 6 | Group: Development/Libraries 7 | License: MIT 8 | URL: https://github.com/my-mail-ru/%{name} 9 | Source0: https://github.com/my-mail-ru/%{name}/archive/%{version}.tar.gz#/%{name}-%{version}.tar.gz 10 | BuildRoot: %(mktemp -ud %{_tmppath}/%{name}-%{version}-%{release}-XXXXXX) 11 | 12 | BuildRequires: swift >= 5 13 | BuildRequires: swift-packaging >= 0.10 14 | 15 | %undefine _missing_build_ids_terminate_build 16 | %swift_find_provides_and_requires 17 | 18 | %description 19 | swiftperl is designed to provide an easy and smooth interoperability between Swift and Perl languages. 20 | The primary goal is to write XS modules for Perl entirely in Swift, though running Perl Interpreter 21 | in Swift environment is also possible. 22 | 23 | %{?__revision:Built from revision %{__revision}.} 24 | 25 | 26 | %prep 27 | %setup -q 28 | 29 | 30 | %build 31 | %swift_build 32 | 33 | 34 | %install 35 | rm -rf %{buildroot} 36 | %swift_install 37 | %swift_install_devel 38 | mkdir -p %{buildroot}%{swift_clangmoduleroot}/CPerl/ 39 | cp Sources/CPerl/{module.modulemap,*.h} %{buildroot}%{swift_clangmoduleroot}/CPerl/ 40 | 41 | 42 | %clean 43 | rm -rf %{buildroot} 44 | 45 | 46 | %files 47 | %defattr(-,root,root,-) 48 | %{swift_libdir}/*.so 49 | 50 | 51 | %package devel 52 | Summary: Swift and Perl Interoperability module 53 | Requires: swiftperl = %{version}-%{release} 54 | Requires: perl-devel 55 | 56 | %description devel 57 | swiftperl is designed to provide an easy and smooth interoperability between Swift and Perl languages. 58 | The primary goal is to write XS modules for Perl entirely in Swift, though running Perl Interpreter 59 | in Swift environment is also possible. 60 | 61 | %{?__revision:Built from revision %{__revision}.} 62 | 63 | 64 | %files devel 65 | %defattr(-,root,root,-) 66 | %{swift_moduledir}/*.swiftmodule 67 | %{swift_moduledir}/*.swiftdoc 68 | %{swift_clangmoduleroot}/CPerl 69 | --------------------------------------------------------------------------------