Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-hslua-objectorientation for
openSUSE:Factory checked in at 2022-02-11 23:09:08
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-hslua-objectorientation (Old)
and /work/SRC/openSUSE:Factory/.ghc-hslua-objectorientation.new.1956 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hslua-objectorientation"
Fri Feb 11 23:09:08 2022 rev:2 rq:953480 version:2.1.0
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-hslua-objectorientation/ghc-hslua-objectorientation.changes
2021-11-11 21:37:54.588953757 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-hslua-objectorientation.new.1956/ghc-hslua-objectorientation.changes
2022-02-11 23:11:02.407228941 +0100
@@ -1,0 +2,9 @@
+Fri Feb 4 12:15:14 UTC 2022 - [email protected]
+
+- Update hslua-objectorientation to version 2.1.0.
+ Upstream has edited the change log file since the last release in
+ a non-trivial way, i.e. they did more than just add a new entry
+ at the top. You can review the file at:
+
http://hackage.haskell.org/package/hslua-objectorientation-2.1.0/src/CHANGELOG.md
+
+-------------------------------------------------------------------
Old:
----
hslua-objectorientation-2.0.1.tar.gz
New:
----
hslua-objectorientation-2.1.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-hslua-objectorientation.spec ++++++
--- /var/tmp/diff_new_pack.tOTbMs/_old 2022-02-11 23:11:02.807230099 +0100
+++ /var/tmp/diff_new_pack.tOTbMs/_new 2022-02-11 23:11:02.823230145 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-hslua-objectorientation
#
-# Copyright (c) 2021 SUSE LLC
+# Copyright (c) 2022 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,7 +19,7 @@
%global pkg_name hslua-objectorientation
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.0.1
+Version: 2.1.0
Release: 0
Summary: Object orientation tools for HsLua
License: MIT
++++++ hslua-objectorientation-2.0.1.tar.gz ->
hslua-objectorientation-2.1.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-objectorientation-2.0.1/CHANGELOG.md
new/hslua-objectorientation-2.1.0/CHANGELOG.md
--- old/hslua-objectorientation-2.0.1/CHANGELOG.md 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-objectorientation-2.1.0/CHANGELOG.md 2001-09-09
03:46:40.000000000 +0200
@@ -1,21 +1,49 @@
# Changelog
-`hslua-objectorientation` uses [PVP Versioning][1].
+`hslua-objectorientation` uses [PVP Versioning][].
-## hslua-objectorientation 2.0.1
+## hslua-objectorientation-2.1.0
-Release 2021-11-04.
+Released 29-01-2022.
- - Excludes absent properties from `pairs`: Properties that are
+- Allow integers as aliases: Aliases can now be of type
+ `AliasIndex`, so integers can now be defined as aliases for
+ other properties. The function `alias` now takes an
+ `AliasIndex` instead of a `Name`; the change entails
+ modifications to the types `UDTypeWithList`, `UDType`, and
+ `Member`. Also, `AliasIndex` is made into an instance of the
+ Eq and Ord type classes.
+
+- Reworked list representation of objects, allowing write access
+ to list components.
+
+ The `ListSpec` type has been updated and contains now a pair
+ of pairs, where the inner pairs define how to push and
+ retrieve lists, respectively. Users of the `deftypeGeneric'`
+ function will have to update their code.
+
+- Fixed some integer type declarations in C code. Some variables
+ had been given incorrect types, like `int` instead of
+ `lua_Integer`. They are usually the same, but may differ in
+ some setups.
+
+- Require hslua-core-2.1.0 and hslua-marshalling-2.1.0, or
+ later.
+
+## hslua-objectorientation-2.0.1
+
+Released 2021-11-04.
+
+- Excludes absent properties from `pairs`: Properties that are
optional and not present in a sum-type value are no longer
included in the iterator output produced by `pairs` (i.e., the
`__pairs` metamethod). Previously, the names of absent
properties were pushed with a `nil` value.
-## hslua-objectorientation 2.0.0
+## hslua-objectorientation-2.0.0
-Release 2021-10-21.
+Released 2021-10-21.
-- Published without warning.
+- Published without warning.
-[1]: https://pvp.haskell.org
+ [PVP Versioning]: https://pvp.haskell.org
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-objectorientation-2.0.1/LICENSE
new/hslua-objectorientation-2.1.0/LICENSE
--- old/hslua-objectorientation-2.0.1/LICENSE 2001-09-09 03:46:40.000000000
+0200
+++ new/hslua-objectorientation-2.1.0/LICENSE 2001-09-09 03:46:40.000000000
+0200
@@ -1,7 +1,7 @@
Copyright ?? 1994-2020 Lua.org, PUC-Rio.
Copyright ?? 2007-2012 Gracjan Polak
Copyright ?? 2012-2015 ??mer Sinan A??acan
-Copyright ?? 2016-2021 Albert Krewinkel
+Copyright ?? 2016-2022 Albert Krewinkel
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-objectorientation-2.0.1/cbits/hslobj.c
new/hslua-objectorientation-2.1.0/cbits/hslobj.c
--- old/hslua-objectorientation-2.0.1/cbits/hslobj.c 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-objectorientation-2.1.0/cbits/hslobj.c 2001-09-09
03:46:40.000000000 +0200
@@ -89,14 +89,16 @@
}
lua_pushvalue(L, 2);
if (lua_rawget(L, -2) != LUA_TTABLE) {
- return 0; /* key is not an alias */
+ lua_pop(L, 2); /* key is not an alias */
+ return 0; /* try a different method */
}
/* key is an alias */
lua_pushvalue(L, 1); /* start with the original object */
/* Iterate over properties; last object is on top of stack,
* list of properties is the second object. */
- for (int i = 1; i <= lua_rawlen(L, -2); i++) {
+ lua_Integer len = (lua_Integer) lua_rawlen(L, -2);
+ for (lua_Integer i = 1; i <= len; i++) {
lua_rawgeti(L, -2, i);
int objtype = lua_gettable(L, -2); /* get property */
lua_remove(L, -2); /* remove previous object */
@@ -127,16 +129,25 @@
int hsluaO_get_numerical(lua_State *L)
{
hsluaO_get_caching_table(L, 1);
- int requested = lua_tointeger(L, 2);
+ lua_Integer requested = lua_tointeger(L, 2);
- lua_getfield(L, 1, "__lazylistindex");
- int last_index = lua_tointeger(L, -1);
- lua_pop(L, 1); /* pop last-index value */
-
- if (requested > last_index) {
- /* index not in cache, force lazy evaluation of list items */
- if (luaL_getmetafield(L, 1, "lazylisteval") == LUA_TFUNCTION &&
- lua_getfield(L, 3, "__lazylist") == LUA_TUSERDATA) {
+ /* The __lazylistindex is set to `nil` or an integer if part of the
+ list is still unevaluated. If it's `false`, then all list values are
+ already in the cache. */
+ if (lua_getfield(L, 1, "__lazylistindex") == LUA_TBOOLEAN) {
+ lua_pop(L, 1); /* remove nil */
+ } else {
+ lua_Integer last_index = lua_tointeger(L, -1);
+ lua_pop(L, 1); /* pop last-index value */
+
+ if (requested > last_index &&
+ /* index not in cache, force lazy evaluation of list items */
+ luaL_getmetafield(L, 1, "lazylisteval") == LUA_TFUNCTION) {
+ if (lua_getfield(L, 3, "__lazylist") != LUA_TUSERDATA) {
+ /* lazy list thunk is missing; that shouldn't happen!! */
+ luaL_error(L, "Error while getting numerical index %d: "
+ "lazy list thunk is missing", requested);
+ }
lua_pushinteger(L, last_index);
lua_pushinteger(L, requested);
lua_pushvalue(L, 3); /* caching table */
@@ -168,12 +179,12 @@
lua_settop(L, 2);
/* do numeric lookup for integer keys */
return lua_isinteger(L, 2)
- ? hsluaO_get_numerical(L)
+ ? (hsluaO_get_via_alias(L) || hsluaO_get_numerical(L))
/* try various sources in order; return 0 if nothing is found. */
- : (hsluaO_get_from_cache(L)
- || hsluaO_get_via_getter(L)
- || hsluaO_get_via_alias(L)
- || hsluaO_get_method(L));
+ : (hsluaO_get_from_cache(L) ||
+ hsluaO_get_via_getter(L) ||
+ hsluaO_get_via_alias(L) ||
+ hsluaO_get_method(L));
}
/*
@@ -193,18 +204,55 @@
lua_pushvalue(L, 1); /* start with the original object */
/* Iterate over properties; last object is on top of stack,
* list of properties is the second object. */
- for (int i = 1; i < lua_rawlen(L, -2); i++) {
+ lua_Integer len = (lua_Integer) lua_rawlen(L, -2);
+ for (int i = 1; i < len; i++) {
lua_rawgeti(L, -2, i);
lua_gettable(L, -2); /* get property */
lua_remove(L, -2); /* remove previous object */
}
- lua_rawgeti(L, -2, lua_rawlen(L, -2)); /* last element */
- lua_pushvalue(L, 3); /* new value */
+ lua_rawgeti(L, -2, len); /* last element */
+ lua_pushvalue(L, 3); /* new value */
lua_settable(L, -3);
return 1;
}
/*
+** Sets a numerical index on this object. The userdata must be in
+** position 1, the key in position 2, and the new value in position 3.
+** Returns 1 on success and 0 otherwise.
+*/
+int hsluaO_set_numerical(lua_State *L)
+{
+ hsluaO_get_caching_table(L, 1);
+ lua_Integer target = lua_tointeger(L, 2);
+
+ /* The `__lazylistindex` field is set to `false` if each list element
+ has already been evaluated and stored in the cache. Otherwise it
+ will be either `nil` or an integer. */
+ if (lua_getfield(L, 1, "__lazylistindex") == LUA_TBOOLEAN) {
+ lua_pop(L, 1); /* pop boolean from last-index */
+ } else {
+ /* list is not fully evaluated yet, we may have to evaluate it
+ further. */
+ lua_Integer last_index = lua_tointeger(L, -1);
+ lua_pop(L, 1); /* pop last-index value */
+
+ if (target > last_index) {
+ /* the index we want to assign has not been cached yet. Evaluation
+ * is forced to avoid any uncertainty about the meaning of
+ * `nil`-valued indices. */
+ lua_pushcfunction(L, &hsluaO_get_numerical);
+ lua_pushvalue(L, 1);
+ lua_pushvalue(L, 2);
+ lua_call(L, 2, 0);
+ }
+ }
+ lua_pushvalue(L, 3); /* new value */
+ lua_rawseti(L, -2, target); /* set in caching table */
+ return 1;
+}
+
+/*
** Set value via a property alias. Assumes the stack to be in a state as
** after __newindex is called. Returns 1 on success, 0 if the object is
** readonly, and throws an error if there is no setter for the given
@@ -239,6 +287,9 @@
int hslua_udnewindex(lua_State *L)
{
if (lua_type(L, 2) == LUA_TNUMBER) {
+ if (hsluaO_set_via_alias(L) || hsluaO_set_numerical(L)) {
+ return 0;
+ }
lua_pushliteral(L, "Cannot set a numerical value.");
return lua_error(L);
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-objectorientation-2.0.1/hslua-objectorientation.cabal
new/hslua-objectorientation-2.1.0/hslua-objectorientation.cabal
--- old/hslua-objectorientation-2.0.1/hslua-objectorientation.cabal
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-objectorientation-2.1.0/hslua-objectorientation.cabal
2001-09-09 03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
cabal-version: 2.2
name: hslua-objectorientation
-version: 2.0.1
+version: 2.1.0
synopsis: Object orientation tools for HsLua
description: Expose Haskell objects to Lua with an object oriented
interface.
@@ -10,7 +10,7 @@
license-file: LICENSE
author: Albert Krewinkel
maintainer: [email protected]
-copyright: ?? 2021 Albert Krewinkel
+copyright: ?? 2021-2022 Albert Krewinkel
category: Foreign
build-type: Simple
extra-source-files: README.md
@@ -20,8 +20,9 @@
, GHC == 8.4.4
, GHC == 8.6.5
, GHC == 8.8.4
- , GHC == 8.10.4
+ , GHC == 8.10.7
, GHC == 9.0.1
+ , GHC == 9.2.1
source-repository head
type: git
@@ -34,10 +35,10 @@
, bytestring >= 0.10.2 && < 0.12
, containers >= 0.5.9 && < 0.7
, exceptions >= 0.8 && < 0.11
- , hslua-core >= 2.0 && < 2.1
- , hslua-marshalling >= 2.0.1 && < 2.1
+ , hslua-core >= 2.1 && < 2.2
+ , hslua-marshalling >= 2.1 && < 2.2
, mtl >= 2.2 && < 2.3
- , text >= 1.0 && < 1.3
+ , text >= 1.2 && < 2.1
ghc-options: -Wall
-Wincomplete-record-updates
-Wnoncanonical-monad-instances
@@ -59,6 +60,7 @@
, HsLua.ObjectOrientation.Operation
hs-source-dirs: src
default-extensions: LambdaCase
+ , StrictData
other-extensions: AllowAmbiguousTypes
, CPP
, FlexibleInstances
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-objectorientation-2.0.1/src/HsLua/ObjectOrientation/Operation.hs
new/hslua-objectorientation-2.1.0/src/HsLua/ObjectOrientation/Operation.hs
--- old/hslua-objectorientation-2.0.1/src/HsLua/ObjectOrientation/Operation.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-objectorientation-2.1.0/src/HsLua/ObjectOrientation/Operation.hs
2001-09-09 03:46:40.000000000 +0200
@@ -1,7 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : HsLua.ObjectOrientation.Operation
-Copyright : ?? 2020-2021 Albert Krewinkel
+Copyright : ?? 2020-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-objectorientation-2.0.1/src/HsLua/ObjectOrientation.hs
new/hslua-objectorientation-2.1.0/src/HsLua/ObjectOrientation.hs
--- old/hslua-objectorientation-2.0.1/src/HsLua/ObjectOrientation.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-objectorientation-2.1.0/src/HsLua/ObjectOrientation.hs
2001-09-09 03:46:40.000000000 +0200
@@ -5,7 +5,7 @@
{-# LANGUAGE TypeApplications #-}
{-|
Module : HsLua.ObjectOrientation
-Copyright : ?? 2021 Albert Krewinkel
+Copyright : ?? 2021-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
@@ -34,6 +34,7 @@
, Operation (..)
, ListSpec
, Possible (..)
+ , Alias
, AliasIndex (..)
) where
@@ -58,18 +59,33 @@
-- Haskell values. The type name must be unique; once the type has been
-- used to push or retrieve a value, the behavior can no longer be
-- modified through this type.
+--
+-- This type includes methods to define how the object should behave as
+-- a read-only list of type @itemtype@.
data UDTypeWithList e fn a itemtype = UDTypeWithList
{ udName :: Name
, udOperations :: [(Operation, fn)]
, udProperties :: Map Name (Property e a)
, udMethods :: Map Name fn
- , udAliases :: Map Name Alias
+ , udAliases :: Map AliasIndex Alias
, udListSpec :: Maybe (ListSpec e a itemtype)
, udFnPusher :: fn -> LuaE e ()
}
-type ListSpec e a itemtype = (a -> [itemtype], Pusher e itemtype)
+-- | Pair of pairs, describing how a type can be used as a Lua list. The
+-- first pair describes how to push the list items, and how the list is
+-- extracted from the type; the second pair contains a method to
+-- retrieve list items, and defines how the list is used to create an
+-- updated value.
+type ListSpec e a itemtype =
+ ( (Pusher e itemtype, a -> [itemtype])
+ , (Peeker e itemtype, a -> [itemtype] -> a)
+ )
+-- | A userdata type, capturing the behavior of Lua objects that wrap
+-- Haskell values. The type name must be unique; once the type has been
+-- used to push or retrieve a value, the behavior can no longer be
+-- modified through this type.
type UDType e fn a = UDTypeWithList e fn a Void
-- | Defines a new type, defining the behavior of objects in Lua.
@@ -125,6 +141,7 @@
data AliasIndex
= StringIndex Name
| IntegerIndex Lua.Integer
+ deriving (Eq, Ord)
instance IsString AliasIndex where
fromString = StringIndex . fromString
@@ -133,7 +150,7 @@
data Member e fn a
= MemberProperty Name (Property e a)
| MemberMethod Name fn
- | MemberAlias Name Alias
+ | MemberAlias AliasIndex Alias
-- | Use a documented function as an object method.
methodGeneric :: Name -> fn -> Member e fn a
@@ -197,9 +214,9 @@
}
-- | Define an alias for another, possibly nested, property.
-alias :: Name -- ^ property alias
- -> Text -- ^ description
- -> [AliasIndex] -- ^ sequence of nested properties
+alias :: AliasIndex -- ^ property alias
+ -> Text -- ^ description
+ -> [AliasIndex] -- ^ sequence of nested properties
-> Member e fn a
alias name _desc = MemberAlias name
@@ -221,7 +238,7 @@
add "aliases" $ pushAliases ty
case udListSpec ty of
Nothing -> pure ()
- Just (_, pushItem) -> do
+ Just ((pushItem, _), _) -> do
add "lazylisteval" $ pushHaskellFunction (lazylisteval pushItem)
where
add :: LuaError e => Name -> LuaE e () -> LuaE e ()
@@ -294,7 +311,7 @@
pushAliases ty = do
newtable
void $ flip Map.traverseWithKey (udAliases ty) $ \name propSeq -> do
- pushName name
+ pushAliasIndex name
pushList pushAliasIndex propSeq
rawset (nth 3)
@@ -330,7 +347,7 @@
--
-- 1. userdata wrapping the unevalled part of the lazy list
-- 2. index of the last evaluated element
--- 3. index of the last requested element
+-- 3. index of the requested element
-- 4. the caching table
lazylisteval :: forall itemtype e. LuaError e
=> Pusher e itemtype -> LuaE e NumResults
@@ -342,16 +359,22 @@
(Just unevaled, Just curindex, Just newindex) -> do
let numElems = fromIntegral $ max (newindex - curindex) 0
(as, rest) = splitAt numElems unevaled
- -- put back remaining unevalled list
- _ <- putuserdata @[itemtype] (nthBottom 1) lazyListStateName rest
+ if null rest
+ then do
+ -- no more elements in list; unset variable
+ pushName "__lazylistindex"
+ pushBool False
+ rawset (nthBottom 4)
+ else do
+ -- put back remaining unevalled list
+ void $ putuserdata @[itemtype] (nthBottom 1) lazyListStateName rest
+ pushName "__lazylistindex"
+ pushinteger (curindex + fromIntegral (length as))
+ rawset (nthBottom 4)
-- push evaluated elements
- settop 4 -- ensure caching table is at the top of the stack
forM_ (zip [(curindex + 1)..] as) $ \(i, a) -> do
pushItem a
rawseti (nthBottom 4) i
- pushName "__lazylistindex"
- pushinteger (curindex + fromIntegral (length as))
- rawset (nthBottom 4)
return (NumResults 0)
_ -> pure (NumResults 0)
@@ -368,7 +391,7 @@
-- add list as value in caching table
case udListSpec ty of
Nothing -> pure ()
- Just (toList, _) -> do
+ Just ((_, toList), _) -> do
newtable
pushName "__lazylist"
newhsuserdata (toList x)
@@ -382,16 +405,17 @@
peekUD ty idx = do
let name = udName ty
x <- reportValueOnFailure name (`fromuserdata` name) idx
- liftLua $ do
- result <- getuservalue idx >>= \case
- TypeTable -> do
+ (`lastly` pop 1) $ liftLua (getuservalue idx) >>= \case
+ TypeTable -> do
+ -- set list
+ xWithList <- maybe pure setList (udListSpec ty) x
+ liftLua $ do
pushnil
- setProperties (udProperties ty) x
- _ -> do
- return x
- pop 1 -- uservalue (caching) table
- return result
+ setProperties (udProperties ty) xWithList
+ _ -> return x
+-- | Retrieves object properties from a uservalue table and sets them on
+-- the given value. Expects the uservalue table at the top of the stack.
setProperties :: LuaError e => Map Name (Property e a) -> a -> LuaE e a
setProperties props x = do
hasNext <- Unsafe.next (nth 2)
@@ -407,3 +431,37 @@
pop 1
setProperties props x'
_ -> x <$ pop 1
+
+-- | Gets a list from a uservalue table and sets it on the given value.
+-- Expects the uservalue (i.e., caching) table to be at the top of the
+-- stack.
+setList :: forall itemtype e a. LuaError e
+ => ListSpec e a itemtype -> a
+ -> Peek e a
+setList (_pushspec, (peekItem, updateList)) x = (x `updateList`) <$!> do
+ liftLua (getfield top "__lazylistindex") >>= \case
+ TypeBoolean -> do
+ -- list had been fully evaluated
+ liftLua $ pop 1
+ peekList peekItem top
+ _ -> do
+ let getLazyList = do
+ liftLua (getfield top "__lazylist") >>= \case
+ TypeUserdata -> pure ()
+ _ -> failPeek "unevaled items of lazy list cannot be peeked"
+ (`lastly` pop 1) $ reportValueOnFailure
+ lazyListStateName
+ (\idx -> fromuserdata @[itemtype] idx lazyListStateName)
+ top
+ mlastIndex <- liftLua (tointeger top <* pop 1)
+ let itemsAfter = case mlastIndex of
+ Nothing -> const getLazyList
+ Just lastIndex -> \i ->
+ if i <= lastIndex
+ then liftLua (rawgeti top i) >>= \case
+ TypeNil -> [] <$ liftLua (pop 1)
+ _ -> do
+ y <- peekItem top `lastly` pop 1
+ (y:) <$!> itemsAfter (i + 1)
+ else getLazyList
+ itemsAfter 1
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-objectorientation-2.0.1/test/HsLua/ObjectOrientationTests.hs
new/hslua-objectorientation-2.1.0/test/HsLua/ObjectOrientationTests.hs
--- old/hslua-objectorientation-2.0.1/test/HsLua/ObjectOrientationTests.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-objectorientation-2.1.0/test/HsLua/ObjectOrientationTests.hs
2001-09-09 03:46:40.000000000 +0200
@@ -5,7 +5,7 @@
Module : HsLua.ObjectOrientationTests
Copyright : ?? 2007???2012 Gracjan Polak;
?? 2012???2016 ??mer Sinan A??acan;
- ?? 2017-2021 Albert Krewinkel
+ ?? 2017-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
Stability : beta
@@ -193,14 +193,71 @@
_ <- dostring "return list[0], list[5]"
(,) <$> ltype (nth 1) <*> ltype (nth 2)
- , "List is read-only" =:
- (ErrRun, "Cannot set a numerical value.") `shouldBeResultOf` do
+ , "Last evaled index is available in __lazylistindex" =:
+ 3 `shouldBeResultOf` do
+ openlibs
+ pushUD typeLazyIntList $ LazyIntList [9..17]
+ setglobal "quuz"
+ _ <- dostring "local foo = quuz[3]; return quuz.__lazylistindex"
+ forcePeek $ peekIntegral @Int top
+
+ , "__lazylistindex becomes `false` when all items are evaled" =:
+ False `shouldBeResultOf` do
+ openlibs
+ pushUD typeLazyIntList $ LazyIntList [1..3]
+ setglobal "quuz"
+ _ <- dostring "local foo = quuz[3]; return quuz.__lazylistindex"
+ forcePeek $ peekBool top
+
+ , "Input can be retrieved unchanged" =:
+ LazyIntList [9..17] `shouldBeResultOf` do
+ openlibs
+ pushUD typeLazyIntList $ LazyIntList [9..17]
+ setglobal "ninetofive"
+ _ <- dostring "assert(ninetofive[3] == 11); return ninetofive"
+ forcePeek $ peekUD typeLazyIntList top
+
+ , "List is writable" =:
+ LazyIntList [1, 4, 9, 16] `shouldBeResultOf` do
+ openlibs
+ pushUD typeLazyIntList $ LazyIntList [0,4,9,16]
+ setglobal "list"
+ OK <- dostring "list[1] = 1; return list"
+ forcePeek $ peekUD typeLazyIntList top
+
+ , "List can be extended" =:
+ LazyIntList [1, 4, 9, 16, 25] `shouldBeResultOf` do
openlibs
pushUD typeLazyIntList $ LazyIntList [1,4,9,16]
setglobal "list"
- statusCode <- dostring "list[1] = 2"
- err <- forcePeek $ peekString top
- pure (statusCode, err)
+ OK <- dostring "list[5] = 25; return list"
+ forcePeek $ peekUD typeLazyIntList top
+
+ , "List can be shortened" =:
+ LazyIntList [1, 9, 27, 81] `shouldBeResultOf` do
+ openlibs
+ pushUD typeLazyIntList $ LazyIntList [1, 9, 27, 81, 243]
+ setglobal "list"
+ OK <- dostring "list[5] = nil; return list"
+ forcePeek $ peekUD typeLazyIntList top
+
+ , "Setting element to nil shortenes the list" =:
+ LazyIntList [1, 9, 27] `shouldBeResultOf` do
+ openlibs
+ pushUD typeLazyIntList $ LazyIntList [1, 9, 27, 81, 243]
+ setglobal "list"
+ OK <- dostring "list[4] = nil; return list"
+ forcePeek $ peekUD typeLazyIntList top
+
+ , "Infinite lists are ok" =:
+ 233 `shouldBeResultOf` do
+ openlibs
+ let fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
+ pushUD typeLazyIntList $ LazyIntList fibs
+ setglobal "fibs"
+ dostring "return fibs[14]" >>= \case
+ OK -> forcePeek $ peekIntegral @Int top
+ _ -> failLua =<< forcePeek (peekString top)
]
, testGroup "possible properties"
@@ -253,6 +310,27 @@
-- msg <- forcePeek $ peekString top
-- liftIO $ putStrLn msg
forcePeek $ peekPoint top
+ , "read subelement via integer alias" =:
+ 13.37 `shouldBeResultOf` do
+ openlibs
+ pushUD typeQux $ Quuz (Point 13.37 0) undefined
+ setglobal "quuz"
+ _ <- dostring "return quuz[1]"
+ forcePeek $ peekRealFloat @Double top
+ , "set subelement via integer alias" =:
+ Point 42 1 `shouldBeResultOf` do
+ openlibs
+ pushUD typeQux $ Quuz (Point 1 1) undefined
+ setglobal "quuz"
+ _ <- dostring "quuz[1] = 42; return quuz.point"
+ forcePeek $ peekPoint top
+ , "non-aliased integer fields are nil" =:
+ TypeNil `shouldBeResultOf` do
+ openlibs
+ pushUD typeQux (Quuz undefined undefined)
+ setglobal "quuz"
+ _ <- dostring "return quuz[3]"
+ ltype top
, "absent alias returns `nil`" =:
TypeNil `shouldBeResultOf` do
openlibs
@@ -261,6 +339,14 @@
dostring "return quux.x" >>= \case
OK -> ltype top
_ -> failLua =<< forcePeek (peekString top)
+ , "alias can point to the element itself" =:
+ 9 `shouldBeResultOf` do
+ openlibs
+ pushUD typeLazyIntList (LazyIntList [1, 1, 1, 3, 5, 9, 17, 31])
+ setglobal "tribonacci"
+ dostring "return tribonacci.seq[6]" >>= \case
+ OK -> forcePeek $ peekIntegral @Int top
+ _ -> failLua =<< forcePeek (peekString top)
]
]
]
@@ -327,8 +413,10 @@
pushString (show lazyList)
return (NumResults 1)
]
- []
- (Just (fromLazyIntList, pushIntegral))
+ [ alias "seq" "sequence" [] ]
+ (Just ( (pushIntegral, fromLazyIntList)
+ , (peekIntegral, \_ lst -> LazyIntList lst)
+ ))
--
-- Sample sum type
@@ -391,4 +479,5 @@
Quux {} -> const Absent)
, alias "x" "The x coordinate of a point in Quuz" ["point", "x"]
+ , alias (IntegerIndex 1) "The x coordinate of a point in Quuz" ["point", "x"]
]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-objectorientation-2.0.1/test/test-hslua-objectorientation.hs
new/hslua-objectorientation-2.1.0/test/test-hslua-objectorientation.hs
--- old/hslua-objectorientation-2.0.1/test/test-hslua-objectorientation.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-objectorientation-2.1.0/test/test-hslua-objectorientation.hs
2001-09-09 03:46:40.000000000 +0200
@@ -2,7 +2,7 @@
Module : Main
Copyright : ?? 2007???2012 Gracjan Polak;
?? 2012???2016 ??mer Sinan A??acan;
- ?? 2017-2021 Albert Krewinkel
+ ?? 2017-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
Stability : beta
