From 5a2b43a4e3929d1cfb94bfcc37a3653280792d9c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fredrik=20H=C3=BCbinette=20=28Hubbe=29?= <hubbe@hubbe.net>
Date: Sun, 22 Nov 1998 05:02:08 -0800
Subject: [PATCH] some bugs fixed..
Rev: src/modules/Perl/.cvsignore:1.2
Rev: src/modules/Perl/Makefile.in:1.2
Rev: src/modules/Perl/acconfig.h:1.1
Rev: src/modules/Perl/configure.in:1.2
Rev: src/modules/Perl/perlmod.c:1.2
Rev: src/modules/Perl/testsuite.in:1.2
---
.gitattributes | 1 +
src/modules/Perl/.cvsignore | 3 +++
src/modules/Perl/.gitignore | 3 +++
src/modules/Perl/Makefile.in | 4 +--
src/modules/Perl/acconfig.h | 14 ++++++++++
src/modules/Perl/configure.in | 13 +++++++++-
src/modules/Perl/perlmod.c | 49 ++++++++++++++++++++++++++---------
src/modules/Perl/testsuite.in | 2 +-
8 files changed, 73 insertions(+), 16 deletions(-)
create mode 100644 src/modules/Perl/acconfig.h
diff --git a/.gitattributes b/.gitattributes
index 997a5d7b9a..2b2b6b1593 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -222,6 +222,7 @@ testfont binary
/src/modules/Oracle/configure.in foreign_ident
/src/modules/Oracle/oracle.c foreign_ident
/src/modules/Perl/Makefile.in foreign_ident
+/src/modules/Perl/acconfig.h foreign_ident
/src/modules/Perl/configure.in foreign_ident
/src/modules/Pipe/Makefile.in foreign_ident
/src/modules/Pipe/acconfig.h foreign_ident
diff --git a/src/modules/Perl/.cvsignore b/src/modules/Perl/.cvsignore
index 9b21632dac..6142494382 100644
--- a/src/modules/Perl/.cvsignore
+++ b/src/modules/Perl/.cvsignore
@@ -9,3 +9,6 @@ modlist_headers
modlist_segment
module_testsuite
stamp-h
+stamp-h.in
+perl_machine.h
+perl_machine.h.in
diff --git a/src/modules/Perl/.gitignore b/src/modules/Perl/.gitignore
index 3bbebf2696..fd1eed75b8 100644
--- a/src/modules/Perl/.gitignore
+++ b/src/modules/Perl/.gitignore
@@ -9,3 +9,6 @@
/modlist_segment
/module_testsuite
/stamp-h
+/stamp-h.in
+/perl_machine.h
+/perl_machine.h.in
diff --git a/src/modules/Perl/Makefile.in b/src/modules/Perl/Makefile.in
index 4b24b88602..c2d52c5dde 100644
--- a/src/modules/Perl/Makefile.in
+++ b/src/modules/Perl/Makefile.in
@@ -1,8 +1,8 @@
-# $Id: Makefile.in,v 1.1 1998/11/22 11:05:03 hubbe Exp $
+# $Id: Makefile.in,v 1.2 1998/11/22 13:02:05 hubbe Exp $
SRCDIR=@srcdir@
VPATH=@srcdir@:@srcdir@/../..:../..
MODULE_LDFLAGS=@LDFLAGS@ @LIBS@ @PERL_LDFLAGS@
-OBJS=perlmod.o perlxsi.o
+OBJS=perlmod.o @extra_objs@
PERL=@perl@
MODULE_CFLAGS=@PERL_CCFLAGS@
diff --git a/src/modules/Perl/acconfig.h b/src/modules/Perl/acconfig.h
new file mode 100644
index 0000000000..bfa0b386df
--- /dev/null
+++ b/src/modules/Perl/acconfig.h
@@ -0,0 +1,14 @@
+/*
+ * $Id: acconfig.h,v 1.1 1998/11/22 13:02:06 hubbe Exp $
+ */
+
+#ifndef GMP_MACHINE_H
+#define GMP_MACHINE_H
+
+@TOP@
+@BOTTOM@
+
+/* Define this if you have an embeddable perl */
+#undef HAVE_PERL
+
+#endif
diff --git a/src/modules/Perl/configure.in b/src/modules/Perl/configure.in
index 7c61d38091..7f640fd4bc 100644
--- a/src/modules/Perl/configure.in
+++ b/src/modules/Perl/configure.in
@@ -1,10 +1,13 @@
-# $Id: configure.in,v 1.1 1998/11/22 11:05:04 hubbe Exp $
+# $Id: configure.in,v 1.2 1998/11/22 13:02:06 hubbe Exp $
AC_INIT(perlmod.c)
+AC_CONFIG_HEADER(perl_machine.h)
AC_MODULE_INIT()
AC_CHECK_PROGS(perl, perl perl5, x)
+objs=
+
if test x$perl != xx ; then
# We have perl, but do we have perlembed?
# PERL_LDFLAGS=`perl -V:lddlflags | sed "s/^lddlflags='\(.*\);$/\1/"`
@@ -12,11 +15,19 @@ if test x$perl != xx ; then
PERL_LDFLAGS=`perl -MExtUtils::Embed -e ldopts`
PERL_CCFLAGS=`perl -MExtUtils::Embed -e ccopts`
+
+ if test "x$PERL_LDFLAGS$PERL_CCFLAGS" != x; then
+ extra_objs='perlxsi.o'
+ AC_DEFINE(HAVE_PERL)
+ fi
fi
AC_SUBST(perl)
+AC_SUBST(extra_objs)
AC_SUBST(PERL_LDFLAGS)
AC_SUBST(PERL_CCFLAGS)
+
+
AC_OUTPUT(Makefile,echo FOO >stamp-h )
diff --git a/src/modules/Perl/perlmod.c b/src/modules/Perl/perlmod.c
index da42897d58..9a936caabe 100644
--- a/src/modules/Perl/perlmod.c
+++ b/src/modules/Perl/perlmod.c
@@ -6,6 +6,9 @@
#include <module_support.h>
#include <threads.h>
#include <mapping.h>
+#include <perl_machine.h>
+
+#ifdef HAVE_PERL
#include <EXTERN.h>
#include <perl.h>
@@ -23,6 +26,7 @@ struct perlmod_storage
char **env;
char *env_block;
struct array *argv_strings;
+ int parsed;
PerlInterpreter *my_perl;
};
@@ -36,6 +40,7 @@ static void init_perl_glue(struct object *o)
THIS->env=0;
THIS->env_block=0;
THIS->argv_strings=0;
+ THIS->parsed=0;
#ifndef MULTIPLICITY
if(num_perl_interpreters>0)
@@ -49,7 +54,6 @@ static void init_perl_glue(struct object *o)
THREADS_ALLOW();
mt_lock(&perl_running);
p=perl_alloc();
- if(p) perl_construct(p);
mt_unlock(&perl_running);
THREADS_DISALLOW();
PERL=p;
@@ -60,11 +64,16 @@ static void exit_perl_glue(struct object *o)
{
if(PERL)
{
- PerlInterpreter *p=PERL;
+ struct perlmod_storage *storage=THIS;
+
THREADS_ALLOW();
mt_lock(&perl_running);
- perl_destruct(p);
- perl_free(p);
+ if(storage->parsed)
+ {
+ perl_destruct(storage->my_perl);
+ storage->parsed=0;
+ }
+ perl_free(storage->my_perl);
mt_unlock(&perl_running);
THREADS_DISALLOW();
num_perl_interpreters--;
@@ -98,6 +107,9 @@ static void perlmod_run(INT32 args)
if(!p) error("No perl interpreter available.\n");
pop_n_elems(args);
+ if(!THIS->argv_strings)
+ error("Perl->create() must be called first.\n");
+
THREADS_ALLOW();
mt_lock(&perl_running);
i=perl_run(p);
@@ -106,7 +118,7 @@ static void perlmod_run(INT32 args)
push_int(i);
}
-static void perlmod_parse(INT32 args)
+static void perlmod_create(INT32 args)
{
extern void xs_init(void);
int e;
@@ -114,11 +126,11 @@ static void perlmod_parse(INT32 args)
PerlInterpreter *p=PERL;
struct perlmod_storage *storage=THIS;
- check_all_args("Perl->parse",args,BIT_ARRAY, BIT_MAPPING|BIT_VOID, 0);
+ check_all_args("Perl->create",args,BIT_ARRAY, BIT_MAPPING|BIT_VOID, 0);
if(!p) error("No perl interpreter available.\n");
if(THIS->argv_strings)
- error("Perl->parse() can only be called once.\n");
+ error("Perl->create() can only be called once.\n");
switch(args)
{
@@ -127,17 +139,20 @@ static void perlmod_parse(INT32 args)
mapping_fix_type_field(env_mapping);
if(m_ind_types(env_mapping) & ~BIT_STRING)
- error("Bad argument 2 to Perl->parse().\n");
+ error("Bad argument 2 to Perl->create().\n");
if(m_val_types(env_mapping) & ~BIT_STRING)
- error("Bad argument 2 to Perl->parse().\n");
+ error("Bad argument 2 to Perl->create().\n");
case 1:
THIS->argv_strings=sp[-args].u.array;
add_ref(THIS->argv_strings);
array_fix_type_field(THIS->argv_strings);
+ if(THIS->argv_strings->size<2)
+ error("Perl: Too few elements in argv array.\n");
+
if(THIS->argv_strings->type_field & ~BIT_STRING)
- error("Bad argument 2 to Perl->parse().\n");
+ error("Bad argument 2 to Perl->create().\n");
}
THIS->argv=(char **)xalloc(sizeof(char *)*THIS->argv_strings->size);
@@ -176,6 +191,11 @@ static void perlmod_parse(INT32 args)
THREADS_ALLOW();
mt_lock(&perl_running);
+ if(!storage->parsed)
+ {
+ perl_construct(p);
+ storage->parsed++;
+ }
e=perl_parse(p,
xs_init,
storage->argv_strings->size,
@@ -199,10 +219,10 @@ static void perlmod_call(INT32 args)
void pike_module_init(void)
{
- perl_destruct_level=1;
+ perl_destruct_level=2;
start_new_program();
add_storage(sizeof(struct perlmod_storage));
- add_function("parse",perlmod_parse,"function(array(string),void|mapping(string:string):int)",0);
+ add_function("create",perlmod_create,"function(array(string),void|mapping(string:string):int)",0);
add_function("run",perlmod_run,"function(:int)",0);
add_function("eval",perlmod_eval,"function(string:int)",0);
add_function("call",perlmod_call,"function(string,mixed...:int)",0);
@@ -222,3 +242,8 @@ void pike_module_init(void)
void pike_module_exit(void)
{
}
+
+#else /* HAVE_PERL */
+void pike_module_init(void) {}
+void pike_module_exit(void) {}
+#endif
diff --git a/src/modules/Perl/testsuite.in b/src/modules/Perl/testsuite.in
index c09d3ac019..6e3606c5ca 100644
--- a/src/modules/Perl/testsuite.in
+++ b/src/modules/Perl/testsuite.in
@@ -1,5 +1,5 @@
cond( [[ master()->resolv("Perl")->Perl ]],
[[
test_true(Perl.Perl)
- test_true(Perl.Perl())
+ test_true(Perl.Perl( ({"perl","-e","exit 1"}) )->run())
]])
--
GitLab