mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-21 20:20:24 +02:00
More goops.c cleanups, and fix a security issue
* libguile/goops.c: Remove unused #includes. (make_class_name): New helper, replaces unsafe use of sprintf. (scm_make_extended_class): Rewrite to call scm_make_standard_class directly. (scm_make_port_classes): Rewrite to use scm_make_standard_class, and no need to patch the CPL any more.
This commit is contained in:
parent
06ea79b73d
commit
2e0b69344b
1 changed files with 37 additions and 49 deletions
|
@ -29,14 +29,9 @@
|
||||||
# include <config.h>
|
# include <config.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#include <stdio.h>
|
|
||||||
|
|
||||||
#include "libguile/_scm.h"
|
#include "libguile/_scm.h"
|
||||||
#include "libguile/alist.h"
|
|
||||||
#include "libguile/async.h"
|
#include "libguile/async.h"
|
||||||
#include "libguile/chars.h"
|
#include "libguile/chars.h"
|
||||||
#include "libguile/debug.h"
|
|
||||||
#include "libguile/dynl.h"
|
|
||||||
#include "libguile/dynwind.h"
|
#include "libguile/dynwind.h"
|
||||||
#include "libguile/eval.h"
|
#include "libguile/eval.h"
|
||||||
#include "libguile/gsubr.h"
|
#include "libguile/gsubr.h"
|
||||||
|
@ -47,13 +42,10 @@
|
||||||
#include "libguile/ports.h"
|
#include "libguile/ports.h"
|
||||||
#include "libguile/procprop.h"
|
#include "libguile/procprop.h"
|
||||||
#include "libguile/programs.h"
|
#include "libguile/programs.h"
|
||||||
#include "libguile/random.h"
|
|
||||||
#include "libguile/root.h"
|
|
||||||
#include "libguile/smob.h"
|
#include "libguile/smob.h"
|
||||||
#include "libguile/strings.h"
|
#include "libguile/strings.h"
|
||||||
#include "libguile/strports.h"
|
#include "libguile/strports.h"
|
||||||
#include "libguile/vectors.h"
|
#include "libguile/vectors.h"
|
||||||
#include "libguile/vm.h"
|
|
||||||
|
|
||||||
#include "libguile/validate.h"
|
#include "libguile/validate.h"
|
||||||
#include "libguile/goops.h"
|
#include "libguile/goops.h"
|
||||||
|
@ -1329,33 +1321,30 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1,
|
||||||
**********************************************************************/
|
**********************************************************************/
|
||||||
|
|
||||||
static SCM
|
static SCM
|
||||||
make_class_from_template (char const *template, char const *type_name, SCM supers, int applicablep)
|
make_class_name (const char *prefix, const char *type_name, const char *suffix)
|
||||||
{
|
{
|
||||||
SCM meta, name;
|
if (!type_name)
|
||||||
|
type_name = "";
|
||||||
if (type_name)
|
return scm_string_to_symbol (scm_string_append
|
||||||
{
|
(scm_list_3 (scm_from_utf8_string (prefix),
|
||||||
char buffer[100];
|
scm_from_utf8_string (type_name),
|
||||||
sprintf (buffer, template, type_name);
|
scm_from_utf8_string (suffix))));
|
||||||
name = scm_from_utf8_symbol (buffer);
|
|
||||||
}
|
|
||||||
else
|
|
||||||
name = SCM_GOOPS_UNBOUND;
|
|
||||||
|
|
||||||
meta = applicablep ? class_procedure_class : class_class;
|
|
||||||
|
|
||||||
return scm_make_standard_class (meta, name, supers, SCM_EOL);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_make_extended_class (char const *type_name, int applicablep)
|
scm_make_extended_class (char const *type_name, int applicablep)
|
||||||
{
|
{
|
||||||
return make_class_from_template ("<%s>",
|
SCM name, meta, supers;
|
||||||
type_name,
|
|
||||||
scm_list_1 (applicablep
|
name = make_class_name ("<", type_name, ">");
|
||||||
? class_applicable
|
meta = class_class;
|
||||||
: class_top),
|
|
||||||
applicablep);
|
if (applicablep)
|
||||||
|
supers = scm_list_1 (class_applicable);
|
||||||
|
else
|
||||||
|
supers = scm_list_1 (class_top);
|
||||||
|
|
||||||
|
return scm_make_standard_class (meta, name, supers, SCM_EOL);
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
|
@ -1410,29 +1399,28 @@ create_smob_classes (void)
|
||||||
void
|
void
|
||||||
scm_make_port_classes (long ptobnum, char *type_name)
|
scm_make_port_classes (long ptobnum, char *type_name)
|
||||||
{
|
{
|
||||||
SCM c, class = make_class_from_template ("<%s-port>",
|
SCM name, meta, super, supers;
|
||||||
type_name,
|
|
||||||
scm_list_1 (class_port),
|
meta = class_class;
|
||||||
0);
|
|
||||||
|
name = make_class_name ("<", type_name, "-port>");
|
||||||
|
supers = scm_list_1 (class_port);
|
||||||
|
super = scm_make_standard_class (meta, name, supers, SCM_EOL);
|
||||||
|
|
||||||
|
name = make_class_name ("<", type_name, "-input-port>");
|
||||||
|
supers = scm_list_2 (super, class_input_port);
|
||||||
scm_i_port_class[SCM_IN_PCLASS_INDEX + ptobnum]
|
scm_i_port_class[SCM_IN_PCLASS_INDEX + ptobnum]
|
||||||
= make_class_from_template ("<%s-input-port>",
|
= scm_make_standard_class (meta, name, supers, SCM_EOL);
|
||||||
type_name,
|
|
||||||
scm_list_2 (class, class_input_port),
|
name = make_class_name ("<", type_name, "-output-port>");
|
||||||
0);
|
supers = scm_list_2 (super, class_output_port);
|
||||||
scm_i_port_class[SCM_OUT_PCLASS_INDEX + ptobnum]
|
scm_i_port_class[SCM_OUT_PCLASS_INDEX + ptobnum]
|
||||||
= make_class_from_template ("<%s-output-port>",
|
= scm_make_standard_class (meta, name, supers, SCM_EOL);
|
||||||
type_name,
|
|
||||||
scm_list_2 (class, class_output_port),
|
name = make_class_name ("<", type_name, "-input-output-port>");
|
||||||
0);
|
supers = scm_list_2 (super, class_input_output_port);
|
||||||
scm_i_port_class[SCM_INOUT_PCLASS_INDEX + ptobnum]
|
scm_i_port_class[SCM_INOUT_PCLASS_INDEX + ptobnum]
|
||||||
= c
|
= scm_make_standard_class (meta, name, supers, SCM_EOL);
|
||||||
= make_class_from_template ("<%s-input-output-port>",
|
|
||||||
type_name,
|
|
||||||
scm_list_2 (class, class_input_output_port),
|
|
||||||
0);
|
|
||||||
/* Patch cpl (since this tree is too complex for the C level compute-cpl) */
|
|
||||||
SCM_SET_SLOT (c, scm_si_cpl,
|
|
||||||
scm_cons2 (c, class, SCM_SLOT (class_input_output_port, scm_si_cpl)));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue