pascal p5c Code

711 lines (609 with data), 20.1 kB

#!/bin/sh

###################################################

# build and test p5x pascal compiler

# options:
#         --notest   => skip tests
#         --debug    => build debug version of p5c
# NB: only one or none of these options may be used

###################################################

BUILD=p5x
CC=gcc

function ldiff {
    diff --text --strip-trailing-cr $1 $2 | less
}

# use this difference program
if [ -n "$DISPLAY" ] && which kdiff3 &> /dev/null; then
    DIFF=kdiff3
else
    DIFF=ldiff
fi

rm -f mkcdefs pcom p5c
# first, generate maxintTarget from gcc
cat << EOF | $CC -x c - -o mkcdefs
#include <stdio.h>
#include <limits.h>
#include <float.h>
int main(void)
{
     printf(" // -- DO NOT EDIT THIS FILE --\n");
     printf("#define CDEF_MAXINT_TARGET %d\n", INT_MAX);

     printf("\n//see float.h info for more details of the following\n\n");

     printf("// accuracy of a real number\n");
     printf("#define REAL_DIGITS %d\n", DBL_DIG);

     printf("// min exponent of a real number\n");
     printf("#define REAL_MIN_EXP %d\n", DBL_MIN_10_EXP);

     printf("// max exponent of a real number\n");
     printf("#define REAL_MAX_EXP %d\n", DBL_MAX_10_EXP);

     printf("// max value of a real number\n");
     printf("#define REAL_MAX %1.*g\n", DBL_DIG+6, DBL_MAX);

     printf("// epsilon of a real number\n");
     printf("#define REAL_EPSILON %1.*g\n", DBL_DIG+6, DBL_EPSILON);

     printf("// min value of a real number\n");
     printf("#define REAL_MIN %1.*g\n", DBL_DIG+6, DBL_MIN);
}

EOF

./mkcdefs > cdefs.inc.pas

if [ "$1" = "--debug" ] ; then
    echo "building debug compiler"
    cpp -E -nostdinc pcom.pas -w | awk '!/^# 1 \"</ || $3=="\"pcom.pas\"" \
                       { sub(/\(*\$t-,d-,v-/, "(*$t-,d+,v+"); print }' > pcom.1.pas
else
    # now pcom needs to be run thru the c preprocessor
    cpp -E -nostdinc pcom.pas -w | grep -v -e "^# 1 \"<" > pcom.1.pas
fi

# initially use gnu pascal to compile pcom.pas
if which gpc > /dev/null 2> /dev/null; then
    gpc --executable-file-name=pcom -g --pointer-checking --stack-checking \
        --standard-pascal --setlimit=600 pcom.1.pas
    if [ $? -ne 0 ] ; then
        echo "gpc pascal compile failed, bailing out"
        exit
    fi

    ## pcom is the pascal to c compiler, generated by gpc

    gpc-run ./pcom --gpc-rts=-nprd:pcom.1.pas --gpc-rts=-nprc:pcom.c \
            < /dev/null > pcom.lst
else
    echo -n 'gnu pascal not found'
    if [ ! -e p5c-good.c ] ; then
        echo
        echo "you need a working pascal compiler to start"
        echo "install gnu pascal, or "
        echo "get p5c.c and use gnu c to build p5c, rename it p5c-good"
        echo "quitting";
        exit;
    fi

    echo ' ... using p5c-good.c to bootstrap pascal'
    rm -f p5c-good
    $CC -I . -lm -o p5c-good p5c-good.c
    ./p5c-good pcom.1.pas pcom.c > pcom.lst

    if ! grep -qF "Errors in program: 0" pcom.lst ; then
        tail  pcom.lst
        echo "compile failed, bailing out" >/dev/stderr
        exit 1
    fi

    $CC -I . -lm -o pcom pcom.c
    ## pcom is the pascal to c compiler, generated by p5c-good

    ./pcom  pcom.1.pas pcom.c > pcom.lst
fi

awk '{ if( $2=="****" ) {print l0 "\n" l1 "\n" $0 ;} \
       else { l0=l1; l1 = $0; }; } \
       /^Errors in program/,0; \
    ' pcom.lst

if ! grep -qF "Errors in program: 0" pcom.lst ; then
    #tail  pcom.lst
    echo "compile failed, bailing out" >/dev/stderr
    exit 1
fi

$CC -std=gnu99 -I . -o $BUILD -lm pcom.c 2> pcom.err
if [ -s pcom.err ]
then
    head pcom.err
    echo "gcc compile failed, bailing out" >/dev/stderr
    exit 1
