Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
crude sketch of auto error checking - please help improve (#50)
* crude sketch of auto error checking

* Cleanup and add new glp functions to export tags list

* Add string output for glGetError returns

* Make glpSetAutoCheckErrors() return the current setting

And take no arguments to just return the current flag value.
  • Loading branch information
wchristian authored and devel-chm committed Apr 8, 2017
1 parent c9bb77f commit 9257866
Show file tree
Hide file tree
Showing 6 changed files with 139 additions and 6 deletions.
29 changes: 29 additions & 0 deletions Modern.xs
Expand Up @@ -11,9 +11,11 @@
#include <src/glew.c>
#include <src/glew-context.c>

#include "gl_errors.h"
#include "const-c.inc"

static int _done_glewInit = 0;
static int _auto_check_errors = 0;

/*
Maybe one day we'll allow Perl callbacks for GLDEBUGPROCARB
Expand Down Expand Up @@ -102,6 +104,33 @@ CODE:
OUTPUT:
RETVAL

int
glpSetAutoCheckErrors(...)
CODE:
int state;
if (items == 1) {
state = (int)SvIV(ST(0));
if (state != 0 && state != 1 )
croak( "Usage: glpSetAutoCheckErrors(1|0)\n" );
_auto_check_errors = state;
}
RETVAL = _auto_check_errors;
OUTPUT:
RETVAL

void
glpCheckErrors()
CODE:
int err = GL_NO_ERROR;
int error_count = 0;
while ( ( err = glGetError() ) != GL_NO_ERROR ) {
/* warn( "OpenGL error: %d", err ); */
warn( "glpCheckErrors: OpenGL error: %d %s", err, gl_error_string(err) );
error_count++;
}
if( error_count )
croak( "glpCheckErrors: %d OpenGL errors encountered.", error_count );

# This isn't a bad idea, but I postpone this API and the corresponding
# typemap hackery until later
#GLboolean
Expand Down
33 changes: 33 additions & 0 deletions gl_errors.h
@@ -0,0 +1,33 @@
/*
#define GL_NO_ERROR 0
#define GL_INVALID_ENUM 0x0500
#define GL_INVALID_VALUE 0x0501
#define GL_INVALID_OPERATION 0x0502
#define GL_STACK_OVERFLOW 0x0503
#define GL_STACK_UNDERFLOW 0x0504
#define GL_OUT_OF_MEMORY 0x0505
#define GL_INVALID_FRAMEBUFFER_OPERATION 0x0506
#define GL_CONTEXT_LOST 0x0507
*/

const char* const gl_error_symbol_strings[] = {
"GL_NO_ERROR",
"GL_INVALID_ENUM",
"GL_INVALID_VALUE",
"GL_INVALID_OPERATION",
"GL_STACK_OVERFLOW",
"GL_STACK_UNDERFLOW",
"GL_OUT_OF_MEMORY",
"GL_INVALID_FRAMEBUFFER_OPERATION",
"GL_CONTEXT_LOST",
};

int is_gl_error(int rval) {
int err;
err = rval & 0x0507 > 0 ? (rval & 0x07) + 1 : 0;
return err;
}

