Learn how easy it is to sync an existing GitHub or Google Code repo to a SourceForge project! See Demo

Close

[r3046]: test / releases / 3.1.2 / tests / oorexxunit / ooRexx / base / class / ooRexx.Base.Class.Class.testUnit Maximize Restore History

Download this file

ooRexx.Base.Class.Class.testUnit    986 lines (721 with data), 35.9 kB

#!/usr/bin/rexx
/*
   name:             ooRexx.Base.Class.CircularQueue.testUnit
   author:           Rony G. Flatscher
   date:             2006-11-28
   version:          1.0.3

-- line commented lines are ignored, when building the directory of infos from this header
   changed:          2006-11-28, ---rgf, added new test case methods

   languageLevel:    6.0
   purpose:          Test the methods of the class CircularQueue.
   remark:           ---

   license:          CPL 1.0 (Common Public License v1.0, see below)
   link:

// category needs not to be numbered, importance is given by position (1=most important)
   category:         ooRexx
   category:         Base
   category:         Class
   category:         Class
*/
/*----------------------------------------------------------------------------*/
/*                                                                            */
/* Copyright (c) 2006 Rexx Language Association. All rights reserved.         */
/*                                                                            */
/* This program and the accompanying materials are made available under       */
/* the terms of the Common Public License v1.0 which accompanies this         */
/* distribution. A copy is also available at the following address:           */
/* http://www.oorexx.org/license.html                                         */
/*                                                                            */
/* Redistribution and use in source and binary forms, with or                 */
/* without modification, are permitted provided that the following            */
/* conditions are met:                                                        */
/*                                                                            */
/* Redistributions of source code must retain the above copyright             */
/* notice, this list of conditions and the following disclaimer.              */
/* Redistributions in binary form must reproduce the above copyright          */
/* notice, this list of conditions and the following disclaimer in            */
/* the documentation and/or other materials provided with the distribution.   */
/*                                                                            */
/* Neither the name of Rexx Language Association nor the names                */
/* of its contributors may be used to endorse or promote products             */
/* derived from this software without specific prior written permission.      */
/*                                                                            */
/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS        */
/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT          */
/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS          */
/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   */
/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,      */
/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED   */
/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,        */
/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY     */
/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING    */
/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS         */
/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.               */
/*                                                                            */
/*----------------------------------------------------------------------------*/


testUnitClass=.ooRexx.Base.Class.Class.TestUnit  -- change accordingly
-------------------------------------------------------------------------------------------
-- ===> adapt the "testUnitList" to your testCase classes; each element in the list is <===
-- ===> an array object, the first element containing the testCase class object, the   <===
-- ===> second element is a list of test method names which are regarded to be         <===
-- ===> mandatory (if the list remains empty all test methods are mandatory)           <===

   /* list of array objects, each containing the testUnit class object and an
      optional list of mandatory test case methods name                       */
mandatoryTestMethods=.list~new   -- no mandatory tests for this testCase class
testUnitList=.list~of( .array~of(.ooRexx.Base.Class.Class.testUnit,  mandatoryTestMethods) )




-------------------------------------------------------------------------------------------
-- ===> the following code needs not to be individualized                              <===

   -- read top comment, containing infos about this program
arrLines=.array~new
do i=1 to 150 until arrLines[i]="*/"
   arrLines[i]=sourceline(i)
end
      -- supply information for the testClass(es) in this file; the class attribute
      -- "TestCaseInfo" (a directory object, index points to a queue) will store
      -- the parsed infos
aTestUnitClass=testUnitList~at(testUnitList~first)[1] -- get first testClass

   -- will parse the array lines and store result in class object
call makeDirTestInfo aTestUnitClass, arrLines
tmpDir=aTestUnitClass~TestCaseInfo
parse source s   -- op_sys invocationType fullPathToThisFile
tmpDir~setentry("test_Case-source", s)

   -- now add this directory to other testCase classes, if any left
do arr over testUnitList
   if arr[1]=aTestUnitClass then iterate  -- already handled
   arr[1]~TestCaseInfo=tmpDir             -- save info in class object
end

-- if this file is CALLed or REQUIRED then define an entry "bRunTestLocally" in .local
-- and set it to .false; this way the independent local invocation of the tests is inhibited
if .local~hasentry("bRunTestsLocally")=.false then
   .local~bRunTestsLocally=.true -- if this file is executed directly, then run tests for debugging

if .bRunTestsLocally=.true then  -- run ALL tests in this test unit
do
   ts=.testSuite~new             -- create a testSuite
   do arr over testUnitList
      -- create a testSuite for the given test case class, use all its testmethods
      ts~addTest( .testSuite~new(arr[1]))
   end
   -- testResult=.testSuite~new(testUnitClass)~run
   testResult=ts~run       -- now run all the tests

   call simpleDumpTestResults testResult