fi


## p5x is (for now) the compiler generated by pcom

./$BUILD pcom.1.pas $BUILD.c > $BUILD.lst

echo

if ! grep -q "Errors in program: 0" $BUILD.lst ; then
    tail  $BUILD.lst
    echo "compile failed, bailing out"
    exit 1
fi

#rm pcom.1.pas

# first test: compare output generated by p5x and trusted compiler
if diff -q pcom.c $BUILD.c ; then
    echo "compiled files look OK"
elif diff -qb pcom.c $BUILD.c ; then
    echo "compiled files have different whitespace"
else
    echo "error: compiled files mismatch, quitting" >/dev/stderr
    exit 1
fi
echo

$CC -std=gnu99 -O -I . -o $BUILD -lm $BUILD.c 2> $BUILD.err
if [ -s $BUILD.err ]
then
    head $BUILD.err
    echo "gcc compile failed, bailing out" > /dev/stderr
    exit 1
fi

## p5x is now generated by itself

if [ "$1" = "--notest" ] ; then
    echo "skipping tests"
    exit 0
fi


## now run the other tests

export P5CDIR=`pwd`
#echo using $P5CDIR

echo "running p5x test program ..."
rm -f tp5x
./r tp5x arg1 arg2 arg3 | tee tp5x.out | awk 'BEGIN { IGNORECASE = 1; np=0; nf=0; } \
                /FAIL/ {nf++; print}; \
                /PASS/ {np++;}; \
                END { print np, "tests passed,", nf==1? "one test": nf " tests", "failed" }'

if ! grep -qF "Errors in program: 0" tp5x.lst ; then
    echo "bailing out now"
    exit 1
fi

if grep -qF ": error:" tp5x.err ; then
    echo "c code generation error - bailing out now"
    exit 1
fi

if diff -qs -I "today's date is .\+, the time is .\+" \
            -I "daylight saving time" \
            tp5x.out tp5x.cmp ; then
    # check date in the out file

    awk 'BEGIN {                                \
     FS="[,: ]";                                \
     month["Jan"] = 1;                          \
     month["Feb"] = 2;                          \
     month["Mar"] = 3;                          \
     month["Apr"] = 4;                          \
     month["May"] = 5;                          \
     month["Jun"] = 6;                          \
     month["Jul"] = 7;                          \
     month["Aug"] = 8;                          \
     month["Sep"] = 9;                          \
     month["Oct"] = 10;                         \
     month["Nov"] = 11;                         \
     month["Dec"] = 12;                         \
     }                                          \
                                                \
     /today.s date is .+, the time is .+/      \
     {                                    \
     yyyy = $7;                      \
     mo = month[$6];                 \
     dd = $5;                        \
     hh = $12;                       \
     # h, mins, secs can be one or 2 digits each ... \
     #   for(i=1;i<=NF;i++) print i "th field is \"" $i "\"";       \
     i = 12;                         \
     if(!$i) i++;                \
     hh = $i; i++;                     \
     if(!$i) i++;                \
     min = $i; i++;\
     if(!$i) i++;                \
     ss = $i; \
     getline;                                           \
     if($1=/daylight/ && NF==3) dst=1;                    \
     else if($2=/daylight/ && NF==4) dst=0;                    \
     else if($1=/daylight/ && NF==4) dst=-1;                   \
     else {print "dst line not found"; dst=""}    \
                                                        \
     $0 = ""; $1=yyyy; $2=mo; $3=dd; $4=hh; $5=min; $6=ss; $7=dst;       \
     # assuming gnu awk, other versions might not work for this bit ...
     timestamp = mktime($0);                                            \
     ago = systime() - timestamp;                                       \
     print "date in " FILENAME " is " $0 ",  this was " ago " seconds ago";  \
     if( ago > 5 ) {print "date test failed"; exit(1);}  \
     else { print "date test passed"; exit(0);} }' tp5x.out;

    if [ $? -ne 0 ] ; then
        echo "please check date function manually"
        read -rsp $'Press any key to continue...\n' -n1 key
    else
        echo "p5x tests passed"
    fi
else
    $DIFF tp5x.out tp5x.cmp
fi

echo
echo "test again with debug on ..."
sed 's/{$d-,v-}/{$d+,v+}/' < tp5x.pas > tp5xd.pas
rm -f tp5xd
./r tp5xd arg1d arg2d arg3d > tp5xd.out
if ! grep -qF "Errors in program: 0" tp5xd.lst ; then
    echo "bailing out now"
    exit 1