const char* gl_error_string(int err) {
return gl_error_symbol_strings[is_gl_error(err)];
}
2 changes: 2 additions & 0 deletions lib/OpenGL/Modern.pm
Expand Up @@ -43,6 +43,8 @@ our %EXPORT_TAGS = (
glGetString
glewInit
done_glewInit
glpSetAutoCheckErrors
glpCheckErrors
glClear
glClearColor
Expand Down
2 changes: 2 additions & 0 deletions lib/OpenGL/Modern/NameLists/Modern.pm
Expand Up @@ -7,6 +7,8 @@ sub gl_functions {
qw(
glGetString
glShaderSource_p
glpCheckErrors
glpSetAutoCheckErrors
glAccum
glActiveProgramEXT
glActiveShaderProgram
Expand Down
48 changes: 48 additions & 0 deletions t/02_auto_error_check.t
@@ -0,0 +1,48 @@
#! /usr/bin/perl

use strict;
use warnings;
use Test::More;
use OpenGL::Modern ':all';
use OpenGL::Modern::Helpers 'glGetVersion_p';
use Capture::Tiny 'capture';

SKIP: {
plan skip_all => "glewContext did not succeed, skipping live tests"
if glewCreateContext() != GLEW_OK; # returns GL_TRUE or GL_FALSE

my $gI_status = ( done_glewInit() ) ? GLEW_OK() : glewInit(); # returns GLEW_OK or ???
plan skip_all => "glewInit did not succeed, skipping live tests"
if $gI_status != GLEW_OK;

glClear GL_COLOR;
pass "didn't crash yet";

my ( $out, $err ) = capture {
eval { $@ = undef; glpCheckErrors };
};
like $err, qr/OpenGL error: 1281/, "got expected errors";
like $@, qr/1 OpenGL errors encountered/, "can check for errors manually";

eval { $@ = undef; glpSetAutoCheckErrors 3 };
is $@, "Usage: glpSetAutoCheckErrors(1|0)\n", "glpSetAutoCheckErrors only accepts 2 values";

glpSetAutoCheckErrors 1;
( $out, $err ) = capture {
eval { $@ = undef; glClear GL_COLOR };
};
like $err, qr/OpenGL error: 1281/, "got expected errors";
like $@, qr/1 OpenGL errors encountered/, "errors cause crashes now";

glpSetAutoCheckErrors 0;
glClear GL_COLOR;
pass "crashes are gone again";

( $out, $err ) = capture {
eval { $@ = undef; glpCheckErrors };
};
like $err, qr/OpenGL error: 1281/, "got expected errors";
like $@, qr/1 OpenGL errors encountered/, "but we can still check for errors manually";

done_testing;
}
31 changes: 25 additions & 6 deletions utils/generate-XS.pl
Expand Up @@ -31,6 +31,8 @@ =head1 PURPOSE
my @manual_list = qw(
glGetString
glShaderSource_p
glpCheckErrors
glpSetAutoCheckErrors
);

my %manual;
Expand Down Expand Up @@ -303,13 +305,30 @@ sub generate_glew_xs {
$decl .= " $xs_args;\n";
}

my $error_check = $name eq "glGetError" ? "" : <<"XS";
if ( _auto_check_errors ) {
int err = GL_NO_ERROR;
int error_count = 0;
while ( ( err = glGetError() ) != GL_NO_ERROR ) {
/* warn( "OpenGL error: %d", err ); */
warn( "$name: OpenGL error: %d %s", err, gl_error_string(err) );
error_count++;
}
if( error_count )
croak( "$name: %d OpenGL errors encountered.", error_count );
}
XS
chomp $error_check; # trailing newline needs to be done conditionally

my $res = $decl . <<XS;
CODE:
if ( ! _done_glewInit ) {
glewExperimental = GL_TRUE;
glewInit() || _done_glewInit++;
}
$error_check
XS

if ( $item->{glewtype} eq 'fun' and $glewImpl ) {
$res .= <<XS;
if ( ! $glewImpl ) {
Expand All @@ -318,23 +337,23 @@ sub generate_glew_xs {
XS
}

$error_check = "\n$error_check" if $error_check; # otherwise glGetError gets a stray newline

if ( $no_return_value ) {
$res .= <<XS;
$name($args);
$name($args);$error_check
XS

}
else {
$res .= " RETVAL = $name" . ( ( $item->{glewtype} eq 'var' ) ? ";\n" : "($args);\n" );
my $arg_list = $item->{glewtype} eq 'var' ? "" : "($args)";
$res .= <<XS;
RETVAL = $name$arg_list;$error_check
OUTPUT:
RETVAL
XS
}

$content .= $res;
$content .= "$res\n";
}
return $content;
}
Expand Down

0 comments on commit 9257866

Please sign in to comment.