end

   /* return list of array objects containing test case classes and
      optionally list of mandatory test methods                      */
return testUnitList



::requires ooRexxUnit.cls     -- load the ooRexxUnit classes

   /* the following "floating" methods define their own object scope and
      are stored in a directory by the runtime system and can be retrieved
      via the ".method" environment symbol   */
::method fm_object            -- getter method
  expose fm_object
  return fm_object

::method "FM_OBJECT="         -- setter method
  expose fm_object
  use arg fm_object

::method floating_Method_1
  expose fm_object
  fm_object="set by floating_method_1"
  return fm_object

::method floating_Method_2
  expose fm_object
  fm_object="set by floating_method_2"
  return fm_object

::method floating_Method_3
  expose fm_object
  fm_object="set by floating_method_3"
  return fm_object


/* ************************************************************************* */


   -- class named exactly like file
::class "ooRexx.Base.Class.Class.TestUnit" subclass TestCase public




::METHOD "test_BASECLASS"

  self~assertSame("subTest1", .object          , .object~baseclass)
  self~assertSame("subTest2", .Vehicle         , .RoadVehicle~baseclass)
  self~assertSame("subTest3", .Vehicle         , .WaterVehicle~baseclass)
  self~assertSame("subTest4", .AmphibianVehicle, .AmphibianVehicle~baseclass)



::METHOD "test_DEFAULTNAME"

  self~assertEquals("subTest1", "The Object class"        , .object~defaultName)
  self~assertEquals("subTest2", "The FAHRZEUG class"      , .fahrzeug~defaultName)
  self~assertEquals("subTest3", "The WasserFahrzeug class", .wasserfahrzeug~defaultName)


::METHOD "test_DEFINE"

  .test_a~define("TESTMETHOD", "return 'test'" )  -- define a method
  o1=.test_a~new                 -- create an instance
  self~assertEquals("subTest1", "test", o1~testmethod)
  self~assertTrue(  "subTest2", o1~hasmethod("TESTMETHOD"))

  self~assertNotNull("subTest2_01", .test_a~method("testmethod"))

      -- "unaccessible" means that from now on the method cannot resolved, even if it existed in a superclass!
  .test_a~define("testmethod")   -- make it unaccessible for new instances
  self~assertNull("subTest2_02", .test_a~method("testmethod"))

  self~assertEquals("subTest3", "test", o1~testmethod)
  self~assertTrue(  "subTest4", o1~hasmethod("TESTMETHOD"))

  o2=.test_a~new                 -- create an instance
  self~assertFalse( "subTest5", o2~hasmethod("TESTMETHOD"))
  self~assertTrue(  "subTest6", test_method_not_available(o2))
  return

test_method_not_available: procedure
  use arg o
  signal on any
  o~testmethod
  return .false
any:
  return .true


::METHOD "test_DELETE"

  .test_b2~define("TESTMETHOD", "return self~testMethod:super 'test'" )  -- define a method
  o1=.test_b2~new                 -- create an instance
  self~assertEquals("subTest1", "test_b1 test", o1~testmethod)
  self~assertTrue(  "subTest2", o1~hasmethod("TESTMETHOD"))
  self~assertTrue(  "subTest2b", o1~hasmethod("someMethod"))

     -- make TESTMETHOD unaccessible for new instances, even if superclass implements it!
  .test_b2~define("testmethod")

   -- existing instance not affected
  self~assertEquals("subTest3", "test_b1 test", o1~testmethod)
  self~assertTrue(  "subTest4", o1~hasmethod("TESTMETHOD"))
  self~assertTrue(  "subTest4b", o1~hasmethod("someMethod"))

   -- new instance has no access to "TESTMETHOD"
  o2=.test_b2~new                 -- create an instance
  self~assertFalse( "subTest5", o2~hasmethod("TESTMETHOD"))
  self~assertTrue(  "subTest6", test_method_not_available(o2))

   -- now testing DELETE
     -- this should nullify the effect of making method unavailable via DEFINE()
  .test_b2~delete("testmethod")  -- method gets deleted from .TEST_B2, not from .TEST_B1 !
  o3=.test_b2~new

  self~assertEquals("subTest7", "test_b1", o3~testmethod)
  self~assertTrue(  "subTest8", o3~hasmethod("TESTMETHOD"))
  self~assertTrue(  "subTest8b", o3~hasmethod("someMethod"))

  return

test_method_not_available: procedure
  use arg o
  signal on any
  o~testmethod
  return .false
any:
  return .true


