develooper Front page | perl.perl5.porters | Postings from September 2000

Internal API regression tests

From:
Simon Cozens
Date:
September 14, 2000 16:06
Subject:
Internal API regression tests
Message ID:
20000915000413.A14281@deep-dark-truthful-mirror.perlhacker.org
I've been working on these, but I'm stopping now before I put a load more
effort into them to give people the chance to tell me why we don't need them.
:)

--- /dev/null	Mon Sep 11 23:54:05 2000
+++ t/internal/Makefile.SH	Thu Sep 14 23:15:06 2000
@@ -0,0 +1,69 @@
+case $CONFIGDOTSH in
+'')
+	if test -f config.sh; then TOP=.;
+	elif test -f ../config.sh; then TOP=..;
+	elif test -f ../../config.sh; then TOP=../..;
+	elif test -f ../../../config.sh; then TOP=../../..;
+	elif test -f ../../../../config.sh; then TOP=../../../..;
+	else
+		echo "Can't find config.sh."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "$0" in
+*/Makefile.SH) cd `expr X$0 : 'X\(.*\)/'` ;;
+Makefile.SH) ;;
+*) case `pwd` in
+   */t/interal) ;;
+   *) if test -d t/internal; then cd t/internal
+      else echo "Can't figure out where to write output."; exit 1
+	  fi;;
+   esac;;
+esac
+
+echo "Extracting t/internal/Makefile (with variable substitutions)"
+rm -f Makefile
+cat >Makefile <<!GROK!THIS!
+
+CC = $cc
+LDFLAGS = $ldflags -L../..
+CCFLAGS = -I../..
+
+libs = $libs -lperl
+
+.SUFFIXES: .c \$(OBJ_EXT)
+
+!GROK!THIS!
+
+cat >>Makefile <<'!NO!SUBS!'
+
+REALPERL = ../../perl
+
+tests = init.t
+
+all: $(tests)
+
+%.t : %.c
+	$(CC) $(CCFLAGS) -o $@ $(LDFLAGS) $< $(libs)
+
+clean:
+	rm -f *.t
+
+realclean: clean
+	rm -f core 
+
+veryclean: realclean
+	rm -f *~ *.orig
+
+!NO!SUBS!
+$eunicefix Makefile
+case `pwd` in
+*SH)
+    $rm -f ../Makefile
+    $ln Makefile ../Makefile
+    ;;
+esac
+rm -f $firstmakefile
--- /dev/null	Mon Sep 11 23:54:05 2000
+++ t/internal/base.c	Thu Sep 14 23:18:45 2000
@@ -0,0 +1,29 @@
+#include <EXTERN.h>
+#include <perl.h>
+
+static PerlInterpreter *my_perl;
+
+main (int argc, char **argv, char **env)
+{
+    char *embedding[] = { "", "-e", "print \"ok 4\\n\"" };
+    printf("1..7\n");
+
+    my_perl = perl_alloc();
+    if (my_perl)
+	printf("ok 1\n");
+
+    perl_construct( my_perl );
+    printf("ok 2\n");
+
+    perl_parse(my_perl, NULL, 3, embedding, NULL);
+    printf("ok 3\n");
+
+    perl_run(my_perl);
+    printf("ok 5\n");
+
+    perl_destruct(my_perl);
+    printf("ok 6\n");
+
+    perl_free(my_perl);
+    printf("ok 7\n");
+}
--- /dev/null	Mon Sep 11 23:54:05 2000
+++ t/internal/sv.c	Fri Sep 15 00:00:24 2000
@@ -0,0 +1,59 @@
+#include <EXTERN.h>
+#include <perl.h>
+#define test(cond) printf("%sok %i\n", !(cond) ? "not ":"", i++)
+
+int i = 1;
+static PerlInterpreter *my_perl;
+
+main (int argc, char **argv, char **env)
+{    
+    char *embedding[] = { "", "-e", "0" };
+    SV* sv;
+    
+    my_perl = perl_alloc();
+    perl_construct( my_perl );
+    perl_parse(my_perl, NULL, 3, embedding, NULL);
+    perl_run(my_perl);
+
+    printf("1..22\n");
+    
+    sv = NEWSV(1,0);
+    test(sv);
+
+    sv_setiv(sv,12);
+    test(SvIOK(sv));
+    test(SvIV(sv) == 12);
+    test(sv_true(sv));
+    
+    test(!SvPOK(sv));
+    test(strEQ(SvPV(sv, PL_na), "12"));
+    test(SvPOK(sv));
+    
+    test(!SvNOK(sv));
+    test(SvNV(sv) == 12.0);
+    test(SvNOK(sv));
+
+    sv_catpv(sv, "1.01");
+    test(!SvNOK(sv));
+    test(!SvIOK(sv));
+
+    test(strEQ(SvPV(sv, PL_na), "121.01"));
+
+    sv_dec(sv);
+    test(!SvIOK(sv));
+    test(!SvPOK(sv));
+    test(SvNOK(sv));
+    test(SvNV(sv) == 120.01);
+    test(strEQ(SvPV(sv, PL_na), "120.01"));
+
+    sv_catpv(sv, "a");
+    test(SvPOK(sv) && !SvNOK(sv));
+    sv_inc(sv);
+    test(SvNOK(sv) && !SvPOK(sv));
+    test(strEQ(SvPV(sv, PL_na), "121.01"));
+
+    test(sv_len(sv) == 6);
+
+    perl_destruct(my_perl);
+    perl_free(my_perl);
+}

-- 
<boojum> luckily, my toes have no trailing newline characters



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About