Code coverage for types_tmp.li

///////////////////////////////////////////////////////////////////////////////
//                             Lisaac Compiler                               //
//                                                                           //
//                   LSIIT - ULP - CNRS - INRIA - FRANCE                     //
//                                                                           //
//   This program 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 3 of the License, or       //
//   (at your option) any later version.                                     //
//                                                                           //
//   This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.   //
//                                                                           //
//                     http://isaacproject.u-strasbg.fr/                     //
///////////////////////////////////////////////////////////////////////////////
Section Header

  + name    := TYPES_TMP;

  - copyright   := "2003-2007 Benoit Sonntag";


  - author  := "Sonntag Benoit (bsonntag@loria.fr)";
  - comment := "Aliser TYPE collection.";

Section Inherit

  + parent_types:Expanded TYPES;

Section Private

  - bucket:HASHED_SET(TYPES) := HASHED_SET(TYPES).create;

  - free_list:FAST_ARRAY(TYPES_TMP) := FAST_ARRAY(TYPES_TMP).create_with_capacity 5;

  + capacity:INTEGER;

  - create_types_tmp:TYPES_TMP <-
  ( + result:TYPES_TMP;

    result := clone;
    result.make_types_tmp;
    result
  );

  - make_types_tmp <-
  (
    capacity := 256;
    storage  := NATIVE_ARRAY(TYPE).calloc_intern capacity;
  )
  [ +? {is_empty}; ];

Section Public

  - print_types <-
  (
    (bucket.lower).to (bucket.upper) do { j:INTEGER;
      bucket.item j.print; '\n'.print;
    };
  );

Section Public

  - types_empty:TYPES := TYPES;

  //
  // Creation.
  //

  - new:TYPES_TMP <-
  ( + result:TYPES_TMP;

    (free_list.is_empty).if {
      result := create_types_tmp;
    } else {
      result := free_list.last;
      free_list.remove_last;
    };
    result
  );

  - update t:TYPES :TYPES <-
  [
    -? { + tmp:TYPES_TMP; tmp ?= t; tmp = NULL};
  ]
  ( + result:TYPES;

    ((t != NULL)    {t.count = count}).if {
      result := t;
      free;
    } else {
      result := to_types;
    };
    result
  );

  - to_types:TYPES <-
  ( + result:TYPES;

    (is_empty).if {
      result := types_empty;
    } else {
      result := bucket.reference_at Self with { (e1,e2:TYPES); e1 ~= e2};
      (result = NULL).if {
	result := TYPES.create Self;
	bucket.fast_add result;
      };
    };
    20 ? {result ~= Self};

    free;
    result
  );

  - clear <-
  (
    upper := -1;
  );

  - free <-
  (
    clear;
    free_list.add_last Self;
  );

  //
  // Update list.
  //

  - remove_first <-
  (
    (lower + 1).to upper do { i:INTEGER;
      storage.put (item i) to (i - 1);
    };
    upper := upper - 1;
  );

  - add t:TYPE <-
  ( + idx:INTEGER;

    (is_empty).if {
      add_last t;
    } else {
      idx := search t from 0 to count;
      (idx > upper).if {
	add_last t;
      }.elseif {item idx != t} then {
	add t to idx;
      };
    };
  )
  [
    20 ? {order_test};
  ];

  - union other:TYPES <-
  ( + idx1,idx2,t2idx:INTEGER;
    + t2:TYPE;

    {idx2 > other.upper}.until_do {
      t2    := other.item idx2;
      t2idx := t2.index;
      {(idx1 <= upper)    {item idx1.index < t2idx}}.while_do {
	idx1 := idx1 + 1;
      };
      ((idx1 > upper) || {item idx1 != t2}).if {
	add t2 to idx1;
      };
      idx1 := idx1 + 1;
      idx2 := idx2 + 1;
    };
  )
  [
    20 ? {order_test};
  ];

Section Private

  - add_last t:TYPE <-
  ( + new_capacity:INTEGER;

    (upper + 1 > capacity - 1 ).if {
      new_capacity := capacity * 2;
      storage := storage.realloc capacity with new_capacity;
      capacity := new_capacity;
    };
    upper := upper + 1;
    storage.put t to upper;
  );

  - add t:TYPE to index:INTEGER <-
  ( + new_capacity:INTEGER;
    (index = upper + 1).if {
      add_last t;
    } else {
      (upper + 1 > capacity - 1 ).if {
	new_capacity := capacity * 2;
	storage := storage.realloc capacity with new_capacity;
	capacity := new_capacity;
      };
      upper := upper + 1;
      (upper - 1).downto index do { i:INTEGER;
	storage.put (item i) to (i + 1);
      };
      storage.put t to index;
    };
  );

  - search t:TYPE from beg:INTEGER to end:INTEGER :INTEGER <-
  // Dichotomic research.
  ( + middle,result:INTEGER;

    ((end - beg) < 2).if {
      (t.index > item beg.index).if {
	result := end;
      } else {
	result := beg;
      };
    } else {
      middle := (beg + end) >> 1;
      (t.index > item middle.index).if {
	result := search t from middle to end;
      } else {
	result := search t from beg to middle;
      };
    };
    result
  );

  - order_test:BOOLEAN <-
  ( + j:INTEGER;

    {(j < upper)    {item j.index < item (j+1).index}}.while_do {
      j := j + 1;
    };
    j >= upper
  );