├── .gitignore ├── .travis.yml ├── AUTHORS ├── LICENSE ├── Makefile ├── README ├── Setup.lhs ├── TODO ├── config.guess ├── config.h.in ├── config.mk.in ├── config.sub ├── configure ├── configure.ac ├── docs ├── Makefile ├── haskell.sty ├── hs-plugins.1 ├── hs-plugins.hdir ├── hs-plugins.tex ├── munge.sed ├── tex2page.sty └── tex2page.tex ├── install.sh ├── plugins.cabal ├── scripts ├── Setup-with-ghc.lhs ├── mkrelease.sh └── openbsd-port │ ├── Makefile │ ├── distinfo │ └── pkg │ ├── DESCR │ └── PLIST ├── src └── System │ ├── Eval.hs │ ├── Eval │ ├── Haskell.hs │ └── Utils.hs │ ├── Plugins.hs │ └── Plugins │ ├── Consts.hs │ ├── Env.hs │ ├── Load.hs │ ├── LoadTypes.hs │ ├── Make.hs │ ├── Parser.hs │ ├── Process.hs │ └── Utils.hs ├── stack.yaml ├── stack.yaml.lock └── testsuite ├── README ├── TIMINGS ├── build.mk ├── check.mk ├── conf └── simple │ ├── Mailrc.conf │ ├── Mailrc.stub │ ├── Makefile │ ├── api │ └── API.hs │ └── prog │ ├── Main.hs │ └── expected ├── dynload ├── io │ ├── Makefile │ ├── TestIO.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── poly │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── should_fail │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── should_fail_1 │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── should_fail_2 │ ├── Makefile │ ├── Plugin.in │ ├── Plugin.stub │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ ├── expected │ │ ├── expected.604 │ │ └── expected.605 ├── should_fail_3 │ ├── Makefile │ ├── Plugin.in │ ├── Plugin.stub │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ ├── expected │ │ ├── expected.604 │ │ └── expected.605 └── simple │ ├── Makefile │ ├── Plugin.hs │ ├── api │ └── API.hs │ └── prog │ ├── Main.hs │ └── expected ├── eval.mk ├── eval ├── eval1 │ ├── Main.hs │ ├── Makefile │ └── expected ├── eval2 │ ├── Main.hs │ ├── Makefile │ └── expected ├── eval3 │ ├── Main.hs │ ├── Makefile │ └── expected ├── eval_ │ ├── Main.hs │ ├── Makefile │ └── expected ├── eval_fn │ ├── Main.hs │ ├── Makefile │ └── expected ├── eval_fn1 │ ├── Main.hs │ ├── Makefile │ ├── Poly.hs │ └── expected ├── foreign_eval │ ├── Makefile │ ├── README │ ├── dont_test │ ├── expected │ └── main.c ├── foreign_eval1 │ ├── Makefile │ ├── dont_test │ ├── expected │ └── main.c ├── foreign_should_fail │ ├── Makefile │ ├── dont_test │ ├── expected │ ├── expected.604 │ ├── expected.605 │ └── main.c ├── foreign_should_fail_illtyped │ ├── Makefile │ ├── dont_test │ ├── expected │ ├── expected.604 │ ├── expected.605 │ └── main.c └── unsafeidir │ ├── Main.hs │ ├── Makefile │ ├── a │ └── Extra.hs │ └── expected ├── foreign.mk ├── hier ├── hier1 │ ├── Makefile │ ├── Modules │ │ ├── Flags.hs │ │ └── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── hier2 │ ├── A │ │ ├── B │ │ │ └── C │ │ │ │ └── Module.hs │ │ └── Makefile │ ├── Makefile │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── hier3 │ ├── Main.hs │ ├── Makefile │ ├── One.hs │ ├── Two.hs │ └── expected └── hier4 │ ├── A.hs │ ├── B.hs │ ├── C.hs │ ├── D.hs │ ├── Main.hs │ ├── Makefile │ └── expected ├── iface └── null │ ├── A.hs │ ├── B.hs │ ├── Main.hs │ ├── Makefile │ ├── expected │ ├── expected.604 │ └── expected.605 ├── load ├── io │ ├── Makefile │ ├── TestIO.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── load_0 │ ├── Makefile │ ├── Test.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── loadpkg │ ├── Main.hs │ ├── Makefile │ └── expected ├── null │ ├── Makefile │ ├── Null.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── plain │ ├── Makefile │ ├── TestIO.hs │ ├── api │ │ └── API.hs │ └── prog │ │ └── Main.hs ├── thiemann0 │ ├── Makefile │ ├── Test.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── thiemann2 │ ├── C.hs │ ├── Makefile │ ├── api │ │ └── API.hs │ └── prog │ │ ├── A.hs │ │ ├── B.hs │ │ ├── Main.hs │ │ └── expected └── unloadpkg │ ├── Main.hs │ ├── Makefile │ └── expected ├── loadCLib └── null │ ├── Makefile │ ├── Null.hs │ ├── api │ └── API.hs │ └── prog │ ├── Main.hs │ └── expected ├── make ├── makeall001 │ ├── A.hs │ ├── B.hs │ ├── C.hs │ ├── Makefile │ ├── Tiny.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── null │ ├── Makefile │ ├── Null.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── o │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── odir │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── remake001 │ ├── Bar.hs │ ├── Foo.hs │ ├── Main.hs │ ├── Makefile │ └── expected ├── remake001_should_fail │ ├── Bar.hs │ ├── Foo.hs │ ├── Main.hs │ ├── Makefile │ └── expected └── simple │ ├── Makefile │ ├── Tiny.hs │ ├── api │ └── API.hs │ └── prog │ ├── Main.hs │ └── expected ├── makewith ├── global_pragma │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── io │ ├── Makefile │ ├── README │ ├── TestIO.conf.in │ ├── TestIO.stub │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── merge00 │ ├── Bar.hs │ ├── Foo.hs │ ├── Main.hs │ ├── Makefile │ └── expected ├── mergeto0 │ ├── Bar.hs │ ├── Foo.hs │ ├── Main.hs │ ├── Makefile │ └── expected ├── module_name │ ├── Bar.hs │ ├── Foo.hs │ ├── Main.hs │ ├── Makefile │ └── expected ├── multi_make │ ├── Bar.hs │ ├── Foo.hs │ ├── Main.hs │ ├── Makefile │ ├── Stub.hs │ └── expected ├── should_fail_0 │ ├── Makefile │ ├── Plugin.in │ ├── Plugin.stub │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── tiny │ ├── Makefile │ ├── Tiny.conf │ ├── Tiny.stub │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected └── unsafeio │ ├── Makefile │ ├── README │ ├── Unsafe.conf.in │ ├── Unsafe.stub │ ├── api │ └── API.hs │ └── prog │ ├── Main.hs │ ├── README │ └── expected ├── misc └── mkstemps │ ├── Main.hs │ ├── Makefile │ └── expected ├── multi └── 3plugins │ ├── Makefile │ ├── Plugin1.hs │ ├── Plugin2.hs │ ├── Plugin3.hs │ ├── api │ └── API.hs │ └── prog │ ├── Main.hs │ └── expected ├── objc └── expression_parser │ ├── ArithmeticExpressionParser.hs │ ├── English.lproj │ ├── Credits.rtf │ ├── InfoPlist.strings │ ├── MainMenu.nib │ │ ├── classes.nib │ │ ├── info.nib │ │ └── objects.nib │ └── MyDocument.nib │ │ ├── classes.nib │ │ ├── info.nib │ │ ├── keyedobjects.nib │ │ └── objects.nib │ ├── Info.plist │ ├── KeyValueParser.hs │ ├── Makefile │ ├── MyDocument.h │ ├── MyDocument.m │ ├── PluginEvalAux.hs │ ├── PluginExpressionParser.xcode │ └── project.pbxproj │ ├── PluginExpressionParser_Prefix.pch │ ├── README │ ├── RunHaskell.h │ ├── dont_test │ ├── main.m │ └── version.plist ├── pdynload ├── badint │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── bayley1 │ ├── Load.hs │ ├── Makefile │ ├── Plugin1.hs │ ├── Sub │ │ └── Plugin2.hs │ ├── api │ │ └── API.hs │ └── prog │ │ └── Main.hs ├── null │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── numclass │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── poly │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── poly1 │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── should_fail0 │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── should_fail1 │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── small │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── spj1 │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ ├── dont_test │ └── prog │ │ ├── Main.hs │ │ └── expected ├── spj2 │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── spj3 │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ ├── expected │ │ ├── expected.604 │ │ └── expected.605 ├── spj4 │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected ├── typealias │ ├── Makefile │ ├── Plugin.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected └── univquant │ ├── Makefile │ ├── Plugin.hs │ ├── api │ └── API.hs │ └── prog │ ├── Main.hs │ └── expected ├── pkgconf └── null │ ├── Makefile │ ├── Null.hs │ ├── api │ ├── API.hs │ └── package.conf.in │ ├── dont_test │ └── prog │ └── Main.hs ├── plugs ├── plugs │ ├── Main.hs │ ├── Makefile │ ├── expected │ └── test.in └── runplugs │ ├── Main.hs │ ├── Makefile │ ├── expected │ └── test.in ├── reload └── null │ ├── Makefile │ ├── Null.hs │ ├── api │ └── API.hs │ └── prog │ ├── Main.hs │ └── expected ├── shell ├── shell │ ├── API.hs │ ├── Main.hs │ ├── Makefile │ ├── Plugin.hs │ ├── Plugin.stub │ ├── README │ └── dont_test └── simple │ ├── Main.hs │ ├── Makefile │ ├── Plugin.hs │ ├── Plugin.stub │ ├── README │ ├── StringProcessorAPI.hs │ └── dont_test ├── unload ├── null │ ├── Makefile │ ├── Null.hs │ ├── api │ │ └── API.hs │ └── prog │ │ ├── Main.hs │ │ └── expected └── sjwtrap │ ├── Makefile │ ├── Null.hs │ ├── api │ └── API.hs │ └── prog │ ├── Main.hs │ └── expected └── unloadAll └── null ├── Dep.hs ├── Makefile ├── Null.hs ├── api └── API.hs └── prog ├── Main.hs └── expected /.gitignore: -------------------------------------------------------------------------------- 1 | /config.h 2 | /config.log 3 | /config.mk 4 | /config.status 5 | /testsuite/hier/hier2/A/B/C/Module.hi 6 | /testsuite/hier/hier2/A/B/C/Module.o 7 | /testsuite/makewith/io/TestIO.conf 8 | /testsuite/makewith/unsafeio/Unsafe.conf 9 | /.stack-work/ 10 | /dist-newstyle/ -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | 2 | Don Stewart 3 | Sean Seefried 4 | Andre Pang 5 | 6 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons 2 | # LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html) 3 | 4 | # 5 | # regress check. TODO check expected output 6 | # 7 | check: 8 | @( d=/tmp/plugins.tmp.$$$$ ; mkdir $$d ; export TMPDIR=$$d ;\ 9 | for i in `find testsuite ! -name CVS -type d -maxdepth 2 -mindepth 2 | sort` ; do \ 10 | printf "=== testing %-50s ... " "$$i" ; \ 11 | ( cd $$i ; if [ -f dont_test ] ; then \ 12 | echo "ignored." ;\ 13 | else ${MAKE} -sk && ${MAKE} -ksi check |\ 14 | sed '/^Compil/d;/^Load/d;/Read/d;/Expan/d;/Savi/d;/Writ/d' ;\ 15 | ${MAKE} -sk clean ;\ 16 | fi ) 2> /dev/null ;\ 17 | done ; rm -rf $$d ) 18 | 19 | # 20 | # making clean 21 | # 22 | 23 | CLEAN_FILES += *.conf.*.old *~ 24 | 25 | EXTRA_CLEANS+=*.conf.inplace* *.conf.in *.h autom4te.cache \ 26 | config.h config.mk config.log config.status 27 | 28 | clean: 29 | cd docs && $(MAKE) clean 30 | runhaskell Setup.lhs clean 2> /dev/null || true 31 | rm -rf $(CLEAN_FILES) 32 | find testsuite -name '*.a' -exec rm {} \; 33 | find testsuite -name '*~' -exec rm {} \; 34 | find testsuite -name 'a.out' -exec rm {} \; 35 | find testsuite -name '*.hi' -exec rm {} \; 36 | find testsuite -name '*.o' -exec rm {} \; 37 | find testsuite -name '*.core' -exec rm {} \; 38 | find testsuite -name 'package.conf' -exec rm {} \; 39 | rm -f testsuite/makewith/io/TestIO.conf 40 | rm -f testsuite/makewith/unsafeio/Unsafe.conf 41 | rm -rf testsuite/plugs/plugs/plugs 42 | rm -rf testsuite/plugs/plugs/runplugs 43 | rm -rf $(EXTRA_CLEANS) 44 | 45 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/README -------------------------------------------------------------------------------- /Setup.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | > module Main where 3 | > import Distribution.Simple 4 | > main :: IO () 5 | > main = defaultMainWithHooks autoconfUserHooks 6 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | For 1.0 2 | ---------- 3 | 4 | + broken on mac. 5 | symbols with suspiciously many _ chars 6 | 7 | + Add verbose versions of the load functions, to avoid -DDEBUG 8 | 9 | + mention that you need .o archives, not .a ones. Use Cabal, ghc-pkg -u 10 | or ld -r --whole-archive 11 | 12 | + hs-plugins doesn't know to look for packages in the user packages, 13 | only in the global packages 14 | 15 | + version numbers in package loads are annyoing 16 | 17 | + .hi file parser is broken on Itanium, again. 18 | 19 | + build way=p and way='' 20 | 21 | Cabal 22 | -------- 23 | 24 | What we'd like is a cabalMake version of make, so rather than just 25 | compiling simple plugins, we let cabalMake rebuild whole Haskell apps -- 26 | like Yi! 27 | -------------------------------------------------------------------------------- /config.h.in: -------------------------------------------------------------------------------- 1 | /* config.h.in. Generated from configure.ac by autoheader. */ 2 | 3 | /* Defined if compiling with mingw */ 4 | #undef CYGWIN 5 | 6 | /* Defined if a debugging version is to be built */ 7 | #undef DEBUG 8 | 9 | /* Path to ghc libraries */ 10 | #undef GHC_LIB_PATH 11 | 12 | /* Define to 1 if you have the `arc4random' function. */ 13 | #undef HAVE_ARC4RANDOM 14 | 15 | /* Whether symbols are prefixed with a leading underscore */ 16 | #undef LEADING_UNDERSCORE 17 | 18 | /* Defined if compiling on the mac */ 19 | #undef MACOSX 20 | 21 | /* Define to the address where bug reports for this package should be sent. */ 22 | #undef PACKAGE_BUGREPORT 23 | 24 | /* Define to the full name of this package. */ 25 | #undef PACKAGE_NAME 26 | 27 | /* Define to the full name and version of this package. */ 28 | #undef PACKAGE_STRING 29 | 30 | /* Define to the one symbol short name of this package. */ 31 | #undef PACKAGE_TARNAME 32 | 33 | /* Define to the home page for this package. */ 34 | #undef PACKAGE_URL 35 | 36 | /* Define to the version of this package. */ 37 | #undef PACKAGE_VERSION 38 | 39 | /* Path to top of build tree */ 40 | #undef TOP 41 | 42 | /* Which ghc to use */ 43 | #undef WITH_GHC 44 | 45 | /* Defined if hs-plugins is to be built with Niklas Broberg's HSX parser */ 46 | #undef WITH_HSX 47 | 48 | /* Defined if compiling with mingw */ 49 | #undef __MINGW32__ 50 | -------------------------------------------------------------------------------- /config.mk.in: -------------------------------------------------------------------------------- 1 | default: all 2 | TOP = @TOP@ 3 | GHC = @GHC@ 4 | GLASGOW_HASKELL = @GLASGOW_HASKELL@ 5 | -------------------------------------------------------------------------------- /docs/Makefile: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons 2 | # LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html) 3 | 4 | .PHONY: build clean html 5 | 6 | SRC = hs-plugins 7 | 8 | build: $(SRC).ps html 9 | 10 | $(SRC).ps: $(SRC).dvi 11 | dvips -f $(SRC).dvi > $@ 12 | 13 | html: $(SRC).tex 14 | tex2page $(SRC) 15 | tex2page $(SRC) 16 | sed -f munge.sed < $(SRC)/$(SRC).html > tmp.out 17 | mv tmp.out $(SRC)/$(SRC).html 18 | cp $(SRC)/$(SRC).html $(SRC)/index.html 19 | tar czf $(SRC).html.tar.gz $(SRC) 20 | mv $(SRC).html.tar.gz $(SRC)/ 21 | 22 | $(SRC).dvi: $(SRC).tex 23 | latex $(SRC).tex && latex $(SRC).tex 24 | 25 | CLEANS= *.{ps,dvi,aux,log} *~ hs-plugins *-Z-* *.toc 26 | 27 | clean: 28 | rm -rf $(CLEANS) 29 | 30 | all: doc 31 | 32 | -------------------------------------------------------------------------------- /docs/hs-plugins.1: -------------------------------------------------------------------------------- 1 | .TH HS-PLUGINS 1 2005-12-27 "hs-plugins version 1.0" "User Manual" 2 | 3 | .SH NAME 4 | hs-plugins \- dynamic linker library for Haskell 5 | 6 | .SH DESCRIPTION 7 | .ds c \fIhs-plugins\fP 8 | \*c is a library for loading code written in Haskell into an 9 | application at runtime, in the form of plugins. It also provides a 10 | mechanism for (re-)compiling Haskell source at runtime. Thirdly, a 11 | combination of runtime compilation and dynamic loading provides a set 12 | of eval functions. Values exported by plugins are transparently 13 | available to Haskell host applications, and bindings exist to use 14 | Haskell plugins from at least C and Objective C programs. hs-plugins 15 | requires GHC 6.4 or later. 16 | 17 | .SH DOCUMENTATION 18 | The hs-plugins user manual is distributed in html format, and may be 19 | found at 20 | 21 | .SH BUGS 22 | Bug reports, and any other feedback, should be sent to 23 | Don Stewart 24 | .SH COPYRIGHT 25 | Copyright \(co 2003-2005 Don Stewart 26 | .PP 27 | The hs-plugins library modules are distributed under the terms of the 28 | LGPL. 29 | .SH "SEE ALSO" 30 | .BR dlopen (3) 31 | 32 | .SH AUTHOR 33 | 34 | This manual page was written by Don Stewart, based on the man page for 35 | cpphs (written by Ian Lynagh). 36 | 37 | -------------------------------------------------------------------------------- /docs/hs-plugins.hdir: -------------------------------------------------------------------------------- 1 | hs-plugins 2 | -------------------------------------------------------------------------------- /docs/hs-plugins.tex: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/docs/hs-plugins.tex -------------------------------------------------------------------------------- /docs/munge.sed: -------------------------------------------------------------------------------- 1 | 2 | # de-boldify and