fi

if grep -qF ": error:" tp5xd.err ; then
    echo "c code generation error - bailing out now"
    exit 1
fi

if sed '/argv/ s/d /  /' tp5xd.out | diff -qs -I "today's date is .\+, the time is .\+" --label "tp5xd.out" - tp5x.out; then

    echo "p5x tests pass with debug turned on"
else
    $DIFF tp5x.out tp5xd.out
fi


echo
cat << EOF > thalt.p
program thalt (output);
begin
  if argc > 1 then begin
    writeln('quitting with exit code -1');
    halt(-1)
  end
  else begin
    writeln('quitting with exit code 0');
    halt;
  end;
end.
EOF

./r thalt
if [ $? -eq 0 ] ; then
  echo "halt OK"
else
  echo "halt failed"
  read -rsp $'Press any key to continue...\n' -n1 key
fi

./thalt 1
rc=$?
if [ $rc -eq 255 ] ; then
  echo "halt OK"
else
  echo "halt failed"
  read -rsp $'Press any key to continue...\n' -n1 key
fi

echo
rm -f tfile
echo "read is OK" > in.txt
./r tfile in.txt out.txt > /dev/null

echo
if [ -f out.txt ]
then
  if file -bi out.txt | grep -q text
  then
     if [ 1 == $(wc -l < out.txt) ]
     then
        if grep -q "this is a response from tfile" out.txt
        then
           echo "external file write is OK"
        else
           echo "external file write has unexpected contents"
           read -rsp $'Press any key to continue ... ' -n1
           echo
        fi
     else
        echo "external file write has unexpected number of lines"
           read -rsp $'Press any key to continue ... ' -n1
           echo
     fi
  else
      echo "external file should be a text file, but looks like it isn't"
      read -rsp $'Press any key to continue ... ' -n1
      echo
  fi
else
   echo "external file write failed"
   read -rsp $'Press any key to continue ... ' -n1
   echo
fi

if [ 1 == $(wc -l < in.txt) ]
  then
     echo "external file write termination is OK"
  else
     echo "external file write is incorrectly terminated"
     read -rsp $'Press any key to continue ... ' -n1
     echo
fi

if [ -f assign.txt ]
then
  if file -bi assign.txt | grep -q text
  then
     if [ 1 == $(wc -l < assign.txt) ]
     then
        if grep -q 'assign test: ***' assign.txt
        then
           echo "assign file write is OK"
        else
           echo "assign file write has unexpected contents"
           read -rsp $'Press any key to continue...\n' -n1 key
        fi
     else
        echo "assign file write has unexpected number of lines"
        read -rsp $'Press any key to continue...\n' -n1 key
     fi
  else
      echo "assign file should be a text file, but looks like it isn't"
      read -rsp $'Press any key to continue...\n' -n1 key
  fi
else
   echo "assign file write failed"
   read -rsp $'Press any key to continue...\n' -n1 key
fi

echo
echo -n "testing string library ..."
rm -f tstring
#TODO: check this test completes
if echo "123456" | ./r tstring.pas | grep failed ; then
    echo "string test failed"
    read -rsp $'Press any key to continue...\n' -n1 key
else
    echo "string test passed"
fi

echo
# run the main p5c test program

# first check that the test program knows how many open files are allowed

awk 'BEGIN {                          \
     cmd = "ulimit -n";               \
     cmd | getline nf;                \
     close(cmd);                      \
     }                                \
                                      \
     /ulimit/ { sub(/;/, "", $3); \
                if( $3 != nf-3 ) { \
                  print "tp5c.pas line", NR, ": file limit test should use", nf-3, "files, currently set to", $3 "!!!!"; \
                                 exit 1; } }' < tp5c.pas
if [ $? -ne 0 ] ; then
   #TODO: fix it then
    read -rsp $'Press any key to continue ... ' -n1
    echo
fi


rm -f tp5c
echo tp5c
./pc -cpp tp5c
if ! grep -qF "Errors in program: 0" tp5c.lst ; then
    echo "bailing out now"
    exit 1
fi

if grep -qF ": error:" tp5c.err ; then
    echo "c code generation error - bailing out now"
    exit 1
fi

# check all warnings occur as expected
# each warning in tp5c must be marked with a {%%Wn ...} comment,
# where n is warning nr.
# the warning must appear on the following line
#
awk 'BEGIN { nr_passes = 0; \
             nr_wrong = 0;      ## wrong warnings\
             nr_not_found = 0;  ## warnings expected but not found\
             nr_unexpected = 0; ## count warnings found but unexpected \
             print "\n";
           }

