texinfo-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

branch master updated: * tp/Texinfo/Document.pm (%XS_overrides, errors),


From: Patrice Dumas
Subject: branch master updated: * tp/Texinfo/Document.pm (%XS_overrides, errors), tp/Texinfo/XS/main/DocumentXS.xs (document_errors), tp/Texinfo/XS/main/build_perl_info.c (add_formatted_error_messages) (pass_errors_to_registrar): override directly Texinfo::Document::errors. Rename pass_converter_errors as add_formatted_error_messages and return error_nrs and errors_warnings Perl references too.
Date: Thu, 07 Mar 2024 12:36:17 -0500

This is an automated email from the git hooks/post-receive script.

pertusus pushed a commit to branch master
in repository texinfo.

The following commit(s) were added to refs/heads/master by this push:
     new 922ad48399 * tp/Texinfo/Document.pm (%XS_overrides, errors), 
tp/Texinfo/XS/main/DocumentXS.xs (document_errors), 
tp/Texinfo/XS/main/build_perl_info.c (add_formatted_error_messages) 
(pass_errors_to_registrar): override directly Texinfo::Document::errors.  
Rename pass_converter_errors as add_formatted_error_messages and return 
error_nrs and errors_warnings Perl references too.
922ad48399 is described below

commit 922ad4839991d506d5b99c2ead9142296be8a432
Author: Patrice Dumas <pertusus@free.fr>
AuthorDate: Thu Mar 7 18:36:15 2024 +0100

    * tp/Texinfo/Document.pm (%XS_overrides, errors),
    tp/Texinfo/XS/main/DocumentXS.xs (document_errors),
    tp/Texinfo/XS/main/build_perl_info.c (add_formatted_error_messages)
    (pass_errors_to_registrar): override directly
    Texinfo::Document::errors.  Rename pass_converter_errors as
    add_formatted_error_messages and return error_nrs and errors_warnings
    Perl references too.
---
 ChangeLog                            |  10 +++
 tp/Texinfo/Document.pm               |  22 ++-----
 tp/Texinfo/XS/main/DocumentXS.xs     |  32 +++++++++-
 tp/Texinfo/XS/main/build_perl_info.c | 117 ++++++++++++++++++++++++++---------
 tp/Texinfo/XS/main/build_perl_info.h |   3 +
 5 files changed, 135 insertions(+), 49 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 806e0633ee..f8c73ac9e8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2024-03-07  Patrice Dumas  <pertusus@free.fr>
+
+       * tp/Texinfo/Document.pm (%XS_overrides, errors),
+       tp/Texinfo/XS/main/DocumentXS.xs (document_errors),
+       tp/Texinfo/XS/main/build_perl_info.c (add_formatted_error_messages)
+       (pass_errors_to_registrar): override directly
+       Texinfo::Document::errors.  Rename pass_converter_errors as
+       add_formatted_error_messages and return error_nrs and errors_warnings
+       Perl references too.
+
 2024-03-07  Patrice Dumas  <pertusus@free.fr>
 
        * tp/Texinfo/ParserNonXS.pm (_end_line_starting_block),
diff --git a/tp/Texinfo/Document.pm b/tp/Texinfo/Document.pm
index dc0e4e3a51..1ed2f2e86b 100644
--- a/tp/Texinfo/Document.pm
+++ b/tp/Texinfo/Document.pm
@@ -50,10 +50,10 @@ my $XS_structuring = ($XS_parser
 our %XS_overrides = (
   "Texinfo::Document::remove_document"
     => "Texinfo::DocumentXS::remove_document",
-  "Texinfo::Document::_XS_pass_document_errors"
-    => "Texinfo::DocumentXS::pass_document_errors",
   "Texinfo::Document::_XS_set_document_global_info",
     => "Texinfo::DocumentXS::set_document_global_info",
+  "Texinfo::Document::errors"
+    => "Texinfo::DocumentXS::document_errors",
 );
 
 # needed by structure code
@@ -433,14 +433,8 @@ sub rebuild_tree($;$)
   return $tree;
 }
 
-# this method does nothing, but the XS override pass the document errors
-sub _XS_pass_document_errors($)
-{
-}
-
-
-# Note that if XS code was not used, all the errors should already be
-# registered in the document registrar.
+# The XS override pass C error messages to the document registrar and destroys
+# C associated data.
 sub errors($)
 {
   my $document = shift;
@@ -448,14 +442,6 @@ sub errors($)
   my $registrar = $document->{'registrar'};
   return if !defined($registrar);
 
-  # get errors from XS data
-  my $XS_document_errors = _XS_pass_document_errors($document);
-  if ($XS_document_errors) {
-    foreach my $error (@{$XS_document_errors}) {
-      $registrar->add_formatted_message($error);
-    }
-  }
-
   return $registrar->errors();
 }
 
