Re: [Gm2] Tru64/Alpha and Freebsd/i386

[Gaius Mulley]

Michael Lambert <address@hidden> writes:

> Tru64:
> 
> The gm2.paranoid test failed, not unexpectedly, on FifoQueue.mod.

Hi Michael,

I've just written this test code and it fails on the ppc architecture
but passes on the LP64 Opteron and i386 GNU/Linux.  I wonder what
happens on the Tru64/Alpha.. ?

If the program gives silence and an exit of 0 all is well, otherwise
it has exposed a set bug..

regards,
Gaius

ps on the ppc (32 bit) 8.2.0 Darwin Kernel I get


./a.out
assert failed in sets, with bit 32
assert failed in sets, with bit 33
assert failed in sets, with bit 34
assert failed in sets, with bit 35
assert failed in sets, with bit 36
assert failed in sets, with bit 37
assert failed in sets, with bit 38
assert failed in sets, with bit 39
assert failed in sets, with bit 40
assert failed in sets, with bit 41
assert failed in sets, with bit 42
assert failed in sets, with bit 43
assert failed in sets, with bit 44
assert failed in sets, with bit 45
assert failed in sets, with bit 46
assert failed in sets, with bit 47
assert failed in sets, with bit 48
assert failed in sets, with bit 49
assert failed in sets, with bit 50
assert failed in sets, with bit 51
assert failed in sets, with bit 52
assert failed in sets, with bit 53
assert failed in sets, with bit 54
assert failed in sets, with bit 55
assert failed in sets, with bit 56
assert failed in sets, with bit 57
assert failed in sets, with bit 58
assert failed in sets, with bit 59
assert failed in sets, with bit 60
assert failed in sets, with bit 61
assert failed in sets, with bit 62
assert failed in sets, with bit 63





(* Copyright (C) 2006 Free Software Foundation, Inc. *)
(* This file is part of GNU Modula-2.

GNU Modula-2 is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 2, or (at your option) any later
version.

GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License along
with gm2; see the file COPYING.  If not, write to the Free Software
Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)

MODULE setcritical ;

FROM libc IMPORT printf, exit ;

TYPE
   tokenum = (eoftok, plustok, minustok, timestok, dividetok, becomestok, 
ambersandtok, periodtok, commatok, semicolontok, lparatok, rparatok, lsbratok, 
rsbratok, lcbratok, rcbratok, uparrowtok, singlequotetok, equaltok, hashtok, 
lesstok, greatertok, lessgreatertok, lessequaltok, greaterequaltok, 
periodperiodtok, colontok, doublequotestok, bartok, andtok, arraytok, begintok, 
bytok, casetok, consttok, definitiontok, divtok, dotok, elsetok, elsiftok, 
endtok, exittok, exporttok, fortok, fromtok, iftok, implementationtok, 
importtok, intok, looptok, modtok, moduletok, nottok, oftok, ortok, pointertok, 
proceduretok, qualifiedtok, unqualifiedtok, recordtok, remtok, repeattok, 
returntok, settok, thentok, totok, typetok, untiltok, vartok, whiletok, 
withtok, asmtok, volatiletok, periodperiodperiodtok, datetok, linetok, filetok, 
attributetok, builtintok, integertok, identtok, realtok, stringtok) ;

   SetOfStop0 = SET OF [eoftok..begintok] ;
   SetOfStop1 = SET OF [bytok..settok] ;
   SetOfStop2 = SET OF [thentok..stringtok] ;

VAR
   e: INTEGER ;


(*
   Assert - 
*)

PROCEDURE Assert (b: BOOLEAN; c: CARDINAL) ;
VAR
   r: INTEGER ;
BEGIN
   IF NOT b
   THEN
      r := printf("assert failed in sets, with bit %d\n", c) ;
      e := 1
   END
END Assert ;

PROCEDURE only0 (s: SetOfStop0; enumValue: tokenum) : BOOLEAN ;
VAR
   i: tokenum ;
   c: CARDINAL ;
BEGIN
   (* just see if one bit has been set *)
   i := eoftok ;
   c := 0 ;
   REPEAT
      IF i IN s
      THEN
         INC(c)
      END ;
      INC(i)
   UNTIL i>begintok ;
   RETURN (c=1) AND (enumValue IN s)
END only0 ;

PROCEDURE only1 (s: SetOfStop1; enumValue: tokenum) : BOOLEAN ;
VAR
   i: tokenum ;
   c: CARDINAL ;
BEGIN
   (* just see if one bit has been set *)
   i := bytok ;
   c := 0 ;
   REPEAT
      IF i IN s
      THEN
         INC(c)
      END ;
      INC(i)
   UNTIL i>settok ;
   RETURN (c=1) AND (enumValue IN s)
END only1 ;

PROCEDURE only2 (s: SetOfStop2; enumValue: tokenum) : BOOLEAN ;
VAR
   i: tokenum ;
   c: CARDINAL ;
BEGIN
   (* just see if one bit has been set *)
   i := thentok ;
   c := 0 ;
   REPEAT
      IF i IN s
      THEN
         INC(c)
      END ;
      INC(i)
   UNTIL i>stringtok ;
   RETURN (c=1) AND (enumValue IN s)
END only2 ;

VAR
   i : tokenum ;
   s0: SetOfStop0 ;
   s1: SetOfStop1 ;
   s2: SetOfStop2 ;
BEGIN
   e := 0 ;
   s0 := SetOfStop0{} ;
   FOR i := eoftok TO stringtok DO
      IF ORD(i)<ORD(bytok)
      THEN
         INCL(s0, i) ;
         Assert(only0(s0, i), ORD(i)) ;
         EXCL(s0, i)
      ELSIF ORD(i)<ORD(thentok)
      THEN
         INCL(s1, i) ;
         Assert(only1(s1, i), ORD(i)) ;
         EXCL(s1, i)
      ELSE
         INCL(s2, i) ;
         Assert(only2(s2, i), ORD(i)) ;
         EXCL(s2, i)
      END
   END ;
   exit(e)
END setcritical.