/{%%W/{ wi=index($0,"%%W");  \
        ws=substr($0, wi+3 );      \
        wnum=strtonum(ws);    \
        getline; \
        if( $3 ~ /\^W/ ) { \
             if( strtonum(substr($3,3)) == wnum )       \
                  nr_passes++;                          \
             else {nr_wrong++; \
                  print "wrong warning at line", $1; \
             }
             getline; # done with warning line
        }
        else { nr_not_found++; \
             print "warning not found at line ", $1; \
        }
      }
     /\^W1/ {nr_unexpected++; \
             print "unexpected warning found at line", $1; \
            }

END { \
       print "warnings verification test: ", nr_passes, "passed"; \
       if( nr_not_found+nr_unexpected+nr_wrong == 0 ) \
            print "all tests passed";               \
       else {
            if( nr_unexpected == 1 ) print "one warning unexpected";    \
            else print nr_unexpected, "unexpected warnings";
            if( nr_not_found == 1 ) print "one warning not found";    \
            else print nr_not_found, "warnings not found";
            if( nr_wrong == 1 ) print "one wrong warning";    \
            else print nr_wrong, "wrong warnings"; \
       }
       exit (nr_wrong + nr_unexpected + nr_not_found) == 0;
    } ' tp5c.lst
if [ $? -eq 0 ] ; then
    read -rsp $'Press any key to continue ...' -n1
    echo
fi


# inspect generated c code to check that set bound calcs are correct
#
#   expected bounds are contained in a line like this
#   iStrxxxx## -50  50xxx;
#
#   where xxx is arbitrary text, -50 and 50 are the lower and upper bounds
#
#   result bounds appear in the next few lines and look like this
#   xxxxxxxxuint8_t s0[(50>>3)-(-50>>3)xxx
#
#   note this time the bounds are in the opposite order.
#

awk 'BEGIN { \
             nr_passes = 0; \
             nr_fails = 0; \
             print "\n"; \
           } \
  \
/iStr.*## *-?[0-9]+ +-?[0-9]+/ { \
  match( $0, /.*## *(-?[0-9]+) +(-?[0-9]+)/, el); \
  #print "line", NR, ": expected bounds are ", el[1], "..", el[2]; \
  do{ \
    getline; \
  } while( $0 !~ /uint8_t \$s0\[/ );  \
  #print "line", NR, ":", $0 \
  match( $0, /.*uint8_t \$s0\[\((-?[0-9]+)>>3\).*-\((-?[0-9]+)>>3\)/, rl); \
  #print "line", NR, ": result bounds are ", rl[2], "..", rl[1]; \
  if( rl[2] == el[1] && rl[1] == el[2] ) nr_passes++; \
  if( rl[2] != el[1] ) { \
     nr_fails++; \
     print "**** problem with lower bound at line", NR, ": expected", el[1], "found", rl[2]                \
          } \
  if( rl[1] != el[2] ) { \
     nr_fails++; \
     print "**** problem with upper bound at line", NR, ": expected", el[2], "found", rl[1]    \
          } \

} \
  \
END { \
       print "code inspection test: ", nr_passes, "passed, "; \
       if( nr_fails == 0 ) print "all tests passed\n"; \
       else if( nr_fails == 1 ) print "one failure\n"; \
       else print nr_fails, "failures\n"; \
       exit nr_fails == 0;
    } ' tp5c.c
if [ $? -eq 0 ] ; then
    read -rsp $'Press any key to continue ...' -n1
    echo
fi

tail -18 tp5c.c | head -16 | md5sum | grep -q 010a1eee7a7b1b6ebefced0b3e617a96
if [ $? -eq 0 ] && \
   grep -q "inline void p01_2(void) {" tp5c.c && \
   grep -q "register int  /\* form (0) \*/ ai_3;" tp5c.c ; then
    echo "embedded c code test passes"
else
    echo "embedded c code test failed"
    read -rsp $'Press any key to continue ... ' -n1
    echo
fi

rm -f tp5c.out
./tp5c | tee tp5c.out | awk 'BEGIN { IGNORECASE = 1; np=0; nf=0; } \
                /FAIL/ {nf++; print}; \
                /PASS/ {np++;}; \
                END { print "tp5c:", np, "tests passed,", nf==1? "one test": nf " tests", "failed" }'
grep "fail" tp5c.out
svn ls tp5c.out &> /dev/null && svn diff tp5c.out