-ify the Contents. 3 | 4 | /Contents/ { 5 | :loop 6 | /Go to/ { 7 | b end 8 | } 9 | s,

,, 10 | s,,, 11 | s,,, 12 | s,

,, 13 | n 14 | b loop 15 | } 16 | :end 17 | -------------------------------------------------------------------------------- /docs/tex2page.sty: -------------------------------------------------------------------------------- 1 | % tex2page.sty 2 | % Dorai Sitaram 3 | 4 | % Loading this file in a LaTeX document 5 | % gives it all the macros of tex2page.tex, 6 | % but via a more LaTeX-convenient filename. 7 | 8 | \input{tex2page} 9 | 10 | -------------------------------------------------------------------------------- /install.sh: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/install.sh -------------------------------------------------------------------------------- /plugins.cabal: -------------------------------------------------------------------------------- 1 | name: plugins 2 | version: 1.6.2 3 | homepage: https://github.com/stepcut/plugins 4 | synopsis: Dynamic linking for Haskell and C objects 5 | description: Dynamic linking and runtime evaluation of Haskell, 6 | and C, including dependency chasing and package resolution. 7 | . 8 | Described in the papers: 9 | 10 | * /Plugging Haskell In/ 11 | 12 | * /Dynamic Applications from the Ground Up/ 13 | 14 | * /Dynamic Extension of Typed Functional Languages/. 15 | 16 | category: System 17 | license: BSD3 18 | License-file: LICENSE 19 | author: Don Stewart 2004..2010 20 | maintainer: Jeremy Shaw 21 | cabal-version: >= 1.10 22 | build-type: Configure 23 | Tested-with: GHC == 7.4.2 24 | , GHC == 7.6.3 25 | , GHC == 7.8.4 26 | , GHC == 7.10.3 27 | , GHC == 8.0.2 28 | , GHC == 8.2.2 29 | , GHC == 8.6.5 30 | , GHC == 8.8.3 31 | , GHC == 8.10.1 32 | extra-source-files: config.guess, config.h.in, config.mk.in, config.sub, 33 | configure, configure.ac, install.sh, Makefile, 34 | testsuite/makewith/io/TestIO.conf.in, 35 | testsuite/makewith/unsafeio/Unsafe.conf.in 36 | 37 | library 38 | default-language: Haskell2010 39 | exposed-modules: 40 | System.Eval, 41 | System.Eval.Haskell, 42 | System.Eval.Utils, 43 | System.Plugins, 44 | System.Plugins.Consts, 45 | System.Plugins.Env, 46 | System.Plugins.Load, 47 | System.Plugins.LoadTypes, 48 | System.Plugins.Make, 49 | System.Plugins.Parser, 50 | System.Plugins.Process, 51 | System.Plugins.Utils 52 | 53 | default-extensions: CPP, 54 | ForeignFunctionInterface 55 | ghc-options: -Wall -funbox-strict-fields -fno-warn-missing-signatures 56 | hs-source-dirs: src 57 | build-depends: base >= 4 && < 5, 58 | Cabal >= 1.6, 59 | haskell-src, 60 | containers, 61 | array, 62 | directory, 63 | filepath, 64 | random, 65 | process, 66 | split, 67 | ghc >= 6.10, 68 | ghc-prim 69 | 70 | if impl(ghc >= 7.2) 71 | build-depends: ghc-paths 72 | 73 | source-repository head 74 | type: git 75 | location: https://github.com/stepcut/plugins 76 | -------------------------------------------------------------------------------- /scripts/Setup-with-ghc.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | > module Main where 3 | > import Distribution.Simple 4 | > import Distribution.Setup ( ConfigFlags (..) ) 5 | > import System.Directory ( findExecutable ) 6 | > 7 | > main :: IO () 8 | > main = defaultMainWithHooks (defaultUserHooks { postConf = defaultPostConf }) 9 | > where defaultPostConf args flags lbi {- xx -} 10 | > = do args' <- fmap (args++) (configToArgs flags) 11 | > (postConf defaultUserHooks) args' flags lbi {- xx -} 12 | > 13 | > -- need to pass with-ghc arg onto ./configure for non-standard ghcs 14 | > configToArgs :: ConfigFlags -> IO [String] 15 | > configToArgs (ConfigFlags { configHcPath = Just hcPath }) 16 | > = do exec <- findExecutable hcPath 17 | > case exec of 18 | > Just realPath -> return ["--with-ghc="++realPath] 19 | > Nothing -> return ["--with-ghc="++hcPath] 20 | > configToArgs _ = return [] 21 | -------------------------------------------------------------------------------- /scripts/mkrelease.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | cd /tmp 4 | rm -rf hs-plugins-0.9.10* 5 | 6 | darcs get --partial --set-scripts-executable /home/dons/hs-plugins 7 | cd hs-plugins 8 | rm -rf _darcs 9 | cd .. 10 | mv hs-plugins hs-plugins-0.9.10 11 | tar czf hs-plugins-0.9.10.tar.gz hs-plugins-0.9.10 12 | -------------------------------------------------------------------------------- /scripts/openbsd-port/Makefile: -------------------------------------------------------------------------------- 1 | # $OpenBSD$ 2 | 3 | COMMENT= "dynamic link library for Haskell" 4 | 5 | V= 0.9.10 6 | DISTNAME= hs-plugins-${V} 7 | CATEGORIES= devel 8 | MAINTAINER= Don Stewart 9 | HOMEPAGE= http://www.cse.unsw.edu.au/~dons/hs-plugins/ 10 | MASTER_SITES= ${HOMEPAGE} 11 | 12 | MODULES= ghc 13 | CONFIGURE_STYLE= gnu dest 14 | 15 | # LGPL 16 | PERMIT_PACKAGE_CDROM= Yes 17 | PERMIT_PACKAGE_FTP= Yes 18 | PERMIT_DISTFILES_CDROM= Yes 19 | PERMIT_DISTFILES_FTP= Yes 20 | 21 | .include 22 | -------------------------------------------------------------------------------- /scripts/openbsd-port/distinfo: -------------------------------------------------------------------------------- 1 | MD5 (hs-plugins-0.9.4.tar.gz) = 120f38ca532b187ee52798f5c36cc920 2 | RMD160 (hs-plugins-0.9.4.tar.gz) = 219eaf70e4bc0f1abc8a782d1bbd64ad2c5f8e86 3 | SHA1 (hs-plugins-0.9.4.tar.gz) = ad38b9f4e5b90c1361c6c96bd94e2a9270ad3d78 4 | -------------------------------------------------------------------------------- /scripts/openbsd-port/pkg/DESCR: -------------------------------------------------------------------------------- 1 | hs-plugins is a library for dynamic loading and compilation of Haskell 2 | code. It provides typesafe "plugins" for Haskell. The interface is 3 | general enough that it can be used to create conventional plugins, 4 | hmake-like Haskell interpreters embedded in applications, or to script 5 | an application with Haskell (or a Haskell EDSL) as the extension 6 | language. 7 | -------------------------------------------------------------------------------- /scripts/openbsd-port/pkg/PLIST: -------------------------------------------------------------------------------- 1 | @comment $OpenBSD$ 2 | lib/hs-plugins/imports/Plugins.hi 3 | lib/hs-plugins/imports/Plugins/BinIface.hi 4 | lib/hs-plugins/imports/Plugins/Binary.hi 5 | lib/hs-plugins/imports/Plugins/Consts.hi 6 | lib/hs-plugins/imports/Plugins/Env.hi 7 | lib/hs-plugins/imports/Plugins/FastMutInt.hi 8 | lib/hs-plugins/imports/Plugins/FastString.hi 9 | lib/hs-plugins/imports/Plugins/Iface.hi 10 | lib/hs-plugins/imports/Plugins/Load.hi 11 | lib/hs-plugins/imports/Plugins/Make.hi 12 | lib/hs-plugins/imports/Plugins/Package.hi 13 | lib/hs-plugins/imports/Plugins/ParsePkgConfLite.hi 14 | lib/hs-plugins/imports/Plugins/Parser.hi 15 | lib/hs-plugins/imports/Plugins/PrimPacked.hi 16 | lib/hs-plugins/imports/Plugins/Utils.hi 17 | lib/hs-plugins/include/hschooks.h 18 | lib/hs-plugins/libHSplugins.a 19 | lib/hs-plugins/libHSplugins_cbits.a 20 | lib/hs-plugins/plugins.conf.in 21 | @dirrm lib/hs-plugins/include 22 | @dirrm lib/hs-plugins/imports/Plugins 23 | @dirrm lib/hs-plugins/imports 24 | @dirrm lib/hs-plugins 25 | @exec /bin/cat %D/lib/hs-plugins/plugins.conf.in | /usr/bin/env PREFIX=%D %D/bin/ghc-pkg -u 26 | @exec /bin/rm -f %D/lib/ghc-6.2.1/package.conf.old 27 | @unexec %D/bin/ghc-pkg -r plugins 28 | @unexec /bin/rm -f %D/lib/ghc-6.2.1/package.conf.old 29 | -------------------------------------------------------------------------------- /src/System/Eval.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons 3 | -- 4 | -- This library is free software; you can redistribute it and/or 5 | -- modify it under the terms of the GNU Lesser General Public 6 | -- License as published by the Free Software Foundation; either 7 | -- version 2.1 of the License, or (at your option) any later version. 8 | -- 9 | -- This library is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 12 | -- Lesser General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Lesser General Public 15 | -- License along with this library; if not, write to the Free Software 16 | -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 17 | -- USA 18 | -- 19 | 20 | module System.Eval ( 21 | module System.Eval.Haskell, 22 | ) where 23 | 24 | import System.Eval.Haskell {-all-} 25 | -------------------------------------------------------------------------------- /src/System/Eval/Utils.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons 3 | -- 4 | -- This library is free software; you can redistribute it and/or 5 | -- modify it under the terms of the GNU Lesser General Public 6 | -- License as published by the Free Software Foundation; either 7 | -- version 2.1 of the License, or (at your option) any later version. 8 | -- 9 | -- This library is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 12 | -- Lesser General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Lesser General Public 15 | -- License along with this library; if not, write to the Free Software 16 | -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 17 | -- USA 18 | -- 19 | 20 | -- 21 | -- compile and run haskell strings at runtime. 22 | -- 23 | 24 | module System.Eval.Utils ( 25 | 26 | Import, 27 | symbol, 28 | escape, 29 | getPaths, 30 | 31 | mkUniqueWith, 32 | cleanup, 33 | 34 | module Data.Maybe, 35 | module Control.Monad, 36 | 37 | ) where 38 | 39 | import System.Plugins.Load ( Symbol ) 40 | import System.Plugins.Utils 41 | 42 | import System.IO 43 | import System.Directory 44 | 45 | import Data.Char 46 | 47 | -- 48 | -- we export these so that eval() users have a nice time 49 | -- 50 | import Data.Maybe 51 | import Control.Monad 52 | 53 | -- 54 | -- imports Foo's 55 | -- 56 | type Import = String 57 | 58 | -- 59 | -- distinguished symbol name 60 | -- 61 | symbol :: Symbol 62 | symbol = "resource" 63 | 64 | -- 65 | -- turn a Haskell string into a printable version of the same string 66 | -- 67 | escape s = concatMap (\c -> showLitChar c $ "") s 68 | 69 | -- 70 | -- For Dynamic eval's, work out the compile and load command lines 71 | -- 72 | getPaths :: IO ([String],[String]) 73 | getPaths = do 74 | let make_line = ["-O0","-package","plugins"] 75 | return (make_line,[]) 76 | 77 | -- --------------------------------------------------------------------- 78 | -- create the tmp file, and write source into it, using wrapper to 79 | -- create extra .hs src. 80 | -- 81 | mkUniqueWith :: (String -> String -> [Import] -> String) 82 | -> String 83 | -> [Import] -> IO FilePath 84 | 85 | mkUniqueWith wrapper src mods = do 86 | (tmpf,hdl) <- hMkUnique 87 | let nm = mkModid (basename tmpf) -- used as a module name 88 | src' = wrapper src nm mods 89 | hPutStr hdl src' >> hFlush hdl >> hClose hdl >> return tmpf 90 | 91 | -- 92 | -- remove all the tmp files 93 | -- 94 | cleanup :: String -> String -> IO () 95 | cleanup a b = mapM_ removeFile [a, b, replaceSuffix b ".hi"] 96 | -------------------------------------------------------------------------------- /src/System/Plugins.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons 3 | -- 4 | -- This library is free software; you can redistribute it and/or 5 | -- modify it under the terms of the GNU Lesser General Public 6 | -- License as published by the Free Software Foundation; either 7 | -- version 2.1 of the License, or (at your option) any later version. 8 | -- 9 | -- This library is distributed in the hope that it will be useful, 10 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 12 | -- Lesser General Public License for more details. 13 | -- 14 | -- You should have received a copy of the GNU Lesser General Public 15 | -- License along with this library; if not, write to the Free Software 16 | -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 17 | -- USA 18 | -- 19 | 20 | module System.Plugins ( 21 | 22 | -- $Description 23 | 24 | module System.Plugins.Make, 25 | module System.Plugins.Load, 26 | 27 | ) where 28 | 29 | import System.Plugins.Make {-all-} 30 | import System.Plugins.Load {-all-} 31 | 32 | -- 33 | -- $Description 34 | -- 35 | -- [@NAME@] hs-plugins library : compile and load Haskell code at runtime 36 | -- 37 | -------------------------------------------------------------------------------- /src/System/Plugins/Consts.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | -- 3 | -- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons 4 | -- 5 | -- This library is free software; you can redistribute it and/or 6 | -- modify it under the terms of the GNU Lesser General Public 7 | -- License as published by the Free Software Foundation; either 8 | -- version 2.1 of the License, or (at your option) any later version. 9 | -- 10 | -- This library is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | -- Lesser General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU Lesser General Public 16 | -- License along with this library; if not, write to the Free Software 17 | -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 18 | -- USA 19 | -- 20 | 21 | module System.Plugins.Consts where 22 | 23 | #include "config.h" 24 | 25 | 26 | #if __GLASGOW_HASKELL__ >= 604 27 | import System.Directory ( getTemporaryDirectory ) 28 | import System.IO.Unsafe ( unsafePerformIO ) 29 | #endif 30 | 31 | 32 | -- | path to *build* dir, used by eval() for testing the examples 33 | top = TOP 34 | 35 | -- | what is ghc called? 36 | ghc = WITH_GHC 37 | 38 | -- | path to standard ghc libraries 39 | ghcLibraryPath = GHC_LIB_PATH 40 | 41 | -- | name of the system package.conf file 42 | sysPkgConf = "package.conf" 43 | 44 | -- | This code is from runtime_loader: 45 | -- The extension used by system modules. 46 | sysPkgSuffix = ".a" 47 | objSuf = ".o" 48 | hiSuf = ".hi" 49 | hsSuf = ".hs" 50 | #if defined(CYGWIN) || defined(__MINGW32__) 51 | dllSuf = ".dll" 52 | #else 53 | dllSuf = ".so" 54 | #endif 55 | 56 | -- | The prefix used by system modules. This, in conjunction with 57 | -- 'systemModuleExtension', will result in a module filename that looks 58 | -- like \"HSconcurrent.o\" 59 | sysPkgPrefix = "HS" 60 | 61 | -- | '_' on a.out, and Darwin 62 | #if LEADING_UNDERSCORE == 1 63 | prefixUnderscore = "_" 64 | #else 65 | prefixUnderscore = "" 66 | #endif 67 | 68 | -- | Define tmpDir to where tmp files should be created on your platform 69 | 70 | #if __GLASGOW_HASKELL__ >= 604 71 | tmpDir = unsafePerformIO getTemporaryDirectory 72 | {-# NOINLINE tmpDir #-} 73 | #else 74 | #if !defined(__MINGW32__) 75 | tmpDir = "/tmp" 76 | #else 77 | tmpDir = error "tmpDir not defined for this platform. Try setting the TMPDIR env var" 78 | #endif 79 | #endif 80 | -------------------------------------------------------------------------------- /src/System/Plugins/LoadTypes.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- Copyright (c) 2005 Lemmih 3 | -- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons 4 | -- 5 | -- This program is free software; you can redistribute it and/or 6 | -- modify it under the terms of the GNU General Public License as 7 | -- published by the Free Software Foundation; either version 2 of 8 | -- the License, or (at your option) any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | -- General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program; if not, write to the Free Software 17 | -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 18 | -- 02111-1307, USA. 19 | -- 20 | 21 | module System.Plugins.LoadTypes 22 | ( Key (..) 23 | , Symbol 24 | , Type 25 | , Errors 26 | , PackageConf 27 | , Module (..) 28 | , ObjType (..) 29 | ) where 30 | 31 | -- import Language.Hi.Parser 32 | 33 | import HscTypes 34 | 35 | data Key = Object String | Package String 36 | 37 | type Symbol = String 38 | type Type = String 39 | type Errors = [String] 40 | type PackageConf = FilePath 41 | 42 | data Module = Module { path :: !FilePath 43 | , mname :: !String 44 | , kind :: !ObjType 45 | , iface :: ModIface -- cache the iface 46 | , key :: Key 47 | } 48 | 49 | instance Ord Module where 50 | compare m1 m2 = mname m1 `compare` mname m2 51 | 52 | instance Eq Module where 53 | m1 == m2 = mname m1 == mname m2 54 | 55 | data ObjType = Vanilla | Shared deriving Eq 56 | -------------------------------------------------------------------------------- /src/System/Plugins/Process.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | -- 3 | -- | A Posix.popen compatibility mapping. 4 | -- 5 | -- If we use this, we should build -threaded 6 | -- 7 | module System.Plugins.Process (exec, popen) where 8 | 9 | import System.Exit 10 | import System.IO 11 | import System.Process 12 | import Control.Concurrent (forkIO) 13 | 14 | import qualified Control.Exception as E 15 | 16 | -- 17 | -- slight wrapper over popen for calls that don't care about stdin to the program 18 | -- 19 | exec :: String -> [String] -> IO ([String],[String],Bool) 20 | exec f as = do 21 | (a,b,c,_) <- popen f as (Just []) 22 | return (lines a, lines b,c) 23 | 24 | type ProcessID = ProcessHandle 25 | 26 | -- 27 | -- Ignoring exit status for now. 28 | -- 29 | -- XXX there are still issues. Large amounts of output can cause what 30 | -- seems to be a dead lock on the pipe write from runplugs, for example. 31 | -- Posix.popen doesn't have this problem, so maybe we can reproduce its 32 | -- pipe handling somehow. 33 | -- 34 | popen :: FilePath -> [String] -> Maybe String -> IO (String,String,Bool,ProcessID) 35 | popen file args minput = 36 | E.handle (\e -> return ([],show (e::E.IOException), False, error (show e))) $ do 37 | 38 | (inp,out,err,pid) <- runInteractiveProcess file args Nothing Nothing 39 | 40 | case minput of 41 | Just input -> hPutStr inp input >> hClose inp -- importante! 42 | Nothing -> return () 43 | 44 | -- Now, grab the input 45 | output <- hGetContents out 46 | errput <- hGetContents err 47 | 48 | -- SimonM sez: 49 | -- ... avoids blocking the main thread, but ensures that all the 50 | -- data gets pulled as it becomes available. you have to force the 51 | -- output strings before waiting for the process to terminate. 52 | -- 53 | _ <- forkIO (E.evaluate (length output) >> return ()) 54 | _ <- forkIO (E.evaluate (length errput) >> return ()) 55 | 56 | -- And now we wait. We must wait after we read, unsurprisingly. 57 | exitCode <- waitForProcess pid -- blocks without -threaded, you're warned. 58 | case exitCode of 59 | ExitFailure code 60 | | null errput -> let errMsg = file ++ ": failed with error code " ++ show code 61 | in return ([],errMsg,False,error errMsg) 62 | | otherwise -> return ([],errput,False,error errput) 63 | _ -> return (output,errput,True,pid) 64 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # For more information, see: https://github.com/commercialhaskell/stack/blob/master/doc/yaml_configuration.md 2 | 3 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) 4 | resolver: lts-16.13 5 | 6 | # Local packages, usually specified by relative directory name 7 | packages: 8 | - '.' 9 | 10 | # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) 11 | extra-deps: [] 12 | 13 | # Override default flag values for local packages and extra-deps 14 | flags: {} 15 | 16 | # Control whether we use the GHC we find on the path 17 | # system-ghc: true 18 | 19 | # Require a specific version of stack, using version ranges 20 | # require-stack-version: -any # Default 21 | # require-stack-version: >= 0.1.4.0 22 | 23 | # Override the architecture used by stack, especially useful on Windows 24 | # arch: i386 25 | # arch: x86_64 26 | 27 | # Extra directories used by stack for building 28 | # extra-include-dirs: [/path/to/dir] 29 | # extra-lib-dirs: [/path/to/dir] 30 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | size: 532381 10 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/13.yaml 11 | sha256: 6ee17f7996e5bc75ae4406250841f1362ad4196418a4d90a0615ff4f26ac98df 12 | original: lts-16.13 13 | -------------------------------------------------------------------------------- /testsuite/README: -------------------------------------------------------------------------------- 1 | These examples illustrate the various uses of hs-plugins. 2 | 3 | conf a configuration file edsl using plugins 4 | dynload dynamically typed load 5 | eval runtime evaluation of haskell strings, from Haskell and C 6 | hmake the 'plugs' haskell interpreter 7 | iface test the interface file parser 8 | load load a plugin 9 | make build a Haskell file 10 | makewith merge and build a Haskell file 11 | multi load multiple plugins at once 12 | objc load Haskell plugins into object C programs 13 | pkgconf test package.conf parsing 14 | popen test popen 15 | reload reload a plugin when it changes 16 | shell a simple string filter 17 | unload test unloading of plugins 18 | -------------------------------------------------------------------------------- /testsuite/TIMINGS: -------------------------------------------------------------------------------- 1 | Method: 2 | * "pdynload" 3 | comes from pdynload/small 4 | * "load + ghc" 5 | comes from pdynload/null, with lines 13-14 6 | uncommented from prog/Main.hs 7 | * "dynload" 8 | from dynload/simple 9 | * "load, no check" 10 | from pdynload/null, with lines 13-14 of prog/Main.hs 11 | commented out 12 | 13 | For example, to run the "pdynload" test: 14 | $ cd pdynload/small 15 | $ make 16 | $ make check # to prime caches, etc. 17 | $ time make check 18 | $ time make check 19 | $ time make check # run 'time make check' until value converges 20 | 21 | The converged value is entered into the "Raw" timings, and then the 22 | scaled timing is calculated for each machine. These scaled values were 23 | then averaged over the number of machines, yielding the final 24 | "Average" scores -- the average over a number of machines and os. 25 | 26 | Raw timing: 27 | pdynload load+ghc dynload load, no check 28 | 29 | 0.33 0.25 0.22 0.21 -- P4 2.6 , OpenBSD 30 | 0.38 0.31 0.29 0.27 -- P4 2.66, Linux 31 | 0.84 0.77 0.64 0.55 -- Quad P4 2.4, Linux 32 | 0.76 0.60 0.52 0.50 -- AMD 1.1G, Linux 33 | 0.95 0.83 0.75 0.72 -- G5 2.0G, Mac OS X 34 | -- Quad Itanium 1,Linux 35 | 36 | Scaled: 37 | 1.57 1.19 1.05 1 38 | 1.40 1.15 1.07 39 | 1.52 1.4 1.16 40 | 1.52 1.2 1.04 41 | 1.32 1.15 1.04 42 | 43 | Average: 44 | =1.46 = 1.218 = 1.07 45 | 46 | -------------------------------------------------------------------------------- /testsuite/build.mk: -------------------------------------------------------------------------------- 1 | # how to build the default projects 2 | 3 | include $(TOP)/config.mk 4 | include $(TOP)/testsuite/check.mk 5 | 6 | BIN= prog/Main 7 | OBJ= prog/Main.o 8 | SRC= prog/Main.hs 9 | 10 | BINDIR= prog 11 | REALBIN= ./Main 12 | 13 | API_OBJ= api/API.o 14 | 15 | INCLUDES= -i$(TOP)/testsuite/$(TEST)/api 16 | GHCFLAGS= -rdynamic -O0 -cpp -fglasgow-exts 17 | 18 | .SUFFIXES : .o .hs .hi .lhs .hc .s 19 | 20 | all: $(BIN) 21 | 22 | $(BIN) : $(PRIOR_OBJS) $(API_OBJ) $(SRC) $(EXTRA_OBJS) 23 | rm -f $@ 24 | $(GHC) --make -o $@ $(INCLUDES) $(PKGFLAGS) $(GHCFLAGS) $(EXTRAFLAGS) $(API) $(SRC) 25 | 26 | # Standard suffix rules 27 | .o.hi: 28 | : 29 | .hs.o: $(API_OBJ) 30 | $(GHC) $(INCLUDES) $(PKGFLAGS) $(GHCFLAGS) $(EXTRAFLAGS) -c $< 31 | 32 | clean: 33 | find . -name '*~' -exec rm {} \; 34 | rm -rf *.{o,hi,dep} 35 | rm -rf */*.{hi,o,old} */Main 36 | rm -rf */*core 37 | rm -rf */*.a 38 | rm -rf */package.conf 39 | rm -rf *.a 40 | 41 | -------------------------------------------------------------------------------- /testsuite/check.mk: -------------------------------------------------------------------------------- 1 | include $(TOP)/config.mk 2 | 3 | check: $(BIN) 4 | (cd $(BINDIR) ;\ 5 | expected="expected" ;\ 6 | if [ -f "expected" -o -f "expected.$(GLASGOW_HASKELL)" ] ;\ 7 | then \ 8 | actual_out="/tmp/hs-plugins-actual.out.$$$$" ;\ 9 | diff_out="/tmp/hs-plugins.diff.$$$$" ;\ 10 | $(REALBIN) > $$actual_out 2>&1 || true ;\ 11 | if [ -f "expected.$(GLASGOW_HASKELL)" ] ; then \ 12 | expected="expected.$(GLASGOW_HASKELL)" ;\ 13 | fi ;\ 14 | diff -u $$expected $$actual_out > $$diff_out || true ;\ 15 | if [ -s "$$diff_out" ] ; then \ 16 | echo "failed with:" ;\ 17 | cat "$$diff_out" | sed '1,3d' ;\ 18 | else \ 19 | echo "ok." ;\ 20 | fi ;\ 21 | rm $$actual_out $$diff_out ;\ 22 | else \ 23 | $(REALBIN) 2>&1 || true ;\ 24 | fi) 25 | -------------------------------------------------------------------------------- /testsuite/conf/simple/Mailrc.conf: -------------------------------------------------------------------------------- 1 | import System.Directory 2 | 3 | resource = mail { 4 | -- editor = do b <- doesFileExist "/usr/bin/emacs" 5 | -- return $ if b then "emacs" else "vi" , 6 | editor = do b <- doesFileExist "/bin/sh" 7 | return "sh", 8 | 9 | attribution = \name -> "Today, "++name++" wrote :" 10 | } 11 | 12 | -------------------------------------------------------------------------------- /testsuite/conf/simple/Mailrc.stub: -------------------------------------------------------------------------------- 1 | module Mailrc ( resource ) where 2 | 3 | import API 4 | 5 | resource :: Interface 6 | resource = mail 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | -------------------------------------------------------------------------------- /testsuite/conf/simple/Makefile: -------------------------------------------------------------------------------- 1 | TEST= conf/simple 2 | 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/conf/simple/api/API.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- the configuration file interface. 3 | -- 4 | 5 | module API where 6 | 7 | data Color = Black | Grey | Green | Cyan | Yellow | Magenta | Red 8 | 9 | data Interface = Interface { 10 | editor :: IO String, 11 | attribution :: String -> String, 12 | header_color :: Color, 13 | colorize :: [String], 14 | include :: Bool 15 | } 16 | 17 | -- Default settings 18 | mail :: Interface 19 | mail = Interface { 20 | editor = return "vi", 21 | 22 | attribution = (\user -> user ++ " wrote:"), 23 | header_color = Grey, 24 | colorize = [], 25 | include = True 26 | } 27 | 28 | -------------------------------------------------------------------------------- /testsuite/conf/simple/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | conf = "../Mailrc.conf" 6 | stub = "../Mailrc.stub" 7 | apipath = "../api" 8 | 9 | main = do 10 | status <- makeWith conf stub ["-i"++apipath] 11 | o <- case status of 12 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 13 | MakeSuccess _ o -> return o 14 | status <- load o [apipath] [] "resource" 15 | v <- case status of 16 | LoadFailure err -> mapM_ putStrLn err >> error "no" 17 | LoadSuccess _ v -> return v 18 | 19 | user_editor <- editor v 20 | putStrLn user_editor 21 | makeCleaner o 22 | 23 | -------------------------------------------------------------------------------- /testsuite/conf/simple/prog/expected: -------------------------------------------------------------------------------- 1 | sh 2 | -------------------------------------------------------------------------------- /testsuite/dynload/io/Makefile: -------------------------------------------------------------------------------- 1 | TEST=dynload/io 2 | 3 | EXTRA_OBJS=TestIO.o 4 | 5 | TOP=../../.. 6 | include ../../build.mk 7 | -------------------------------------------------------------------------------- /testsuite/dynload/io/TestIO.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons 3 | -- LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html) 4 | -- 5 | 6 | module TestIO ( resource_dyn ) where 7 | 8 | import API 9 | import Data.Dynamic 10 | 11 | import Control.Exception (SomeException, catch) 12 | 13 | import System.IO 14 | import System.Posix.Types ( ProcessID, Fd ) 15 | import System.Posix.Process ( forkProcess, executeFile, getProcessID ) 16 | import System.Posix.IO ( createPipe, stdInput, 17 | stdOutput, fdToHandle, closeFd, dupTo ) 18 | 19 | resource_dyn :: Dynamic 20 | resource_dyn = toDyn resource 21 | 22 | resource :: TestIO 23 | resource = testio { field = date } 24 | 25 | 26 | -- 27 | -- call a shell command , returning it's output 28 | -- 29 | date :: IO String 30 | date = do (hdl,_,_) <- catch (popen "/bin/date") (\(_ :: SomeException)->error "popen failed") 31 | hGetLine hdl 32 | 33 | ------------------------------------------------------------------------ 34 | -- 35 | -- my implementation of $val = `cmd`; (if this was perl) 36 | -- 37 | -- provide similar functionality to popen(3), 38 | -- along with bidirectional ipc via pipes 39 | -- return's the pid of the child process 40 | -- 41 | -- there are two different forkProcess functions. the pre-620 was a 42 | -- unix-fork style function, and the modern function has semantics more 43 | -- like the Awkward-Squad paper. We provide implementations of popen 44 | -- using both versions, depending on which GHC the user wants to try. 45 | -- 46 | 47 | popen :: FilePath -> IO (Handle, Handle, ProcessID) 48 | popen cmd = do 49 | (pr, pw) <- createPipe 50 | (cr, cw) <- createPipe 51 | 52 | -- parent -- 53 | let parent = do closeFd cw 54 | closeFd pr 55 | -- child -- 56 | let child = do closeFd pw 57 | closeFd cr 58 | exec cmd (pr,cw) 59 | error "exec cmd failed!" -- typing only 60 | 61 | -- if the parser front end understood cpp, this would work 62 | -- #if __GLASGOW_HASKELL__ >= 601 63 | pid <- forkProcess child -- fork child 64 | parent -- and run parent code 65 | -- #else 66 | -- p <- forkProcess 67 | -- pid <- case p of 68 | -- Just pid -> parent >> return pid 69 | -- Nothing -> child 70 | -- #endif 71 | 72 | hcr <- fdToHandle cr 73 | hpw <- fdToHandle pw 74 | 75 | return (hcr,hpw,pid) 76 | 77 | -- 78 | -- execve cmd in the child process, dup'ing the file descriptors passed 79 | -- as arguments to become the child's stdin and stdout. 80 | -- 81 | exec :: FilePath -> (Fd,Fd) -> IO () 82 | exec cmd (pr,cw) = do 83 | dupTo pr stdInput 84 | dupTo cw stdOutput 85 | executeFile cmd False [] Nothing 86 | 87 | ------------------------------------------------------------------------ 88 | -------------------------------------------------------------------------------- /testsuite/dynload/io/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | import Data.Typeable 4 | 5 | data TestIO = TestIO { 6 | field :: IO String 7 | #if __GLASGOW_HASKELL__ >= 800 8 | } deriving Typeable 9 | #else 10 | } 11 | instance Typeable TestIO where 12 | #if __GLASGOW_HASKELL__ >= 603 13 | typeOf i = mkTyConApp (mkTyCon "API.TestIO") [] 14 | #else 15 | typeOf i = mkAppTy (mkTyCon "API.TestIO") [] 16 | #endif 17 | #endif 18 | 19 | testio :: TestIO 20 | testio = TestIO { field = return "default value" } 21 | -------------------------------------------------------------------------------- /testsuite/dynload/io/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | 4 | import API 5 | 6 | main = do 7 | m_v <- dynload "../TestIO.o" ["../api"] 8 | [] "resource_dyn" :: IO (LoadStatus TestIO) 9 | case m_v of 10 | LoadFailure _ -> error "couldn't link" 11 | LoadSuccess _ v -> do 12 | s <- field v 13 | if s /= "" then print True else print False 14 | -------------------------------------------------------------------------------- /testsuite/dynload/io/prog/expected: -------------------------------------------------------------------------------- 1 | True 2 | -------------------------------------------------------------------------------- /testsuite/dynload/poly/Makefile: -------------------------------------------------------------------------------- 1 | TEST=dynload/poly 2 | EXTRA_OBJS=Plugin.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/dynload/poly/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | import API 4 | import Data.Dynamic 5 | 6 | my_fun = plugin { 7 | equals = \x y -> (x /= y) -- a strange equals function :) 8 | } 9 | 10 | resource_dyn :: Dynamic 11 | resource_dyn = toDyn my_fun 12 | 13 | -------------------------------------------------------------------------------- /testsuite/dynload/poly/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -cpp #-} 2 | 3 | module API where 4 | 5 | import Data.Typeable 6 | 7 | data Interface = Interface { 8 | equals :: forall t. Eq t => t -> t -> Bool 9 | } 10 | 11 | -- 12 | -- see how it hides the internal type.. but to compile GHC still checks 13 | -- the type. 14 | -- 15 | instance Typeable Interface where 16 | #if __GLASGOW_HASKELL__ >= 603 17 | typeOf i = mkTyConApp (mkTyCon "API.Interface") [] 18 | #else 19 | typeOf i = mkAppTy (mkTyCon "API.Interface") [] 20 | #endif 21 | 22 | plugin :: Interface 23 | plugin = Interface { equals = (==) } 24 | 25 | -------------------------------------------------------------------------------- /testsuite/dynload/poly/prog/Main.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -cpp #-} 2 | 3 | #include "../../../../config.h" 4 | 5 | import System.Plugins 6 | import API 7 | 8 | main = do 9 | m_v <- dynload "../Plugin.o" ["../api"] 10 | [] 11 | "resource_dyn" 12 | case m_v of 13 | LoadFailure _ -> error "didn't compile" 14 | LoadSuccess _ (Interface eq) -> do 15 | putStrLn $ show $ 1 `eq` 2 16 | putStrLn $ show $ 'a' `eq` 'b' 17 | 18 | -------------------------------------------------------------------------------- /testsuite/dynload/poly/prog/expected: -------------------------------------------------------------------------------- 1 | True 2 | True 3 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail/Makefile: -------------------------------------------------------------------------------- 1 | TEST= dynload/should_fail 2 | EXTRA_OBJS=Plugin.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail/Plugin.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | module Plugin where 3 | 4 | import API 5 | import Data.Dynamic 6 | 7 | v :: Int 8 | v = 0xdeadbeef 9 | 10 | resource_dyn :: Dynamic 11 | resource_dyn = toDyn v 12 | 13 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | import Data.Typeable 6 | 7 | data Interface = Interface { 8 | function :: String 9 | } 10 | 11 | instance Typeable Interface where 12 | #if __GLASGOW_HASKELL__ >= 603 13 | typeOf i = mkTyConApp (mkTyCon "API.Interface") [] 14 | #else 15 | typeOf i = mkAppTy (mkTyCon "API.Interface") [] 16 | #endif 17 | 18 | plugin :: Interface 19 | plugin = Interface { function = "goodbye" } 20 | 21 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | main = do 6 | m_v <- dynload "../Plugin.o" 7 | ["../api"] 8 | [] 9 | "resource_dyn" 10 | 11 | case m_v of 12 | LoadFailure _ -> putStrLn "didn't compile" 13 | LoadSuccess _ v -> putStrLn $ function v 14 | 15 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail/prog/expected: -------------------------------------------------------------------------------- 1 | Couldn't match `API.Interface' against `Int' 2 | Expected type: API.Interface 3 | Inferred type: Int 4 | didn't compile 5 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_1/Makefile: -------------------------------------------------------------------------------- 1 | TEST= dynload/should_fail_1 2 | EXTRA_OBJS=Plugin.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_1/Plugin.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- trying to be really mean. 3 | -- 4 | 5 | module Plugin where 6 | 7 | import API 8 | import Data.Dynamic 9 | 10 | v :: Int -> Int 11 | v = \x -> 0xdeadbeef 12 | 13 | resource_dyn :: Dynamic 14 | resource_dyn = toDyn v 15 | 16 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_1/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | import Data.Typeable 6 | 7 | data Interface = Interface { 8 | function :: String 9 | } 10 | 11 | instance Typeable Interface where 12 | #if __GLASGOW_HASKELL__ >= 603 13 | typeOf i = mkTyConApp (mkTyCon "API.Interface") [] 14 | #else 15 | typeOf i = mkAppTy (mkTyCon "API.Interface") [] 16 | #endif 17 | 18 | plugin :: Interface 19 | plugin = Interface { function = "goodbye" } 20 | 21 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_1/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | main = do 6 | m_v <- dynload "../Plugin.o" ["../api"] 7 | [] "resource_dyn" 8 | case m_v of 9 | LoadFailure _ -> putStrLn "didn't compile" 10 | LoadSuccess _ v -> putStrLn $ (function v) 11 | 12 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_1/prog/expected: -------------------------------------------------------------------------------- 1 | Couldn't match `API.Interface' against `Int -> Int' 2 | Expected type: API.Interface 3 | Inferred type: Int -> Int 4 | didn't compile 5 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_2/Makefile: -------------------------------------------------------------------------------- 1 | TEST= dynload/should_fail_2 2 | 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_2/Plugin.in: -------------------------------------------------------------------------------- 1 | -- 2 | -- the plugin doesn't even make the resource_dyn a Dynamic. 3 | -- 4 | -- let's hope that makeWith strips out the invalid declarations 5 | -- 6 | 7 | {-# OPTIONS -fglasgow-exts #-} 8 | 9 | module Plugin where 10 | 11 | import API 12 | import Data.Typeable 13 | import GHC.Base 14 | 15 | v :: Int 16 | v = 0xdeadbeef 17 | 18 | resource_dyn = (typeOf v, unsafeCoerce v) 19 | 20 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_2/Plugin.stub: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module Plugin ( resource_dyn ) where 4 | 5 | import API 6 | import Data.Dynamic 7 | 8 | resource = plugin 9 | 10 | resource_dyn :: Dynamic 11 | resource_dyn = toDyn resource 12 | 13 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_2/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | import Data.Typeable 6 | import GHC.Base 7 | 8 | data Interface = Interface { 9 | function :: String 10 | } 11 | 12 | instance Typeable Interface where 13 | #if __GLASGOW_HASKELL__ >= 603 14 | typeOf i = mkTyConApp (mkTyCon "API.Interface") [] 15 | #else 16 | typeOf i = mkAppTy (mkTyCon "API.Interface") [] 17 | #endif 18 | 19 | plugin :: Interface 20 | plugin = Interface { function = "goodbye" } 21 | 22 | unsafeCoerce = unsafeCoerce# 23 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_2/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | conf = "../Plugin.in" 6 | stub = "../Plugin.stub" 7 | 8 | main = do 9 | status <- makeWith conf stub ["-i../api", "-i../../../../src/altdata/"] 10 | case status of 11 | MakeFailure e -> mapM_ putStrLn e >> putStrLn "failed" 12 | MakeSuccess _ o -> do { 13 | ; m_v <- dynload o ["../api"] [] "resource_dyn" 14 | ; makeCleaner o 15 | ; case m_v of 16 | LoadFailure _ -> putStrLn "didn't load" 17 | LoadSuccess _ v -> putStrLn $ (function v) 18 | } 19 | 20 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_2/prog/expected: -------------------------------------------------------------------------------- 1 | 2 | ../Plugin.in:18: 3 | Couldn't match `Dynamic' against `(t, t1)' 4 | Expected type: Dynamic 5 | Inferred type: (t, t1) 6 | In the definition of `resource_dyn': 7 | resource_dyn = (typeOf v, unsafeCoerce v) 8 | failed 9 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_2/prog/expected.604: -------------------------------------------------------------------------------- 1 | 2 | ../Plugin.in:18:15: 3 | Couldn't match `Dynamic' against `(a, b)' 4 | Expected type: Dynamic 5 | Inferred type: (a, b) 6 | In the definition of `resource_dyn': resource_dyn = (typeOf v, unsafeCoerce v) 7 | failed 8 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_2/prog/expected.605: -------------------------------------------------------------------------------- 1 | 2 | ../Plugin.in:18:15: 3 | Couldn't match `Dynamic' against `(a, b)' 4 | Expected type: Dynamic 5 | Inferred type: (a, b) 6 | In the definition of `resource_dyn': resource_dyn = (typeOf v, unsafeCoerce v) 7 | failed 8 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_3/Makefile: -------------------------------------------------------------------------------- 1 | TEST= dynload/should_fail_3 2 | 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_3/Plugin.in: -------------------------------------------------------------------------------- 1 | -- 2 | -- the plugin doesn't even make the resource_dyn a Dynamic. 3 | -- let's hope that makeWith strips out the invalid declarations 4 | -- 5 | 6 | {-# OPTIONS -fglasgow-exts #-} 7 | 8 | module Plugin where 9 | 10 | import API 11 | 12 | import Data.Typeable 13 | import GHC.Base 14 | 15 | v :: Int 16 | v = 0xdeadbeef 17 | 18 | resource_dyn = (typeOf plugin, unsafeCoerce v) 19 | 20 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_3/Plugin.stub: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module Plugin ( resource_dyn ) where 4 | 5 | import API 6 | import Data.Dynamic 7 | 8 | resource = plugin 9 | 10 | resource_dyn :: Dynamic 11 | resource_dyn = toDyn resource 12 | 13 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_3/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -cpp -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | import Data.Typeable 6 | import GHC.Base 7 | 8 | data Interface = Interface { 9 | function :: String 10 | } 11 | 12 | instance Typeable Interface where 13 | #if __GLASGOW_HASKELL__ >= 603 14 | typeOf _ = mkTyConApp (mkTyCon "API.Interface") [] 15 | #else 16 | typeOf _ = mkAppTy (mkTyCon "API.Interface") [] 17 | #endif 18 | 19 | plugin :: Interface 20 | plugin = Interface { function = "goodbye" } 21 | 22 | unsafeCoerce = unsafeCoerce# 23 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_3/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | conf = "../Plugin.in" 6 | stub = "../Plugin.stub" 7 | 8 | main = do 9 | status <- makeWith conf stub ["-i../api", "-i../../../../src/altdata"] 10 | o <- case status of 11 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 12 | MakeSuccess _ o -> return o 13 | m_v <- dynload o ["../api"] [] "resource_dyn" 14 | case m_v of 15 | LoadFailure _ -> error "didn't compile" 16 | LoadSuccess _ v -> do putStrLn $ (function v) 17 | makeCleaner o 18 | 19 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_3/prog/expected: -------------------------------------------------------------------------------- 1 | 2 | ../Plugin.in:18: 3 | Couldn't match `Dynamic' against `(t, t1)' 4 | Expected type: Dynamic 5 | Inferred type: (t, t1) 6 | In the definition of `resource_dyn': 7 | resource_dyn = (typeOf plugin, unsafeCoerce v) 8 | 9 | Fail: failed 10 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_3/prog/expected.604: -------------------------------------------------------------------------------- 1 | 2 | ../Plugin.in:18:15: 3 | Couldn't match `Dynamic' against `(a, b)' 4 | Expected type: Dynamic 5 | Inferred type: (a, b) 6 | In the definition of `resource_dyn': 7 | resource_dyn = (typeOf plugin, unsafeCoerce v) 8 | a.out: failed 9 | -------------------------------------------------------------------------------- /testsuite/dynload/should_fail_3/prog/expected.605: -------------------------------------------------------------------------------- 1 | 2 | ../Plugin.in:18:15: 3 | Couldn't match `Dynamic' against `(a, b)' 4 | Expected type: Dynamic 5 | Inferred type: (a, b) 6 | In the definition of `resource_dyn': 7 | resource_dyn = (typeOf plugin, unsafeCoerce v) 8 | a.out: failed 9 | -------------------------------------------------------------------------------- /testsuite/dynload/simple/Makefile: -------------------------------------------------------------------------------- 1 | TEST=dynload/simple 2 | EXTRA_OBJS=Plugin.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/dynload/simple/Plugin.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | module Plugin where 3 | 4 | import API 5 | import Data.Dynamic 6 | 7 | my_fun = plugin { function = "plugin says \"hello\"" } 8 | 9 | resource_dyn :: Dynamic 10 | resource_dyn = toDyn my_fun 11 | 12 | -------------------------------------------------------------------------------- /testsuite/dynload/simple/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -cpp #-} 2 | 3 | module API where 4 | 5 | import Data.Typeable 6 | 7 | data Interface = Interface { 8 | function :: String 9 | } 10 | 11 | instance Typeable Interface where 12 | #if __GLASGOW_HASKELL__ >= 603 13 | typeOf i = mkTyConApp (mkTyCon "API.Interface") [] 14 | #else 15 | typeOf i = mkAppTy (mkTyCon "API.Interface") [] 16 | #endif 17 | 18 | plugin :: Interface 19 | plugin = Interface { function = "goodbye" } 20 | 21 | -------------------------------------------------------------------------------- /testsuite/dynload/simple/prog/Main.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -cpp #-} 2 | 3 | #include "../../../../config.h" 4 | 5 | import System.Plugins 6 | import API 7 | 8 | main = do 9 | m_v <- dynload "../Plugin.o" ["../api"] 10 | [] 11 | "resource_dyn" 12 | case m_v of 13 | LoadFailure _ -> error "didn't compile" 14 | LoadSuccess _ v -> putStrLn $ (function v) 15 | 16 | -------------------------------------------------------------------------------- /testsuite/dynload/simple/prog/expected: -------------------------------------------------------------------------------- 1 | plugin says "hello" 2 | -------------------------------------------------------------------------------- /testsuite/eval.mk: -------------------------------------------------------------------------------- 1 | include $(TOP)/config.mk 2 | include $(TOP)/testsuite/check.mk 3 | 4 | BIN=Main 5 | SRC=Main.hs 6 | 7 | BINDIR= "." 8 | REALBIN= ./$(BIN) 9 | 10 | .SUFFIXES : .o .hs .hi .lhs .hc .s 11 | 12 | all: $(BIN) 13 | 14 | $(BIN): $(SRC) $(OBJS) 15 | rm -f $@ 16 | $(GHC) --make -fglasgow-exts $(GHCFLAGS) $(PKGFLAGS) $(EXTRAFLAGS) $(SRC) 17 | 18 | # Standard suffix rules 19 | .o.hi: 20 | : 21 | .hs.o: 22 | $(GHC) $(INCLUDES) $(PKGFLAGS) $(GHCFLAGS) $(EXTRAFLAGS) -c $< 23 | 24 | clean: 25 | rm -rf *.hi *.o *~ $(BIN) 26 | -------------------------------------------------------------------------------- /testsuite/eval/eval1/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Eval.Haskell 3 | 4 | main = do i <- eval "1 + 6 :: Int" [] :: IO (Maybe Int) 5 | if isJust i then putStrLn $ show (fromJust i) else return () 6 | -------------------------------------------------------------------------------- /testsuite/eval/eval1/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../eval.mk 3 | -------------------------------------------------------------------------------- /testsuite/eval/eval1/expected: -------------------------------------------------------------------------------- 1 | 7 2 | -------------------------------------------------------------------------------- /testsuite/eval/eval2/Main.hs: -------------------------------------------------------------------------------- 1 | import System.Eval.Haskell 2 | 3 | main = do m_s <- eval "map toUpper \"haskell\"" ["Data.Char"] 4 | case m_s of 5 | Nothing -> putStrLn "typechecking failed" 6 | Just s -> putStrLn s 7 | -------------------------------------------------------------------------------- /testsuite/eval/eval2/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../eval.mk 3 | -------------------------------------------------------------------------------- /testsuite/eval/eval2/expected: -------------------------------------------------------------------------------- 1 | HASKELL 2 | -------------------------------------------------------------------------------- /testsuite/eval/eval3/Main.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -cpp #-} 2 | -- 3 | -- Should evaluate to '3', unless something goes wrong. 4 | -- 5 | -- Not so bad to use AltData, as it is already derived for all the basic 6 | -- types. Then, just replace deriving Typeable, with hand-derived 7 | -- instance of Typeable (see hs-plugins/testsuite/eval/eval_fn1/Poly.hs 8 | -- 9 | -- 10 | 11 | #include "../../../config.h" 12 | 13 | import System.Eval 14 | import Data.Dynamic 15 | 16 | main = do 17 | a <- return $ toDyn (3::Integer) 18 | 19 | -- so, we try to compile a function that takes a dyn. 20 | -- looks like with GHC 6.4, we need to make sure the package.confs work: 21 | m_b <- unsafeEval_ "\\dyn -> fromDyn dyn (7 :: Integer)" 22 | ["Data.Dynamic"] 23 | [ ] 24 | [ ] 25 | [] 26 | 27 | case m_b of 28 | Left s -> mapM_ putStrLn s 29 | Right b -> putStrLn $ show (b a :: Integer) -- now apply it 30 | 31 | {- 32 | -- should work, but doesn't. type check fails 33 | -- (due to static vs dynamic typing issue) 34 | 35 | m_b <- unsafeEval_ "\\dyn -> fromMaybe (7 :: Int) (fromDynamic dyn)" 36 | ["Data.Dynamic","Data.Maybe"] [] [] 37 | -} 38 | 39 | -------------------------------------------------------------------------------- /testsuite/eval/eval3/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../eval.mk 3 | -------------------------------------------------------------------------------- /testsuite/eval/eval3/expected: -------------------------------------------------------------------------------- 1 | 3 2 | -------------------------------------------------------------------------------- /testsuite/eval/eval_/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Eval.Haskell 3 | 4 | main = do i <- eval_ "Just (7 :: Int)" 5 | ["Data.Maybe"] 6 | ["-fglasgow-exts"] 7 | [] 8 | [] :: IO (Either [String] (Maybe (Maybe Int))) 9 | print i 10 | -------------------------------------------------------------------------------- /testsuite/eval/eval_/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../eval.mk 3 | -------------------------------------------------------------------------------- /testsuite/eval/eval_/expected: -------------------------------------------------------------------------------- 1 | Right (Just (Just 7)) 2 | -------------------------------------------------------------------------------- /testsuite/eval/eval_fn/Main.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- lambda abstraction! 3 | -- 4 | -- 5 | -- needs unsafeEval because eval has a broken Dynamic check 6 | -- 7 | import System.Eval.Haskell 8 | 9 | main = do fn <- unsafeEval "(\\x -> (x,x::Int))" [] :: IO (Maybe (Int -> (Int,Int))) 10 | when (isJust fn) $ putStrLn $ show $ (fromJust fn) 7 11 | -------------------------------------------------------------------------------- /testsuite/eval/eval_fn/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../eval.mk 3 | -------------------------------------------------------------------------------- /testsuite/eval/eval_fn/expected: -------------------------------------------------------------------------------- 1 | (7,7) 2 | -------------------------------------------------------------------------------- /testsuite/eval/eval_fn1/Main.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | -- 3 | -- polymorphic eval! 4 | -- 5 | 6 | module Main where 7 | 8 | import Poly 9 | import System.Eval.Haskell 10 | 11 | main = do m_f <- eval "Fn (\\x y -> x == y)" ["Poly"] 12 | when (isJust m_f) $ do 13 | let (Fn f) = fromJust m_f 14 | putStrLn $ show (f True True) 15 | putStrLn $ show (f 1 2) 16 | -------------------------------------------------------------------------------- /testsuite/eval/eval_fn1/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../eval.mk 3 | -------------------------------------------------------------------------------- /testsuite/eval/eval_fn1/Poly.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -cpp -fglasgow-exts #-} 2 | module Poly where 3 | 4 | import Data.Typeable 5 | 6 | data Fn = Fn {fn :: forall t. Eq t => t -> t -> Bool} 7 | 8 | -- 9 | -- ignore type inside the Fn... is this correct? 10 | -- 11 | instance Typeable Fn where 12 | #if __GLASGOW_HASKELL__ >= 603 13 | typeOf _ = mkTyConApp (mkTyCon "Poly.Fn") [] 14 | #else 15 | typeOf _ = mkAppTy (mkTyCon "Poly.Fn") [] 16 | #endif 17 | -------------------------------------------------------------------------------- /testsuite/eval/eval_fn1/expected: -------------------------------------------------------------------------------- 1 | True 2 | False 3 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_eval/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../foreign.mk 3 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_eval/README: -------------------------------------------------------------------------------- 1 | run a string of Haskell code from a C program. 2 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_eval/dont_test: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/eval/foreign_eval/dont_test -------------------------------------------------------------------------------- /testsuite/eval/foreign_eval/expected: -------------------------------------------------------------------------------- 1 | 10946 2 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_eval/main.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include "EvalHaskell.h" 4 | 5 | int main(int argc, char *argv[]) 6 | { 7 | int *p; 8 | hs_init(&argc, &argv); 9 | p = hs_eval_i("let fibs = 1:1:zipWith (+) fibs (tail fibs) in fibs !! 20 :: Int"); 10 | if (p == NULL) 11 | printf("failed!\n"); 12 | else 13 | printf("%d\n",*p); 14 | hs_exit(); 15 | return 0; 16 | } 17 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_eval1/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../foreign.mk 3 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_eval1/dont_test: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/eval/foreign_eval1/dont_test -------------------------------------------------------------------------------- /testsuite/eval/foreign_eval1/expected: -------------------------------------------------------------------------------- 1 | 10946 2 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_eval1/main.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include "EvalHaskell.h" 4 | 5 | int main(int argc, char *argv[]) 6 | { 7 | char *p; 8 | hs_init(&argc, &argv); 9 | p = hs_eval_s("show $ let fibs = 1:1:zipWith (+) fibs (tail fibs) in fibs !! 20"); 10 | if (p == NULL) 11 | printf("failed!\n"); 12 | else 13 | printf("%s\n",p); 14 | hs_exit(); 15 | return 0; 16 | } 17 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_should_fail/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../foreign.mk 3 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_should_fail/dont_test: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/eval/foreign_should_fail/dont_test -------------------------------------------------------------------------------- /testsuite/eval/foreign_should_fail/expected: -------------------------------------------------------------------------------- 1 | :1: parse error on input `in' 2 | failed! 3 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_should_fail/expected.604: -------------------------------------------------------------------------------- 1 | failed! 2 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_should_fail/expected.605: -------------------------------------------------------------------------------- 1 | failed! 2 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_should_fail/main.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include "EvalHaskell.h" 4 | 5 | int main(int argc, char *argv[]) 6 | { 7 | int *p; 8 | hs_init(&argc, &argv); 9 | p = hs_eval_i("show $ case 1 + 2 in{-wrong-} x -> x"); 10 | if (p == NULL) 11 | printf("failed!\n"); 12 | else 13 | printf("%d\n",*p); 14 | hs_exit(); 15 | return 0; 16 | } 17 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_should_fail_illtyped/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../foreign.mk 3 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_should_fail_illtyped/dont_test: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/eval/foreign_should_fail_illtyped/dont_test -------------------------------------------------------------------------------- /testsuite/eval/foreign_should_fail_illtyped/expected: -------------------------------------------------------------------------------- 1 | Couldn't match `Int' against `[Char]' 2 | Expected type: Int 3 | Inferred type: [Char] 4 | failed! 5 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_should_fail_illtyped/expected.604: -------------------------------------------------------------------------------- 1 | failed! 2 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_should_fail_illtyped/expected.605: -------------------------------------------------------------------------------- 1 | failed! 2 | -------------------------------------------------------------------------------- /testsuite/eval/foreign_should_fail_illtyped/main.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include "EvalHaskell.h" 4 | 5 | int main(int argc, char *argv[]) 6 | { 7 | int *p; 8 | hs_init(&argc, &argv); 9 | p = hs_eval_i("\"an ill-typed string\""); 10 | if (p == NULL) 11 | printf("failed!\n"); 12 | else 13 | printf("%d\n",*p); 14 | hs_exit(); 15 | return 0; 16 | } 17 | -------------------------------------------------------------------------------- /testsuite/eval/unsafeidir/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins.Make 3 | import System.Eval.Haskell 4 | 5 | main = do make "a/Extra.hs" [] 6 | 7 | i <- unsafeEval_ "show (Just (1 + 6 :: Int)) ++ extra" 8 | ["Data.Maybe", "Extra"] 9 | ["-ia"] -- no make flags 10 | [] -- no package.confs 11 | ["a"] -- include paths to load from 12 | :: IO (Either [String] String) 13 | 14 | case i of 15 | Right i -> putStrLn $ show i 16 | Left es -> mapM_ putStrLn es 17 | -------------------------------------------------------------------------------- /testsuite/eval/unsafeidir/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../eval.mk 3 | -------------------------------------------------------------------------------- /testsuite/eval/unsafeidir/a/Extra.hs: -------------------------------------------------------------------------------- 1 | module Extra where 2 | 3 | extra = "an extra value" 4 | -------------------------------------------------------------------------------- /testsuite/eval/unsafeidir/expected: -------------------------------------------------------------------------------- 1 | "Just 7an extra value" 2 | -------------------------------------------------------------------------------- /testsuite/foreign.mk: -------------------------------------------------------------------------------- 1 | include $(TOP)/config.mk 2 | include $(TOP)/testsuite/check.mk 3 | 4 | 5 | INCLUDES= -I$(TOP) 6 | 7 | # compile with GHC to save us setting all the necessary include and 8 | # lib flags. use ghc -v to find out what these are if you wish to go 9 | # via gcc. 10 | BIN=./Main 11 | SRC=main.c 12 | 13 | BINDIR= "." 14 | REALBIN= $(BIN) 15 | 16 | all: $(BIN) 17 | 18 | $(BIN): $(SRC) 19 | $(GHC) -package plugins $(INCLUDES) $(PKGFLAGS) $(SRC) 20 | 21 | clean: 22 | rm -rf *.hi *.o *~ $(BIN) 23 | -------------------------------------------------------------------------------- /testsuite/hier/hier1/Makefile: -------------------------------------------------------------------------------- 1 | TEST= hier/hier1 2 | 3 | EXTRA_OBJS=Plugin.o 4 | PRIOR_OBJS=Modules/Flags.o 5 | EXTRAFLAGS= 6 | 7 | TOP=../../.. 8 | include ../../build.mk 9 | -------------------------------------------------------------------------------- /testsuite/hier/hier1/Modules/Flags.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- A simple module 3 | -- 4 | 5 | module Modules.Flags where 6 | 7 | 8 | data FlagRec = FlagRec { 9 | f1 :: Int, 10 | f2 :: Int 11 | } 12 | 13 | 14 | foo :: FlagRec -> Int 15 | foo x = f1 x 16 | -------------------------------------------------------------------------------- /testsuite/hier/hier1/Modules/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: 3 | ghc -O -c Flags.hs 4 | 5 | clean: 6 | rm -f *.hi *.o 7 | -------------------------------------------------------------------------------- /testsuite/hier/hier1/Plugin.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- Plugin 3 | -- 4 | 5 | module Plugin where 6 | 7 | import API 8 | import Modules.Flags as Flags 9 | 10 | 11 | resource = plugin { 12 | dbFunc = (\x -> Flags.f1 x) 13 | } 14 | 15 | -------------------------------------------------------------------------------- /testsuite/hier/hier1/api/API.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- API for plugin test 3 | -- 4 | 5 | module API where 6 | 7 | import Modules.Flags as Flags 8 | 9 | data Interface = Interface { 10 | dbFunc :: Flags.FlagRec -> Int 11 | } 12 | 13 | 14 | plugin :: Interface 15 | plugin = Interface { dbFunc = (\x -> 1) } 16 | 17 | -------------------------------------------------------------------------------- /testsuite/hier/hier1/prog/Main.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- Test multiple plugins 3 | -- 4 | 5 | 6 | module Main where 7 | 8 | import System.Plugins 9 | import API 10 | import Modules.Flags as Flags 11 | 12 | record = Flags.FlagRec { Flags.f1 = 4, Flags.f2 = 10 } 13 | 14 | 15 | main = do 16 | status <- load "../Plugin.o" ["../api",".."] [] "resource" 17 | case status of 18 | LoadFailure _ -> error "load failed" 19 | LoadSuccess _ v -> do let func = dbFunc v 20 | print (func record) 21 | -------------------------------------------------------------------------------- /testsuite/hier/hier1/prog/expected: -------------------------------------------------------------------------------- 1 | 4 2 | -------------------------------------------------------------------------------- /testsuite/hier/hier2/A/B/C/Module.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- A simple module 3 | -- 4 | 5 | module A.B.C.Module where 6 | 7 | symbol = "You found me" 8 | 9 | -------------------------------------------------------------------------------- /testsuite/hier/hier2/A/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: 3 | ghc -c B/C/Module.hs 4 | 5 | 6 | clean: 7 | rm -f B/C/*.hi B/C/*.o 8 | -------------------------------------------------------------------------------- /testsuite/hier/hier2/Makefile: -------------------------------------------------------------------------------- 1 | TEST= hier/hier2 2 | 3 | PRIOR_OBJS=A/B/C/Module.o 4 | EXTRAFLAGS= 5 | 6 | TOP=../../.. 7 | include ../../build.mk 8 | -------------------------------------------------------------------------------- /testsuite/hier/hier2/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | -- just a dummy for the build system 4 | 5 | -------------------------------------------------------------------------------- /testsuite/hier/hier2/prog/Main.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- Test if we can load a module with a hierarchical name from some weird 3 | -- path. Tests our the module name handling in the .hi file parser. 4 | -- 5 | 6 | 7 | module Main where 8 | 9 | import System.Plugins 10 | 11 | main = do 12 | status <- load "../A/B/C/Module.o" [".."] [] "symbol" 13 | case status of 14 | LoadFailure ers -> mapM_ putStrLn ers 15 | LoadSuccess _ v -> print (v :: String) 16 | -------------------------------------------------------------------------------- /testsuite/hier/hier2/prog/expected: -------------------------------------------------------------------------------- 1 | "You found me" 2 | -------------------------------------------------------------------------------- /testsuite/hier/hier3/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import System.Plugins 4 | 5 | main = do 6 | 7 | makeAll "One.hs" [] 8 | 9 | load2 "Two.o" 10 | 11 | load2 "./Two.o" -- shouldn't load 12 | load2 "../hier3/Two.o" -- shouldn't load 13 | load2 "././././Two.o" -- shouldn't load 14 | 15 | -- and this one pulls in "../hier3/Two.o" as a dep 16 | y <- load "One.o" ["../hier3"] [] "resource" 17 | case y of 18 | LoadSuccess _ s -> putStrLn $ "One plugin: " ++ s 19 | LoadFailure _ -> putStrLn "Failure: y" 20 | 21 | load2 f = do 22 | x <- load f [".", "../hier3", ""] [] "resource" -- depend on One.o 23 | case x of 24 | LoadSuccess _ s -> putStrLn $ "Two plugin: " ++ s 25 | LoadFailure _ -> putStrLn "Failure: x" 26 | -------------------------------------------------------------------------------- /testsuite/hier/hier3/Makefile: -------------------------------------------------------------------------------- 1 | TEST= hier/hier3 2 | 3 | EXTRA_OBJS=One.o Two.o 4 | EXTRAFLAGS= 5 | 6 | TOP=../../.. 7 | include ../../eval.mk 8 | -------------------------------------------------------------------------------- /testsuite/hier/hier3/One.hs: -------------------------------------------------------------------------------- 1 | 2 | module One where 3 | 4 | import qualified Two 5 | 6 | resource = "This is the sub-plugin of (" ++ Two.resource ++ ")" 7 | 8 | -------------------------------------------------------------------------------- /testsuite/hier/hier3/Two.hs: -------------------------------------------------------------------------------- 1 | module Two where 2 | 3 | resource = "This is the top plugin" 4 | 5 | -------------------------------------------------------------------------------- /testsuite/hier/hier3/expected: -------------------------------------------------------------------------------- 1 | Two plugin: This is the top plugin 2 | Two plugin: This is the top plugin 3 | Two plugin: This is the top plugin 4 | Two plugin: This is the top plugin 5 | One plugin: This is the sub-plugin of (This is the top plugin) 6 | -------------------------------------------------------------------------------- /testsuite/hier/hier4/A.hs: -------------------------------------------------------------------------------- 1 | 2 | -- now, the question is: is it possible to not depend on a module or 3 | -- package, but nonetheless have an orphan to it? this could cause 4 | -- problems.... 5 | 6 | module A where 7 | 8 | import B 9 | 10 | u :: Int 11 | u = undefined 12 | -------------------------------------------------------------------------------- /testsuite/hier/hier4/B.hs: -------------------------------------------------------------------------------- 1 | module B where 2 | 3 | import C () -- instances, to make available to those who use B 4 | 5 | -------------------------------------------------------------------------------- /testsuite/hier/hier4/C.hs: -------------------------------------------------------------------------------- 1 | 2 | -- try to construct an orphan module == an instance decl-only module, 3 | -- that uses classes and types not defined in this module 4 | 5 | module C (C) where 6 | 7 | import D 8 | 9 | instance C a => D (T a) where 10 | 11 | class C a where 12 | 13 | -------------------------------------------------------------------------------- /testsuite/hier/hier4/D.hs: -------------------------------------------------------------------------------- 1 | 2 | module D where 3 | 4 | class D a where 5 | 6 | data T a = T 7 | -------------------------------------------------------------------------------- /testsuite/hier/hier4/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import System.Plugins 4 | 5 | main = do 6 | 7 | makeAll "A.hs" [] 8 | 9 | y <- load "A.o" ["."] [] "u" 10 | case y of 11 | LoadSuccess _ _ -> putStrLn $ "YES" 12 | LoadFailure e -> mapM_ putStrLn e 13 | -------------------------------------------------------------------------------- /testsuite/hier/hier4/Makefile: -------------------------------------------------------------------------------- 1 | TEST= hier/hier4 2 | 3 | TOP=../../.. 4 | include ../../eval.mk 5 | -------------------------------------------------------------------------------- /testsuite/hier/hier4/expected: -------------------------------------------------------------------------------- 1 | YES 2 | -------------------------------------------------------------------------------- /testsuite/iface/null/A.hs: -------------------------------------------------------------------------------- 1 | module A where 2 | -------------------------------------------------------------------------------- /testsuite/iface/null/B.hs: -------------------------------------------------------------------------------- 1 | module B where 2 | -------------------------------------------------------------------------------- /testsuite/iface/null/Main.hs: -------------------------------------------------------------------------------- 1 | module Main ( main ) where 2 | 3 | import Language.Hi.Parser 4 | 5 | import A 6 | import B 7 | 8 | main = do iface <- readIface "Main.hi" 9 | putStrLn (showIface iface) 10 | -------------------------------------------------------------------------------- /testsuite/iface/null/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../eval.mk 3 | -------------------------------------------------------------------------------- /testsuite/iface/null/expected: -------------------------------------------------------------------------------- 1 | interface "main" Main 2 | module dependencies: A, B 3 | package dependencies: base, plugins-1.0 4 | 5 | -------------------------------------------------------------------------------- /testsuite/iface/null/expected.604: -------------------------------------------------------------------------------- 1 | interface "unknown" Main 2 | module dependencies: A, B 3 | package dependencies: base-1.0, plugins-1.0 4 | import B 5 | import A 6 | -------------------------------------------------------------------------------- /testsuite/iface/null/expected.605: -------------------------------------------------------------------------------- 1 | interface "unknown" Main 2 | module dependencies: A, B 3 | package dependencies: base-1.0, plugins-1.0 4 | import B 5 | import A 6 | -------------------------------------------------------------------------------- /testsuite/load/io/Makefile: -------------------------------------------------------------------------------- 1 | TEST= load/io 2 | 3 | EXTRA_OBJS=TestIO.o 4 | 5 | TOP=../../.. 6 | include ../../build.mk 7 | -------------------------------------------------------------------------------- /testsuite/load/io/TestIO.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -cpp #-} 2 | -- 3 | -- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons 4 | -- LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html) 5 | -- 6 | 7 | module TestIO ( resource, resource_dyn ) where 8 | 9 | import API 10 | import Data.Dynamic 11 | 12 | import Distribution.Package 13 | import Language.Haskell.Parser 14 | import Network.HxWeb 15 | 16 | import System.IO 17 | import System.Posix.Types ( ProcessID, Fd ) 18 | import System.Posix.Process ( forkProcess, executeFile, getProcessID ) 19 | import System.Posix.IO ( createPipe, stdInput, 20 | stdOutput, fdToHandle, closeFd, dupTo ) 21 | 22 | resource = testio { field = date } 23 | 24 | resource_dyn :: Dynamic 25 | resource_dyn = toDyn resource 26 | 27 | -- 28 | -- call a shell command , returning it's output 29 | -- 30 | date :: IO String 31 | date = do (hdl,_,_) <- catch (popen "/bin/date") (\_->error "popen failed") 32 | hGetLine hdl 33 | 34 | ------------------------------------------------------------------------ 35 | -- 36 | -- my implementation of $val = `cmd`; (if this was perl) 37 | -- 38 | -- provide similar functionality to popen(3), 39 | -- along with bidirectional ipc via pipes 40 | -- return's the pid of the child process 41 | -- 42 | -- there are two different forkProcess functions. the pre-620 was a 43 | -- unix-fork style function, and the modern function has semantics more 44 | -- like the Awkward-Squad paper. We provide implementations of popen 45 | -- using both versions, depending on which GHC the user wants to try. 46 | -- 47 | 48 | popen :: FilePath -> IO (Handle, Handle, ProcessID) 49 | popen cmd = do 50 | (pr, pw) <- createPipe 51 | (cr, cw) <- createPipe 52 | 53 | -- parent -- 54 | let parent = do closeFd cw 55 | closeFd pr 56 | -- child -- 57 | let child = do closeFd pw 58 | closeFd cr 59 | exec cmd (pr,cw) 60 | error "exec cmd failed!" -- typing only 61 | 62 | -- if the parser front end understood cpp, this would work 63 | -- #if __GLASGOW_HASKELL__ >= 601 64 | pid <- forkProcess child -- fork child 65 | parent -- and run parent code 66 | -- #else 67 | -- p <- forkProcess 68 | -- pid <- case p of 69 | -- Just pid -> parent >> return pid 70 | -- Nothing -> child 71 | -- #endif 72 | 73 | hcr <- fdToHandle cr 74 | hpw <- fdToHandle pw 75 | 76 | return (hcr,hpw,pid) 77 | 78 | -- 79 | -- execve cmd in the child process, dup'ing the file descriptors passed 80 | -- as arguments to become the child's stdin and stdout. 81 | -- 82 | exec :: FilePath -> (Fd,Fd) -> IO () 83 | exec cmd (pr,cw) = do 84 | dupTo pr stdInput 85 | dupTo cw stdOutput 86 | executeFile cmd False [] Nothing 87 | 88 | ------------------------------------------------------------------------ 89 | -------------------------------------------------------------------------------- /testsuite/load/io/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | import Data.Dynamic 6 | 7 | data TestIO = TestIO { 8 | field :: IO String 9 | } 10 | deriving (Typeable, Show) 11 | 12 | instance Show (IO String) where 13 | show _ = "<>" 14 | 15 | testio :: TestIO 16 | testio = TestIO { field = return "default value" } 17 | -------------------------------------------------------------------------------- /testsuite/load/io/prog/Main.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -cpp #-} 2 | 3 | #include "../../../../config.h" 4 | 5 | import System.Plugins 6 | import API 7 | 8 | main :: IO () 9 | main = do 10 | m_v <- load "../TestIO.o" ["../api"] [] "resource" 11 | v <- case m_v of 12 | LoadFailure _ -> error "load failed" 13 | LoadSuccess _ v -> return v 14 | s <- field v 15 | if null s then print False else print True 16 | -------------------------------------------------------------------------------- /testsuite/load/io/prog/expected: -------------------------------------------------------------------------------- 1 | True 2 | -------------------------------------------------------------------------------- /testsuite/load/load_0/Makefile: -------------------------------------------------------------------------------- 1 | TEST= load/load_0 2 | 3 | EXTRA_OBJS=Test.o 4 | 5 | TOP=../../.. 6 | include ../../build.mk 7 | -------------------------------------------------------------------------------- /testsuite/load/load_0/Test.hs: -------------------------------------------------------------------------------- 1 | 2 | module Test where 3 | 4 | import API 5 | 6 | resource = test { field = "success" } 7 | -------------------------------------------------------------------------------- /testsuite/load/load_0/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | data Test = Test { 4 | field :: String 5 | } 6 | 7 | test :: Test 8 | test = Test { field = "default value" } 9 | -------------------------------------------------------------------------------- /testsuite/load/load_0/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | main = do 6 | m_v <- load_ "../Test.o" ["../api"] "resource" 7 | v <- case m_v of 8 | LoadFailure _ -> error "load failed" 9 | LoadSuccess _ v -> return v 10 | let s = field v 11 | print s 12 | -------------------------------------------------------------------------------- /testsuite/load/load_0/prog/expected: -------------------------------------------------------------------------------- 1 | "success" 2 | -------------------------------------------------------------------------------- /testsuite/load/loadpkg/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | 4 | main = loadPackageWith "posix" [] 5 | -------------------------------------------------------------------------------- /testsuite/load/loadpkg/Makefile: -------------------------------------------------------------------------------- 1 | TEST= load/loadpkg 2 | 3 | TOP=../../.. 4 | include ../../eval.mk 5 | -------------------------------------------------------------------------------- /testsuite/load/loadpkg/expected: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/load/loadpkg/expected -------------------------------------------------------------------------------- /testsuite/load/null/Makefile: -------------------------------------------------------------------------------- 1 | TEST= load/null 2 | EXTRA_OBJS=Null.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/load/null/Null.hs: -------------------------------------------------------------------------------- 1 | module Null ( resource, resource_dyn ) where 2 | 3 | import API 4 | import Data.Dynamic 5 | import Prelude hiding (null) 6 | 7 | resource = null 8 | 9 | -- ! this has to be special: it can't be overridden by the user. 10 | resource_dyn :: Dynamic 11 | resource_dyn = toDyn resource 12 | -------------------------------------------------------------------------------- /testsuite/load/null/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | import Data.Dynamic 6 | 7 | data Null = Null { a, b :: Int } 8 | deriving (Typeable, Show) 9 | 10 | null :: Null 11 | null = Null { a = 42 , b = 1 } 12 | 13 | -------------------------------------------------------------------------------- /testsuite/load/null/prog/Main.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -cpp #-} 2 | 3 | #include "../../../../config.h" 4 | 5 | import System.Plugins 6 | import API 7 | 8 | -- an example where we just want to load an object and run it 9 | 10 | main = do 11 | let includes = [TOP ++ "/testsuite/load/null/api"] 12 | m_v <- load "../Null.o" includes [] "resource" 13 | v <- case m_v of 14 | LoadSuccess _ v -> return v 15 | _ -> error "load failed" 16 | 17 | putStrLn ( show (a v) ) 18 | -------------------------------------------------------------------------------- /testsuite/load/null/prog/expected: -------------------------------------------------------------------------------- 1 | 42 2 | -------------------------------------------------------------------------------- /testsuite/load/plain/Makefile: -------------------------------------------------------------------------------- 1 | TEST=load/plain 2 | 3 | EXTRA_OBJS=TestIO.o 4 | 5 | TOP=../../.. 6 | include ../../build.mk 7 | -------------------------------------------------------------------------------- /testsuite/load/plain/TestIO.hs: -------------------------------------------------------------------------------- 1 | module TestIO (resource) where 2 | 3 | import Control.Monad (forever) 4 | 5 | import API 6 | 7 | resource :: CLIInterface 8 | resource = testio { repl = loop } 9 | 10 | loop :: IO () 11 | loop = forever $ getLine >>= putStrLn 12 | -------------------------------------------------------------------------------- /testsuite/load/plain/api/API.hs: -------------------------------------------------------------------------------- 1 | module API(CLIInterface(..), testio) where 2 | 3 | import Data.Typeable 4 | 5 | data CLIInterface = CLIInterface { 6 | repl :: IO () 7 | } deriving Typeable 8 | 9 | testio :: CLIInterface 10 | testio = CLIInterface { repl = return () } 11 | -------------------------------------------------------------------------------- /testsuite/load/plain/prog/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Control.Exception (handle) 4 | 5 | import System.Plugins 6 | 7 | import API 8 | 9 | fexn :: IOError -> IO () 10 | fexn = print 11 | 12 | main :: IO () 13 | main = handle fexn $ do 14 | mf <- load "../TestIO.o" ["../api"] [] "resource" 15 | case mf of 16 | LoadFailure _ -> error "nope" 17 | LoadSuccess _ v -> do 18 | putStrLn "success" 19 | engage v 20 | 21 | engage :: CLIInterface -> IO () 22 | engage plugin = repl plugin 23 | -------------------------------------------------------------------------------- /testsuite/load/thiemann0/Makefile: -------------------------------------------------------------------------------- 1 | TEST= load/thiemann0 2 | 3 | #EXTRA_OBJS=Test.o 4 | 5 | TOP=../../.. 6 | include ../../build.mk 7 | -------------------------------------------------------------------------------- /testsuite/load/thiemann0/Test.hs: -------------------------------------------------------------------------------- 1 | 2 | -- P.Thiemann reports that 'import Char' leads to undefined symbol for 3 | -- __stginit_Char_. 4 | 5 | module Test where 6 | 7 | import API 8 | import Char 9 | 10 | resource = test { field = map toUpper "success" } 11 | 12 | -------------------------------------------------------------------------------- /testsuite/load/thiemann0/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | data Test = Test { 4 | field :: String 5 | } 6 | 7 | test :: Test 8 | test = Test { field = "default value" } 9 | -------------------------------------------------------------------------------- /testsuite/load/thiemann0/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | main = do 6 | status <- make "../Test.hs" ["-i../api"] 7 | obj <- case status of 8 | MakeSuccess _ o -> return o 9 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 10 | 11 | m_v <- load_ obj ["../api"] "resource" 12 | v <- case m_v of 13 | LoadFailure _ -> error "load failed" 14 | LoadSuccess _ v -> return v 15 | let s = field v 16 | print s 17 | -------------------------------------------------------------------------------- /testsuite/load/thiemann0/prog/expected: -------------------------------------------------------------------------------- 1 | "SUCCESS" 2 | -------------------------------------------------------------------------------- /testsuite/load/thiemann2/C.hs: -------------------------------------------------------------------------------- 1 | module C where 2 | 3 | import API 4 | import qualified A 5 | 6 | resource = let Test s = A.resource in Test { field = s } 7 | -------------------------------------------------------------------------------- /testsuite/load/thiemann2/Makefile: -------------------------------------------------------------------------------- 1 | TEST= load/thiemann2 2 | EXTRAFLAGS+=-iprog 3 | 4 | TOP=../../.. 5 | include ../../build.mk 6 | 7 | -------------------------------------------------------------------------------- /testsuite/load/thiemann2/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | data Test = Test { 4 | field :: String 5 | } 6 | 7 | test :: Test 8 | test = Test { field = "default value" } 9 | -------------------------------------------------------------------------------- /testsuite/load/thiemann2/prog/A.hs: -------------------------------------------------------------------------------- 1 | module A where 2 | 3 | import API 4 | 5 | import qualified B 6 | 7 | resource = Test { field = B.resource } 8 | 9 | -------------------------------------------------------------------------------- /testsuite/load/thiemann2/prog/B.hs: -------------------------------------------------------------------------------- 1 | module B where 2 | 3 | resource = "i'm in b" 4 | -------------------------------------------------------------------------------- /testsuite/load/thiemann2/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | import A 6 | 7 | main = do 8 | -- compile C (A and B are already compiled) 9 | status <- makeAll "../C.hs" ["-i../api"] 10 | obj <- case status of 11 | MakeSuccess _ o -> return o 12 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 13 | 14 | -- should load C 15 | m_v <- load_ obj ["../api","."] "resource" 16 | v <- case m_v of 17 | LoadFailure _ -> error "load failed" 18 | LoadSuccess _ v -> return v 19 | let s = field v 20 | print s 21 | -------------------------------------------------------------------------------- /testsuite/load/thiemann2/prog/expected: -------------------------------------------------------------------------------- 1 | "i'm in b" 2 | -------------------------------------------------------------------------------- /testsuite/load/unloadpkg/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | 4 | main = do loadPackage "posix" 5 | unloadPackage "posix" 6 | loadPackage "posix" 7 | -------------------------------------------------------------------------------- /testsuite/load/unloadpkg/Makefile: -------------------------------------------------------------------------------- 1 | TEST= load/unloadpkg 2 | 3 | TOP=../../.. 4 | include ../../eval.mk 5 | -------------------------------------------------------------------------------- /testsuite/load/unloadpkg/expected: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/load/unloadpkg/expected -------------------------------------------------------------------------------- /testsuite/loadCLib/null/Makefile: -------------------------------------------------------------------------------- 1 | TEST= loadCLib/null 2 | EXTRA_OBJS=Null.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/loadCLib/null/Null.hs: -------------------------------------------------------------------------------- 1 | module Null ( resource ) where 2 | 3 | import API 4 | import Data.Dynamic 5 | import Prelude hiding (null) 6 | import Graphics.Rendering.OpenGL 7 | 8 | resource = null 9 | 10 | -- ! this has to be special: it can't be overridden by the user. 11 | resource_dyn :: Dynamic 12 | resource_dyn = toDyn resource 13 | -------------------------------------------------------------------------------- /testsuite/loadCLib/null/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | import Data.Dynamic 6 | 7 | data Null = Null { a, b :: Int } 8 | deriving (Typeable, Show) 9 | 10 | null :: Null 11 | null = Null { a = 42 , b = 1 } 12 | 13 | -------------------------------------------------------------------------------- /testsuite/loadCLib/null/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | -- an example where we just want to load an object and run it 6 | 7 | main = do 8 | m_v <- load_ "../Null.o" ["../api",".."] "resource" 9 | case m_v of 10 | LoadFailure err -> error (unlines err) 11 | LoadSuccess m v -> do putStrLn ( show (a v) ) ; unload m 12 | -------------------------------------------------------------------------------- /testsuite/loadCLib/null/prog/expected: -------------------------------------------------------------------------------- 1 | 42 2 | -------------------------------------------------------------------------------- /testsuite/make/makeall001/A.hs: -------------------------------------------------------------------------------- 1 | module A where 2 | 3 | a = "a" 4 | -------------------------------------------------------------------------------- /testsuite/make/makeall001/B.hs: -------------------------------------------------------------------------------- 1 | module B where 2 | 3 | b = "b" 4 | -------------------------------------------------------------------------------- /testsuite/make/makeall001/C.hs: -------------------------------------------------------------------------------- 1 | module C where 2 | 3 | c = "c" 4 | -------------------------------------------------------------------------------- /testsuite/make/makeall001/Makefile: -------------------------------------------------------------------------------- 1 | TEST= make/makeall001 2 | TOP=../../.. 3 | include ../../build.mk 4 | -------------------------------------------------------------------------------- /testsuite/make/makeall001/Tiny.hs: -------------------------------------------------------------------------------- 1 | module Tiny ( resource ) where 2 | 3 | import API 4 | 5 | import A 6 | import B 7 | import C 8 | 9 | resource = tiny { 10 | 11 | field = a ++ b ++ c 12 | 13 | } 14 | -------------------------------------------------------------------------------- /testsuite/make/makeall001/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | -- ^ needed to derive Typeable 3 | 4 | module API where 5 | 6 | import Data.Dynamic 7 | 8 | data Tiny = Tiny { field :: String } 9 | deriving (Typeable, Show) 10 | 11 | tiny :: Tiny 12 | tiny = Tiny { field = "default value" } 13 | 14 | -------------------------------------------------------------------------------- /testsuite/make/makeall001/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | -- little more complex. use the path to the obj file we get back from 3 | -- 'make'. load() uses this to find the .hi file 4 | 5 | import System.Plugins 6 | import API 7 | 8 | main = do 9 | status <- makeAll "../Tiny.hs" ["-i../api"] 10 | o <- case status of 11 | MakeSuccess _ o -> return o 12 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 13 | m_v <- load o [".."] [] "resource" 14 | v <- case m_v of 15 | LoadSuccess _ v -> return v 16 | _ -> error "load failed" 17 | putStrLn $ field v 18 | 19 | -------------------------------------------------------------------------------- /testsuite/make/makeall001/prog/expected: -------------------------------------------------------------------------------- 1 | abc 2 | -------------------------------------------------------------------------------- /testsuite/make/null/Makefile: -------------------------------------------------------------------------------- 1 | TEST= make/null 2 | 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/make/null/Null.hs: -------------------------------------------------------------------------------- 1 | module Null ( resource, resource_dyn ) where 2 | 3 | import API 4 | import Data.Dynamic 5 | import Prelude hiding (null) 6 | 7 | resource = null 8 | 9 | -- ! this has to be special: it can't be overridden by the user. 10 | resource_dyn :: Dynamic 11 | resource_dyn = toDyn resource 12 | -------------------------------------------------------------------------------- /testsuite/make/null/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | import Data.Dynamic 6 | 7 | data Null = Null { a, b :: Int } 8 | deriving (Typeable, Show) 9 | 10 | null :: Null 11 | null = Null { a = 42 , b = 1 } 12 | 13 | -------------------------------------------------------------------------------- /testsuite/make/null/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | -- an example where we want to compile and load a file 3 | 4 | import System.Plugins 5 | import API 6 | 7 | main = do 8 | make "../Null.hs" ["-i../api"] 9 | m_v <- load "../Null.o" ["../api"] [] "resource" 10 | v <- case m_v of 11 | LoadSuccess _ v -> return v 12 | _ -> error "load failed" 13 | putStrLn ( show (a v) ) 14 | -------------------------------------------------------------------------------- /testsuite/make/null/prog/expected: -------------------------------------------------------------------------------- 1 | 42 2 | -------------------------------------------------------------------------------- /testsuite/make/o/Makefile: -------------------------------------------------------------------------------- 1 | TEST=make/o 2 | TOP =../../.. 3 | include ../../build.mk 4 | -------------------------------------------------------------------------------- /testsuite/make/o/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin ( resource ) where 2 | 3 | import API 4 | 5 | resource = plugin { 6 | field = "hello out there" 7 | } 8 | -------------------------------------------------------------------------------- /testsuite/make/o/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | data Interface = Interface { 4 | field :: String 5 | } 6 | 7 | plugin :: Interface 8 | plugin = Interface { field = undefined } 9 | -------------------------------------------------------------------------------- /testsuite/make/o/prog/Main.hs: -------------------------------------------------------------------------------- 1 | import System.Plugins 2 | import API 3 | 4 | import System.Directory 5 | 6 | -- note: the name of the original *source* module is used to find 7 | -- symbols in the *object* file. load works out what the source file 8 | -- name was by looking at the object file name, i.e. it assumes they 9 | -- have the same name. so, if you are going to store objects in a 10 | -- tmpdir, you should make a tmp directory, and store them inside that, 11 | -- rather than mkstemp'ing the name of the object file yourself. 12 | -- 13 | -- this should go away once we can read .hi files. 14 | 15 | main = do 16 | #if __GLASGOW_HASKELL__ >= 604 17 | tmpDir <- getTemporaryDirectory 18 | #else 19 | let tmpDir = "/tmp" 20 | #endif 21 | make "../Plugin.hs" [ "-i../api", "-o", (tmpDir ++ "/Plugin.o") ] 22 | m_v <- load (tmpDir ++ "/Plugin.o") ["../api"] [] "resource" 23 | v <- case m_v of 24 | LoadSuccess _ v -> return v 25 | _ -> error "load failed" 26 | putStrLn $ field v 27 | 28 | mapM_ removeFile [ (tmpDir ++ "/Plugin.hi"), (tmpDir ++ "/Plugin.o") ] 29 | -------------------------------------------------------------------------------- /testsuite/make/o/prog/expected: -------------------------------------------------------------------------------- 1 | hello out there 2 | -------------------------------------------------------------------------------- /testsuite/make/odir/Makefile: -------------------------------------------------------------------------------- 1 | TEST= make/odir 2 | TOP=../../.. 3 | include ../../build.mk 4 | -------------------------------------------------------------------------------- /testsuite/make/odir/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin ( resource ) where 2 | 3 | import API 4 | 5 | resource = plugin { 6 | field = "hello out there" 7 | } 8 | -------------------------------------------------------------------------------- /testsuite/make/odir/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | data Interface = Interface { 4 | field :: String 5 | } 6 | 7 | plugin :: Interface 8 | plugin = Interface { field = undefined } 9 | -------------------------------------------------------------------------------- /testsuite/make/odir/prog/Main.hs: -------------------------------------------------------------------------------- 1 | import System.Plugins 2 | import API 3 | import System.Directory 4 | 5 | main = do 6 | #if __GLASGOW_HASKELL__ >= 604 7 | tmpDir <- getTemporaryDirectory 8 | #else 9 | let tmpDir = "/tmp" 10 | #endif 11 | status <- make "../Plugin.hs" [ "-i../api", "-odir", tmpDir ] 12 | o <- case status of 13 | MakeSuccess _ o -> return o 14 | MakeFailure e -> mapM_ putStrLn e >> error "didn't compile" 15 | m_v <- load o ["../api"] [] "resource" 16 | v <- case m_v of 17 | LoadSuccess _ v -> return v 18 | _ -> error "load failed" 19 | putStrLn $ field v 20 | mapM_ removeFile [(tmpDir ++ "/Plugin.hi"), (tmpDir ++ "/Plugin.o") ] 21 | 22 | -------------------------------------------------------------------------------- /testsuite/make/odir/prog/expected: -------------------------------------------------------------------------------- 1 | hello out there 2 | -------------------------------------------------------------------------------- /testsuite/make/remake001/Bar.hs: -------------------------------------------------------------------------------- 1 | module Bar where 2 | 3 | bar = undefined 4 | -------------------------------------------------------------------------------- /testsuite/make/remake001/Foo.hs: -------------------------------------------------------------------------------- 1 | module Foo where 2 | 3 | foo = undefined 4 | -------------------------------------------------------------------------------- /testsuite/make/remake001/Main.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- expected output: 3 | -- $ ./a.out 4 | -- True 5 | -- False 6 | -- True 7 | -- False 8 | -- 9 | 10 | import System.Plugins 11 | import System.Directory 12 | 13 | main = do 14 | status <- make "Foo.hs" [] -- should make 15 | print status 16 | 17 | status <- make "Foo.hs" [] -- shouldn't make 18 | print status 19 | 20 | status <- merge "Foo.hs" "Bar.hs" 21 | case status of 22 | MergeFailure e -> error $ show e 23 | MergeSuccess _ _ fp -> do { 24 | 25 | ;status <- make fp [] -- should make 26 | ;() <- case status of 27 | MakeSuccess c _ -> print c 28 | MakeFailure e -> error $ show e 29 | 30 | ;status <- make fp [] -- shouldn't make 31 | ;case status of 32 | MakeSuccess c _ -> print c 33 | MakeFailure e -> error $ show e 34 | ;removeFile "Foo.o" 35 | } 36 | 37 | -------------------------------------------------------------------------------- /testsuite/make/remake001/Makefile: -------------------------------------------------------------------------------- 1 | TEST= merge/remake001 2 | 3 | TOP=../../.. 4 | include ../../eval.mk 5 | -------------------------------------------------------------------------------- /testsuite/make/remake001/expected: -------------------------------------------------------------------------------- 1 | MakeSuccess ReComp "Foo.o" 2 | MakeSuccess NotReq "Foo.o" 3 | ReComp 4 | NotReq 5 | -------------------------------------------------------------------------------- /testsuite/make/remake001_should_fail/Bar.hs: -------------------------------------------------------------------------------- 1 | module Bar where 2 | 3 | bar = undef {- error -} 4 | -------------------------------------------------------------------------------- /testsuite/make/remake001_should_fail/Foo.hs: -------------------------------------------------------------------------------- 1 | module Foo where 2 | 3 | foo = undefined 4 | -------------------------------------------------------------------------------- /testsuite/make/remake001_should_fail/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | 4 | import System.Directory 5 | 6 | main = do 7 | status <- make "Foo.hs" [] -- should make 8 | print status 9 | 10 | status <- make "Foo.hs" [] -- shouldn't make 11 | print status 12 | 13 | status <- merge "Foo.hs" "Bar.hs" 14 | case status of 15 | MergeFailure e -> error $ show e 16 | MergeSuccess _ _ fp -> do { 17 | 18 | ;status <- make fp [] -- should make 19 | ;() <- case status of 20 | MakeSuccess c _ -> print c 21 | MakeFailure _ -> print "make failure" 22 | 23 | ;status <- make fp [] -- shouldn't make 24 | ;case status of 25 | MakeSuccess c _ -> print c 26 | MakeFailure _ -> print "make failure" 27 | 28 | ;removeFile "Foo.o" -- make test deterministic 29 | } 30 | 31 | 32 | -------------------------------------------------------------------------------- /testsuite/make/remake001_should_fail/Makefile: -------------------------------------------------------------------------------- 1 | TEST= make/remake001_should_fail 2 | 3 | TOP=../../.. 4 | include ../../eval.mk 5 | -------------------------------------------------------------------------------- /testsuite/make/remake001_should_fail/expected: -------------------------------------------------------------------------------- 1 | MakeSuccess ReComp "Foo.o" 2 | MakeSuccess NotReq "Foo.o" 3 | "make failure" 4 | "make failure" 5 | -------------------------------------------------------------------------------- /testsuite/make/simple/Makefile: -------------------------------------------------------------------------------- 1 | TEST= make/simple 2 | TOP=../../.. 3 | include ../../build.mk 4 | -------------------------------------------------------------------------------- /testsuite/make/simple/Tiny.hs: -------------------------------------------------------------------------------- 1 | module Tiny ( resource, resource_dyn ) where 2 | 3 | import API 4 | import Data.Dynamic 5 | 6 | resource = tiny { 7 | 8 | field = "hello strange world" 9 | 10 | } 11 | 12 | resource_dyn :: Dynamic 13 | resource_dyn = toDyn resource 14 | 15 | -------------------------------------------------------------------------------- /testsuite/make/simple/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | -- ^ needed to derive Typeable 3 | 4 | module API where 5 | 6 | import Data.Dynamic 7 | 8 | data Tiny = Tiny { field :: String } 9 | deriving (Typeable, Show) 10 | 11 | tiny :: Tiny 12 | tiny = Tiny { field = "default value" } 13 | 14 | -------------------------------------------------------------------------------- /testsuite/make/simple/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | -- little more complex. use the path to the obj file we get back from 3 | -- 'make'. load() uses this to find the .hi file 4 | 5 | import System.Plugins 6 | import API 7 | 8 | main = do 9 | status <- make "../Tiny.hs" ["-i../api"] 10 | o <- case status of 11 | MakeSuccess _ o -> return o 12 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 13 | 14 | m_v <- load o ["../api"] [] "resource" 15 | v <- case m_v of 16 | LoadSuccess _ v -> return v 17 | _ -> error "load failed" 18 | putStrLn $ field v 19 | 20 | -------------------------------------------------------------------------------- /testsuite/make/simple/prog/expected: -------------------------------------------------------------------------------- 1 | hello strange world 2 | -------------------------------------------------------------------------------- /testsuite/makewith/global_pragma/Makefile: -------------------------------------------------------------------------------- 1 | 2 | TEST=makewith/global_pragma 3 | 4 | TOP=../../.. 5 | include ../../build.mk 6 | -------------------------------------------------------------------------------- /testsuite/makewith/global_pragma/Plugin.hs: -------------------------------------------------------------------------------- 1 | {-# GLOBALOPTIONS -package mtl #-} 2 | 3 | module M ( resource ) where 4 | 5 | import API 6 | import System.IO.Unsafe 7 | import System.Process 8 | import System.IO 9 | 10 | resource = tiny { field = date } 11 | 12 | date :: String 13 | date = unsafePerformIO $ do 14 | (_,outh,_,proc) <- runInteractiveProcess "echo" ["hello"] Nothing Nothing 15 | waitForProcess proc 16 | s <- hGetContents outh 17 | return s 18 | -------------------------------------------------------------------------------- /testsuite/makewith/global_pragma/api/API.hs: -------------------------------------------------------------------------------- 1 | 2 | module API where 3 | 4 | data Tiny = Tiny { field :: String } 5 | 6 | tiny :: Tiny 7 | tiny = Tiny { field = "default value" } 8 | 9 | -------------------------------------------------------------------------------- /testsuite/makewith/global_pragma/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | conf = "../Plugin.hs" 6 | apipath = "../api" 7 | 8 | main = do 9 | status <- makeWith conf conf ["-i"++apipath] 10 | o <- case status of 11 | MakeFailure e -> mapM_ putStrLn e >> error "compile failed" 12 | MakeSuccess _ o -> return o 13 | m_v <- load o [apipath] [] "resource" 14 | v <- case m_v of 15 | LoadSuccess _ v -> return v 16 | LoadFailure ers -> mapM_ putStrLn ers >> error "load failed" 17 | putStr $ field v 18 | makeCleaner o 19 | 20 | -------------------------------------------------------------------------------- /testsuite/makewith/global_pragma/prog/expected: -------------------------------------------------------------------------------- 1 | hello 2 | -------------------------------------------------------------------------------- /testsuite/makewith/io/Makefile: -------------------------------------------------------------------------------- 1 | TEST=makewith/io 2 | 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/makewith/io/README: -------------------------------------------------------------------------------- 1 | An example using IO monad fields in the .conf file. 2 | 3 | -------------------------------------------------------------------------------- /testsuite/makewith/io/TestIO.conf.in: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -cpp #-} 2 | -- 3 | -- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons 4 | -- LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html) 5 | -- 6 | 7 | import System.IO 8 | import System.Process 9 | 10 | resource = testio { field = date } 11 | 12 | -- 13 | -- call a shell command , returning it's output 14 | -- 15 | date :: IO String 16 | date = do 17 | #if !defined(CYGWIN) || !defined(__MINGW32__) 18 | (_,out,_,_) <- catch (runInteractiveCommand "/bin/date") (\_->error "popen failed") 19 | #else 20 | (_,out,_,_) <- catch (runInteractiveCommand "@PREFIX@/../../bin/date") (\_->error "popen failed") 21 | #endif 22 | hGetLine out 23 | -------------------------------------------------------------------------------- /testsuite/makewith/io/TestIO.stub: -------------------------------------------------------------------------------- 1 | 2 | module TestIO ( resource, resource_dyn ) where 3 | 4 | import API 5 | import Data.Dynamic 6 | 7 | resource = testio 8 | 9 | resource_dyn :: Dynamic 10 | resource_dyn = toDyn resource 11 | -------------------------------------------------------------------------------- /testsuite/makewith/io/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | import Data.Dynamic 6 | 7 | data TestIO = TestIO { 8 | field :: IO String 9 | } 10 | deriving (Typeable, Show) 11 | 12 | instance Show (IO String) where 13 | show _ = "<>" 14 | 15 | testio :: TestIO 16 | testio = TestIO { field = return "default value" } 17 | -------------------------------------------------------------------------------- /testsuite/makewith/io/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | conf = "../TestIO.conf" 6 | stub = "../TestIO.stub" 7 | apipath = "../api" 8 | 9 | main = do 10 | status <- makeWith conf stub ["-i"++apipath] 11 | o <- case status of 12 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 13 | MakeSuccess _ o -> return o 14 | m_v <- load o [apipath] [] "resource" 15 | v <- case m_v of 16 | LoadSuccess _ v -> return v 17 | _ -> error "load failed" 18 | s <- field v 19 | 20 | makeCleaner o 21 | if null s then print False else print True 22 | -------------------------------------------------------------------------------- /testsuite/makewith/io/prog/expected: -------------------------------------------------------------------------------- 1 | merge failed: 2 | 3 | parse error in ../TestIO.conf 4 | line: 17, col: 1 5 | 6 | Main: failed 7 | -------------------------------------------------------------------------------- /testsuite/makewith/merge00/Bar.hs: -------------------------------------------------------------------------------- 1 | module Bar where 2 | 3 | resource :: Int 4 | -------------------------------------------------------------------------------- /testsuite/makewith/merge00/Foo.hs: -------------------------------------------------------------------------------- 1 | module Foo where 2 | 3 | resource :: Integer 4 | resource = 0xBAD 5 | -------------------------------------------------------------------------------- /testsuite/makewith/merge00/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | 4 | import System.Directory 5 | 6 | a = "Foo.hs" -- uesr code 7 | b = "Bar.hs" -- trusted code. Result is "Bar.o" 8 | 9 | main = do 10 | status <- merge a b 11 | f <- case status of 12 | MergeFailure e -> error "merge failure" 13 | MergeSuccess _ _ f -> return f 14 | 15 | status <- merge a b 16 | f' <- case status of 17 | MergeFailure e -> error "merge failure" 18 | MergeSuccess ReComp _ f -> error "unnec. merge" 19 | MergeSuccess NotReq _ f -> return f 20 | 21 | print ( f == f' ) 22 | 23 | status <- make f' [] 24 | o <- case status of 25 | MakeFailure e -> error "make failed" 26 | MakeSuccess _ o -> return o 27 | 28 | m_v <- load o [] [] "resource" 29 | v <- case m_v of 30 | LoadSuccess _ v -> return v 31 | _ -> error "load failed" 32 | putStrLn $ show $ (v :: Int) 33 | 34 | removeFile o 35 | return () 36 | 37 | makeCleaner f 38 | 39 | -------------------------------------------------------------------------------- /testsuite/makewith/merge00/Makefile: -------------------------------------------------------------------------------- 1 | TEST=makewith/merge00 2 | 3 | TOP=../../.. 4 | include ../../eval.mk 5 | -------------------------------------------------------------------------------- /testsuite/makewith/merge00/expected: -------------------------------------------------------------------------------- 1 | True 2 | 2989 3 | -------------------------------------------------------------------------------- /testsuite/makewith/mergeto0/Bar.hs: -------------------------------------------------------------------------------- 1 | module Bar where 2 | 3 | resource :: Int 4 | -------------------------------------------------------------------------------- /testsuite/makewith/mergeto0/Foo.hs: -------------------------------------------------------------------------------- 1 | module Foo where 2 | 3 | resource :: Integer 4 | resource = 0xBAD 5 | -------------------------------------------------------------------------------- /testsuite/makewith/mergeto0/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | 4 | import System.Directory 5 | 6 | a = "Foo.hs" -- uesr code 7 | b = "Bar.hs" -- trusted code. Result is "Bar.o" 8 | c = "Out.hs" 9 | 10 | main = do 11 | status <- mergeTo a b c 12 | f <- case status of 13 | MergeFailure e -> error "mergeto failure" 14 | MergeSuccess _ _ f -> return f 15 | print $ f == c 16 | 17 | status <- mergeTo a b c 18 | f' <- case status of 19 | MergeFailure e -> error "mergeto failure" 20 | MergeSuccess ReComp _ f -> error "unnec. mergeto" 21 | MergeSuccess NotReq _ f -> return f -- good, not req 22 | 23 | print $ f == f' && f == c 24 | 25 | status <- make f' [] 26 | o <- case status of 27 | MakeFailure e -> error "make failed" 28 | MakeSuccess _ o -> return o 29 | 30 | m_v <- load o [] [] "resource" 31 | v <- case m_v of 32 | LoadSuccess _ v -> return v 33 | _ -> error "load failed" 34 | putStrLn $ show $ (v :: Int) 35 | 36 | makeCleaner c 37 | 38 | -------------------------------------------------------------------------------- /testsuite/makewith/mergeto0/Makefile: -------------------------------------------------------------------------------- 1 | TEST=makewith/mergeto0 2 | 3 | TOP=../../.. 4 | include ../../eval.mk 5 | -------------------------------------------------------------------------------- /testsuite/makewith/mergeto0/expected: -------------------------------------------------------------------------------- 1 | True 2 | True 3 | 2989 4 | -------------------------------------------------------------------------------- /testsuite/makewith/module_name/Bar.hs: -------------------------------------------------------------------------------- 1 | module Bar where 2 | 3 | resource :: Int 4 | -------------------------------------------------------------------------------- /testsuite/makewith/module_name/Foo.hs: -------------------------------------------------------------------------------- 1 | module Foo where 2 | 3 | resource :: Integer 4 | resource = 1 5 | -------------------------------------------------------------------------------- /testsuite/makewith/module_name/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | 4 | import System.Directory 5 | 6 | a = "Foo.hs" -- uesr code 7 | b = "Bar.hs" -- trusted code. Result is "Bar.o" 8 | 9 | main = do 10 | status <- makeWith a b [] 11 | s <- case status of 12 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 13 | MakeSuccess n s -> print n >> return s 14 | 15 | status <- makeWith a b [] 16 | s' <- case status of 17 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 18 | MakeSuccess n s -> print n >> return s 19 | 20 | status <- makeWith a b [] 21 | s'' <- case status of 22 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 23 | MakeSuccess n s -> print n >> return s 24 | 25 | print $ (s == s') && (s' == s'') 26 | 27 | m_v <- load s [] [] "resource" 28 | v <- case m_v of 29 | LoadSuccess _ v -> return v 30 | _ -> error "load failed" 31 | putStrLn $ show $ (v :: Int) 32 | 33 | makeCleaner s'' 34 | -------------------------------------------------------------------------------- /testsuite/makewith/module_name/Makefile: -------------------------------------------------------------------------------- 1 | TEST=makewith/module_name 2 | 3 | TOP=../../.. 4 | include ../../eval.mk 5 | -------------------------------------------------------------------------------- /testsuite/makewith/module_name/expected: -------------------------------------------------------------------------------- 1 | ReComp 2 | NotReq 3 | NotReq 4 | True 5 | 1 6 | -------------------------------------------------------------------------------- /testsuite/makewith/multi_make/Bar.hs: -------------------------------------------------------------------------------- 1 | module Bar where 2 | 3 | resource :: Int 4 | resource = 2 5 | -------------------------------------------------------------------------------- /testsuite/makewith/multi_make/Foo.hs: -------------------------------------------------------------------------------- 1 | module Foo where 2 | 3 | resource :: Integer 4 | resource = 1 5 | -------------------------------------------------------------------------------- /testsuite/makewith/multi_make/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | 4 | import System.Directory 5 | 6 | a = "Foo.hs" -- user code 7 | b = "Bar.hs" -- more user code 8 | z = "Stub.hs" -- and a stub 9 | 10 | main = do 11 | status <- makeWith a z [] 12 | s <- case status of 13 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 14 | MakeSuccess n s -> print n >> return s 15 | 16 | status <- makeWith b z [] 17 | s' <- case status of 18 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 19 | MakeSuccess n s -> print n >> return s 20 | 21 | -- shouldn't need to remerge (a,z) 22 | status <- makeWith a z [] 23 | t <- case status of 24 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 25 | MakeSuccess n s -> print n >> return s 26 | 27 | -- shouldn't need to remerge (b,z) 28 | status <- makeWith b z [] 29 | t' <- case status of 30 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 31 | MakeSuccess n s -> print n >> return s 32 | 33 | print $ s /= s' -- test we got unique modules 34 | print $ t /= t' -- test we got unique modules 35 | 36 | mapM_ makeCleaner [s,s'] 37 | 38 | -------------------------------------------------------------------------------- /testsuite/makewith/multi_make/Makefile: -------------------------------------------------------------------------------- 1 | TEST=makewith/multi_make 2 | 3 | TOP=../../.. 4 | include ../../eval.mk 5 | -------------------------------------------------------------------------------- /testsuite/makewith/multi_make/Stub.hs: -------------------------------------------------------------------------------- 1 | module Stub where 2 | 3 | resource :: Int 4 | 5 | -------------------------------------------------------------------------------- /testsuite/makewith/multi_make/expected: -------------------------------------------------------------------------------- 1 | ReComp 2 | ReComp 3 | NotReq 4 | NotReq 5 | True 6 | True 7 | -------------------------------------------------------------------------------- /testsuite/makewith/should_fail_0/Makefile: -------------------------------------------------------------------------------- 1 | TEST=makewith/should_fail_0 2 | 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/makewith/should_fail_0/Plugin.in: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | resource = 0xBAD :: Int 4 | -------------------------------------------------------------------------------- /testsuite/makewith/should_fail_0/Plugin.stub: -------------------------------------------------------------------------------- 1 | module Plugin ( resource ) where 2 | 3 | import API 4 | 5 | resource :: Interface 6 | resource = plugin 7 | -------------------------------------------------------------------------------- /testsuite/makewith/should_fail_0/api/API.hs: -------------------------------------------------------------------------------- 1 | 2 | module API where 3 | 4 | data Interface = Interface { 5 | function :: String 6 | } 7 | 8 | plugin :: Interface 9 | plugin = Interface { function = "goodbye" } 10 | 11 | -------------------------------------------------------------------------------- /testsuite/makewith/should_fail_0/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | conf = "../Plugin.in" 6 | stub = "../Plugin.stub" 7 | 8 | main = do 9 | status <- makeWith conf stub ["-i../api"] 10 | case status of 11 | MakeFailure e -> putStrLn "make failed" 12 | MakeSuccess _ o -> do 13 | m_v <- load o ["../api"] [] "resource" 14 | v <- case m_v of 15 | LoadSuccess _ v -> return v 16 | _ -> error "load failed" 17 | putStrLn $ (function v) 18 | makeCleaner o 19 | 20 | -------------------------------------------------------------------------------- /testsuite/makewith/should_fail_0/prog/expected: -------------------------------------------------------------------------------- 1 | make failed 2 | -------------------------------------------------------------------------------- /testsuite/makewith/tiny/Makefile: -------------------------------------------------------------------------------- 1 | 2 | TEST=makewith/tiny 3 | 4 | TOP=../../.. 5 | include ../../build.mk 6 | -------------------------------------------------------------------------------- /testsuite/makewith/tiny/Tiny.conf: -------------------------------------------------------------------------------- 1 | resource = tiny { 2 | 3 | field = "hello strange world" 4 | 5 | } 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /testsuite/makewith/tiny/Tiny.stub: -------------------------------------------------------------------------------- 1 | module Tiny ( resource, resource_dyn ) where 2 | 3 | import API 4 | import Data.Dynamic 5 | 6 | resource = tiny 7 | 8 | resource_dyn :: Dynamic 9 | resource_dyn = toDyn resource 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | -------------------------------------------------------------------------------- /testsuite/makewith/tiny/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | -- ^ needed to derive Typeable 3 | 4 | module API where 5 | 6 | import Data.Dynamic 7 | 8 | data Tiny = Tiny { field :: String } 9 | deriving (Typeable, Show) 10 | 11 | tiny :: Tiny 12 | tiny = Tiny { field = "default value" } 13 | 14 | -------------------------------------------------------------------------------- /testsuite/makewith/tiny/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | import Data.Either 5 | 6 | conf = "../Tiny.conf" 7 | stub = "../Tiny.stub" 8 | apipath = "../api" 9 | 10 | main = do 11 | status <- makeWith conf stub ["-i"++apipath] 12 | o <- case status of 13 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 14 | MakeSuccess _ o -> return o 15 | m_v <- load o [apipath] [] "resource" 16 | v <- case m_v of 17 | LoadSuccess _ v -> return v 18 | _ -> error "load failed" 19 | putStrLn $ field v 20 | makeCleaner o 21 | 22 | -------------------------------------------------------------------------------- /testsuite/makewith/tiny/prog/expected: -------------------------------------------------------------------------------- 1 | hello strange world 2 | -------------------------------------------------------------------------------- /testsuite/makewith/unsafeio/Makefile: -------------------------------------------------------------------------------- 1 | 2 | TEST=makewith/unsafeio 3 | 4 | TOP=../../.. 5 | include ../../build.mk 6 | -------------------------------------------------------------------------------- /testsuite/makewith/unsafeio/README: -------------------------------------------------------------------------------- 1 | hmm. on 6.3 we need to add 'mtl' to a package dependency, other 2 | HSlang complains of a missing symbol. Is this a bug in the 3 | package.conf for HSlang? 4 | -------------------------------------------------------------------------------- /testsuite/makewith/unsafeio/Unsafe.conf.in: -------------------------------------------------------------------------------- 1 | {-# GLOBALOPTIONS -package mtl #-} 2 | -- illustrates the use of static options in pragmas 3 | 4 | import System.IO.Unsafe 5 | import System.IO 6 | import System.Process 7 | 8 | resource = unsafe { field = date } 9 | 10 | -- illustrates the use of the devil's work 11 | date :: String 12 | date = unsafePerformIO $ do 13 | #if !defined(CYGWIN) || !defined(__MINGW32__) 14 | (_,outh,_,proc) <- runInteractiveProcess "date" [] Nothing Nothing 15 | #else 16 | (_,outh,_,proc) <- runInteractiveProcess "@PREFIX@/../../bin/date" [] Nothing Nothing 17 | #endif 18 | waitForProcess proc 19 | s <- hGetContents outh 20 | return s 21 | 22 | -------------------------------------------------------------------------------- /testsuite/makewith/unsafeio/Unsafe.stub: -------------------------------------------------------------------------------- 1 | 2 | module Unsafe ( resource, resource_dyn ) where 3 | 4 | import API 5 | import Data.Dynamic 6 | 7 | resource = unsafe 8 | 9 | -- 10 | -- special 11 | -- 12 | resource_dyn :: Dynamic 13 | resource_dyn = toDyn resource 14 | -------------------------------------------------------------------------------- /testsuite/makewith/unsafeio/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | import Data.Dynamic 6 | 7 | data Unsafe = Unsafe { 8 | field :: String 9 | } 10 | deriving (Typeable, Show) 11 | 12 | unsafe :: Unsafe 13 | unsafe = Unsafe { field = "default value" } 14 | -------------------------------------------------------------------------------- /testsuite/makewith/unsafeio/prog/Main.hs: -------------------------------------------------------------------------------- 1 | import System.Plugins 2 | import API 3 | import Data.Either 4 | 5 | conf = "../Unsafe.conf" 6 | stub = "../Unsafe.stub" 7 | apipath = "../api" 8 | 9 | main = do 10 | status <- makeWith conf stub ["-i"++apipath] 11 | o <- case status of 12 | MakeFailure e -> mapM_ putStrLn e >> error "failed" 13 | MakeSuccess _ o -> return o 14 | m_v <- load o [apipath] [] "resource" 15 | v <- case m_v of 16 | LoadSuccess _ v -> return v 17 | _ -> error "load failed" 18 | let s = field v 19 | makeCleaner o 20 | if null s then print False else print True 21 | -------------------------------------------------------------------------------- /testsuite/makewith/unsafeio/prog/README: -------------------------------------------------------------------------------- 1 | this is an example of an application that uses the HSConf library to 2 | dynamically load compiled conf files. 3 | 4 | We use the .conf file in the parent directory, and communicate with 5 | the plugin via the API in the api_package/ directory. 6 | 7 | The plugin is a .o file 8 | The api is a GHC package archive 9 | -------------------------------------------------------------------------------- /testsuite/makewith/unsafeio/prog/expected: -------------------------------------------------------------------------------- 1 | merge failed: 2 | 3 | parse error in ../Unsafe.conf 4 | line: 13, col: 1 5 | 6 | Main: failed 7 | -------------------------------------------------------------------------------- /testsuite/misc/mkstemps/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.MkTemp 3 | 4 | import Data.Maybe 5 | 6 | import System.IO 7 | import System.Directory 8 | 9 | main = do 10 | createDirectory "t" 11 | 12 | ------------------------------------------------------------------------ 13 | -- Try mkstemp with simple template 14 | -- 15 | ts <- mapM (\_ -> mkstemp "t/t.X" ) [0..(26+26)] -- 1+26+26 files 16 | () <- if (not $ all isJust ts) 17 | then putStrLn $ "mkstemp couldn't create all expected files" 18 | else putStrLn $ "created "++(show $ length $ catMaybes ts)++" files" 19 | closeAll ts 20 | 21 | -- next one shouldn't be possible 22 | t <- mkstemp "t/t.X" 23 | () <- if (not $ isNothing t) 24 | then putStrLn $ "shouldn't have been able to create this file" 25 | else putStrLn $ "correctly ran out of permutations" 26 | closeAll [t] 27 | 28 | rmAll (t:ts) 29 | 30 | ------------------------------------------------------------------------ 31 | -- Try again with large tmp 32 | -- 33 | ts <- mapM (\_->do v <- mkstemp "t/t.XXXXXXXXXX" 34 | case v of Just (t,h) -> hClose h >> return v 35 | _ -> return v ) [1..10000] 36 | 37 | () <- if (not $ all isJust ts) 38 | then putStrLn $ "mkstemp couldn't create all expected files" 39 | else putStrLn $ "mkstemp: created "++(show $ length $ catMaybes ts)++" files" 40 | rmAll ts 41 | 42 | ------------------------------------------------------------------------ 43 | -- test mkstemps 44 | -- 45 | ts <- mapM (\_->do v <- mkstemps "t/t.XXXXXXXXXX.hs" 3 46 | case v of Just (t,h) -> hClose h >> return v 47 | _ -> return v ) [1..2000] 48 | () <- if (not $ all isJust ts) 49 | then putStrLn $ "mkstemps couldn't create all expected files" 50 | else putStrLn $ "mkstemps: created "++(show $ length $ catMaybes ts)++" files" 51 | rmAll ts 52 | 53 | ------------------------------------------------------------------------ 54 | -- mkdtemp 55 | -- 56 | ts <- mapM (\_ -> mkdtemp "t/XXXXXXXXXX") [1..2000] 57 | () <- if (not $ all isJust ts) 58 | then putStrLn $ "mkdtemp: couldn't create all expected directories" 59 | else putStrLn $ "mkdtemp: created "++(show $ length $ catMaybes ts)++" directories" 60 | rmAllDirs ts 61 | 62 | ------------------------------------------------------------------------ 63 | 64 | removeDirectory "t" 65 | 66 | where 67 | closeAll ts = mapM_ hClose $ map snd $ catMaybes ts 68 | rmAll ts = mapM_ removeFile $ map fst $ catMaybes ts 69 | rmAllDirs ts = mapM_ removeDirectory $ catMaybes ts 70 | -------------------------------------------------------------------------------- /testsuite/misc/mkstemps/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../eval.mk 3 | -------------------------------------------------------------------------------- /testsuite/misc/mkstemps/expected: -------------------------------------------------------------------------------- 1 | created 53 files 2 | correctly ran out of permutations 3 | mkstemp: created 10000 files 4 | mkstemps: created 2000 files 5 | mkdtemp: created 2000 directories 6 | -------------------------------------------------------------------------------- /testsuite/multi/3plugins/Makefile: -------------------------------------------------------------------------------- 1 | TEST= multi/3plugins 2 | 3 | EXTRA_OBJS=Plugin1.o Plugin2.o Plugin3.o 4 | 5 | TOP=../../.. 6 | include ../../build.mk 7 | -------------------------------------------------------------------------------- /testsuite/multi/3plugins/Plugin1.hs: -------------------------------------------------------------------------------- 1 | module Plugin1 where 2 | 3 | import API 4 | import Data.Char 5 | 6 | resource = plugin { 7 | valueOf = map toUpper 8 | } 9 | -------------------------------------------------------------------------------- /testsuite/multi/3plugins/Plugin2.hs: -------------------------------------------------------------------------------- 1 | module Plugin2 where 2 | 3 | import API 4 | import Data.Char 5 | 6 | resource = plugin { 7 | valueOf = \s -> show $ map ord s 8 | } 9 | 10 | -------------------------------------------------------------------------------- /testsuite/multi/3plugins/Plugin3.hs: -------------------------------------------------------------------------------- 1 | module Plugin3 where 2 | 3 | import API 4 | 5 | resource = plugin { 6 | valueOf = reverse 7 | } 8 | -------------------------------------------------------------------------------- /testsuite/multi/3plugins/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | data Interface = Interface { 4 | valueOf :: String -> String 5 | } 6 | 7 | plugin :: Interface 8 | plugin = Interface { valueOf = id } 9 | 10 | -------------------------------------------------------------------------------- /testsuite/multi/3plugins/prog/Main.hs: -------------------------------------------------------------------------------- 1 | import System.Plugins 2 | import API 3 | 4 | main = do 5 | let plist = ["../Plugin1.o", "../Plugin2.o", "../Plugin3.o"] 6 | plugins <- mapM (\p -> load p ["../api"] [] "resource") plist 7 | let functions = map (valueOf . fromLoadSuc) plugins 8 | 9 | -- apply the function from each plugin in turn 10 | mapM_ (\f -> putStrLn $ f "haskell is for hackers") functions 11 | 12 | fromLoadSuc (LoadFailure _) = error "load failed" 13 | fromLoadSuc (LoadSuccess _ v) = v 14 | -------------------------------------------------------------------------------- /testsuite/multi/3plugins/prog/expected: -------------------------------------------------------------------------------- 1 | HASKELL IS FOR HACKERS 2 | [104,97,115,107,101,108,108,32,105,115,32,102,111,114,32,104,97,99,107,101,114,115] 3 | srekcah rof si lleksah 4 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/ArithmeticExpressionParser.hs: -------------------------------------------------------------------------------- 1 | module ArithmeticExpressionParser where 2 | 3 | import Text.ParserCombinators.Parsec 4 | import Text.ParserCombinators.Parsec.Expr 5 | 6 | resource :: String -> IO String 7 | resource text = do 8 | parsedText <- mapM parseString (lines text) 9 | return (unlines parsedText) 10 | 11 | parseString s = do 12 | case (parse expr "" s) of 13 | Left err -> return ("Error " ++ show err) 14 | Right num -> return (show num) 15 | 16 | expr :: Parser Integer 17 | expr = buildExpressionParser table factor "expression" 18 | 19 | table = [ [op "*" (*) AssocLeft, op "/" div AssocLeft] 20 | , [op "+" (+) AssocLeft, op "-" (-) AssocLeft] ] 21 | where 22 | op s f assoc = Infix (do { string s; return f }) assoc 23 | 24 | factor = do { char '('; x <- expr; char ')'; return x } 25 | <|> number 26 | "simple expression" 27 | 28 | number :: Parser Integer 29 | number = do { ds <- many1 digit; return (read ds) } "number" 30 | 31 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/English.lproj/Credits.rtf: -------------------------------------------------------------------------------- 1 | {\rtf0\ansi{\fonttbl\f0\fswiss Helvetica;} 2 | {\colortbl;\red255\green255\blue255;} 3 | \paperw9840\paperh8400 4 | \pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\ql\qnatural 5 | 6 | \f0\b\fs24 \cf0 Engineering: 7 | \b0 \ 8 | Some people\ 9 | \ 10 | 11 | \b Human Interface Design: 12 | \b0 \ 13 | Some other people\ 14 | \ 15 | 16 | \b Testing: 17 | \b0 \ 18 | Hopefully not nobody\ 19 | \ 20 | 21 | \b Documentation: 22 | \b0 \ 23 | Whoever\ 24 | \ 25 | 26 | \b With special thanks to: 27 | \b0 \ 28 | Mom\ 29 | } 30 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/English.lproj/InfoPlist.strings: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/objc/expression_parser/English.lproj/InfoPlist.strings -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/English.lproj/MainMenu.nib/classes.nib: -------------------------------------------------------------------------------- 1 | { 2 | IBClasses = ({CLASS = FirstResponder; LANGUAGE = ObjC; SUPERCLASS = NSObject; }); 3 | IBVersion = 1; 4 | } -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/English.lproj/MainMenu.nib/info.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBDocumentLocation 6 | 116 123 356 240 0 0 1600 1178 7 | IBEditorPositions 8 | 9 | 29 10 | 117 405 318 44 0 0 1600 1178 11 | 12 | IBFramework Version 13 | 328.0 14 | IBOpenObjects 15 | 16 | 29 17 | 18 | IBSystem Version 19 | 7B8 20 | 21 | 22 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/English.lproj/MainMenu.nib/objects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/objc/expression_parser/English.lproj/MainMenu.nib/objects.nib -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/English.lproj/MyDocument.nib/classes.nib: -------------------------------------------------------------------------------- 1 | { 2 | IBClasses = ( 3 | {CLASS = FirstResponder; LANGUAGE = ObjC; SUPERCLASS = NSObject; }, 4 | { 5 | ACTIONS = {chooseParser = id; evaluateExpression = id; }; 6 | CLASS = MyDocument; 7 | LANGUAGE = ObjC; 8 | OUTLETS = {evaluation = id; expressionEntry = id; parser = id; }; 9 | SUPERCLASS = NSDocument; 10 | } 11 | ); 12 | IBVersion = 1; 13 | } -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/English.lproj/MyDocument.nib/info.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBDocumentLocation 6 | 79 43 356 240 0 0 1280 832 7 | IBFramework Version 8 | 349.0 9 | IBOpenObjects 10 | 11 | 21 12 | 13 | IBSystem Version 14 | 7F44 15 | 16 | 17 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/English.lproj/MyDocument.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/keyedobjects.nib -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/English.lproj/MyDocument.nib/objects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/objc/expression_parser/English.lproj/MyDocument.nib/objects.nib -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/Info.plist: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | CFBundleDevelopmentRegion 6 | English 7 | CFBundleDocumentTypes 8 | 9 | 10 | CFBundleTypeExtensions 11 | 12 | ???? 13 | 14 | CFBundleTypeIconFile 15 | 16 | CFBundleTypeName 17 | DocumentType 18 | CFBundleTypeOSTypes 19 | 20 | ???? 21 | 22 | CFBundleTypeRole 23 | Editor 24 | NSDocumentClass 25 | MyDocument 26 | 27 | 28 | CFBundleExecutable 29 | PluginExpressionParser 30 | CFBundleIconFile 31 | 32 | CFBundleIdentifier 33 | com.apple.yourCocoaDocApp 34 | CFBundleInfoDictionaryVersion 35 | 6.0 36 | CFBundlePackageType 37 | APPL 38 | CFBundleSignature 39 | ???? 40 | CFBundleVersion 41 | 0.1 42 | NSMainNibFile 43 | MainMenu 44 | NSPrincipalClass 45 | NSApplication 46 | 47 | 48 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/KeyValueParser.hs: -------------------------------------------------------------------------------- 1 | module KeyValueParser where 2 | 3 | import Text.ParserCombinators.Parsec 4 | 5 | parseKeyValue = do 6 | key <- parseKey 7 | char '=' 8 | value <- parseValue 9 | return (key, value) 10 | 11 | parseKey = many1 letter 12 | 13 | parseValue = 14 | do 15 | openQuote <- char '"' <|> char '\'' 16 | value <- many1 letter 17 | char openQuote 18 | return value 19 | <|> 20 | do 21 | value <- many1 letter 22 | return value 23 | 24 | parseString s = do 25 | case (parse parseKeyValue "" s) of 26 | Left err -> return ("Error " ++ show err) 27 | Right (key, value) -> return ("Key: " ++ key ++ ", Value: " ++ value) 28 | 29 | resource :: String -> IO String 30 | resource text = do 31 | parsedText <- mapM parseString (lines text) 32 | return (unlines parsedText) 33 | 34 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/Makefile: -------------------------------------------------------------------------------- 1 | APP_DIR = build/PluginExpressionParser.app 2 | APP_CONTENTS_DIR = $(APP_DIR)/Contents 3 | APP_ARCH_EXEC_DIR = $(APP_CONTENTS_DIR)/MacOS 4 | APP_RESOURCES_DIR = $(APP_CONTENTS_DIR)/Resources 5 | EXECUTABLE = $(APP_ARCH_EXEC_DIR)/PluginExpressionParser 6 | 7 | OBJECT_FILES = main.o MyDocument.o PluginEvalAux.o 8 | BUILD_OBJECT_FILES = $(addprefix build/,$(OBJECT_FILES)) \ 9 | build/PluginEvalAux_stub.o 10 | 11 | HOST = $(shell uname) 12 | 13 | ifeq ($(HOST),Darwin) 14 | default: app 15 | else 16 | default: no_app 17 | endif 18 | 19 | app: $(APP_CONTENTS_DIR) $(APP_RESOURCES_DIR) $(EXECUTABLE) 20 | 21 | # 22 | 23 | $(EXECUTABLE): $(APP_ARCH_EXEC_DIR) $(BUILD_OBJECT_FILES) 24 | ghc \ 25 | -o "$(EXECUTABLE)" \ 26 | -framework Cocoa \ 27 | -package-conf ../../../plugins.conf.inplace \ 28 | -package plugins \ 29 | -no-hs-main \ 30 | $(BUILD_OBJECT_FILES) 31 | 32 | build/MyDocument.o: MyDocument.m MyDocument.h 33 | gcc -c -o "$@" -Wall -I`ghc --print-libdir`/include "$<" 34 | 35 | build/main.o: main.m 36 | gcc -c -o "$@" -Wall -I`ghc --print-libdir`/include "$<" 37 | 38 | build/PluginEvalAux.o: PluginEvalAux.hs 39 | ghc --make \ 40 | -package-conf ../../../plugins.conf.inplace \ 41 | -package plugins \ 42 | -odir build/ \ 43 | -hidir build/ \ 44 | "$<" 45 | 46 | # 47 | 48 | $(APP_DIR): 49 | mkdir -p "$@" 50 | 51 | $(APP_ARCH_EXEC_DIR): $(APP_DIR) 52 | mkdir -p "$@" 53 | 54 | $(APP_CONTENTS_DIR): $(APP_DIR) Info.plist 55 | mkdir -p "$(APP_CONTENTS_DIR)" 56 | cp Info.plist "$@" 57 | echo -n 'APPL????' > "$@"/PkgInfo 58 | 59 | $(APP_RESOURCES_DIR): $(APP_DIR) English.lproj 60 | mkdir -p "$(APP_RESOURCES_DIR)" 61 | cp -R English.lproj "$@" 62 | 63 | # 64 | 65 | clean: 66 | -rm -rf build *_stub.? 67 | 68 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/MyDocument.h: -------------------------------------------------------------------------------- 1 | /* MyDocument */ 2 | 3 | #import 4 | 5 | #include "RunHaskell.h" 6 | 7 | @interface MyDocument : NSDocument 8 | { 9 | IBOutlet id evaluation; 10 | IBOutlet id expressionEntry; 11 | IBOutlet id parser; 12 | } 13 | - (IBAction)chooseParser:(id)sender; 14 | - (IBAction)evaluateExpression:(id)sender; 15 | 16 | @end 17 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/MyDocument.m: -------------------------------------------------------------------------------- 1 | #import "MyDocument.h" 2 | 3 | @implementation MyDocument 4 | 5 | - (NSString *)windowNibName { 6 | return @"MyDocument"; 7 | } 8 | 9 | - (NSData *)dataRepresentationOfType:(NSString *)type { 10 | return nil; 11 | } 12 | 13 | - (BOOL)loadDataRepresentation:(NSData *)data ofType:(NSString *)type { 14 | return NO; 15 | } 16 | 17 | 18 | - (IBAction)chooseParser:(id)sender 19 | { 20 | int result; 21 | NSArray *fileTypes = [NSArray arrayWithObject:@"hs"]; 22 | NSOpenPanel *oPanel = [NSOpenPanel openPanel]; 23 | 24 | result = [oPanel runModalForDirectory:nil file:nil types:fileTypes]; 25 | if (result == NSOKButton) 26 | { 27 | NSArray *filesToOpen = [oPanel filenames]; 28 | [parser setStringValue:[filesToOpen objectAtIndex:0]]; 29 | } 30 | } 31 | 32 | - (IBAction)evaluateExpression:(id)sender 33 | { 34 | NSLog(@"evaluateExpression"); 35 | NSString *filePathNSS = [parser stringValue]; 36 | char *filePath = [filePathNSS cString]; 37 | 38 | NSString *expressionNSS = [[expressionEntry textStorage] string]; 39 | char *expression = [expressionNSS cString]; 40 | 41 | NSLog (@"filePath:%s expression:%s", filePath, expression); 42 | 43 | char *result = evalhaskell_CString(filePath, expression); 44 | NSString *resultNSS = [NSString stringWithCString:result]; 45 | NSAttributedString *resultNSAS = [[NSAttributedString alloc] 46 | initWithString:resultNSS 47 | attributes:nil]; 48 | [[evaluation textStorage] setAttributedString:resultNSAS]; 49 | 50 | } 51 | 52 | @end 53 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/PluginEvalAux.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts -fffi #-} 2 | 3 | module PluginEvalAux where 4 | 5 | import System.Plugins.Make 6 | import System.Plugins.Load 7 | import System.Plugins.Utils 8 | 9 | import Foreign.C 10 | import Control.Exception ( evaluate ) 11 | import System.IO 12 | import System.Directory ( renameFile, removeFile ) 13 | 14 | symbol = "resource" 15 | 16 | evalWithStringResult :: FilePath -> String -> IO String 17 | evalWithStringResult srcFile s = do 18 | status <- make srcFile ["-O0"] 19 | case status of 20 | MakeFailure err -> putStrLn "error occurred" >> return (show err) 21 | MakeSuccess _ obj -> load' obj 22 | where 23 | load' obj = do 24 | loadResult <- load obj [] [] symbol 25 | case loadResult of 26 | LoadFailure errs -> putStrLn "load error" >> return (show errs) 27 | LoadSuccess m (rsrc :: String -> IO String) -> do 28 | v' <- rsrc s 29 | unload m 30 | mapM_ removeFile [ obj, replaceSuffix obj ".hi" ] 31 | return v' 32 | 33 | foreign export ccall evalhaskell_CString :: CString -> CString -> IO CString 34 | 35 | evalhaskell_CString :: CString -> CString -> IO CString 36 | evalhaskell_CString filePathCS sCS = do 37 | s <- peekCString sCS 38 | filePath <- peekCString filePathCS 39 | retval <- evalWithStringResult filePath s 40 | newCString retval 41 | 42 | -- vi:sw=2 sts=2 43 | 44 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/PluginExpressionParser_Prefix.pch: -------------------------------------------------------------------------------- 1 | // 2 | // Prefix header for all source files of the 'PluginExpressionParser' target in the 'PluginExpressionParser' project 3 | // 4 | 5 | #ifdef __OBJC__ 6 | #import 7 | #endif 8 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/README: -------------------------------------------------------------------------------- 1 | This little application is an example of using hs-plugins to embed a Haskell 2 | 'interpreter' inside an Objective-C, Cocoa-based program. You will need Mac OS 3 | X for this to be of any use! 4 | 5 | To build it, type 'make', which will build a .app bundle in the build/ directory. Or, 'open *.xcode', and hit the build button in there. 6 | 7 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/RunHaskell.h: -------------------------------------------------------------------------------- 1 | #include "HsFFI.h" 2 | 3 | extern HsPtr evalhaskell_CString(HsPtr a1, HsPtr a2); 4 | 5 | -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/dont_test: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/objc/expression_parser/dont_test -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/main.m: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/objc/expression_parser/main.m -------------------------------------------------------------------------------- /testsuite/objc/expression_parser/version.plist: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | BuildVersion 6 | 17 7 | CFBundleShortVersionString 8 | 0.1 9 | CFBundleVersion 10 | 0.1 11 | ProjectName 12 | NibPBTemplates 13 | SourceVersion 14 | 1150000 15 | 16 | 17 | -------------------------------------------------------------------------------- /testsuite/pdynload/badint/Makefile: -------------------------------------------------------------------------------- 1 | 2 | TEST=pdynload/badint 3 | 4 | TOP=../../.. 5 | include ../../build.mk 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/badint/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | resource :: Num t => t 4 | resource = 0xBAD 5 | -------------------------------------------------------------------------------- /testsuite/pdynload/badint/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | data Interface = Interface { 4 | transform :: String -> String 5 | } 6 | 7 | rsrc :: Interface 8 | rsrc = Interface { transform = id } 9 | 10 | -------------------------------------------------------------------------------- /testsuite/pdynload/badint/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | src = "../Plugin.hs" 6 | wrap = "../Wrapper.hs" 7 | apipath = "../api" 8 | 9 | main = do status <- make src ["-i"++apipath] 10 | case status of 11 | MakeSuccess _ _ -> f 12 | MakeFailure e-> mapM_ putStrLn e 13 | 14 | where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" 15 | case v of 16 | LoadSuccess _ a -> putStrLn $ (transform a) "foo" 17 | _ -> putStrLn "wrong types" 18 | 19 | -------------------------------------------------------------------------------- /testsuite/pdynload/badint/prog/expected: -------------------------------------------------------------------------------- 1 | wrong types 2 | -------------------------------------------------------------------------------- /testsuite/pdynload/bayley1/Load.hs: -------------------------------------------------------------------------------- 1 | module Load where 2 | 3 | import API 4 | import System.Plugins 5 | 6 | -- 7 | -- load doesn't seem to behave nicely when using dirname on hier names 8 | -- 9 | -- make, and maybe other places, use dirname to work out various names 10 | -- from paths, which is invalid when hier names are used.. 11 | -- 12 | 13 | testload = do 14 | 15 | s <- make "../Plugin1.hs" ["-i../api"] 16 | o1 <- case s of 17 | MakeSuccess _ o -> return o 18 | MakeFailure e -> mapM_ putStrLn e >> fail "o1" 19 | 20 | s <- make "../Sub/Plugin2.hs" ["-i../api","-hidir.."] -- ! 21 | o2 <- case s of 22 | MakeSuccess _ o -> return o 23 | MakeFailure e -> mapM_ putStrLn e >> fail "o2" 24 | 25 | fc <- pdynload o1 ["..","../api"] [] "API.PluginAPI" "action" 26 | 27 | case fc of 28 | LoadFailure msg -> mapM_ putStrLn msg 29 | LoadSuccess modul proc -> do 30 | let ac :: API.PluginAPI; ac = proc 31 | let s = proc 42 32 | print s 33 | 34 | -- will reqeust 'Plugin2', but module is actually 'Sub.Plugin2' 35 | print o2 36 | fc <- pdynload (o2) ["..","../api"] [] "API.PluginAPI" "action" 37 | case fc of 38 | LoadFailure msg -> mapM_ putStrLn msg 39 | LoadSuccess modul proc -> do 40 | let ac :: API.PluginAPI; ac = proc 41 | let s = proc 42 42 | print s 43 | -------------------------------------------------------------------------------- /testsuite/pdynload/bayley1/Makefile: -------------------------------------------------------------------------------- 1 | 2 | TEST=pdynload/bayley1 3 | 4 | TOP=../../.. 5 | include ../../build.mk 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/bayley1/Plugin1.hs: -------------------------------------------------------------------------------- 1 | module Plugin1 where 2 | 3 | import qualified API 4 | action :: API.PluginAPI 5 | action i = show i 6 | 7 | -------------------------------------------------------------------------------- /testsuite/pdynload/bayley1/Sub/Plugin2.hs: -------------------------------------------------------------------------------- 1 | module Sub.Plugin2 where 2 | 3 | import qualified API 4 | action :: API.PluginAPI 5 | action i = show i 6 | 7 | -------------------------------------------------------------------------------- /testsuite/pdynload/bayley1/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | type PluginAPI = Int -> String 4 | action :: PluginAPI 5 | action i = show i 6 | 7 | -------------------------------------------------------------------------------- /testsuite/pdynload/bayley1/prog/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | import Load 3 | main = testload 4 | 5 | -------------------------------------------------------------------------------- /testsuite/pdynload/null/Makefile: -------------------------------------------------------------------------------- 1 | 2 | TEST= pdynload/null 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/pdynload/null/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | import API 4 | 5 | resource = D 1 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/null/api/API.hs: -------------------------------------------------------------------------------- 1 | 2 | module API where 3 | 4 | data Num t => Interface t = D t 5 | 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/null/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | -- import System.Plugins.Utils 4 | import API 5 | 6 | src = "../Plugin.hs" 7 | wrap = "../Wrapper.hs" 8 | apipath = "../api" 9 | 10 | main = do status <- make src ["-i"++apipath] 11 | case status of 12 | MakeSuccess _ _ -> f 13 | MakeFailure e-> mapM_ putStrLn e 14 | 15 | where f = do v <- load "../Plugin.o" ["../api"] [] "resource" 16 | -- (i,_) <- exec "ghc" ["--numeric-version"] 17 | -- mapM_ putStrLn i 18 | putStrLn "done." 19 | 20 | -------------------------------------------------------------------------------- /testsuite/pdynload/null/prog/expected: -------------------------------------------------------------------------------- 1 | done. 2 | -------------------------------------------------------------------------------- /testsuite/pdynload/numclass/Makefile: -------------------------------------------------------------------------------- 1 | 2 | TEST= pdynload/numclass 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/pdynload/numclass/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | -- import API 4 | 5 | resource = "error" 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/numclass/api/API.hs: -------------------------------------------------------------------------------- 1 | 2 | module API where 3 | 4 | data Num t => Interface t = D t 5 | 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/numclass/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | src = "../Plugin.hs" 6 | wrap = "../Wrapper.hs" 7 | apipath = "../api" 8 | 9 | main = do status <- make src ["-i"++apipath] 10 | case status of 11 | MakeFailure _ -> putStrLn "make failed" 12 | MakeSuccess _ _ -> do { 13 | 14 | ;v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface Integer" "resource" 15 | ;case v of 16 | LoadSuccess _ a -> let D i = snd a in putStrLn $ show i 17 | _ -> putStrLn "wrong types" 18 | 19 | } 20 | -------------------------------------------------------------------------------- /testsuite/pdynload/numclass/prog/expected: -------------------------------------------------------------------------------- 1 | wrong types 2 | -------------------------------------------------------------------------------- /testsuite/pdynload/poly/Makefile: -------------------------------------------------------------------------------- 1 | 2 | TEST=pdynload/poly 3 | 4 | TOP=../../.. 5 | include ../../build.mk 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/poly/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | import Data.Typeable 4 | import Data.Generics.Aliases 5 | import Data.Generics.Schemes 6 | 7 | import API 8 | 9 | resource = rsrc { 10 | field = id listify :: Typeable r => (r -> Bool) -> GenericQ [r] 11 | } 12 | -------------------------------------------------------------------------------- /testsuite/pdynload/poly/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | -- a really nasty type: 3 | 4 | module API where 5 | 6 | import Data.Generics 7 | 8 | data Interface = Interface { field :: Typeable r => (r -> Bool) -> GenericQ [r] } 9 | 10 | rsrc :: Interface 11 | rsrc = Interface { field = listify } 12 | 13 | -------------------------------------------------------------------------------- /testsuite/pdynload/poly/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | src = "../Plugin.hs" 6 | wrap = "../Wrapper.hs" 7 | apipath = "../api" 8 | 9 | main = do status <- make src ["-i"++apipath] 10 | case status of 11 | MakeSuccess _ _ -> f 12 | MakeFailure e -> mapM_ putStrLn e 13 | 14 | where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" 15 | case v of 16 | LoadSuccess _ a -> putStrLn "loaded .. yay!" 17 | _ -> putStrLn "wrong types" 18 | -------------------------------------------------------------------------------- /testsuite/pdynload/poly/prog/expected: -------------------------------------------------------------------------------- 1 | loaded .. yay! 2 | -------------------------------------------------------------------------------- /testsuite/pdynload/poly1/Makefile: -------------------------------------------------------------------------------- 1 | TEST= pdynload/poly1 2 | EXTRA_OBJS=Plugin.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/pdynload/poly1/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | import API 4 | 5 | resource = plugin { function = (+) } 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/poly1/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | data Interface = Interface { 4 | function :: (Num a) => a -> a -> a 5 | } 6 | 7 | plugin :: Interface 8 | plugin = Interface { function = error "no function defined" } 9 | 10 | -------------------------------------------------------------------------------- /testsuite/pdynload/poly1/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | src = "../Plugin.hs" 6 | wrap = "../Wrapper.hs" 7 | apipath = "../api" 8 | 9 | main = do status <- make src ["-i"++apipath] 10 | case status of 11 | MakeSuccess _ _ -> f 12 | MakeFailure e -> mapM_ putStrLn e 13 | 14 | where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" 15 | case v of 16 | LoadSuccess _ a -> let fn = function a in putStrLn $ show $ 1 `fn` 2 17 | _ -> putStrLn "wrong types" 18 | 19 | -------------------------------------------------------------------------------- /testsuite/pdynload/poly1/prog/expected: -------------------------------------------------------------------------------- 1 | 3 2 | -------------------------------------------------------------------------------- /testsuite/pdynload/should_fail0/Makefile: -------------------------------------------------------------------------------- 1 | TEST= pdynload/should_fail0 2 | EXTRA_OBJS=Plugin.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/pdynload/should_fail0/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | import API 4 | 5 | resource = 0xBAD :: Int 6 | 7 | -- resource = tiny { 8 | -- field = "hello strange world" 9 | -- } 10 | -------------------------------------------------------------------------------- /testsuite/pdynload/should_fail0/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | -- ^ needed to derive Typeable 3 | 4 | module API where 5 | 6 | import Data.Dynamic 7 | 8 | data Interface = Interface { field :: String } 9 | deriving (Show) 10 | 11 | rsrc :: Interface 12 | rsrc = Interface { field = "default value" } 13 | 14 | -------------------------------------------------------------------------------- /testsuite/pdynload/should_fail0/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | src = "../Plugin.hs" 6 | wrap = "../Wrapper.hs" 7 | apipath = "../api" 8 | 9 | main = do status <- make src ["-i"++apipath] 10 | case status of 11 | MakeSuccess _ _ -> f 12 | MakeFailure e -> mapM_ putStrLn e 13 | where 14 | f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" 15 | case v of 16 | LoadSuccess _ a -> putStrLn "loaded .. yay!" 17 | _ -> putStrLn "wrong types" 18 | 19 | -------------------------------------------------------------------------------- /testsuite/pdynload/should_fail0/prog/expected: -------------------------------------------------------------------------------- 1 | wrong types 2 | -------------------------------------------------------------------------------- /testsuite/pdynload/should_fail1/Makefile: -------------------------------------------------------------------------------- 1 | # Missing class constraint... can't do that in Clean 2 | 3 | TEST= pdynload/should_fail1 4 | TOP=../../.. 5 | include ../../build.mk 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/should_fail1/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | data I = I Int 4 | 5 | resource = I 1 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/should_fail1/api/API.hs: -------------------------------------------------------------------------------- 1 | 2 | module API where 3 | 4 | newtype Interface = I Int 5 | 6 | rsrc :: Interface 7 | rsrc = I 1 8 | 9 | -------------------------------------------------------------------------------- /testsuite/pdynload/should_fail1/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | src = "../Plugin.hs" 6 | wrap = "../Wrapper.hs" 7 | apipath = "../api" 8 | 9 | main = do status <- make src ["-i"++apipath] 10 | case status of 11 | MakeSuccess _ _ -> f 12 | MakeFailure e -> mapM_ putStrLn e 13 | 14 | where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" 15 | case v of 16 | LoadSuccess _ a -> putStrLn "loaded .. yay!" 17 | _ -> putStrLn "wrong types" 18 | -------------------------------------------------------------------------------- /testsuite/pdynload/should_fail1/prog/expected: -------------------------------------------------------------------------------- 1 | wrong types 2 | -------------------------------------------------------------------------------- /testsuite/pdynload/small/Makefile: -------------------------------------------------------------------------------- 1 | TEST= pdynload/small 2 | EXTRA_OBJS=Plugin.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/pdynload/small/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | import API 4 | 5 | resource = plugin { function = "good" } 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/small/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | data Interface = Interface { 4 | function :: String 5 | } 6 | 7 | plugin :: Interface 8 | plugin = Interface { function = "goodbye" } 9 | 10 | -------------------------------------------------------------------------------- /testsuite/pdynload/small/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | src = "../Plugin.hs" 6 | wrap = "../Wrapper.hs" 7 | apipath = "../api" 8 | 9 | main = do status <- make src ["-i"++apipath] 10 | case status of 11 | MakeSuccess _ _ -> f 12 | MakeFailure e -> mapM_ putStrLn e 13 | 14 | where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" 15 | case v of 16 | LoadSuccess _ a -> putStrLn "loaded .. yay!" 17 | _ -> putStrLn "wrong types" 18 | 19 | -------------------------------------------------------------------------------- /testsuite/pdynload/small/prog/expected: -------------------------------------------------------------------------------- 1 | loaded .. yay! 2 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj1/Makefile: -------------------------------------------------------------------------------- 1 | 2 | TEST=pdynload/spj1 3 | 4 | TOP=../../.. 5 | include ../../build.mk 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj1/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | -- user doesn't import the API 4 | -- and provides a polymorphic value 5 | 6 | -- import API 7 | -- resource :: Interface 8 | 9 | -- 10 | -- should pass type check, and dump core 11 | -- 12 | -- resource :: Num a => a 13 | 14 | -- import API 15 | 16 | resource :: Num a => a 17 | resource = 7 18 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj1/api/API.hs: -------------------------------------------------------------------------------- 1 | 2 | module API where 3 | 4 | -- data Interface = Interface { field :: Int } 5 | 6 | -- newtype Interface = Interface Int 7 | 8 | type Interface = Int 9 | 10 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj1/dont_test: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/pdynload/spj1/dont_test -------------------------------------------------------------------------------- /testsuite/pdynload/spj1/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | src = "../Plugin.hs" 6 | wrap = "../Wrapper.hs" 7 | apipath = "../api" 8 | 9 | main = do status <- make src ["-i"++apipath] 10 | case status of 11 | MakeSuccess _ _ -> f 12 | MakeFailure e -> mapM_ putStrLn e 13 | 14 | where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" 15 | case v of 16 | LoadSuccess _ (a :: Interface) -> print $ a -- will crash 17 | LoadFailure es -> putStrLn $ show es 18 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj1/prog/expected: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/pdynload/spj1/prog/expected -------------------------------------------------------------------------------- /testsuite/pdynload/spj2/Makefile: -------------------------------------------------------------------------------- 1 | 2 | TEST=pdynload/spj1 3 | 4 | TOP=../../.. 5 | include ../../build.mk 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj2/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | -- user doesn't import the API 4 | -- and provides a polymorphic value 5 | 6 | import API 7 | resource :: Interface 8 | 9 | -- 10 | -- should pass type check, and dump core 11 | -- 12 | -- resource :: Num a => a 13 | resource = 7 14 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj2/api/API.hs: -------------------------------------------------------------------------------- 1 | 2 | module API where 3 | 4 | -- simple type 5 | type Interface = Int 6 | 7 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj2/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | src = "../Plugin.hs" 6 | wrap = "../Wrapper.hs" 7 | apipath = "../api" 8 | 9 | main = do status <- make src ["-i"++apipath] 10 | case status of 11 | MakeSuccess _ _ -> f 12 | MakeFailure e -> mapM_ putStrLn e 13 | 14 | where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" 15 | case v of 16 | LoadSuccess _ (a :: Interface) -> putStrLn $ show a -- will crash 17 | LoadFailure es -> putStrLn $ show es 18 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj2/prog/expected: -------------------------------------------------------------------------------- 1 | 7 2 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj3/Makefile: -------------------------------------------------------------------------------- 1 | TEST= pdynload/spj3 2 | TOP=../../.. 3 | include ../../build.mk 4 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj3/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | import API 4 | 5 | resource = plugin { function = (+) :: Int -> Int -> Int } 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj3/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | data Interface = Interface { 4 | function :: (Num a) => a -> a -> a 5 | } 6 | 7 | plugin :: Interface 8 | plugin = Interface { function = error "no function defined" } 9 | 10 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj3/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | src = "../Plugin.hs" 6 | wrap = "../Wrapper.hs" 7 | apipath = "../api" 8 | 9 | main = do status <- make src ["-i"++apipath] 10 | case status of 11 | MakeSuccess _ _ -> f 12 | MakeFailure e -> mapM_ putStrLn e 13 | 14 | where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" 15 | case v of 16 | LoadSuccess _ a -> let fn = function a in putStrLn $ show $ 1 `fn` 2 17 | _ -> putStrLn "wrong types" 18 | 19 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj3/prog/expected: -------------------------------------------------------------------------------- 1 | 2 | ../Plugin.hs:5: 3 | Cannot unify the type-signature variable `a' with the type `Int' 4 | Expected type: a -> a -> a 5 | Inferred type: Int -> Int -> Int 6 | When checking the type signature of the expression: 7 | (+) :: Int -> Int -> Int 8 | In the `function' field of a record 9 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj3/prog/expected.604: -------------------------------------------------------------------------------- 1 | 2 | ../Plugin.hs:5:31: 3 | Couldn't match the rigid variable `a' against `Int' 4 | `a' is bound by the polymorphic type `forall a. (Num a) => a -> a -> a' 5 | at ../Plugin.hs:5:11-56 6 | Expected type: a -> a -> a 7 | Inferred type: Int -> Int -> Int 8 | In the expression: (+) :: Int -> Int -> Int 9 | In the `function' field of a record 10 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj3/prog/expected.605: -------------------------------------------------------------------------------- 1 | 2 | ../Plugin.hs:5:31: 3 | Couldn't match the rigid variable `a' against `Int' 4 | `a' is bound by the polymorphic type `forall a. (Num a) => a -> a -> a' 5 | at ../Plugin.hs:5:11-56 6 | Expected type: a -> a -> a 7 | Inferred type: Int -> Int -> Int 8 | In the expression: (+) :: Int -> Int -> Int 9 | In the `function' field of a record 10 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj4/Makefile: -------------------------------------------------------------------------------- 1 | 2 | TEST=pdynload/spj4 3 | 4 | TOP=../../.. 5 | include ../../build.mk 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj4/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | -- user doesn't import the API 4 | -- and provides a polymorphic value 5 | 6 | -- import API 7 | -- resource :: Interface 8 | 9 | -- 10 | -- should pass type check, and dump core 11 | -- 12 | -- resource :: Num a => a 13 | 14 | import API 15 | 16 | resource = Interface { field = 7 :: Num a => a } 17 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj4/api/API.hs: -------------------------------------------------------------------------------- 1 | 2 | module API where 3 | 4 | newtype Interface = Interface { field :: Int } 5 | 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj4/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | src = "../Plugin.hs" 6 | wrap = "../Wrapper.hs" 7 | apipath = "../api" 8 | 9 | main = do status <- make src ["-i"++apipath] 10 | case status of 11 | MakeSuccess _ _ -> f 12 | MakeFailure e -> error "there was a type error" 13 | 14 | where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" 15 | case v of 16 | LoadSuccess _ (a :: Interface) -> print $ field a -- will crash 17 | LoadFailure es -> mapM_ putStrLn es 18 | -------------------------------------------------------------------------------- /testsuite/pdynload/spj4/prog/expected: -------------------------------------------------------------------------------- 1 | 7 2 | -------------------------------------------------------------------------------- /testsuite/pdynload/typealias/Makefile: -------------------------------------------------------------------------------- 1 | # Missing class constraint... can't do that in Clean 2 | 3 | TEST= pdynload/typealias 4 | TOP=../../.. 5 | include ../../build.mk 6 | -------------------------------------------------------------------------------- /testsuite/pdynload/typealias/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | resource = 1 :: Int 4 | -------------------------------------------------------------------------------- /testsuite/pdynload/typealias/api/API.hs: -------------------------------------------------------------------------------- 1 | 2 | module API where 3 | 4 | type Interface = Int 5 | 6 | rsrc :: Interface 7 | rsrc = 1 8 | 9 | -------------------------------------------------------------------------------- /testsuite/pdynload/typealias/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | src = "../Plugin.hs" 6 | wrap = "../Wrapper.hs" 7 | apipath = "../api" 8 | 9 | main = do status <- make src ["-i"++apipath] 10 | case status of 11 | MakeSuccess _ _ -> f 12 | MakeFailure e -> mapM_ putStrLn e 13 | 14 | where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" 15 | case v of 16 | LoadSuccess _ a -> putStrLn "loaded .. yay!" 17 | _ -> putStrLn "wrong types" 18 | 19 | 20 | -------------------------------------------------------------------------------- /testsuite/pdynload/typealias/prog/expected: -------------------------------------------------------------------------------- 1 | loaded .. yay! 2 | -------------------------------------------------------------------------------- /testsuite/pdynload/univquant/Makefile: -------------------------------------------------------------------------------- 1 | TEST= pdynload/univquant 2 | EXTRA_OBJS=Plugin.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/pdynload/univquant/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Plugin where 2 | 3 | import API 4 | 5 | resource = plugin { function = my_id } 6 | 7 | my_id :: forall a. a -> a 8 | my_id x = x 9 | -------------------------------------------------------------------------------- /testsuite/pdynload/univquant/api/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | data Interface = Interface { 4 | function :: forall a. a -> a 5 | } 6 | 7 | plugin :: Interface 8 | plugin = Interface { function = id } 9 | 10 | -------------------------------------------------------------------------------- /testsuite/pdynload/univquant/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | src = "../Plugin.hs" 6 | wrap = "../Wrapper.hs" 7 | apipath = "../api" 8 | 9 | main = do status <- make src ["-i"++apipath] 10 | case status of 11 | MakeSuccess _ _ -> f 12 | MakeFailure e -> mapM_ putStrLn e 13 | 14 | where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource" 15 | case v of 16 | LoadSuccess _ a -> putStrLn "loaded .. yay!" 17 | _ -> putStrLn "wrong types" 18 | -------------------------------------------------------------------------------- /testsuite/pdynload/univquant/prog/expected: -------------------------------------------------------------------------------- 1 | loaded .. yay! 2 | -------------------------------------------------------------------------------- /testsuite/pkgconf/null/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | @echo "test disabled" 3 | 4 | #true_api:: 5 | # ( cd api ;\ 6 | # $(GHC) -Onot $(EXTRAFLAGS) -c $(API).hs ;\ 7 | # $(RM) -f libHSapi.a ;\ 8 | # $(AR) cq libHSapi.a API.o ;\ 9 | # $(RANLIB) libHSapi.a ;\ 10 | # $(LD) -r $(LD_X) $(WHOLE_ARCHIVE_FLAG) -o HSapi.o libHSapi.a ;\ 11 | # rm API.o ;\ 12 | # echo [] > package.conf ;\ 13 | # env PREFIX=`pwd` $(GHC_PKG) -f package.conf -u < package.conf.in ) 14 | # $(GHC) -package-conf ${TOP}/plugins.conf.inplace -package plugins \ 15 | # -package-conf api/package.conf -package api \ 16 | # -O $(EXTRAFLAGS) -c Null.hs 17 | -------------------------------------------------------------------------------- /testsuite/pkgconf/null/Null.hs: -------------------------------------------------------------------------------- 1 | module Null ( resource ) where 2 | 3 | import API 4 | 5 | resource = plugin { a = 7 } 6 | 7 | -------------------------------------------------------------------------------- /testsuite/pkgconf/null/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | data Null = Null { a, b :: Int } 6 | deriving Show 7 | 8 | plugin :: Null 9 | plugin = Null { a = 42 , b = 1 } 10 | 11 | -------------------------------------------------------------------------------- /testsuite/pkgconf/null/api/package.conf.in: -------------------------------------------------------------------------------- 1 | Package { 2 | name = "api", 3 | auto = False, 4 | 5 | import_dirs = [ "${PREFIX}" ], 6 | library_dirs = [ "${PREFIX}" ], 7 | hs_libraries = [ "HSapi" ], 8 | 9 | include_dirs = [], 10 | c_includes = [], 11 | source_dirs = [], 12 | extra_libraries = [], 13 | package_deps = [], 14 | extra_ghc_opts = [], 15 | extra_cc_opts = [], 16 | extra_ld_opts = [] 17 | } 18 | 19 | -------------------------------------------------------------------------------- /testsuite/pkgconf/null/dont_test: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/pkgconf/null/dont_test -------------------------------------------------------------------------------- /testsuite/pkgconf/null/prog/Main.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -cpp #-} 2 | 3 | #include "../../../../config.h" 4 | 5 | import System.Plugins 6 | import API 7 | 8 | main = do 9 | let includes = TOP ++ "/testsuite/load/null/api" 10 | (_,v) <- load "../Null.o" ["."] ["../api/package.conf"] "resource" 11 | putStrLn ( show (a v) ) 12 | 13 | -------------------------------------------------------------------------------- /testsuite/plugs/plugs/Main.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons 3 | -- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html) 4 | -- 5 | 6 | import System.Eval.Haskell 7 | import System.Plugins.Load 8 | 9 | import System.Exit ( ExitCode(..), exitWith ) 10 | import System.IO 11 | import System.Console.Readline ( readline, addHistory ) 12 | 13 | symbol = "resource" 14 | 15 | main = do 16 | putStrLn banner 17 | putStr "Loading package base" >> hFlush stdout 18 | loadPackage "base" 19 | putStr " ... linking ... " >> hFlush stdout 20 | resolveObjs (return ()) 21 | putStrLn "done" 22 | 23 | shell [] 24 | 25 | shell :: [String] -> IO () 26 | shell imps = do 27 | s <- readline "plugs> " 28 | cmd <- case s of 29 | Nothing -> exitWith ExitSuccess 30 | Just (':':'q':_) -> exitWith ExitSuccess 31 | Just s -> addHistory s >> return s 32 | imps' <- run cmd imps 33 | shell imps' 34 | 35 | run :: String -> [String] -> IO [String] 36 | run "" is = return is 37 | run ":?" is = putStrLn help >> return is 38 | 39 | run ":l" _ = return [] 40 | run (':':'l':' ':m) is = return (m:is) 41 | 42 | run (':':'t':' ':s) is = do 43 | ty <- typeOf s is 44 | when (not $ null ty) (putStrLn $ s ++ " :: " ++ ty) 45 | return is 46 | 47 | run (':':_) is = putStrLn help >> return is 48 | 49 | run s is = do 50 | s <- unsafeEval ("show $ "++s) is 51 | when (isJust s) (putStrLn (fromJust s)) 52 | return is 53 | 54 | banner = "\ 55 | \ __ \n\ 56 | \ ____ / /_ ______ ______ \n\ 57 | \ / __ \\/ / / / / __ `/ ___/ PLugin User's GHCi System, for Haskell 98\n\ 58 | \ / /_/ / / /_/ / /_/ (__ ) http://www.cse.unsw.edu.au/~dons/hs-plugins\n\ 59 | \ / .___/_/\\__,_/\\__, /____/ Type :? for help \n\ 60 | \/_/ /____/ \n" 61 | 62 | help = "\ 63 | \Commands :\n\ 64 | \ evaluate expression\n\ 65 | \ :t show type of expression (monomorphic only)\n\ 66 | \ :l module bring module in to scope\n\ 67 | \ :l clear module list\n\ 68 | \ :quit quit\n\ 69 | \ :? display this list of commands" 70 | -------------------------------------------------------------------------------- /testsuite/plugs/plugs/Makefile: -------------------------------------------------------------------------------- 1 | GHCFLAGS= -O 2 | PKGFLAGS+= -package plugins -package readline 3 | 4 | all: build 5 | 6 | build: 7 | @$(GHC) $(GHCFLAGS) $(PKGFLAGS) $(EXTRAFLAGS) Main.hs -o plugs 8 | check: build 9 | @(if [ -f "expected" ] ;\ 10 | then \ 11 | actual_out="/tmp/hs-plugins-actual.out.$$$$" ;\ 12 | diff_out="/tmp/hs-plugins.diff.$$$$" ;\ 13 | cat test.in | ./plugs > $$actual_out 2>&1 || true ;\ 14 | diff -u expected $$actual_out > $$diff_out || true ;\ 15 | if [ -s "$$diff_out" ] ; then \ 16 | echo "failed with:" ;\ 17 | cat "$$diff_out" | sed '1,3d' ;\ 18 | else \ 19 | echo "ok." ;\ 20 | fi ;\ 21 | rm $$actual_out ;\ 22 | else \ 23 | cat test.in | ./plugs 2>&1 || true ;\ 24 | fi) 25 | clean: 26 | rm -rf *.hi *.o *~ *.dep ./plugs 27 | 28 | include ../../../config.mk 29 | -------------------------------------------------------------------------------- /testsuite/plugs/plugs/expected: -------------------------------------------------------------------------------- 1 | __ 2 | ____ / /_ ______ ______ 3 | / __ \/ / / / / __ `/ ___/ PLugin User's GHCi System, for Haskell 98 4 | / /_/ / / /_/ / /_/ (__ ) http://www.cse.unsw.edu.au/~dons/hs-plugins 5 | / .___/_/\__,_/\__, /____/ Type :? for help 6 | /_/ /____/ 7 | 8 | Loading package base ... linking ... plugs> plugs> done 9 | 453973694165307953197296969697410619233826 10 | -------------------------------------------------------------------------------- /testsuite/plugs/plugs/test.in: -------------------------------------------------------------------------------- 1 | let fibs = 1 : 1 : zipWith (+) fibs (tail fibs) in fibs !! 200 2 | :quit 3 | -------------------------------------------------------------------------------- /testsuite/plugs/runplugs/Main.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons 3 | -- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html) 4 | -- 5 | 6 | -- 7 | -- | Runplugs: use hs-plugins to run a Haskell expression under 8 | -- controlled conditions. 9 | -- 10 | import System.Eval.Haskell (unsafeEval) 11 | 12 | import Data.Char (chr) 13 | import Data.Maybe (isJust, fromJust) 14 | import Control.Monad 15 | 16 | import System.Random 17 | import System.Exit (exitWith, ExitCode(ExitSuccess)) 18 | import System.IO (getContents, putStrLn) 19 | import System.Posix.Resource (setResourceLimit, 20 | Resource(ResourceCPUTime), 21 | ResourceLimits(ResourceLimits), 22 | ResourceLimit(ResourceLimit)) 23 | 24 | import qualified Control.Exception (catch) 25 | 26 | rlimit = ResourceLimit 3 27 | 28 | context = prehier ++ datas ++ qualifieds ++ controls 29 | 30 | prehier = ["Char", "List", "Maybe", "Numeric", "Random" ] 31 | 32 | qualifieds = ["qualified Data.Map as M" 33 | ,"qualified Data.Set as S" 34 | ,"qualified Data.IntSet as I"] 35 | 36 | datas = map ("Data." ++) [ 37 | "Bits", "Bool", "Char", "Dynamic", "Either", 38 | "Graph", "Int", "Ix", "List", 39 | "Maybe", "Ratio", "Tree", "Tuple", "Typeable", "Word" 40 | ] 41 | 42 | controls = map ("Control." ++) ["Monad", "Monad.Reader", "Monad.Fix", "Arrow"] 43 | 44 | main = do 45 | setResourceLimit ResourceCPUTime (ResourceLimits rlimit rlimit) 46 | s <- getLine 47 | when (not . null $ s) $ do 48 | x <- sequence (take 3 (repeat $ getStdRandom (randomR (97,122)) >>= return . chr)) 49 | s <- unsafeEval ("let { "++x++ 50 | " = \n# 1 \"\"\n"++s++ 51 | "\n} in take 2048 (show "++x++ 52 | ")") context 53 | when (isJust s) $ Control.Exception.catch 54 | (putStrLn $ fromJust s) 55 | (\e -> putStrLn $ "Exception: " ++ show e ) 56 | exitWith ExitSuccess 57 | 58 | -------------------------------------------------------------------------------- /testsuite/plugs/runplugs/Makefile: -------------------------------------------------------------------------------- 1 | GHCFLAGS= -O0 $(GHC_EXTRA_OPTS) 2 | PKGFLAGS= -package posix 3 | PKGFLAGS+= -package plugins 4 | 5 | all: build 6 | 7 | build: 8 | @$(GHC) $(GHCFLAGS) $(PKGFLAGS) $(EXTRAFLAGS) Main.hs -o runplugs 9 | include ../../../config.mk 10 | check: build 11 | @(if [ -f "expected" ] ;\ 12 | then \ 13 | actual_out="/tmp/hs-plugins-actual.out.$$$$" ;\ 14 | diff_out="/tmp/hs-plugins.diff.$$$$" ;\ 15 | cat test.in | ./runplugs > $$actual_out 2>&1 || true ;\ 16 | diff -u expected $$actual_out > $$diff_out || true ;\ 17 | if [ -s "$$diff_out" ] ; then \ 18 | echo "failed with:" ;\ 19 | cat "$$diff_out" | sed '1,3d' ;\ 20 | else \ 21 | echo "ok." ;\ 22 | fi ;\ 23 | rm $$actual_out ;\ 24 | else \ 25 | cat test.in | ./runplugs 2>&1 || true ;\ 26 | fi) 27 | clean: 28 | rm -rf *.hi *.o *~ *.dep ./runplugs 29 | 30 | include ../../../config.mk 31 | -------------------------------------------------------------------------------- /testsuite/plugs/runplugs/expected: -------------------------------------------------------------------------------- 1 | 453973694165307953197296969697410619233826 2 | -------------------------------------------------------------------------------- /testsuite/plugs/runplugs/test.in: -------------------------------------------------------------------------------- 1 | let fibs = 1 : 1 : zipWith (+) fibs (tail fibs) in fibs !! 200 2 | -------------------------------------------------------------------------------- /testsuite/reload/null/Makefile: -------------------------------------------------------------------------------- 1 | TEST= reload/null 2 | EXTRA_OBJS=Null.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/reload/null/Null.hs: -------------------------------------------------------------------------------- 1 | module Null ( resource, resource_dyn ) where 2 | 3 | import API 4 | import Data.Dynamic 5 | import Prelude hiding (null) 6 | 7 | resource = null 8 | 9 | -- ! this has to be special: it can't be overridden by the user. 10 | resource_dyn :: Dynamic 11 | resource_dyn = toDyn resource 12 | -------------------------------------------------------------------------------- /testsuite/reload/null/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | import Data.Dynamic 6 | 7 | data Null = Null { a, b :: Int } 8 | deriving (Typeable, Show) 9 | 10 | null :: Null 11 | null = Null { a = 42 , b = 1 } 12 | 13 | -------------------------------------------------------------------------------- /testsuite/reload/null/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | -- an example where we just want to load an object and run it 6 | 7 | main = do 8 | m_v <- load "../Null.o" ["../api"] [] "resource" 9 | (m,v) <- case m_v of 10 | LoadSuccess m v -> return (m,v) 11 | _ -> error "load failed" 12 | putStrLn ( show (a v) ) 13 | 14 | m_v <- reload m "resource" -- get a new version 15 | v' <- case m_v of 16 | LoadSuccess _ v -> return v 17 | _ -> error "load failed" 18 | putStrLn ( show (a v') ) 19 | 20 | -------------------------------------------------------------------------------- /testsuite/reload/null/prog/expected: -------------------------------------------------------------------------------- 1 | 42 2 | 42 3 | -------------------------------------------------------------------------------- /testsuite/shell/shell/API.hs: -------------------------------------------------------------------------------- 1 | module API where 2 | 3 | -- the interface between the app and the plugin 4 | data Interface = Interface { function :: String -> String } 5 | 6 | -- default values for the interface 7 | plugin :: Interface 8 | plugin = Interface { function = id } 9 | -------------------------------------------------------------------------------- /testsuite/shell/shell/Main.hs: -------------------------------------------------------------------------------- 1 | -- 2 | -- a simple shell for loading plugins and evaluating their functions 3 | -- 4 | 5 | import System.Plugins 6 | import API 7 | 8 | import Data.Either 9 | import Data.Char 10 | import Control.Monad ( when ) 11 | import System.Console.Readline ( readline ) 12 | import System.Exit ( ExitCode(..), exitWith ) 13 | 14 | 15 | source = "Plugin.hs" 16 | stub = "Plugin.stub" 17 | 18 | sym = "resource" 19 | 20 | main = do 21 | status <- makeWith source stub [] 22 | p <- case status of 23 | MakeFailure e -> mapM_ putStrLn e >> error "failed to compile" 24 | MakeSuccess _ obj -> do 25 | m_v <- load obj ["."] [] sym 26 | case m_v of 27 | LoadSuccess m v -> return (m,v) 28 | LoadFailure e -> do mapM_ putStrLn e 29 | error "failed to load" 30 | shell p 31 | 32 | where 33 | shell p@(m,v) = do 34 | 35 | s <- readline "> " 36 | cmd <- case s of 37 | Nothing -> exitWith ExitSuccess 38 | Just ":q" -> exitWith ExitSuccess 39 | Just s -> return (chomp s) 40 | 41 | status <- makeWith source stub [] 42 | case status of 43 | MakeFailure e -> do 44 | mapM_ putStrLn e 45 | shell p -- print error and back to prompt 46 | 47 | MakeSuccess NotReq o -> do 48 | p' <- eval cmd p 49 | shell p' -- eval str again 50 | 51 | MakeSuccess ReComp o -> do 52 | m_v' <- reload m sym 53 | case m_v' of 54 | LoadFailure e -> mapM_ putStrLn e >> error "failed to load" 55 | LoadSuccess _ v' -> do 56 | let p' = (m,v') 57 | p'' <- eval cmd p' 58 | shell p'' 59 | 60 | -- 61 | -- shell commands 62 | -- 63 | eval "" p = return p 64 | 65 | eval ":clear" p = do 66 | let loop i = when (i < 40) (do putStr "\n" ; loop $! i+1) 67 | loop 0 68 | return p 69 | 70 | eval ":?" p = do 71 | putStrLn$"\":?\"\n" ++ 72 | "\":quit\"\n" ++ 73 | "\":clear\"\n" ++ 74 | "\"foo\"" 75 | return p 76 | 77 | eval s (m,v) = putStrLn ((function v) s) >> return (m,v) 78 | 79 | -- 80 | -- strip trailing whitespace 81 | -- 82 | chomp :: String -> String 83 | chomp [] = [] 84 | chomp s | isSpace (last s) = chomp $! init s 85 | | otherwise = s 86 | -------------------------------------------------------------------------------- /testsuite/shell/shell/Makefile: -------------------------------------------------------------------------------- 1 | TOP=../../.. 2 | include ../../eval.mk 3 | -------------------------------------------------------------------------------- /testsuite/shell/shell/Plugin.hs: -------------------------------------------------------------------------------- 1 | 2 | resource = plugin { 3 | function = map toUpper 4 | } 5 | 6 | -------------------------------------------------------------------------------- /testsuite/shell/shell/Plugin.stub: -------------------------------------------------------------------------------- 1 | -- 2 | -- this is a "stub" file, containing default syntax we don't 3 | -- want the user to have to write 4 | -- 5 | -- for example, it constrains the module name and force the API to be 6 | -- imported 7 | 8 | module Plugin ( resource ) where 9 | 10 | import API 11 | import Data.Char 12 | import Data.List 13 | 14 | -- this is a default definition of 'resource'. it will be overridden 15 | -- by anything the user writes. useful for default values 16 | 17 | resource :: Interface 18 | resource = plugin 19 | 20 | -------------------------------------------------------------------------------- /testsuite/shell/shell/README: -------------------------------------------------------------------------------- 1 | $ make 2 | $ ./a.out 3 | Compiling plugin ... done 4 | Loading package base ... linking ... done 5 | Loading objects API Plugin ... done 6 | > ? 7 | "?" 8 | "quit" 9 | "clear" 10 | "filter foo" 11 | > filter adf adsf 12 | fsda fda 13 | > filter asd faSDFADSF 14 | FSDAFDSaf dsa 15 | 16 | -- at this point I edit the plugin and save the source 17 | 18 | > filter asfdaSDFASD 19 | Compiling plugin ... done 20 | Reloading Plugin ... done 21 | DSAFDSADFSA 22 | 23 | -- it compiled and reloaded it for me. nice. 24 | -------------------------------------------------------------------------------- /testsuite/shell/shell/dont_test: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/shell/shell/dont_test -------------------------------------------------------------------------------- /testsuite/shell/simple/Main.hs: -------------------------------------------------------------------------------- 1 | import System.Plugins 2 | import StringProcessorAPI 3 | import System.Console.Readline 4 | import System.Exit 5 | 6 | source = "Plugin.hs" 7 | stub = "Plugin.stub" 8 | symbol = "resource" 9 | 10 | main = do s <- makeWith source stub [] 11 | o <- case s of 12 | MakeSuccess _ obj -> do 13 | ls <- load obj ["."] [] symbol 14 | case ls of LoadSuccess m v -> return (m,v) 15 | LoadFailure err -> error "load failed" 16 | MakeFailure e -> mapM_ putStrLn e >> error "compile failed" 17 | shell o 18 | 19 | shell o@(m,plugin) = do 20 | s <- readline "> " 21 | cmd <- case s of 22 | Nothing -> exitWith ExitSuccess 23 | Just (':':'q':_) -> exitWith ExitSuccess 24 | Just s -> addHistory s >> return s 25 | 26 | s <- makeWith source stub [] -- maybe recompile the source 27 | o' <- case s of 28 | MakeSuccess ReComp o -> do 29 | ls <- reload m symbol 30 | case ls of LoadSuccess m' v' -> return (m',v') 31 | LoadFailure err -> error "reload failed" 32 | MakeSuccess NotReq _ -> return o 33 | MakeFailure e -> mapM_ putStrLn e >> shell o 34 | eval cmd o' 35 | shell o' 36 | 37 | eval ":?" _ = putStrLn ":?\n:q\n" 38 | 39 | eval s (_,plugin) = let fn = (stringProcessor plugin) in putStrLn (fn s) 40 | 41 | 42 | -------------------------------------------------------------------------------- /testsuite/shell/simple/Makefile: -------------------------------------------------------------------------------- 1 | OBJS=StringProcessorAPI.o 2 | TOP=../../.. 3 | include ../../eval.mk 4 | 5 | #all: 6 | # @echo test disabled 7 | -------------------------------------------------------------------------------- /testsuite/shell/simple/Plugin.hs: -------------------------------------------------------------------------------- 1 | import Char 2 | 3 | resource = plugin { 4 | stringProcessor = map toUpper 5 | } 6 | -------------------------------------------------------------------------------- /testsuite/shell/simple/Plugin.stub: -------------------------------------------------------------------------------- 1 | -- 2 | -- this is a "stub" file, containing default syntax we don't 3 | -- want the user to have to write 4 | -- 5 | -- for example, it constrains the module name and force the API to be 6 | -- imported 7 | 8 | module Plugin ( resource ) where 9 | 10 | import StringProcessorAPI 11 | import Data.Char 12 | import Data.List 13 | 14 | -- this is a default definition of 'resource'. it will be overridden 15 | -- by anything the user writes. useful for default values 16 | 17 | resource :: Interface 18 | resource = plugin 19 | 20 | -------------------------------------------------------------------------------- /testsuite/shell/simple/README: -------------------------------------------------------------------------------- 1 | $ make 2 | $ ./a.out 3 | Compiling plugin ... done 4 | Loading package base ... linking ... done 5 | Loading objects API Plugin ... done 6 | > ? 7 | "?" 8 | "quit" 9 | "clear" 10 | "filter foo" 11 | > filter adf adsf 12 | fsda fda 13 | > filter asd faSDFADSF 14 | FSDAFDSaf dsa 15 | 16 | -- at this point I edit the plugin and save the source 17 | 18 | > filter asfdaSDFASD 19 | Compiling plugin ... done 20 | Reloading Plugin ... done 21 | DSAFDSADFSA 22 | 23 | -- it compiled and reloaded it for me. nice. 24 | -------------------------------------------------------------------------------- /testsuite/shell/simple/StringProcessorAPI.hs: -------------------------------------------------------------------------------- 1 | module StringProcessorAPI where 2 | 3 | data Interface = Interface { 4 | stringProcessor :: String -> String 5 | } 6 | 7 | plugin :: Interface 8 | plugin = Interface { stringProcessor = id } 9 | -------------------------------------------------------------------------------- /testsuite/shell/simple/dont_test: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stepcut/plugins/eaf90eeb3cb79e32a442776388f067754f513b5d/testsuite/shell/simple/dont_test -------------------------------------------------------------------------------- /testsuite/unload/null/Makefile: -------------------------------------------------------------------------------- 1 | TEST= unload/null 2 | EXTRA_OBJS=Null.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/unload/null/Null.hs: -------------------------------------------------------------------------------- 1 | module Null ( resource, resource_dyn ) where 2 | 3 | import API 4 | import Data.Dynamic 5 | import Prelude hiding (null) 6 | 7 | resource = null 8 | 9 | -- ! this has to be special: it can't be overridden by the user. 10 | resource_dyn :: Dynamic 11 | resource_dyn = toDyn resource 12 | -------------------------------------------------------------------------------- /testsuite/unload/null/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | import Data.Dynamic 6 | 7 | data Null = Null { a, b :: Int } 8 | deriving (Typeable, Show) 9 | 10 | null :: Null 11 | null = Null { a = 42 , b = 1 } 12 | 13 | -------------------------------------------------------------------------------- /testsuite/unload/null/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | -- an example where we just want to load an object and run it 6 | 7 | main = do 8 | m_v <- load "../Null.o" ["../api"] [] "resource" 9 | case m_v of 10 | LoadFailure _ -> error "load failed" 11 | LoadSuccess m v -> do putStrLn ( show (a v) ) ; unload m 12 | -------------------------------------------------------------------------------- /testsuite/unload/null/prog/expected: -------------------------------------------------------------------------------- 1 | 42 2 | -------------------------------------------------------------------------------- /testsuite/unload/sjwtrap/Makefile: -------------------------------------------------------------------------------- 1 | TEST= unload/sjwtrap 2 | EXTRA_OBJS=Null.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/unload/sjwtrap/Null.hs: -------------------------------------------------------------------------------- 1 | module Null where 2 | 3 | import qualified Prelude 4 | import API 5 | 6 | resource = null 7 | -------------------------------------------------------------------------------- /testsuite/unload/sjwtrap/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | data Null = Null { a, b :: Int } 6 | 7 | null :: Null 8 | null = Null { a = 42 , b = 1 } 9 | 10 | -------------------------------------------------------------------------------- /testsuite/unload/sjwtrap/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | -- 6 | -- what happens if we try to use code that has been unloaded? 7 | -- 8 | 9 | main = do 10 | m_v <- load "../Null.o" ["../api"] [] "resource" 11 | (m,v) <- case m_v of 12 | LoadSuccess m v -> return (m,v) 13 | _ -> error "load failed" 14 | putStrLn ( show (a v) ) 15 | unload m 16 | -------------------------------------------------------------------------------- /testsuite/unload/sjwtrap/prog/expected: -------------------------------------------------------------------------------- 1 | 42 2 | -------------------------------------------------------------------------------- /testsuite/unloadAll/null/Dep.hs: -------------------------------------------------------------------------------- 1 | module Dep ( resource ) where 2 | 3 | import API 4 | import Data.Dynamic 5 | import Prelude hiding (null) 6 | 7 | resource = null 8 | -------------------------------------------------------------------------------- /testsuite/unloadAll/null/Makefile: -------------------------------------------------------------------------------- 1 | TEST= unloadAll/null 2 | EXTRA_OBJS=Dep.o Null.o 3 | TOP=../../.. 4 | include ../../build.mk 5 | -------------------------------------------------------------------------------- /testsuite/unloadAll/null/Null.hs: -------------------------------------------------------------------------------- 1 | module Null ( resource ) where 2 | 3 | import API 4 | import Data.Dynamic 5 | import Prelude hiding (null) 6 | import qualified Dep 7 | 8 | resource = Dep.resource 9 | 10 | -- ! this has to be special: it can't be overridden by the user. 11 | resource_dyn :: Dynamic 12 | resource_dyn = toDyn resource 13 | -------------------------------------------------------------------------------- /testsuite/unloadAll/null/api/API.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fglasgow-exts #-} 2 | 3 | module API where 4 | 5 | import Data.Dynamic 6 | 7 | data Null = Null { a, b :: Int } 8 | deriving (Typeable, Show) 9 | 10 | null :: Null 11 | null = Null { a = 42 , b = 1 } 12 | 13 | -------------------------------------------------------------------------------- /testsuite/unloadAll/null/prog/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Plugins 3 | import API 4 | 5 | -- an example where we just want to load an object and run it 6 | 7 | main = do 8 | m_v <- load_ "../Null.o" ["../api",".."] "resource" 9 | t <- load_ "../Dep.o" ["../api"] "resource" 10 | case m_v of 11 | LoadFailure err -> error (unlines err) 12 | LoadSuccess m v -> do putStrLn ( show (a v) ) ; unloadAll m -- unloads Null.o but not Dep.o since we're still using it. 13 | case t of 14 | LoadFailure err -> error (unlines err) 15 | LoadSuccess m v -> do putStrLn ( show (a v) ) ; unloadAll m 16 | -------------------------------------------------------------------------------- /testsuite/unloadAll/null/prog/expected: -------------------------------------------------------------------------------- 1 | 42 2 | 42 3 | --------------------------------------------------------------------------------