::method "test_ENHANCED"

  o=.test_c~enhanced(.methods)      -- create an instance enhanced with the floating methods
  self~assertEquals("subTest1", "set by floating_method_1", o~floating_method_1)
  self~assertEquals("subTest2", "set by floating_method_2", o~floating_method_2)
  self~assertEquals("subTest3", "set by floating_method_3", o~floating_method_3)
  self~assertEquals("subTest4", "set by floating_method_3", o~fm_object        )
  tmp="   olah! oho! ah-sooo! "
  o~fm_object=tmp
  self~assertEquals("subTest5", tmp, o~fm_object        )
  self~assertSame("subTest6", tmp, o~fm_object        )

  tmpArg="This is an argument text."
  o2=.test_c~enhanced(.methods, tmpArg)
  self~assertEquals("subTest7", "set by floating_method_1", o2~floating_method_1)
  self~assertEquals("subTest8", "set by floating_method_2", o2~floating_method_2)
  self~assertEquals("subTest9", "set by floating_method_3", o2~floating_method_3)
  self~assertEquals("subTest10", "set by floating_method_3", o2~fm_object        )
  tmp="   olah! oho! ah-sooo! "
  o2~fm_object=tmp
  self~assertEquals("subTest11", tmp, o2~fm_object        )
  self~assertSame("subTest12", tmp, o2~fm_object        )

  self~assertEquals("subTest13", tmpArg, o2~rgf)
  o2~rgf=tmp
  self~assertEquals("subTest14", tmp, o2~rgf)
  self~assertSame("subTest15",   tmp, o2~rgf)


::method "test_ID"

  self~assertEquals("subTest01", "Object", .object~id)
  self~assertEquals("subTest02", "FAHRZEUG", .fahrzeug~id)
  self~assertEquals("subTest03", "WasserFahrzeug", .wasserFahrzeug~id)


