[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
|
From: |
Patrice Dumas |
|
Date: |
Tue, 20 Feb 2024 15:11:56 -0500 (EST) |
branch: master
commit c135c7d4b6c2b9be6ae6ac2bc389df4042406dbc
Author: Patrice Dumas <pertusus@free.fr>
AuthorDate: Tue Feb 20 21:05:25 2024 +0100
* tp/Texinfo/Document.pm (rebuild_document),
tp/Texinfo/XS/main/DocumentXS.xs (rebuild_document),
tp/Texinfo/XS/main/build_perl_info.c (fill_document_hv)
(build_document, rebuild_document): distinguish building document and
rebuilding an existing HV. Reuse the reference given as
rebuild_document argument, do not return anything. Update callers of
Texinfo::Document::rebuild_document.
* tp/Texinfo/XS/main/build_perl_info.c (rebuild_output_units_list):
add a debug message.
* tp/Texinfo/XS/main/DocumentXS.xs (rebuild_tree): handle better
no_store.
* tp/Texinfo/XS/main/DocumentXS.xs: move code around.
---
ChangeLog | 18 ++++
tp/Texinfo/Document.pm | 2 -
tp/Texinfo/XS/convert/ConvertXS.xs | 3 +-
tp/Texinfo/XS/main/DocumentXS.xs | 121 +++++++++++--------------
tp/Texinfo/XS/main/build_perl_info.c | 78 +++++++++++++---
tp/Texinfo/XS/main/build_perl_info.h | 1 +
tp/t/automatic_nodes.t | 4 +-
tp/t/do_master_menu.t | 8 +-
tp/t/protect_character_in_texinfo.t | 2 +-
tp/t/test_protect_hashchar_at_line_beginning.t | 2 +-
tp/t/test_utils.pl | 2 +-
tp/texi2any.pl | 4 +-
12 files changed, 146 insertions(+), 99 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 8139355afd..81cc46515f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -10,6 +10,24 @@
$self->{'encoding_disabled'} if not outputting to a file, before
any conversion is done.
+2024-02-20 Patrice Dumas <pertusus@free.fr>
+
+ * tp/Texinfo/Document.pm (rebuild_document),
+ tp/Texinfo/XS/main/DocumentXS.xs (rebuild_document),
+ tp/Texinfo/XS/main/build_perl_info.c (fill_document_hv)
+ (build_document, rebuild_document): distinguish building document and
+ rebuilding an existing HV. Reuse the reference given as
+ rebuild_document argument, do not return anything. Update callers of
+ Texinfo::Document::rebuild_document.
+
+ * tp/Texinfo/XS/main/build_perl_info.c (rebuild_output_units_list):
+ add a debug message.
+
+ * tp/Texinfo/XS/main/DocumentXS.xs (rebuild_tree): handle better
+ no_store.
+
+ * tp/Texinfo/XS/main/DocumentXS.xs: move code around.
+
2024-02-20 Patrice Dumas <pertusus@free.fr>
* tp/Texinfo/Structuring.pm (rebuild_output_units),
diff --git a/tp/Texinfo/Document.pm b/tp/Texinfo/Document.pm
index 6495c3a411..62d729d369 100644
--- a/tp/Texinfo/Document.pm
+++ b/tp/Texinfo/Document.pm
@@ -416,8 +416,6 @@ sub rebuild_document($;$)
{
my $document = shift;
my $no_store = shift;
-
- return $document;
}
# this method does nothing, but the XS override rebuilds the Perl
diff --git a/tp/Texinfo/XS/convert/ConvertXS.xs
b/tp/Texinfo/XS/convert/ConvertXS.xs
index 3a860d8b15..93a7291e79 100644
--- a/tp/Texinfo/XS/convert/ConvertXS.xs
+++ b/tp/Texinfo/XS/convert/ConvertXS.xs
@@ -1829,7 +1829,8 @@ html_prepare_conversion_units (SV *converter_in, ...)
newRV_inc ((SV *) output_units_hv), 0);
/* calls perl customization functions, so need to be done after
- build_output_units_list calls to be able to retrieve perl units */
+ build_output_units_list calls to be able to retrieve Perl
+ output units references */
html_prepare_conversion_units_targets (self, document_name,
output_units_descriptor, special_units_descriptor,
associated_special_units_descriptor);
diff --git a/tp/Texinfo/XS/main/DocumentXS.xs b/tp/Texinfo/XS/main/DocumentXS.xs
index ff702b5ac1..adb8e65c10 100644
--- a/tp/Texinfo/XS/main/DocumentXS.xs
+++ b/tp/Texinfo/XS/main/DocumentXS.xs
@@ -51,75 +51,12 @@ configure_output_strings_translations (localesdir,
strings_textdomain="texinfo_d
CODE:
configure_output_strings_translations (localesdir, strings_textdomain);
-SV *
-rebuild_document (SV *document_in, ...)
- PROTOTYPE: $;$
- PREINIT:
- int no_store = 0;
- int document_descriptor;
- SV **document_descriptor_sv;
- char *descriptor_key = "document_descriptor";
- HV *hv_in;
- CODE:
- if (items > 1 && SvOK(ST(1)))
- no_store = SvIV (ST(1));
-
- hv_in = (HV *)SvRV (document_in);
- document_descriptor_sv = hv_fetch (hv_in, descriptor_key,
- strlen (descriptor_key), 0);
- if (document_descriptor_sv)
- {
- SV *rebuilt_doc_sv;
-
- document_descriptor = SvIV (*document_descriptor_sv);
- rebuilt_doc_sv = build_document (document_descriptor, no_store);
- RETVAL = rebuilt_doc_sv;
- }
- else
- {
- fprintf (stderr, "ERROR: document rebuild: no %s\n",
descriptor_key);
- RETVAL = newSV(0);
- }
- 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));
- }
- else
- {
- add_associated_info_string_dup (
- &document->global_info->other_info,
- key, (char *)SvPVutf8_nolen(value_sv));
- }
- }
+rebuild_document (SV *document_in, int no_store=0)
+# Since build_document is called, the underlying document HV is destroyed
+# instead of being reused. Being able to get the document HV from the
+# XS document or from the Perl tree would be needed to do it differently.
SV *
rebuild_tree (SV *tree_in, ...)
PROTOTYPE: $;$
@@ -133,11 +70,18 @@ rebuild_tree (SV *tree_in, ...)
document = get_sv_tree_document (tree_in, "rebuild_tree");
if (document)
{
- ELEMENT *tree;
+ /* if no_store is set, get the reference on the tree HV before calling
+ build_document, as the tree is gonna be destroyed. This requires
+ that the document the tree comes from to have already been built to
+ Perl, which should be the general case */
+
+ ELEMENT *tree = document->tree;
+ if (no_store)
+ RETVAL = newRV_inc ((SV *) tree->hv);
build_document (document->descriptor, no_store);
- tree = document->tree;
- RETVAL = newRV_inc ((SV *) tree->hv);
+ if (!no_store)
+ RETVAL = newRV_inc ((SV *) tree->hv);
}
else
RETVAL = newSV(0);
@@ -174,6 +118,43 @@ set_document_options (SV *sv_options_in, SV *document_in)
register_document_options (document, options);
}
+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));
+ }
+ else
+ {
+ add_associated_info_string_dup (
+ &document->global_info->other_info,
+ key, (char *)SvPVutf8_nolen(value_sv));
+ }
+ }
+
# registrar, main_configuration, prefer_reference_element
SV *
indices_sort_strings (SV *document_in, ...)
diff --git a/tp/Texinfo/XS/main/build_perl_info.c
b/tp/Texinfo/XS/main/build_perl_info.c
index dad45c4020..c2f7514ed0 100644
--- a/tp/Texinfo/XS/main/build_perl_info.c
+++ b/tp/Texinfo/XS/main/build_perl_info.c
@@ -1201,15 +1201,9 @@ get_document (size_t document_descriptor)
return sv;
}
-/* Return Texinfo::Document perl object corresponding to the
- C document structure corresponding to DOCUMENT_DESCRIPTOR.
- If NO_STORE is set, destroy the C document.
- */
-SV *
-build_document (size_t document_descriptor, int no_store)
+static void
+fill_document_hv (HV *hv, size_t document_descriptor, int no_store)
{
- HV *hv;
- SV *sv;
DOCUMENT *document;
HV *hv_tree;
HV *hv_info;
@@ -1223,12 +1217,9 @@ build_document (size_t document_descriptor, int no_store)
AV *av_errors_list;
AV *av_nodes_list = 0;
AV *av_sections_list = 0;
- HV *hv_stash;
dTHX;
- hv = newHV ();
-
document = retrieve_document (document_descriptor);
hv_tree = build_texinfo_tree (document->tree, 0);
@@ -1308,6 +1299,24 @@ build_document (size_t document_descriptor, int no_store)
newSViv (document_descriptor), 0);
}
+}
+
+/* Return Texinfo::Document perl object corresponding to the
+ C document structure corresponding to DOCUMENT_DESCRIPTOR.
+ If NO_STORE is set, destroy the C document.
+ */
+SV *
+build_document (size_t document_descriptor, int no_store)
+{
+ HV *hv;
+ SV *sv;
+ HV *hv_stash;
+
+ dTHX;
+
+ hv = newHV ();
+
+ fill_document_hv (hv, document_descriptor, no_store);
hv_stash = gv_stashpv ("Texinfo::Document", GV_ADD);
sv = newRV_noinc ((SV *) hv);
@@ -1315,6 +1324,31 @@ build_document (size_t document_descriptor, int no_store)
return sv;
}
+void
+rebuild_document (SV *document_in, int no_store)
+{
+ HV *hv;
+ SV **document_descriptor_sv;
+ char *descriptor_key = "document_descriptor";
+
+ dTHX;
+
+ hv = (HV *)SvRV (document_in);
+
+ document_descriptor_sv = hv_fetch (hv, descriptor_key,
+ strlen (descriptor_key), 0);
+
+ if (document_descriptor_sv)
+ {
+ int document_descriptor = SvIV (*document_descriptor_sv);
+ hv_clear (hv);
+ fill_document_hv (hv, document_descriptor, no_store);
+ }
+ else
+ {
+ fprintf (stderr, "ERROR: document rebuild: no %s\n", descriptor_key);
+ }
+}
static void
output_unit_to_perl_hash (OUTPUT_UNIT *output_unit)
@@ -1555,8 +1589,19 @@ rebuild_output_units_list (SV *output_units_sv, size_t
output_units_descriptor)
if (!fill_output_units_descriptor_av (av_output_units,
output_units_descriptor))
- /* TODO cannot associate output_units_descriptor. A problem? */
- return;
+ {
+ /* the output_units_descriptor is not found. In the codes calling
+ this function, the output_units_descriptor should have been found
+ within the Perl reference used as argument here. If there is
+ something to rebuild, this should mean that there is an output
+ units list in C, therefore we output an error here. It could
+ be redundant with errors output earlier in calling code, but it
+ is better to have more debug messages.
+ */
+ fprintf (stderr, "BUG: rebuild_output_units_list: output unit"
+ "descriptor not found: %zu\n", output_units_descriptor);
+ return;
+ }
}
SV *
@@ -1571,8 +1616,11 @@ get_conf (CONVERTER *converter, const char *option_name)
/* add C messages to a Texinfo::Report object, like
Texinfo::Report::add_formatted_message does.
- TODO it could replace the calls to add_formatted_message
- in perl code, if it is found relevant.
+ 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.
*/
void
pass_converter_errors (ERROR_MESSAGE_LIST *error_messages,
diff --git a/tp/Texinfo/XS/main/build_perl_info.h
b/tp/Texinfo/XS/main/build_perl_info.h
index 5410668a5e..26fea9cbc1 100644
--- a/tp/Texinfo/XS/main/build_perl_info.h
+++ b/tp/Texinfo/XS/main/build_perl_info.h
@@ -26,6 +26,7 @@ void element_to_perl_hash (ELEMENT *e, int avoid_recursion);
SV *build_document (size_t document_descriptor, int no_store);
SV *get_document (size_t document_descriptor);
+void rebuild_document (SV *document_in, int no_store);
HV *build_texinfo_tree (ELEMENT *root, int avoid_recursion);
AV *build_errors (ERROR_MESSAGE* error_list, size_t error_number);
diff --git a/tp/t/automatic_nodes.t b/tp/t/automatic_nodes.t
index 9208119ecd..6cd99043dc 100644
--- a/tp/t/automatic_nodes.t
+++ b/tp/t/automatic_nodes.t
@@ -177,7 +177,7 @@
Texinfo::Structuring::associate_internal_references($document, $registrar,
$parser);
Texinfo::Transformations::insert_nodes_for_sectioning_commands($document,
$registrar, $parser);
-$document = Texinfo::Document::rebuild_document($document);
+Texinfo::Document::rebuild_document($document);
$tree = $document->tree();
my $result = Texinfo::Convert::Texinfo::convert_to_texinfo($tree);
is ($result, $reference, 'add nodes');
@@ -201,7 +201,7 @@
Texinfo::Structuring::associate_internal_references($document, $registrar,
Texinfo::Transformations::insert_nodes_for_sectioning_commands($document,
$registrar, $parser);
-$document = Texinfo::Document::rebuild_document($document);
+Texinfo::Document::rebuild_document($document);
my $identifier_target = $document->labels_information();
my $indices_information = $document->indices_information();
diff --git a/tp/t/do_master_menu.t b/tp/t/do_master_menu.t
index c9da6ebfdc..25142cb835 100644
--- a/tp/t/do_master_menu.t
+++ b/tp/t/do_master_menu.t
@@ -128,7 +128,7 @@ my $document = $parser->parse_texi_piece($in_detailmenu);
my $registrar = $parser->registered_errors();
Texinfo::Structuring::associate_internal_references($document, $registrar,
$parser);
-$document = Texinfo::Document::rebuild_document($document);
+Texinfo::Document::rebuild_document($document);
my $identifier_target = $document->labels_information();
my $top_node = $identifier_target->{'Top'};
# FIXME does not test XS
@@ -177,7 +177,7 @@ $document = $parser->parse_texi_piece($no_detailmenu);
$registrar = $parser->registered_errors();
Texinfo::Structuring::associate_internal_references($document, $registrar,
$parser);
-$document = Texinfo::Document::rebuild_document($document);
+Texinfo::Document::rebuild_document($document);
$identifier_target = $document->labels_information();
$top_node = $identifier_target->{'Top'};
# FIXME does not test XS
@@ -193,7 +193,7 @@ $registrar = $parser->registered_errors();
Texinfo::Structuring::associate_internal_references($document, $registrar,
$parser);
Texinfo::Transformations::regenerate_master_menu($document, $parser);
-$document = Texinfo::Document::rebuild_document($document);
+Texinfo::Document::rebuild_document($document);
my $tree = $document->tree();
$out = Texinfo::Convert::Texinfo::convert_to_texinfo($tree);
@@ -207,7 +207,7 @@ $registrar = $parser->registered_errors();
Texinfo::Structuring::associate_internal_references($document, $registrar,
$parser);
Texinfo::Transformations::regenerate_master_menu($document, $parser);
-$document = Texinfo::Document::rebuild_document($document);
+Texinfo::Document::rebuild_document($document);
$tree = $document->tree();
$out = Texinfo::Convert::Texinfo::convert_to_texinfo($tree);
diff --git a/tp/t/protect_character_in_texinfo.t
b/tp/t/protect_character_in_texinfo.t
index 0dcbb8eced..a42157de7a 100644
--- a/tp/t/protect_character_in_texinfo.t
+++ b/tp/t/protect_character_in_texinfo.t
@@ -52,7 +52,7 @@ sub run_test($$$$)
}
}
- $document = Texinfo::Document::rebuild_document($document);
+ Texinfo::Document::rebuild_document($document);
$tree_as_text = $document->tree();
$tree_as_line = Texinfo::Document::rebuild_tree($tree_as_line);
diff --git a/tp/t/test_protect_hashchar_at_line_beginning.t
b/tp/t/test_protect_hashchar_at_line_beginning.t
index 089617e9f3..5c33a8aaf8 100644
--- a/tp/t/test_protect_hashchar_at_line_beginning.t
+++ b/tp/t/test_protect_hashchar_at_line_beginning.t
@@ -44,7 +44,7 @@ sub run_test($$$;$)
Texinfo::Transformations::protect_hashchar_at_line_beginning($tree,
$registrar, $parser);
- $document = Texinfo::Document::rebuild_document($document);
+ Texinfo::Document::rebuild_document($document);
$corrected_tree = $document->tree();
if ($with_XS) {
diff --git a/tp/t/test_utils.pl b/tp/t/test_utils.pl
index 37d6db77fe..cc55aaa0fc 100644
--- a/tp/t/test_utils.pl
+++ b/tp/t/test_utils.pl
@@ -1142,7 +1142,7 @@ sub test($$)
# could be in a if !$XS_structuring, but the function should not be
# overriden already in that case
- $document = Texinfo::Document::rebuild_document($document);
+ Texinfo::Document::rebuild_document($document);
# should not actually be useful, as the same element should be reused.
$tree = $document->tree();
diff --git a/tp/texi2any.pl b/tp/texi2any.pl
index eb0d291374..ed97c40caa 100755
--- a/tp/texi2any.pl
+++ b/tp/texi2any.pl
@@ -1554,7 +1554,7 @@ while(@input_files) {
# no need to rebuild the tree here if convert_to_texinfo is XS code.
if (not (defined $ENV{TEXINFO_XS_CONVERT}
and $ENV{TEXINFO_XS_CONVERT} eq '1')) {
- $document = Texinfo::Document::rebuild_document($document);
+ Texinfo::Document::rebuild_document($document);
$tree = $document->tree();
}
my $texinfo_text = Texinfo::Convert::Texinfo::convert_to_texinfo($tree);
@@ -1681,7 +1681,7 @@ while(@input_files) {
$main_configuration);
}
- $document = Texinfo::Document::rebuild_document($document);
+ Texinfo::Document::rebuild_document($document);
if ($XS_structuring) {
foreach my $error (@{$document->{'errors'}}) {