This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix up faulty perl embeddings
authorZefram <zefram@fysh.org>
Thu, 21 Dec 2017 05:40:49 +0000 (05:40 +0000)
committerZefram <zefram@fysh.org>
Thu, 21 Dec 2017 05:47:52 +0000 (05:47 +0000)
Some platform-specific embeddings of perl were misusing the
return values from perl_parse() and perl_run(), in some cases
causing failure due to exit(0) combined with the recent changes
in commit 0301e899536a22752f40481d8a1d141b7a7dda82.  Commit
d4a50999a5525c2681d59cae5fcd94f94ff897fd partially fixed a Windows
embedding.  More fully fix that, along with NetWare and OS/2.  Even in
embeddings with correct logic, stop using a variable named "exitstatus"
to hold the result of perl_parse() or perl_run(), to avoid misleading
people who copy the code.

NetWare/interface.c
NetWare/interface.cpp
NetWare/interface.h
NetWare/iperlhost.h
ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm
miniperlmain.c
os2/perlrexx.c
pod/perlinterp.pod
win32/perllib.c

index 29a8dc0..1d29885 100644 (file)
@@ -78,10 +78,10 @@ ClsPerlHost::PerlRun(PerlInterpreter *my_perl)
        return(perl_run(my_perl));      // Run Perl.
 }
 
-void
+int
 ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)
 {
-       perl_destruct(my_perl);         // Destructor for Perl.
+       return(perl_destruct(my_perl));         // Destructor for Perl.
 }
 
 void
@@ -148,19 +148,18 @@ int RunPerl(int argc, char **argv, char **env)
        {
                PL_perl_destruct_level = 0;
 
-               exitstatus = nlm.PerlParse(my_perl, argc, argv, env);
-               if(exitstatus == 0)
+               if(!nlm.PerlParse(my_perl, argc, argv, env))
                {
                        #if defined(TOP_CLONE) && defined(USE_ITHREADS)         // XXXXXX testing
                                new_perl = perl_clone(my_perl, 1);
 
-                               exitstatus = perl_run(new_perl);        // Run Perl.
+                               (void) perl_run(new_perl);      // Run Perl.
                                PERL_SET_THX(my_perl);
                        #else
-                               exitstatus = nlm.PerlRun(my_perl);
+                               (void) nlm.PerlRun(my_perl);
                        #endif
                }
-               nlm.PerlDestroy(my_perl);
+               exitstatus = nlm.PerlDestroy(my_perl);
        }
        if(my_perl)
                nlm.PerlFree(my_perl);
@@ -169,7 +168,7 @@ int RunPerl(int argc, char **argv, char **env)
                if (new_perl)
                {
                        PERL_SET_THX(new_perl);
-                       nlm.PerlDestroy(new_perl);
+                       exitstatus = nlm.PerlDestroy(new_perl);
                        nlm.PerlFree(my_perl);
                }
        #endif
index aef71f9..b08d6c2 100644 (file)
@@ -69,11 +69,12 @@ ClsPerlHost::PerlRun(PerlInterpreter *my_perl)
        return(perl_run(my_perl));      // Run Perl.
 }
 
-void
+int
 ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)
 {
-       perl_destruct(my_perl);         // Destructor for Perl.
+       int ret = perl_destruct(my_perl);               // Destructor for Perl.
 ////   perl_free(my_perl);                     // Free the memory allocated for Perl.
+       return(ret);
 }
 
 void
@@ -142,8 +143,7 @@ int RunPerl(int argc, char **argv, char **env)
        {
                PL_perl_destruct_level = 0;
 
-               exitstatus = nlm.PerlParse(my_perl, argc, argv, env);
-               if(exitstatus == 0)
+               if(!nlm.PerlParse(my_perl, argc, argv, env))
                {
                        #if defined(TOP_CLONE) && defined(USE_ITHREADS)         // XXXXXX testing
                                #  ifdef PERL_OBJECT
@@ -164,13 +164,13 @@ int RunPerl(int argc, char **argv, char **env)
                                        new_perl = perl_clone(my_perl, 1);
                                #  endif
 
-                               exitstatus = perl_run(new_perl);        // Run Perl.
+                               (void) perl_run(new_perl);      // Run Perl.
                                PERL_SET_THX(my_perl);
                        #else
-                               exitstatus = nlm.PerlRun(my_perl);
+                               (void) nlm.PerlRun(my_perl);
                        #endif
                }
-               nlm.PerlDestroy(my_perl);
+               exitstatus = nlm.PerlDestroy(my_perl);
        }
        if(my_perl)
                nlm.PerlFree(my_perl);
@@ -179,7 +179,7 @@ int RunPerl(int argc, char **argv, char **env)
                if (new_perl)
                {
                        PERL_SET_THX(new_perl);
-                       nlm.PerlDestroy(new_perl);
+                       exitstatus = nlm.PerlDestroy(new_perl);
                        nlm.PerlFree(my_perl);
                }
        #endif
index 9897993..2c9d46d 100644 (file)
@@ -35,7 +35,7 @@ public:
        int PerlCreate(PerlInterpreter *my_perl);
        int PerlParse(PerlInterpreter *my_perl, int argc, char** argv, char** env);
        int PerlRun(PerlInterpreter *my_perl);
