branch master updated: * tp/Texinfo/Document.pm (%XS_overrides, _XS_set_document_global_info) (set_document_global_info), tp/Texinfo/XS/main/DocumentXS.xs (set_document_global_info, rebuild_document), tp/Texinfo/XS/main/build_perl_info.c (build_global_info), tp/Texinfo/XS/main/document_types.h (GLOBAL_INFO), tp/Texinfo/XS/main/utils.c (delete_global_info), tp/Texinfo/XS/parsetexi/Parsetexi.pm (_get_parser_info), tp/t/test_utils.pl (test): setup an method in Texinfo::Document, set_document_global_info to set docu [...]

[Patrice Dumas]

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 7b7bd05ad2 * tp/Texinfo/Document.pm (%XS_overrides, 
_XS_set_document_global_info) (set_document_global_info), 
tp/Texinfo/XS/main/DocumentXS.xs (set_document_global_info, rebuild_document), 
tp/Texinfo/XS/main/build_perl_info.c (build_global_info), 
tp/Texinfo/XS/main/document_types.h (GLOBAL_INFO), tp/Texinfo/XS/main/utils.c 
(delete_global_info), tp/Texinfo/XS/parsetexi/Parsetexi.pm (_get_parser_info), 
tp/t/test_utils.pl (test): setup an method in Texinfo::Document, 
set_document_gl [...]
7b7bd05ad2 is described below

commit 7b7bd05ad275e245013b545be015e9ac34d6b0c5
Author: Patrice Dumas <pertusus@free.fr>
AuthorDate: Wed Dec 13 13:11:29 2023 +0100

    * tp/Texinfo/Document.pm (%XS_overrides, _XS_set_document_global_info)
    (set_document_global_info), tp/Texinfo/XS/main/DocumentXS.xs
    (set_document_global_info, rebuild_document),
    tp/Texinfo/XS/main/build_perl_info.c (build_global_info),
    tp/Texinfo/XS/main/document_types.h (GLOBAL_INFO),
    tp/Texinfo/XS/main/utils.c (delete_global_info),
    tp/Texinfo/XS/parsetexi/Parsetexi.pm (_get_parser_info),
    tp/t/test_utils.pl (test): setup an method in Texinfo::Document,
    set_document_global_info to set document global info.  Add an XS
    interface and add the input_perl_encoding to the global info known in
    XS even though it is used in perl only.  Remove from rebuild_document
    the code copying perl data from the input document to the rebuilt
    perl document, as it is now stored in C.
---
 ChangeLog                            | 16 +++++++++
 tp/Texinfo/Document.pm               | 18 ++++++++++
 tp/Texinfo/XS/main/DocumentXS.xs     | 70 ++++++++++++++++--------------------
 tp/Texinfo/XS/main/build_perl_info.c |  9 +++--
 tp/Texinfo/XS/main/document_types.h  |  3 ++
 tp/Texinfo/XS/main/utils.c           |  3 ++
 tp/Texinfo/XS/parsetexi/Parsetexi.pm | 13 +++----
 tp/Texinfo/XS/parsetexi/parser.c     |  6 ++--
 tp/t/test_utils.pl                   |  5 ++-
 9 files changed, 87 insertions(+), 56 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 1820405f69..09cf25d536 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+2023-12-13  Patrice Dumas  <pertusus@free.fr>
+
+       * tp/Texinfo/Document.pm (%XS_overrides, _XS_set_document_global_info)
+       (set_document_global_info), tp/Texinfo/XS/main/DocumentXS.xs
+       (set_document_global_info, rebuild_document),
+       tp/Texinfo/XS/main/build_perl_info.c (build_global_info),
+       tp/Texinfo/XS/main/document_types.h (GLOBAL_INFO),
+       tp/Texinfo/XS/main/utils.c (delete_global_info),
+       tp/Texinfo/XS/parsetexi/Parsetexi.pm (_get_parser_info),
+       tp/t/test_utils.pl (test): setup an method in Texinfo::Document,
+       set_document_global_info to set document global info.  Add an XS
+       interface and add the input_perl_encoding to the global info known in
+       XS even though it is used in perl only.  Remove from rebuild_document
+       the code copying perl data from the input document to the rebuilt
+       perl document, as it is now stored in C.
+
 2023-12-13  Patrice Dumas  <pertusus@free.fr>
 
        * tp/Texinfo/Convert/Converter.pm (set_conf, force_conf): no need to