::method "test_INIT_INHERIT_UNINHERIT_SUBCLASS_MIXINCLASS_QUERYMIXINCLASS"

   -- create a base test_class
   vehicle_Name="RGF_VEHICLE"
   rgf_vehicle=.object~subclass(vehicle_Name)
         -- define the instance methods
   rgf_vehicle~define("NAME",     "expose name; return  name")
   rgf_vehicle~define("NAME=",    "expose name; use arg name")
   rgf_vehicle~define("INIT",     "self~name=(arg(1))")

   rgf_vehicle_show_off="RGF_VEHICLE_SHOW_OFF"   -- text to return
   rgf_vehicle~define("SHOW_OFF", "return" en_quote(rgf_vehicle_show_off))

   rgf_vehicle_drive="RGF_VEHICLE_DRIVE"   -- text to return
   rgf_vehicle~define("DRIVE", "return" en_quote(rgf_vehicle_drive))

   rgf_vehicle_swim ="RGF_VEHICLE_SWIM"   -- text to return
   rgf_vehicle~define("SWIM", "return" en_quote(rgf_vehicle_swim ))

   -- create RoadVehicle
   road_Vehicle_Name="RGF_ROADVEHICLE"
   rgf_road_vehicle=rgf_vehicle~mixinclass(road_Vehicle_Name)
         -- define the instance methods
   drive_string=": I drive now..."
   rgf_road_vehicle~define("drive", "return self~name ||" en_quote(drive_string))

   -- create WaterVehicle
   water_Vehicle_Name="RGF_WaterVehicle"
   rgf_water_vehicle=rgf_vehicle~mixinclass(water_Vehicle_Name)
         -- define the instance methods
   swim_string=": I swim now..."
   rgf_water_vehicle~define("swim", "return self~name ||" en_quote(swim_string))

   -- create AmphibianVehicle
   amphibian_Vehicle_Name="RgF_AmPhIbIaNvEhIcLe"
   rgf_amphibian_vehicle=rgf_road_vehicle~subclass(amphibian_Vehicle_Name)
   rgf_amphibian_vehicle~inherit(rgf_water_vehicle)
         -- define the instance methods
   rgf_amphibian_vehicle~define("SHOW_OFF", "return self~swim self~drive" )


   -- create instances
   vo_name="SomeVehicle"
   vo=rgf_vehicle~new(vo_name)

   rvo_name="Truck"
   rvo=rgf_road_vehicle~new(rvo_name)

   wvo_name="Boat"
   wvo=rgf_water_vehicle~new(wvo_name)

   avo_name="SwimCar"
   avo=rgf_amphibian_vehicle~new(avo_name)

   ------------ assertions
      -- assert BASECLASS
   self~assertSame("subTest_01", rgf_vehicle          , rgf_vehicle~baseclass           )
   self~assertSame("subTest_02", rgf_vehicle          , rgf_road_vehicle~baseclass      )
   self~assertSame("subTest_03", rgf_vehicle          , rgf_water_vehicle~baseclass     )
   self~assertSame("subTest_04", rgf_amphibian_vehicle, rgf_amphibian_vehicle~baseclass )

      -- assert DEFAULTNAME
   self~assertEquals("subTest_05", "The" vehicle_Name "class"           , rgf_vehicle~defaultname           )
   self~assertEquals("subTest_06", "The" road_Vehicle_Name "class"      , rgf_road_vehicle~defaultname      )
   self~assertEquals("subTest_07", "The" water_Vehicle_Name "class"     , rgf_water_vehicle~defaultname     )
   self~assertEquals("subTest_08", "The" amphibian_Vehicle_Name "class" , rgf_amphibian_vehicle~defaultname )

      -- assert ID
   self~assertEquals("subTest_09", vehicle_Name           , rgf_vehicle~id           )
   self~assertEquals("subTest_10", road_Vehicle_Name      , rgf_road_vehicle~id      )
   self~assertEquals("subTest_11", water_Vehicle_Name     , rgf_water_vehicle~id     )
   self~assertEquals("subTest_12", amphibian_Vehicle_Name , rgf_amphibian_vehicle~id )

      -- assert method lookup
   self~assertEquals("subTest_13", rgf_vehicle_show_off, vo~show_off )
   self~assertEquals("subTest_14", rgf_vehicle_drive   , vo~drive    )
   self~assertEquals("subTest_15", rgf_vehicle_swim    , vo~swim     )

   self~assertEquals("subTest_16", rgf_vehicle_show_off      , rvo~show_off )
   self~assertEquals("subTest_17", rvo_name || drive_string  , rvo~drive    )
   self~assertEquals("subTest_18", rgf_vehicle_swim          , rvo~swim     )

   self~assertEquals("subTest_19", rgf_vehicle_show_off      , wvo~show_off )
   self~assertEquals("subTest_20", rgf_vehicle_drive         , wvo~drive    )
   self~assertEquals("subTest_21", wvo_name || swim_string   , wvo~swim     )

   tmp_drive=avo_name || drive_string
   tmp_swim =avo_name || swim_string
   tmp_amph = tmp_swim tmp_drive
   self~assertEquals("subTest_22", tmp_amph , avo~show_off )
   self~assertEquals("subTest_23", tmp_drive, avo~drive    )
   self~assertEquals("subTest_24", tmp_swim , avo~swim     )

   self~assertFalse("subTest_25", rgf_vehicle~queryMixinclass)
   self~assertTrue( "subTest_26", rgf_road_vehicle~queryMixinclass)
   self~assertTrue( "subTest_27", rgf_water_vehicle~queryMixinclass)
   self~assertFalse("subTest_28", rgf_amphibian_vehicle~queryMixinclass)


   ------------ uninherit "RGF_WATER_VEHICLE"
   rgf_amphibian_vehicle~uninherit(rgf_water_vehicle)
   ------------ assertions
   tmp_drive= avo_name || drive_string
   tmp_swim = rgf_vehicle_swim
   tmp_amph = tmp_swim tmp_drive
   self~assertEquals("subTest_29", tmp_amph , avo~show_off )
   self~assertEquals("subTest_30", tmp_drive, avo~drive    )
   self~assertEquals("subTest_31", tmp_swim , avo~swim     )


   ------------ inherit "RGF_WATER_VEHICLE" again !
   rgf_amphibian_vehicle~inherit(rgf_water_vehicle)
   ------------ assertions
   tmp_drive=avo_name || drive_string
   tmp_swim =avo_name || swim_string
   tmp_amph = tmp_swim tmp_drive
   self~assertEquals("subTest_32", tmp_amph , avo~show_off )
   self~assertEquals("subTest_33", tmp_drive, avo~drive    )
   self~assertEquals("subTest_34", tmp_swim , avo~swim     )

::METHOD "test_INHERIT_01"
   self~expectSyntax(97.1)
   .object~inherit(.String)

::METHOD "test_INHERIT_02"
   self~expectSyntax(98.942)
   .amphibianVehicle~inherit(.object)

::METHOD "test_INHERIT_03"
    self~expectSyntax(98.944)
   .amphibianVehicle~inherit(.roadVehicle)


::method "test_INIT_01"
  self~expectSyntax(93.901)
  cl=.class~new


::method "test_INIT_02"
  self~expectSyntax(93.902)
  cl=.class~new("what a wonderful world!", "oops.")