-       void PerlDestroy(PerlInterpreter *my_perl);
+       int PerlDestroy(PerlInterpreter *my_perl);
        void PerlFree(PerlInterpreter *my_perl);
 
        //bool RegisterWithThreadTable(void);
index cc1754a..fe3dab7 100644 (file)
@@ -33,7 +33,7 @@ public:
        virtual int PerlCreate(PerlInterpreter *my_perl) = 0;
        virtual int PerlParse(PerlInterpreter *my_perl,int argc, char** argv, char** env) = 0;
        virtual int PerlRun(PerlInterpreter *my_perl) = 0;
-       virtual void PerlDestroy(PerlInterpreter *my_perl) = 0;
+       virtual int PerlDestroy(PerlInterpreter *my_perl) = 0;
        virtual void PerlFree(PerlInterpreter *my_perl) = 0;
 
        //virtual bool RegisterWithThreadTable(void)=0;
index fec33a4..6090970 100644 (file)
@@ -6,7 +6,7 @@ use ExtUtils::Embed 1.31, qw(xsi_header xsi_protos xsi_body);
 
 our @ISA = qw(Exporter);
 our @EXPORT = qw(writemain);
-our $VERSION = '1.07';
+our $VERSION = '1.08';
 
 # blead will run this with miniperl, hence we can't use autodie or File::Temp
 my $temp;
@@ -151,8 +151,7 @@ main(int argc, char **argv, char **env)
        PL_perl_destruct_level = 0;
     }
     PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
-    exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
-    if (!exitstatus)
+    if (!perl_parse(my_perl, xs_init, argc, argv, (char **)NULL))
         perl_run(my_perl);
 
 #ifndef PERL_MICRO
index a79099b..c885e0e 100644 (file)
@@ -124,8 +124,7 @@ main(int argc, char **argv, char **env)
        PL_perl_destruct_level = 0;
     }
     PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
-    exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
-    if (!exitstatus)
+    if (!perl_parse(my_perl, xs_init, argc, argv, (char **)NULL))
         perl_run(my_perl);
 
 #ifndef PERL_MICRO
index 98a5502..18d6551 100644 (file)
@@ -61,7 +61,6 @@ init_perlos2(void)
 static int
 init_perl(int doparse)
 {
-    int exitstatus;
     char *argv[3] = {"perl_in_REXX", "-e", ""};
 
     if (!perlos2_is_inited) {
@@ -79,8 +78,7 @@ init_perl(int doparse)
     }
     if (!doparse)
         return 1;
-    exitstatus = perl_parse(my_perl, xs_init, 3, argv, (char **)NULL);
-    return !exitstatus;
+    return !perl_parse(my_perl, xs_init, 3, argv, (char **)NULL);
 }
 
 static char last_error[4096];
@@ -125,12 +123,10 @@ ULONG PERL (PCSZ name, LONG rargc, const RXSTRING *rargv,
     memcpy(buf, rargv[0].strptr, rargv[0].strlength);
     buf[rargv[0].strlength] = 0;
     
-    exitstatus = perl_parse(my_perl, xs_init, 3, argv, (char **)NULL);
-    if (!exitstatus) {
-       exitstatus = perl_run(my_perl);
-    }
+    if (!perl_parse(my_perl, xs_init, 3, argv, (char **)NULL))
+       perl_run(my_perl);
 
-    perl_destruct(my_perl);
+    exitstatus = perl_destruct(my_perl);
     perl_free(my_perl);
     my_perl = 0;
 
index e1af333..7ac6c9e 100644 (file)
@@ -70,8 +70,7 @@ needs, the stacks, and so on.
 
 Now we pass Perl the command line options, and tell it to go:
 
- exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
- if (!exitstatus)
+ if (!perl_parse(my_perl, xs_init, argc, argv, (char **)NULL))
      perl_run(my_perl);
 
  exitstatus = perl_destruct(my_perl);
index 8a6626f..246f67a 100644 (file)
@@ -242,14 +242,13 @@ RunPerl(int argc, char **argv, char **env)
     if (use_environ)
         env = environ;
 
-    exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
-    if (!exitstatus) {
+    if (!perl_parse(my_perl, xs_init, argc, argv, env)) {
 #if defined(TOP_CLONE) && defined(USE_ITHREADS)                /* XXXXXX testing */
        new_perl = perl_clone(my_perl, 1);
-       exitstatus = perl_run(new_perl);
+       (void) perl_run(new_perl);
        PERL_SET_THX(my_perl);
 #else
-       exitstatus = perl_run(my_perl);
+       (void) perl_run(my_perl);
 #endif
     }
 
@@ -258,7 +257,7 @@ RunPerl(int argc, char **argv, char **env)
 #ifdef USE_ITHREADS
     if (new_perl) {
        PERL_SET_THX(new_perl);
-       perl_destruct(new_perl);
+       exitstatus = perl_destruct(new_perl);
        perl_free(new_perl);
     }
 #endif