echo
echo "test again with debug on ..."
sed 's/{$d-,v-}/{$d+,v+,w-}/' < tp5c.pas > tp5cd.pas
rm -f tp5cd tp5cd.out
echo tp5cd
./r -cpp tp5cd | tee tp5cd.out | awk 'BEGIN { IGNORECASE = 1; np=0; nf=0; } \
                /FAIL/ {nf++; print}; \
                /PASS/ {np++;}; \
                END { print np, "tests passed,", nf==1? "one test": nf " tests", "failed" }'

 if [ ! -x tp5cd ] ; then
        echo "tp5cd compile failed, bailing out" >/dev/stderr
        exit 1
 fi

 diff -qs tp5c.out tp5cd.out || $DIFF tp5c.out tp5cd.out

echo
rm -f tclib
./r -cpp tclib | tee tclib.out
if ! grep -q "c library tests passed" tclib.out ; then
   echo "tclib test failed"
   read -rsp $'Press any key to continue ...' -n1
   echo
fi

rm -f copytext copytextf

echo    "1: this is a text file to test copytext.p"      > in.txt
echo    "2: note that the last line is not terminated"  >> in.txt
echo                                                    >> in.txt
echo                                                    >> in.txt
echo    "3: next line is last line"                     >> in.txt
echo -n "4: last line"                                  >> in.txt

cat << EOF > copytext.p
program copytext (input, output);
var ch : char;
begin
 while not eof do begin
  while not eoln do begin read(ch); write(ch) end;
  readln; writeln
 end
end.
EOF


./r copytext < in.txt > /dev/null
./copytext < in.txt > out1.txt

echo
cat << EOF > copytextf.p
program copytextf (infile, outfile);
var ch : char;
    infile, outfile: text;
begin
 reset(infile); rewrite(outfile);
 while not eof(infile) do begin
  while not eoln(infile) do begin read(infile, ch); write(outfile, ch) end;
  readln(infile); writeln(outfile)
 end
end.
EOF


./r copytextf in.txt out2.txt

# add new line to in.txt, check out.txt is identical
echo >> in.txt


if diff -q --text --strip-trailing-cr in.txt out1.txt >/dev/null ; then
  echo "read/write standard in/out OK"
else
  echo "read/write standard in/out failed"
  read -rsp $'Press any key to continue ...' -n1
  echo
fi

if diff -q --text --strip-trailing-cr in.txt out2.txt >/dev/null ; then
  echo "read/write file in/out OK"
else
  echo "read/write file in/out failed"
  read -rsp $'Press any key to continue ... ' -n1
  echo
fi

echo
echo -n "pan test ... "
./pan tpan > tpan.rpt
if which svn > /dev/null 2> /dev/null && svn ls tpan.rpt 2> /dev/null ; then
    if [ `svn diff --diff-cmd diff --extensions "-I analysis" tpan.rpt | \
       wc -l ` -ne  2 ] ; then
        svn diff tpan.rpt
    else
        svn revert -q tpan.rpt
        echo "OK"
    fi
else
    echo "skipped - no previous version of tpan.rpt"
fi


# run more tests
for d in *-tests ; do
    if [ -d $d ] ; then
        pushd $d > /dev/null

        if which xset &> /dev/null && xset q &>/dev/null; then
            xterm -title $d -e ./test.sh &
        else
            #echo "No X server at \$DISPLAY [$DISPLAY]" >&2
            ./test.sh
        fi

        popd
    fi
done;


echo
echo -n "set test program test4.p ... "
rm -f tgen test4*
./r tgen test4.p >/dev/null 2>&1
./pc test4.p
if [ -e ./test4 ] ; then
    if [ $(./test4 | grep -cv pass) -eq 0 ] ; then
        echo " passed"

        # comment out this test if it consumes too much memory or time
        echo -n "set test program test5.p ... "
        rm -f tgen test5*
        ./r -DN=5 -DM=31 tgen test5.p >/dev/null 2>&1
        test -e test5.p && ./pc test5
        if [ -e ./test5 ]; then
            if [ $(./test5 | grep -cv pass) -eq 0 ] ; then
                echo "passed"
            else
                ./test5 | grep -v pass
                read -rsp $' failed, Press any key to continue ... ' -n1
                echo
            fi
        else
            echo "not generated"
            read -rsp $'Press any key to continue ... ' -n1
            echo
        fi

    else
        ./test4 | grep -v pass
        read -rsp $'Press any key to continue ... ' -n1
        echo
    fi
else
    echo "not generated"
    read -rsp $'Press any key to continue ...' -n1
    echo
fi