diff --git a/tp/Texinfo/XS/main/DocumentXS.xs b/tp/Texinfo/XS/main/DocumentXS.xs
index 2d62d4afc1..bcebf3fd00 100644
--- a/tp/Texinfo/XS/main/DocumentXS.xs
+++ b/tp/Texinfo/XS/main/DocumentXS.xs
@@ -102,6 +102,7 @@ remove_document (SV *document_in)
         if (document)
           remove_document_descriptor (document->descriptor);
 
+# Currently unused
 SV *
 pass_document_errors (SV *document_in)
     PREINIT:
@@ -119,7 +120,34 @@ pass_document_errors (SV *document_in)
         RETVAL
 
 void
-clear_document_errors (int document_descriptor)
+document_errors (SV *document_in)
+    PREINIT:
+        DOCUMENT *document = 0;
+        SV *errors_warnings_sv = 0;
+        SV *error_nrs_sv = 0;
+        ERROR_MESSAGE_LIST *error_messages = 0;
+     PPCODE:
+        document = get_sv_document_document (document_in, 0);
+        if (document)
+          error_messages = document->error_messages;
+
+        pass_errors_to_registrar (error_messages, document_in,
+                                  &errors_warnings_sv,
+                                  &error_nrs_sv);
+
+        if (!errors_warnings_sv)
+          errors_warnings_sv = newSV (0);
+        else
+          SvREFCNT_inc (errors_warnings_sv);
+        if (!error_nrs_sv)
+          error_nrs_sv = newSV (0);
+        else
+          SvREFCNT_inc (error_nrs_sv);
+
+        EXTEND(SP, 2);
+        PUSHs(sv_2mortal(errors_warnings_sv));
+        PUSHs(sv_2mortal(error_nrs_sv));
+
 
 void
 set_document_options (SV *sv_options_in, SV *document_in)
@@ -256,7 +284,7 @@ gdt (string, ...)
                    SV *value = hv_iternextsv(hv_replaced_substrings,
                                              &key, &retlen);
                    DOCUMENT *document = get_sv_tree_document (value, 0);
-                   /* TODO should warn/error if not found or return 
+                   /* TODO should warn/error if not found or return
                       a list of missing string identifiers?  Or check
                       in caller?  In any case, it cannot be good to
                       ignore a replaced substring */
diff --git a/tp/Texinfo/XS/main/build_perl_info.c 
b/tp/Texinfo/XS/main/build_perl_info.c
index 6dc1899ced..04d8dbf9d6 100644
--- a/tp/Texinfo/XS/main/build_perl_info.c
+++ b/tp/Texinfo/XS/main/build_perl_info.c
@@ -1185,7 +1185,7 @@ convert_error (ERROR_MESSAGE e)
 
 /* Errors */
 AV *
-build_errors (ERROR_MESSAGE* error_list, size_t error_number)
+build_errors (ERROR_MESSAGE *error_list, size_t error_number)
 {
   AV *av;
   int i;
@@ -1227,6 +1227,7 @@ pass_document_parser_errors (size_t document_descriptor)
 }
 
 /* build perl errors list and clear XS document errors */
