Quelle  ringbuffer.cob

         IDENTIFICATION DIVISION.
         CLASS-ID. "Ringbuffer"  Inherits SOMObject.
      *   aus Hoffmann, Software-Qualität
      *   p184, Kapitel 4, Tests
      *   Springer 2008
         ENVIRONMENT DIVISION.
         Configuration Section.
         DATA DIVISION.
         Working-Storage Section.
           77 a        pic 9(4) occurs 8.
           77 readptr  pic 9(4).
           77 writeptr pic 9(4).
         PROCEDURE DIVISION.
         
         IDENTIFICATION DIVISION.
         METHOD-ID. "Writex" .
         DATA DIVISION.
         Working-Storage Section.
         Linkage Section.
         01 valu pic 9(4).
         PROCEDURE DIVISION Using valu .
           move valu to a(writeptr).
           compute writeptr = (writeptr+1)
           compute writeptr = function mod(writeptr,2)
           if readptr = writeptr then
             compute readptr = (readptr+1)
             compute readptr = function mod(readptr,2)
           end-if  
         END METHOD "Writex" .
         
         IDENTIFICATION DIVISION.
         METHOD-ID. "Readx" .
         DATA DIVISION.
         Working-Storage Section.
         01 resul pic 9(4).
         PROCEDURE DIVISION.
           move a(readptr) to resul.
           if readptr not= writeptr then
             compute readptr = (readptr+1)
             compute readptr = function mod(readptr,2)
           end-if  
         END METHOD "Readx" .
         
         
        END CLASS "Ringbuffer" .