Extract code into a function

This creates a function in toke.c to output the compilation aborted
message, changing perl.c to call that function.  This is in preparation
for this to be called from a 2nd place

diff --git a/embed.fnc b/embed.fnc
index 2ce7274..c1fa1f5 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1877,6 +1877,7 @@ inR       |bool   |should_warn_nl|NN const char *pv
 p      |void   |write_to_stderr|NN SV* msv
 : Used in op.c
 p      |int    |yyerror        |NN const char *const s
+p      |void   |abort_execution|NN const char * const msg|NN const char * const name
 p      |int    |yyerror_pv     |NN const char *const s|U32 flags
 p      |int    |yyerror_pvn    |NN const char *const s|STRLEN len|U32 flags
 : Used in perly.y, and by Data::Alias

diff --git a/embed.h b/embed.h
index ce7b9c6..89a5fd9 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1164,6 +1164,7 @@
 #ifdef PERL_CORE
 #define Slab_Alloc(a)          Perl_Slab_Alloc(aTHX_ a)
 #define Slab_Free(a)           Perl_Slab_Free(aTHX_ a)
+#define abort_execution(a,b)   Perl_abort_execution(aTHX_ a,b)
 #define alloc_LOGOP(a,b,c)     Perl_alloc_LOGOP(aTHX_ a,b,c)
 #define allocmy(a,b,c)         Perl_allocmy(aTHX_ a,b,c)
 #define amagic_is_enabled(a)   Perl_amagic_is_enabled(aTHX_ a)

diff --git a/perl.c b/perl.c
index 09eb2f4..98bf356 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2374,12 +2374,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 
     SETERRNO(0,SS_NORMAL);
     if (yyparse(GRAMPROG) || PL_parser->error_count) {
-       if (PL_minus_c)
-           Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename);
-       else {
-           Perl_croak(aTHX_ "Execution of %s aborted due to compilation errors.\n",
-                      PL_origfilename);
-       }
+        abort_execution("", PL_origfilename);
     }
     CopLINE_set(PL_curcop, 0);
     SET_CURSTASH(PL_defstash);

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index b6de3c7..99da61e 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2193,7 +2193,7 @@ variable and glob that.
 (F) The C<exec> function is not implemented on some systems, e.g., Symbian
 OS.  See L<perlport>.
 
-=item Execution of %s aborted due to compilation errors.
+=item %sExecution of %s aborted due to compilation errors.
 
 (F) The final summary message when a Perl compilation fails.
 

diff --git a/proto.h b/proto.h
index 076df94..7a74c8f 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -115,6 +115,9 @@ PERL_CALLCONV UV    Perl__to_utf8_upper_flags(pTHX_ const U8 *p, const U8 *e, U8* u
 #define PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS  \
        assert(p); assert(ustrp); assert(file)
 PERL_CALLCONV void     Perl__warn_problematic_locale(void);
+PERL_CALLCONV void     Perl_abort_execution(pTHX_ const char * const msg, const char * const name);
+#define PERL_ARGS_ASSERT_ABORT_EXECUTION       \
+       assert(msg); assert(name)
 PERL_CALLCONV LOGOP*   Perl_alloc_LOGOP(pTHX_ I32 type, OP *first, OP *other);
 PERL_CALLCONV PADOFFSET        Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags);
 #define PERL_ARGS_ASSERT_ALLOCMY       \

diff --git a/toke.c b/toke.c
index a252c75..a825f6a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -11450,6 +11450,20 @@ S_yywarn(pTHX_ const char *const s, U32 flags)
     return 0;
 }
 
+void
+Perl_abort_execution(pTHX_ const char * const msg, const char * const name)
+{
+    PERL_ARGS_ASSERT_ABORT_EXECUTION;
+
+    if (PL_minus_c)
+        Perl_croak(aTHX_ "%s%s had compilation errors.\n", msg, name);
+    else {
+        Perl_croak(aTHX_
+                "%sExecution of %s aborted due to compilation errors.\n", msg, name);
+    }
+    NOT_REACHED; /* NOTREACHED */
+}
+
 int
 Perl_yyerror(pTHX_ const char *const s)
 {