::method "test_METACLASS"
   self~assertSame("subTest_01", .class, .object~metaclass)
   self~assertSame("subTest_02", .class, .class~metaclass)

   cl=.object~mixinclass("test_mixin_01",    .counter)
   self~assertSame("subTest_03", .counter,   cl~metaclass)
   cl=.object~mixinclass("test_mixin_01",    .singleton)
   self~assertSame("subTest_04", .singleton, cl~metaclass)

   self~assertSame("subTest_05", .class, .counter~class)



::method "test_METACLASS_CounterSingleton_via_normal_inheritance"
      -- test counter metaclass
   cl=.object~mixinclass("test_01", .SingletonCounter_via_normal_inheritance)
   a1=cl~new
   i=4
   do i
      a2=cl~new      -- create an object
   end
   self~assertEquals("subTest_01", 5, cl~counter)  -- test whether five instances have been created
   self~assertSame("subTest_02", a1, a2)  -- test whether singleton instances


::method "test_METACLASS_SingletonCounter_via_normal_inheritance"
      -- test counter metaclass
   cl=.object~mixinclass("test_01", .CounterSingleton_via_normal_inheritance)
   a1=cl~new
   i=4
   do i
      a2=cl~new      -- create an object
   end
   self~assertSame(  "subTest_01", a1, a2)  -- test whether singleton instances
   self~assertEquals("subTest_02", 1, cl~counter)  -- test whether five instances have been created




::method "test_METHOD"

   self~assertNotNull("subTest_01", m=.WaterVehicle~method("swim"))

   -- testing for undefined method took place in "test_DEFINE" above

   self~expectSyntax(97.1)
   self~assertNull("subTest_02", m=.WaterVehicle~method("swimmolilily"))




::method "test_METHODS"
   a_o =getBags(.Object~methods(.nil))       -- get only Object methods
   a_v =getBags(.Vehicle~methods(.nil))      -- get only Vehicle methods
   a_wv=getBags(.WaterVehicle~methods(.nil)) -- get only WaterVehicle methods
   a_wv_all=getBags(.WaterVehicle~methods)   -- get all methods

   self~assertTrue("subTest_01", a_o[1]~Subset(a_wv_all[1]) )
   self~assertTrue("subTest_02", a_o[2]~Subset(a_wv_all[2]) )

   self~assertTrue("subTest_03", a_v[1]~Subset(a_wv_all[1]) )
   self~assertTrue("subTest_04", a_v[2]~Subset(a_wv_all[2]) )

   self~assertTrue("subTest_05", a_wv[1]~Subset(a_wv_all[1]) )
   self~assertTrue("subTest_06", a_wv[2]~Subset(a_wv_all[2]) )

   do i=1 to 2
      tmp=.bag~new~union(a_o[i])~union(a_v[i])~union(a_wv[i])
      self~assertTrue("subTest_07_"i, tmp~subset(a_wv_all[i]))
      self~assertTrue("subTest_07_"i, a_wv_all[i]~subset(tmp))
   end

   self~assertEquals("subTest_08", a_wv_all[1]~items, a_o[1]~items + a_v[1]~items + a_wv[1]~items)

   return

getBags: procedure         -- return indices in an index bag, and method items in a method bag
   use arg s
   a=.array~new

   if s~available then
   do
      a[1]=.bag~new    -- index
      a[2]=.bag~new    -- item (object)
   end

   do while s~available
      a[1]~put(s~index)
      a[2]~put(s~item)
      s~next
   end
   return a



::method "test_MIXINCLASS"    -- just the arguments, rest already tested
      -- test counter metaclass
   cl=.object~mixinclass("test_mixin_01", .counter)
   i=5
   do i
      cl~new      -- create an object
   end
   self~assertTrue("subTest_01", cl~counter=5)  -- test whether five instances have been created


      -- test counter metaclass, enhance class methods
   cl=.object~mixinclass("test_mixin_02", .counter, .methods)
   str=cl~floating_Method_1    -- is class method available?
   i=5
   do i
      a1=cl~new      -- create an object
   end
   self~assertTrue("subTest_02", cl~counter=5)  -- test whether five instances have been created
   self~assertEquals("subTest_03", str, cl~fm_object)


      -- test singleton metaclass
   cl=.object~mixinclass("test_mixin_03", .singleton)
   i=5
   a1=cl~new
   do i
      a2=cl~new      -- create an object
   end
   self~assertSame("subTest_04", a1, a2)  -- test whether instances are singletons


::method "test_MIXINCLASS_01"
   self~expectSyntax(99.927)
   cl=.object~mixinclass("subTest_01", not_an_existing_class)


::method "test_MIXINCLASS_02"
   self~expectSyntax(99.927)
   cl=.object~mixinclass("subTest_01", .object)



