src/warnings.c

   1 /*
   2 Copyright (C) 2001-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/warnings.c - Warning and error reporting
   8
   9 =head1 DESCRIPTION
  10
  11 Parrot C<STRING> and C string versions of a function to print warning/error
  12 messages.
  13
  14 =over 4
  15
  16 =cut
  17
  18 */
  19
  20 #include "parrot/parrot.h"
  21
  22 #include <stdarg.h>
  23
  24 /* HEADERIZER HFILE: include/parrot/warnings.h */
  25
  26 /* HEADERIZER BEGIN: static */
  27 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  28
  29 static INTVAL print_warning(PARROT_INTERP, ARGIN_NULLOK(STRING *msg))
  30         __attribute__nonnull__(1);
  31
  32 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  33 /* HEADERIZER END: static */
  34
  35 /*
  36
  37 =item C<void print_pbc_location>
  38
  39 Prints the bytecode location of the warning or error to C<PIO_STDERR>.
  40
  41 =cut
  42
  43 */
  44
  45 PARROT_API
  46 void
  47 print_pbc_location(PARROT_INTERP)
  48 {
  49     Interp * const tracer = interp->debugger ? interp->debugger : interp;
  50     PIO_eprintf(tracer, "%Ss\n",
  51             Parrot_Context_infostr(interp,
  52                 CONTEXT(interp)));
  53 }
  54
  55 /*
  56
  57 =item C<static INTVAL print_warning>
  58
  59 Prints the warning message and the bytecode location.
  60
  61 =cut
  62
  63 */
  64
  65 static INTVAL
  66 print_warning(PARROT_INTERP, ARGIN_NULLOK(STRING *msg))
  67 {
  68     if (!msg)
  69         PIO_puts(interp, PIO_STDERR(interp), "Unknown warning\n");
  70     else {
  71         PIO_putps(interp, PIO_STDERR(interp), msg);
  72         if (string_ord(interp, msg, -1) != '\n')
  73             PIO_eprintf(interp, "%c", '\n');
  74     }
  75     print_pbc_location(interp);
  76     return 1;
  77 }
  78
  79 /*
  80
  81 =back
  82
  83 =head2 Parrot Warnings Interface
  84
  85 =over 4
  86
  87 =item C<INTVAL Parrot_warn>
  88
  89 The Parrot C string warning/error reporter.
  90
  91 Returns 2 on error, 1 on success.
  92
  93 C<message, ..> can be a C<Parrot_vsprintf_c()> format with arguments.
  94
  95 =cut
  96
  97 */
  98
  99 PARROT_API
 100 INTVAL
 101 Parrot_warn(PARROT_INTERP, INTVAL warnclass,
 102             ARGIN(const char *message), ...)
 103 {
 104     PARROT_ASSERT(interp);
 105     if (!PARROT_WARNINGS_test(interp, warnclass))
 106         return 2;
 107     else {
 108         STRING *targ;
 109         va_list args;
 110
 111         va_start(args, message);
 112         targ = Parrot_vsprintf_c(interp, message, args);
 113         va_end(args);
 114         return print_warning(interp, targ);
 115     }
 116 }
 117
 118 /*
 119
 120 =item C<INTVAL Parrot_warn_s>
 121
 122 The Parrot C<STRING> warning/error reporter.
 123
 124 Returns 2 on error, 1 on success.
 125
 126 C<message, ..> can be a C<Parrot_vsprintf_s()> format with arguments.
 127
 128 =cut
 129
 130 */
 131
 132 PARROT_API
 133 INTVAL
 134 Parrot_warn_s(NULLOK_INTERP, INTVAL warnclass,
 135               ARGIN(STRING *message), ...)
 136 {
 137     if (!interp || !PARROT_WARNINGS_test(interp, warnclass))
 138         return 2;
 139     else {
 140         STRING *targ;
 141         va_list args;
 142
 143         va_start(args, message);
 144         targ = Parrot_vsprintf_s(interp, message, args);
 145         va_end(args);
 146
 147         return print_warning(interp, targ);
 148     }
 149 }
 150
 151 /*
 152
 153 =back
 154
 155 =head1 SEE ALSO
 156
 157 F<include/parrot/warnings.h>.
 158
 159 =cut
 160
 161 */
 162
 163
 164 /*
 165  * Local variables:
 166  *   c-file-style: "parrot"
 167  * End:
 168  * vim: expandtab shiftwidth=4:
 169  */