+/* Currently unused */
 SV *
 pass_document_errors (size_t document_descriptor)
 {
@@ -1698,31 +1699,32 @@ get_conf (CONVERTER *converter, const char *option_name)
 
 /* add C messages to a Texinfo::Report object, like
    Texinfo::Report::add_formatted_message does.
-   TODO currently unused. It could replace the calls to add_formatted_message
-   in perl code, if it is found relevant.  For converters, this is unlikely,
-   as errors need to be passed explicitely both from Perl and XS.  For
-   errors registered in document, it may be useful to avoid the need to
-   rebuild the document prior to passing error messages.
+   NOTE probably not useful for converters as errors need to be passed
+   explicitely both from Perl and XS.
+
+   Also return $report->{'errors_warnings'} in ERRORS_WARNINGS_OUT and
+   $report->{'error_nrs'} in ERRORS_NRS_OUT, even if ERROR_MESSAGES is
+   0, to avoid the need to fetch them from report_hv if calling code
+   is interested in those SV.
  */
-void
-pass_converter_errors (ERROR_MESSAGE_LIST *error_messages,
-                       HV *report_hv)
+static void
+add_formatted_error_messages (ERROR_MESSAGE_LIST *error_messages,
+                              HV *report_hv, SV **errors_warnings_out,
+                              SV **error_nrs_out)
 {
-  int i;
   SV **errors_warnings_sv;
   SV **error_nrs_sv;
+  int i;
 
   dTHX;
 
-  if (!error_messages)
-    {
-      fprintf (stderr, "pass_converter_errors: NOTE: no error_messages\n");
-      return;
-    }
+
+  *errors_warnings_out = 0;
+  *error_nrs_out = 0;
 
   if (!report_hv)
     {
-      fprintf (stderr, "pass_converter_errors: BUG: no perl report\n");
+      fprintf (stderr, "add_formatted_error_messages: BUG: no perl report\n");
       return;
     }
 
@@ -1732,25 +1734,54 @@ pass_converter_errors (ERROR_MESSAGE_LIST 
*error_messages,
   error_nrs_sv = hv_fetch (report_hv, "error_nrs",
                                       strlen ("error_nrs"), 0);
 
-  if (errors_warnings_sv && SvOK(*errors_warnings_sv))
+  if (errors_warnings_sv && SvOK (*errors_warnings_sv))
     {
-      AV *av = (AV *)SvRV (*errors_warnings_sv);
       int error_nrs = 0;
-      if (error_nrs_sv)
-        error_nrs = SvIV (*error_nrs_sv);
+      if (error_nrs_sv && SvOK (*error_nrs_sv))
+        {
+          error_nrs = SvIV (*error_nrs_sv);
+          *error_nrs_out = *error_nrs_sv;
+        }
+      *errors_warnings_out = *errors_warnings_sv;
 
-      for (i = 0; i < error_messages->number; i++)
+      if (!error_messages)
         {
-          ERROR_MESSAGE error_msg = error_messages->list[i];
-          SV *sv = convert_error (error_msg);
+          /* TODO if this message appears in output, it should probably
+             be removed, as this situation is allowed from DocumentXS.xs
+             document_errors */
+          fprintf (stderr,
+               "add_formatted_error_messages: NOTE: no error_messages\n");
+          return;
+        }
+      else
+        {
+          AV *av = (AV *)SvRV (*errors_warnings_sv);
 
-          if (error_msg.type == MSG_error && !error_msg.continuation)
-            error_nrs++;
-          av_push (av, sv);
+          for (i = 0; i < error_messages->number; i++)
+            {
+              ERROR_MESSAGE error_msg = error_messages->list[i];
+              SV *sv = convert_error (error_msg);
+
+              if (error_msg.type == MSG_error && !error_msg.continuation)
+                error_nrs++;
+              av_push (av, sv);
+            }
+
+          if (error_nrs)
+            {
+              if (error_nrs_sv && SvOK (*error_nrs_sv))
+                {
+                  sv_setiv(*error_nrs_sv, error_nrs);
+                }
+              else
+                {
+                  SV *new_error_nrs_sv = newSViv (error_nrs);
+                  hv_store (report_hv, "error_nrs",
+                       strlen ("error_nrs"), new_error_nrs_sv, 0);
+                  *error_nrs_out = new_error_nrs_sv;
+                }
+            }
         }
-      if (error_nrs)
-        hv_store (report_hv, "error_nrs",
-                  strlen ("error_nrs"), newSViv (error_nrs), 0);
     }
   else
     {
@@ -1762,6 +1793,34 @@ pass_converter_errors (ERROR_MESSAGE_LIST 
*error_messages,
   clear_error_message_list (error_messages);
 }
 
+/* ERROR_MESSAGES can be 0, in that case the function is used to get
+   the perl references but they are not modified */
+SV *
+pass_errors_to_registrar (ERROR_MESSAGE_LIST *error_messages, SV *object_sv,
+                          SV **errors_warnings_out, SV **error_nrs_out)
+{
+  HV *object_hv;
+  SV **registrar_sv;
+  const char *registrar_key = "registrar";
+
+  dTHX;
+
+  object_hv = (HV *) SvRV (object_sv);
+
+  registrar_sv = hv_fetch (object_hv, registrar_key,
+                           strlen (registrar_key), 0);
+  if (registrar_sv && SvOK (*registrar_sv))
+    {
+      HV *report_hv = (HV *) SvRV (*registrar_sv);
+      add_formatted_error_messages (error_messages, report_hv,
+                                    errors_warnings_out, error_nrs_out);
+      return newRV_inc ((SV *) report_hv);
+    }
+  *errors_warnings_out = 0;
+  *error_nrs_out = 0;
+  return newSV (0);
+}
+
 AV *
 build_integer_stack (const INTEGER_STACK *integer_stack)
 {
diff --git a/tp/Texinfo/XS/main/build_perl_info.h 
b/tp/Texinfo/XS/main/build_perl_info.h
index 6d654037ec..533add9a5f 100644
--- a/tp/Texinfo/XS/main/build_perl_info.h
+++ b/tp/Texinfo/XS/main/build_perl_info.h
@@ -49,6 +49,9 @@ HV *build_global_commands (GLOBAL_COMMANDS 
*global_commands_ref);
 
 SV *pass_document_parser_errors (size_t document_descriptor);
 SV *pass_document_errors (size_t document_descriptor);
+SV *pass_errors_to_registrar (ERROR_MESSAGE_LIST *error_messages,
+                              SV *object_sv,
+                              SV **errors_warnings_out, SV **error_nrs_out);
 
 SV *build_output_units_list (size_t output_units_descriptor);
 void rebuild_output_units_list (SV *output_units_sv,



reply via email to

[Prev in Thread] Current Thread [Next in Thread]