::method "test_MIXINCLASS_MULTIPLE_INHERITANCE_ON_METACLASSES_01"    -- just the arguments, rest already tested

      -- cf. working ::method "test_METACLASS_CounterSingleton_via_normal_inheritance" above !
      -- test counter metaclass
   cl=.object~mixinclass("test_mixin_01", .counterSingleton_mixinclass)
   a1=cl~new
   i=4
   do i
      a2=cl~new      -- create an object
   end
   self~assertEquals("subTest_01", 1, cl~counter)  -- test whether five instances have been created
   self~assertSame("subTest_02", a1, a2)  -- test whether singleton instances


::method "test_MIXINCLASS_MULTIPLE_INHERITANCE_ON_METACLASSES_02"    -- just the arguments, rest already tested

      -- cf. working ::method "test_METACLASS_SingletonCounter_via_normal_inheritance" above !
      -- test counter metaclass
   cl=.object~mixinclass("test_mixin_01", .SingletonCounter_mixinclass)
   a1=cl~new
   i=4
   do i
      a2=cl~new      -- create an object
   end
   self~assertSame(  "subTest_01", a1, a2)  -- test whether singleton instances
   self~assertEquals("subTest_02", 5, cl~counter)  -- test whether five instances have been created


::method "test_MIXINCLASS_MULTIPLE_INHERITANCE_ON_METACLASSES_03"    -- just the arguments, rest already tested

      -- cf. working ::method "test_METACLASS_CounterSingleton_via_normal_inheritance" above !
      -- test counter metaclass
   cl=.object~mixinclass("test_subclass_01", .counterSingleton_subclass)
   a1=cl~new
   i=4
   do i
      a2=cl~new      -- create an object
   end
   self~assertEquals("subTest_01", 1, cl~counter)  -- test whether five instances have been created
   self~assertSame("subTest_02", a1, a2)  -- test whether singleton instances


::method "test_MIXINCLASS_MULTIPLE_INHERITANCE_ON_METACLASSES_04"    -- just the arguments, rest already tested

      -- cf. working ::method "test_METACLASS_SingletonCounter_via_normal_inheritance" above !
      -- test counter metaclass
   cl=.object~mixinclass("test_subclass_01", .SingletonCounter_subclass)
   a1=cl~new
   i=4
   do i
      a2=cl~new      -- create an object
   end
   self~assertSame("subTest_01", a1, a2)  -- test whether singleton instances
   self~assertEquals("subTest_02", 5, cl~counter)  -- test whether five instances have been created



::method "test_NEW"


::method "test_SUBCLASS"      -- just the arguments, rest already tested

      -- test counter metaclass
   cl=.object~subclass("test_mixin_01", .counter)
   i=5
   do i
      cl~new      -- create an object
   end
   self~assertTrue("subTest_01", cl~counter=5)  -- test whether five instances have been created


      -- test counter metaclass, enhance class methods
   cl=.object~subclass("test_mixin_02", .counter, .methods)
   str=cl~floating_Method_1    -- is class method available?
   i=5
   do i
      a1=cl~new      -- create an object
   end
   self~assertTrue("subTest_02", cl~counter=5)  -- test whether five instances have been created
   self~assertEquals("subTest_03", str, cl~fm_object)


      -- test singleton metaclass
   cl=.object~subclass("test_mixin_03", .singleton)
   i=5
   a1=cl~new
   do i
      a2=cl~new      -- create an object
   end
   self~assertSame("subTest_04", a1, a2)  -- test whether instances are singletons


::method "test_SUBCLASS_01"
   self~expectSyntax(99.927)
   cl=.object~subclass("subtest_01", not_an_existing_class)

::method "test_SUBCLASS_02"
   self~expectSyntax(99.927)
   cl=.object~subclass("subtest_01", .object)



::method "test_SUBCLASS_MULTIPLE_INHERITANCE_ON_METACLASSES_01"    -- just the arguments, rest already tested

      -- cf. working ::method "test_METACLASS_CounterSingleton_via_normal_inheritance" above !
      -- test counter metaclass
   cl=.object~subclass("test_mixin_01", .counterSingleton_mixinclass)
   a1=cl~new
   i=4
   do i
      a2=cl~new      -- create an object
   end
   self~assertEquals("subTest_01", 1, cl~counter)  -- test whether five instances have been created
   self~assertSame("subTest_02", a1, a2)  -- test whether singleton instances


::method "test_SUBCLASS_MULTIPLE_INHERITANCE_ON_METACLASSES_02"    -- just the arguments, rest already tested

      -- cf. working ::method "test_METACLASS_SingletonCounter_via_normal_inheritance" above !
      -- test counter metaclass
   cl=.object~subclass("test_mixin_01", .SingletonCounter_mixinclass)
   a1=cl~new
   i=4
   do i
      a2=cl~new      -- create an object
   end
   self~assertSame(  "subTest_01", a1, a2)  -- test whether singleton instances
   self~assertEquals("subTest_02", 5, cl~counter)  -- test whether five instances have been created