diff --git a/tp/Texinfo/Document.pm b/tp/Texinfo/Document.pm
index bd23650bd1..20edbfbaef 100644
--- a/tp/Texinfo/Document.pm
+++ b/tp/Texinfo/Document.pm
@@ -52,6 +52,8 @@ our %XS_overrides = (
     => "Texinfo::DocumentXS::clear_document_errors",
   "Texinfo::Document::remove_document_descriptor"
     => "Texinfo::DocumentXS::remove_document_descriptor",
+  "Texinfo::Document::_XS_set_document_global_info",
+    => "Texinfo::DocumentXS::set_document_global_info",
 );
 
 # needed by structure code
@@ -121,6 +123,22 @@ sub register_document_sections_list($$)
   $document->{'sections_list'} = $sections_list;
 }
 
+sub _XS_set_document_global_info($$$)
+{
+}
+
+# TODO document
+sub set_document_global_info($$$)
+{
+  my $document = shift;
+  my $key = shift;
+  my $value = shift;
+  if ($XS_parser) {
+    _XS_set_document_global_info($document, $key, $value);
+  }
+  $document->{'global_info'}->{$key} = $value;
+}
+
 sub tree($)
 {
   my $self = shift;
diff --git a/tp/Texinfo/XS/main/DocumentXS.xs b/tp/Texinfo/XS/main/DocumentXS.xs
index 1bbc8fc604..61cea0bfe2 100644
--- a/tp/Texinfo/XS/main/DocumentXS.xs
+++ b/tp/Texinfo/XS/main/DocumentXS.xs
@@ -69,50 +69,11 @@ rebuild_document (SV *document_in, ...)
                                            strlen (descriptor_key), 0);
         if (document_descriptor_sv)
           {
-            SV **info_sv;
             SV *rebuilt_doc_sv;
-            HV *rebuilt_doc_hv;
 
             document_descriptor = SvIV (*document_descriptor_sv);
             rebuilt_doc_sv = build_document (document_descriptor, no_store);
             RETVAL = rebuilt_doc_sv;
-            rebuilt_doc_hv = (HV *)SvRV (rebuilt_doc_sv);
-            info_sv = hv_fetch (hv_in, "global_info",
-                                strlen ("global_info"), 0);
-            /* copy input document info keys values not already in new document
-               info.  Should only happen for info keys set in perl only. */
-            if (info_sv)
-              {
-                I32 hv_number;
-                I32 i;
-                HV *info_hv = (HV *)SvRV (*info_sv);
-                SV **rebuilt_info_sv = hv_fetch (rebuilt_doc_hv, "global_info",
-                                                strlen ("global_info"), 0);
-                HV *rebuilt_info_hv = 0;
-                if (!rebuilt_info_sv)
-                  {
-                    HV *rebuilt_info_hv = newHV ();
-                    SV *rebuilt_info_ref = newRV_noinc ((SV *) 
rebuilt_info_hv);
-                    hv_store (rebuilt_doc_hv, "info", strlen ("info"),
-                              rebuilt_info_ref, 0);
-                  }
-                else
-                  {
-                    rebuilt_info_hv = (HV *)SvRV (*rebuilt_info_sv);
-                  }
-                hv_number = hv_iterinit (info_hv);
-                for (i = 0; i < hv_number; i++)
-                  {
-                    char *key;
-                    I32 retlen;
-                    SV *value = hv_iternextsv(info_hv,
-                                              &key, &retlen);
-                    SV **existing_key_sv = hv_fetch (rebuilt_info_hv, key,
-                                                     strlen (key), 0);
-                    if (!existing_key_sv)
-                      hv_store (rebuilt_info_hv, key, strlen (key), value, 0);
-                  }
-              }
           }
         else
           {
@@ -122,6 +83,37 @@ rebuild_document (SV *document_in, ...)
     OUTPUT:
         RETVAL
 
+void
+set_document_global_info (SV *document_in, char *key, SV *value_sv)
+      PREINIT:
+        DOCUMENT *document = 0;
+      CODE:
+        document = get_sv_document_document (document_in, 0);
+        if (document)
+          {
+            if (!strcmp (key, "input_file_name"))
+              {
+                char *value = (char *)SvPVbyte_nolen(value_sv);
+                if (document->global_info->input_file_name)
+                  {
+                    fprintf (stderr,
+                        "BUG: %d: reset input_file_name '%s' -> '%s'\n",
+                        document->descriptor,
+                        document->global_info->input_file_name, value);
+                    free (document->global_info->input_file_name);
+                  }
+                document->global_info->input_file_name = strdup (value);
+              }
+            else if (!strcmp (key, "input_perl_encoding"))
+              {
+                /* should not be needed, but in case global information
+                   is reused, it will be ok */
+                free (document->global_info->input_perl_encoding);
+                document->global_info->input_perl_encoding
+                   = strdup ((char *)SvPVbyte_nolen(value_sv));
+              }
+          }
+
 SV *
 rebuild_tree (SV *tree_in, ...)
       PROTOTYPE: $;$
diff --git a/tp/Texinfo/XS/main/build_perl_info.c 
b/tp/Texinfo/XS/main/build_perl_info.c
index f290e3ce1a..44e9fb305f 100644
--- a/tp/Texinfo/XS/main/build_perl_info.c
+++ b/tp/Texinfo/XS/main/build_perl_info.c
@@ -899,10 +899,13 @@ build_global_info (GLOBAL_INFO *global_info_ref,
   if (global_info.input_directory)
     hv_store (hv, "input_directory", strlen ("input_directory"),
               newSVpv (global_info.input_directory, 0), 0);
+  if (global_info.input_perl_encoding)
+    hv_store (hv, "input_perl_encoding", strlen ("input_perl_encoding"),
+              newSVpv (global_info.input_perl_encoding, 0), 0);
 
-  /* duplicate information to avoid needing to use global_commands and build
-     tree elements, for information useful for structuring and transformation
-     codes */
+  /* duplicate information with global_commands to avoid needing to use
+     global_commands and build tree elements in other codes, for
+     information useful for structuring and transformation codes */
   if (global_commands.novalidate)
     hv_store (hv, "novalidate", strlen ("novalidate"),
               newSViv (1), 0);
diff --git a/tp/Texinfo/XS/main/document_types.h 
b/tp/Texinfo/XS/main/document_types.h
index f25a01762d..92c1884f9f 100644
--- a/tp/Texinfo/XS/main/document_types.h
+++ b/tp/Texinfo/XS/main/document_types.h
@@ -54,6 +54,9 @@ typedef struct GLOBAL_INFO {
     ELEMENT_LIST dircategory_direntry; /* an array of elements */
     /* Ignored characters for index sort key */
     IGNORED_CHARS ignored_chars;
+
+    /* perl specific */
+    char *input_perl_encoding;
 } GLOBAL_INFO;
 
 typedef struct DOCUMENT {
diff --git a/tp/Texinfo/XS/main/utils.c b/tp/Texinfo/XS/main/utils.c
index 734185715e..7d97b3d1a3 100644
--- a/tp/Texinfo/XS/main/utils.c
+++ b/tp/Texinfo/XS/main/utils.c
@@ -873,6 +873,9 @@ delete_global_info (GLOBAL_INFO *global_info_ref)
   free (global_info.input_encoding_name);
   free (global_info.input_file_name);
   free (global_info.input_directory);
+
+  /* perl specific information */
+  free (global_info.input_perl_encoding);
 }
 
 void
diff --git a/tp/Texinfo/XS/parsetexi/Parsetexi.pm 
b/tp/Texinfo/XS/parsetexi/Parsetexi.pm
index 60d9fbecf4..090bdee7ee 100644
--- a/tp/Texinfo/XS/parsetexi/Parsetexi.pm
+++ b/tp/Texinfo/XS/parsetexi/Parsetexi.pm
@@ -29,10 +29,7 @@
 # * the 'file_name' values in 'source_info' from convert_errors and in
 #   the tree elements 'source_info' are returned as binary strings
 #
-# The following information is directly determined from the
-# input file name as binary strings
-# ->{'global_info'}->{'input_file_name'}
-# ->{'global_info'}->{'input_directory'}
+# Binary strings are passed from parse_texi_file as arguments of parse_file.
 
 package Texinfo::Parser;
 
@@ -224,12 +221,12 @@ sub _get_parser_info($$;$$) {
   clear_document_errors($document_descriptor);
 
   # additional info relevant in perl only.
-  $document->{'global_info'}->{'input_perl_encoding'} = 'utf-8';
   my $perl_encoding
     = Texinfo::Common::get_perl_encoding($document->{'commands_info'},
                               $registrar, $configuration_information);
-  $document->{'global_info'}->{'input_perl_encoding'} = $perl_encoding
-     if (defined($perl_encoding));
+  $perl_encoding = 'utf-8' if (!defined($perl_encoding));
+  Texinfo::Document::set_document_global_info($document,
+                     'input_perl_encoding', $perl_encoding);
 
   return $document;
 }
@@ -244,7 +241,7 @@ sub parse_texi_file ($$;$)
   # the file is already a byte string, taken as is from the command
   # line.  The encoding was detected as COMMAND_LINE_ENCODING, but
   # it is not useful for the XS parser.
-  # FIXME instead of using fileparse here, reimplement fileparse
+  # TODO instead of using fileparse here, reimplement fileparse
   # in XS, or use a file name parsing code from somewhere else?
   my ($basename, $directories, $suffix) = fileparse($input_file_path);
   my $document_descriptor = parse_file ($input_file_path,
diff --git a/tp/Texinfo/XS/parsetexi/parser.c b/tp/Texinfo/XS/parsetexi/parser.c
index 86cdf1fefa..47c4bfe9fc 100644
--- a/tp/Texinfo/XS/parsetexi/parser.c
+++ b/tp/Texinfo/XS/parsetexi/parser.c
@@ -437,10 +437,10 @@ wipe_parser_global_info (void)
   global_kbdinputstyle = kbd_distinct;
 
   delete_global_info (&global_info);
-  delete_global_commands (&global_commands);
-
-  /* clear the rest of the fields and reset elements lists */
   memset (&global_info, 0, sizeof (global_info));
+
+  delete_global_commands (&global_commands);
+  /* clear the fields and reset elements lists */
   memset (&global_commands, 0, sizeof (global_commands));
 }
 
diff --git a/tp/t/test_utils.pl b/tp/t/test_utils.pl
index 46f7f98d9c..7e567807a6 100644
--- a/tp/t/test_utils.pl
+++ b/tp/t/test_utils.pl
@@ -1009,9 +1009,8 @@ sub test($$)
     if (defined($test_input_file_name)) {
       # FIXME should we need to encode or do we assume that
       # $test_input_file_name is already bytes?
-      # FIXME it is incorrect to do that outside of an API.  It is actually
-      # more to set the output file, so maybe it should be done differently.
-      $document->{'global_info'}->{'input_file_name'} = $test_input_file_name;
+      $document->set_document_global_info('input_file_name',
+                                          $test_input_file_name);
     }
   } else {
     print STDERR "  TEST $test_name ($test_file)\n" if ($self->{'DEBUG'});