::method "test_SUBCLASS_MULTIPLE_INHERITANCE_ON_METACLASSES_03"    -- just the arguments, rest already tested

      -- cf. working ::method "test_METACLASS_CounterSingleton_via_normal_inheritance" above !
      -- test counter metaclass
   cl=.object~subclass("test_subclass_01", .counterSingleton_subclass)
   a1=cl~new
   i=4
   do i
      a2=cl~new      -- create an object
   end
   self~assertEquals("subTest_01", 1, cl~counter)  -- test whether five instances have been created
   self~assertSame("subTest_02", a1, a2)  -- test whether singleton instances


::method "test_SUBCLASS_MULTIPLE_INHERITANCE_ON_METACLASSES_04"    -- just the arguments, rest already tested

      -- cf. working ::method "test_METACLASS_SingletonCounter_via_normal_inheritance" above !
      -- test counter metaclass
   cl=.object~subclass("test_subclass_01", .SingletonCounter_subclass)
   a1=cl~new
   i=4
   do i
      a2=cl~new      -- create an object
   end
   self~assertSame("subTest_01", a1, a2)  -- test whether singleton instances
   self~assertEquals("subTest_02", 5, cl~counter)  -- test whether five instances have been created


::method "test_SUBCLASSES"

   self~assertTrue("subTest_01: '.object~subclasses~items>15'",  .object~subclasses~items>15)
   self~assertTrue("subTest_02: '.relation~subclasses~items>0'", .relation~subclasses~items>0)
   self~assertTrue("subTest_03: '.alarm~subclasses~items=0'",    .alarm~subclasses~items=0)



::method "test_SUPERCLASSES"
   self~assertTrue("subTest_01: '.object~superclasses~items=0'", .object~superclasses~items=0)
   self~assertTrue("subTest_02: '.relation~superclasses~items=1'", .relation~superclasses~items=1)



::method "test_UNINHERIT_01"
   -- create a base test_class
   vehicle_Name="RGF_VEHICLE"
   rgf_vehicle=.object~subclass(vehicle_Name)

   -- create RoadVehicle
   road_Vehicle_Name="RGF_ROADVEHICLE"
   rgf_road_vehicle=rgf_vehicle~mixinclass(road_Vehicle_Name)

   -- create WaterVehicle
   water_Vehicle_Name="RGF_WaterVehicle"
   rgf_water_vehicle=rgf_vehicle~mixinclass(water_Vehicle_Name)

   -- create AmphibianVehicle
   amphibian_Vehicle_Name="RgF_AmPhIbIaNvEhIcLe"
   rgf_amphibian_vehicle=rgf_road_vehicle~subclass(amphibian_Vehicle_Name)
   rgf_amphibian_vehicle~inherit(rgf_water_vehicle)

   self~expectSyntax(98.945)
   rgf_amphibian_vehicle~uninherit("class that does not exist")


::method "test_UNINHERIT_02"
   -- create a base test_class
   vehicle_Name="RGF_VEHICLE"
   rgf_vehicle=.object~subclass(vehicle_Name)

   -- create RoadVehicle
   road_Vehicle_Name="RGF_ROADVEHICLE"
   rgf_road_vehicle=rgf_vehicle~mixinclass(road_Vehicle_Name)

   -- create WaterVehicle
   water_Vehicle_Name="RGF_WaterVehicle"
   rgf_water_vehicle=rgf_vehicle~mixinclass(water_Vehicle_Name)

   -- create AmphibianVehicle
   amphibian_Vehicle_Name="RgF_AmPhIbIaNvEhIcLe"
   rgf_amphibian_vehicle=rgf_road_vehicle~subclass(amphibian_Vehicle_Name)
   rgf_amphibian_vehicle~inherit(rgf_water_vehicle)

   rgf_amphibian_vehicle~uninherit(rgf_water_vehicle)

   self~expectSyntax(98.945)
   rgf_amphibian_vehicle~uninherit(rgf_water_vehicle)




/* ************************************************************************* */
/* ************************************************************************* */
/* ************************************************************************* */


/* ************************************************************************* */
::CLASS test_a    -- used in test case method "test_DEFINE"


/* ************************************************************************* */
::CLASS test_b1   -- used in test case method "test_DELETE"
::method testMethod
  return 'test_b1'

::CLASS test_b2 subclass test_b1 -- used in test case method "test_DELETE"
::method someMethod
  return 'hello'


/* ************************************************************************* */
::CLASS test_c    -- used in test case method "test_ENHANCED"
::method init
  expose rgf
  use arg rgf

::method rgf attribute

/* ************************************************************************* */


/* ************************************************************************* */
/*    Single inheritance                                                     */
/* ************************************************************************* */

::CLASS  Fahrzeug
::METHOD name    ATTRIBUTE
::METHOD INIT
  self~name = ARG(1)

::CLASS  StrassenFahrzeug  SUBCLASS Fahrzeug
::METHOD drive
  RETURN self~name": 'Ich fahre jetzt...'"

::CLASS  "WasserFahrzeug"  SUBCLASS Fahrzeug
::METHOD swim
  RETURN self~name": 'Ich schwimme jetzt...'"

/* ************************************************************************* */



/* ************************************************************************* */
/*    Multiple Inheritance: DO NOT CHANGE CLASS DEFINITION                   */
/* ************************************************************************* */

/*
/* Multiple Inheritance */
.RoadVehicle      ~new("Truck")   ~drive
.WaterVehicle     ~new("Boat")    ~swim
.AmphibianVehicle ~new("SwimCar") ~show_off
*/

::CLASS  Vehicle                                   -- base class
::METHOD name    ATTRIBUTE
::METHOD INIT
  self~name = ARG(1)

::METHOD show_off
  return "Vehicle's SHOW_OFF method"

::CLASS  RoadVehicle   MIXINCLASS Vehicle
::METHOD drive
  RETURN self~name": 'I drive now...'"

::CLASS  WaterVehicle     MIXINCLASS Vehicle
::METHOD swim
  RETURN self~name": 'I swim now...'"

::CLASS AmphibianVehicle SUBCLASS RoadVehicle INHERIT WaterVehicle
::METHOD show_off
  RETURN self~drive self~swim

/* ************************************************************************* */



/* ************************************************************************* */
/*    Metaclasses, Multiple Inheritance                                      */
/* ************************************************************************* */

   /* Metaclass: count number of new messages (to create instances) */
::class counter mixinclass class
::method init                 -- initialize attribute
  expose counter
  counter=0
  forward class (super)       -- let the superclass initialize

::method counter attribute    -- define attribute

::method new                  -- count number of instances
  expose counter
  counter=counter+1
  forward class (super)


   /* Metaclass: make sure that only one and only one instance is created and returned */
::class singleton mixinclass class
::method init                 -- initialize attribute
  expose singleton
  singleton=.nil
  forward class (super)       -- let the superclass initialize

::method singleton attribute  -- define attribute

::method new                  -- implement singleton semantics
  expose singleton

  if .nil=singleton then      -- an instance has not been created
  do
     forward class (super) continue    -- create an instance
     singleton=result                  -- save the instance
  end
  return singleton            -- return the (singleton) instance



   /* Count number of new-messages, return singleton instance.
      Uses MIXINCLASS. */
::class CounterSingleton_mixinclass mixinclass Counter inherit Singleton


   /* Return singleton instance, count number of instances (<=1)
      Uses MIXINCLASS. */
::class SingletonCounter_mixinclass mixinclass Singleton inherit Counter


   /* Count number of new-messages, return singleton instance.
      Uses SUBCLASS. */
::class CounterSingleton_subclass subclass Counter inherit Singleton


   /* Return singleton instance, count number of instances (<=1)
      Uses SUBCLASS. */
::class SingletonCounter_subclass subclass Singleton inherit Counter



   /* This time do not use multiple inheritance, but physically copy the
      singleton code, such that the semantics are: count number of new-messages,
      return singleton instance
   */
::class CounterSingleton_via_normal_inheritance mixinclass counter
::method init                 -- initialize attribute
  expose singleton
  singleton=.nil
  forward class (super)       -- let the superclass initialize

::method singleton attribute  -- define attribute

::method new                  -- implement singleton semantics
  expose singleton

  if .nil=singleton then      -- an instance has not been created
  do
     forward class (super) continue    -- create an instance
     singleton=result                  -- save the instance
  end
  return singleton            -- return the (singleton) instance



   /* This time do not use multiple inheritance, but physically copy the
      counter code, such that the semantics are: return singleton instance,
      count number of instances (<=1)
   */
::class SingletonCounter_via_normal_inheritance mixinclass singleton
::method init                 -- initialize attribute
  expose counter
  counter=0
  forward class (super)       -- let the superclass initialize

::method counter attribute    -- define attribute

::method new                  -- count number of instances
  expose counter
  counter=counter+1
  forward class (super)




/* ************************************************************************* */


::routine en_quote   -- returns string enquoted (escaping quotes within string)
  parse arg str
  q='"'     -- define quote
  return '"' || str~changestr('"', '"'||'"') || '"'