What follows below is an error that I have encountered. It is mostly a
user error (not understanding the translation process) problem. But in
part could be ameliorated with an appropriate warning message in the
Unicon compiler.
Just an aside, I have downloaded the latest svn source, and the version
date has not changed. Under what circumstances does this change?
unicon -version
Unicon Version 12.1. April 13, 2013
unicon -features
UNIX
POSIX
DBM
ASCII
co-expressions
concurrent threads
dynamic loading
environment variables
event monitoring
external functions
keyboard functions
large integers
multiple programs
pipes
pseudo terminals
system function
messaging
graphics
3D graphics
X Windows
libz file compression
PNG images
CCompiler gcc 4.7.2
Revision 3516
Arch x86_32
Binaries at /home/bruce/unicon/bin/
Error being reported. I have a test program in which I have created a
class A which contains a method A. I get the following error when
running the class call the first time.
./testClassObject
Run-time error 107
File testClassObject.icn; Line 53
record expected
offending value: &null
Traceback:
main()
A() from line 6 in testClassObject.icn
A_initially(object A_1()) from line 85 in testClassObject.icn
A_A(object A_1(),&null) from line 61 in testClassObject.icn
{&null . A} from line 53 in testClassObject.icn
The relevant code files are attached. Hopefully the code will make
sense. It is part of a CSG code development that I am doing. At the
moment, I am building a set of test files for each of the classes. From
my understanding, there should be no conflicts between the method name
and the name of the class itself.
Just having a further look at the problem, this using the -E option, I
notice that if attempting to access the class name when you have a class
name the same as a method name, it finds the method name.
Hence, it may be worth adding a warning that there is a method name the
same as the class name. Admittedly, this is only a problem if you are
creating a singleton, which is the case that I am doing here.
Lastly, for Clinton. Would you mind having a quick look at the code and
giving me a critique in terms of whether you would want to have such
code available in the IPL or UPL? If and only if you find it applicable
or interesting, we can continue this via email. If it doesn't look
appropriate, I'll just keep it in my private code base.
At any rate, to all a good night and an interesting week ahead.
Hopefully, you are having better weather than the rain and wind we are
experiencing here tonight. Wind's blowing and rain's pouring.
regards
Bruce Rennie
########################################################################
# #
# file : classobject.icn #
# #
# Author : Bruce Rennie #
# Date : 11-July-2013 #
# #
# Purpose: This provides a generalised object value and object algebra #
# facility for use in other classes and objects. It is based #
# on the Error class for common error handling facilities. #
# #
# #
# Conventions: #
# Private fields start with __ #
# Private methods start with _ or __ #
# #
# Private classes start with __ #
# Private classes have an associated Public Class #
# #
########################################################################
# #
# Public Classes: #
# #
# class ClassObject : Error() #
# class ClassClass : ClassObject() #
# #
########################################################################
# #
# Private Classes: #
# #
########################################################################
# #
# Private Fields: #
# #
########################################################################
# #
# Public Fields: #
# #
########################################################################
# #
# Private Methods: #
# #
# class ClassClass #
# __InitClass() -> returns the name of the originating #
# class #
# #
########################################################################
# #
# Public Methods: #
# #
# Inherit from class Error() #
# StopMessage(param[]) -: Halts program with message param[] #
# PrintMessage(param[]) -: Print message param[] onto current #
# error file (default &errout) #
# Caller() -> name of procedure or method that has #
# called the current procedure #
# ProcedureCalling(level) #
# -> name of procedure that has called #
# the current procedure #
# ClassCalling(level) -> name of the class that has called the #
# current procedure #
# MethodCalling(level) -> name of the method that has called the #
# current procedure #
# ParamCalling(level) -> the list of parameters from the calling #
# procedure #
# CallingComponents(name) #
# -> return a list containing the components #
# the calling procedure or class/method #
# Debug(mode) -: sets whether the Debug mode is on or #
# for all methods that test this #
# DebugMode() -> succeeds if debug mode is on, fails if #
# debug mode if off #
# ErrorOut(errorfile, writeappend) #
# -> Sets the errorout file to be used, #
# if called with no parameters, sets to #
# &errout, otherwise if a string, opens #
# the specified file based on writeappend #
# ("w" for write, "a" for append, default #
# is "w"), if errorfile is an open file, #
# the output will be sent to this file #
# #
# ###################### #
# classes and method found in this file #
# #
# class ClassObject #
# New(objectparams[]) -> return a new object of the private #
# object class associated with the public #
# class class #
# Copy() -> returns a copy of the calling object #
# ClassName() -> returns the name of the public class #
# to which the current object private #
# is associated with #
# #
# class ClassClass #
# SetClass(obj) -: sets the associated private object #
# class to the public class class #
# #
########################################################################
# #
# Public Procedures: #
# IsObjectOf(val, expectedtypes[]) #
# -> tests if the object is a member of any #
# of the supplied public class names. Any #
# object belonging to a subclass is a #
# member of the superclass, on success it #
# returns the name of the public class #
# this object belongs #
# IsObject(val) -> tests if value given is an object of #
# any kind and on success returns the #
# of the public class this object belongs #
# to #
# ObjectProperties(objectorclassname) #
# -> a generator returning the field names #
# and method names available to an object #
# or to the string name of a public class #
# class #
# AlreadyRun(obj) -> succeeds if a public class class has #
# been run and converted to a singleton #
# object representing the public class #
# class #
# SuperClass(obj) -> returns a list containing all the names #
# of the superclasses for this obj. #
# Private class names are converted to #
# associated public class name #
# DeepCopy(obj) -> returns a copy of the value or object #
# given. The copy process is applied to #
# levels of the object, including any and #
# structures found in the object #
# #
########################################################################
# required link statements
link ximage
link equiv
link numbers
link error
# required import statements
import lang
# required global statements
global __ClassToObject, __ObjectToClass
# class ClassClass - This class is used as a parent of all classes that
# provide general facilities for an associated object
# class
#
# An example is to be found in the Matrix class and associated matrix
# objects
#
class ClassClass : ClassObject()
method SetClass(obj)
local procname, objname, objID, i := 0
static type
initial {
type := proc("type", 0)
/__ClassToObject := table()
/__ObjectToClass := table()
}
objID := __InitClass()
image(obj) ? {="procedure "; objname := tab(0) }
__ObjectToClass[objname] := objID
__ObjectToClass[objID] := objID
__ObjectToClass[trim(objname, "_", 0)] := objID
if type(obj) == "procedure" then {
__ClassToObject[objID] := obj
} else
if procname := classname(obj) then {
__ClassToObject[objID] := proc(procname)
} else
if type(obj) == "string" then {
__ClassToObject[objID] := proc(obj)
} else
StopMessage("Unable to set the Class object creator:",
ximage(obj))
end
method __InitClass()
local classId, i := 0
while classId := ClassCalling(i +:= 1)
return classId
end
initially()
if not AlreadyRun(ClassClass) then {
self.ClassObject.initially()
ClassClass := self
}
end
# class ClassObject - This is the parent object for object classes that
# have an associated operations class
#
class ClassObject : Error()
method New(objectparams[])
local printargs := "", i := 0, name, func
name := ClassName()
/__ClassToObject := table()
/__ObjectToClass := table()
if func := \__ClassToObject[name] then
return func ! objectparams
else
if not DebugMode() then
return fail
else {
every printargs ||:= "Parameter " || (i +:= 1) || ": " ||
ximage(!objectparams) || "\n"
StopMessage("When creating Object of ", name,
" one or more arguments were incorrect:\n",
printargs)
}
end
method Copy()
return DeepCopy(self)
end
method ClassName()
local name := classname(self)
return \__ObjectToClass[name]
end
initially()
if not AlreadyRun(Error) then
self.Error.initially()
if not AlreadyRun(ClassObject) then {
/__ClassToObject := table()
/__ObjectToClass := table()
ClassObject := self
}
end
# procedure IsObjectOf(val, expectedtypes[])
procedure IsObjectOf(val, expectedtypes[])
local tx, parentclass, p, pc1
static type
initial {
type := proc("type", 0)
}
image(val) ? { ="record"; tx := tab(0)}
parentclass := SuperClass(val)
/parentclass := []
pc1 := []
every p := !parentclass do {
#write(p)
put(pc1, \__ObjectToClass[p] | p)
}
push(pc1, classname(val) & val.ClassName())
if \tx & \classname(val) & (!pc1 == !expectedtypes) then
return val.ClassName()
else
fail
end
# procedure IsObject(val)
procedure IsObject(val)
local tx
static type
initial {
type := proc("type", 0)
}
image(val) ? { ="record"; tx := tab(0)}
if \tx & \classname(val) then
return classname(val)
else
fail
end
# procedure ObjectProperties(object-or-classname)
procedure ObjectProperties(objectorclassname)
local membname, methname, clname
static type
initial {
type := proc("type", 0)
}
if type(objectorclassname) == "string" then {
clname := proc(objectorclassname, 0)
if type(clname) ~== "procedure" then
clname := &null
} else
clname := (IsObject(objectorclassname) & objectorclassname)
if \clname then {
suspend [!membernames(clname), "member"]
suspend [!methodnames(clname), "procedure"]
} else
fail
end
procedure AlreadyRun(obj)
return IsObject(obj)
end
procedure SuperClass(obj)
local l, i, m, o, fn, f
static type
initial {
type := proc("type", 0)
}
if IsObject(obj) then {
l := []
o := oprec(obj)
f := []
every put(f, fieldnames(o))
every i := 1 to *f do {
m := o[i]
fn := f[i]
if type(m) ~== "procedure" then
put(l, fn)
}
return l
}
end
procedure DeepCopy(obj)
local y, k
static type
initial {
type := proc("type", 0)
}
case type(obj) of {
"integer" | "real" | "string" | "cset" | "file" | "window" :
return obj
"set" : {
y := set()
every insert(y, DeepCopy(!obj))
}
default : {
y := copy(obj)
every k := key(obj) do {
if not (k == ("__s" | "__m")) then
y[k] := DeepCopy(obj[k])
else if k == "__s" then
y[k] := y
}
}
}
return y
end
########################################################################
# #
# file : error.icn #
# #
# Author : Bruce Rennie #
# Date : 11-July-2013 #
# #
# Purpose: To provide a class that provides a set of common error #
# handling facilities. #
# #
# #
# #
# #
# #
# #
# #
# Conventions: #
# Private fields start with __ #
# Private methods start with _ or __ #
# #
# Private classes start with __ #
# Private classes have an associated Public Class #
# #
########################################################################
# #
# Public Classes: #
# #
# class Error() #
# #
########################################################################
# #
# Private Classes: #
# #
########################################################################
# #
# Private Fields: #
# #
########################################################################
# #
# Public Fields: #
# #
########################################################################
# #
# Private Methods: #
# #
########################################################################
# #
# Public Methods: #
# #
# StopMessage(param[]) -: Halts program with message param[] #
# PrintMessage(param[]) -: Print message param[] onto current #
# error file (default &errout) #
# Caller() -> name of procedure or method that has #
# called the current procedure #
# ProcedureCalling(level) #
# -> name of procedure that has called #
# the current procedure #
# ClassCalling(level) -> name of the class that has called the #
# current procedure #
# MethodCalling(level) -> name of the method that has called the #
# current procedure #
# ParamCalling(level) -> the list of parameters from the calling #
# procedure #
# CallingComponents(name) #
# -> return a list containing the components #
# the calling procedure or class/method #
# Debug(mode) -: sets whether the Debug mode is on or #
# for all methods that test this #
# DebugMode() -> succeeds if debug mode is on, fails if #
# debug mode if off #
# ErrorOut(errorfile, writeappend) #
# -> Sets the errorout file to be used, #
# if called with no parameters, sets to #
# &errout, otherwise if a string, opens #
# the specified file based on writeappend #
# ("w" for write, "a" for append, default #
# is "w"), if errorfile is an open file, #
# the output will be sent to this file #
# #
########################################################################
# #
# Public Procedures: #
# #
########################################################################
# required link statements
# required import statements
# required global statements
global __DebugMode, __ErrorOutFile
# class Error
class Error()
method StopMessage(param[])
every writes(__ErrorOutFile, !param)
write(__ErrorOutFile)
stop(__ErrorOutFile, "Error in ", Caller(), ".")
end
method PrintMessage(param[])
every writes(__ErrorOutFile, !param)
write(__ErrorOutFile)
write(__ErrorOutFile, "Error in ", Caller() , ".")
end
method Caller()
local pc, cc, mc, parc
pc := ProcedureCalling(3)
cc := ClassCalling(3)
mc := MethodCalling(3)
parc := ParamCalling(3)
return (("procedure " || \pc) | "method " || cc || "." || mc) || parc
end
method ProcedureCalling(level)
local name, res
image(proc(¤t, \level | 1)) ? {="procedure "; name := tab(0) }
res := CallingComponents(name)
return \res[1]
end
method ClassCalling(level)
local name, res
image(proc(¤t, \level | 1)) ? {="procedure "; name := tab(0) }
res := CallingComponents(name)
return \res[2]
end
method MethodCalling(level)
local name, res
image(proc(¤t, \level | 1)) ? {="procedure "; name := tab(0) }
res := CallingComponents(name)
return \res[3]
end
method ParamCalling(level)
local name
name := "("
/level := 1
every name ||:= paramnames((proc(¤t, level))) || ","
name[-1] := (name[-1] == "," & "")
name[2:7] := (name[2:7] == "self," & "")
name ||:= ")"
return name
end
method CallingComponents(name)
local nameproc, nameclass, namemethod, i
name ? {
i := find("_")
if \i then {
nameclass := tab(i)
move(1)
namemethod := tab(0)
} else
nameproc := name
}
return [nameproc, nameclass, namemethod]
end
method Debug(mode)
__DebugMode := mode
end
method DebugMode()
if \__DebugMode then
return __DebugMode
else
return fail
end
method ErrorOut(errorfile, writeappend)
static type
initial {
type := proc("type", 0)
}
/errorfile := &errout
if \__ErrorOutFile then
close(__ErrorOutFile)
if type(errorfile) == "string" then {
/writeappend := "w"
if type(writeappend) == "string" then
__ErrorOutFile := open(errorfile, (("w" | "a") == writeappend)
| "w")
else
__ErrorOutFile := open(errorfile, "w")
} else if type(errorfile) == "file" then
__ErrorOutFile := errorfile
else
__ErrorOutFile := &errout
end
initially(errorfile, writeappend)
static type
initial {
type := proc("type", 0)
}
ErrorOut(errorfile, writeappend)
Error := self
end
link classobject
procedure main()
local a, b
writeln("Initialisation of class A")
A()
writeln("create a new object of hidden class _A associated with A")
a := A.New("aaaa")
writeln("a: ", ximage(a))
writeln("a.A(): ", a.A())
writeln("setting a to new A() value")
a.SetA("bbba")
writeln("a.A(): ", a.A())
writeln("A.A(a): ", A.Aa(a))
writeln("Set a new value to a")
A.SetA(a, "abbb")
writeln("a.A(): ", a.A())
writeln("IsObjectOf(a, \"A\")", IsObjectOf(a, "A"))
writeln("create a DeepCopy of a and assign to b")
b := DeepCopy(a)
writeln("a: ", ximage(a))
writeln("b: ", ximage(b))
writeln("update b")
b.SetA("xxxx")
writeln("a: ", ximage(a))
writeln("b: ", ximage(b))
writeln("a.A(): ", a.A())
writeln("b.A(): ", b.A())
writeln("IsObjectOf(b, \"A\")", IsObjectOf(b, "A"))
every writeln("Properties of A: ", ximage(ObjectProperties(A)))
every writeln("Properties of A: ", ximage(ObjectProperties("A")))
writeln("Superclass of a:", ximage(SuperClass(a)))
writeln("Is A already run:", AlreadyRun(A))
end
class __A : ClassObject(_a)
method A()
return _a
end
method SetA(a)
_a := a
end
initially(a)
_a := a
end
class A : ClassClass()
method A(a)
return a.A()
end
method SetA(a, aa)
a.SetA(aa)
end
initially()
if not AlreadyRun(A) then {
writeln("Initialisation of A started")
SetClass(__A)
self.ClassClass.initially()
A := self
}
end
procedure writeln(l[])
static fout
initial {
fout := open("testClassObject.output", "w")
}
push(l, fout)
write ! l
end
------------------------------------------------------------------------------
Get your SQL database under version control now!
Version control is standard for application code, but databases havent
caught up. So what steps can you take to put your SQL databases under
version control? Why should you start doing it? Read more to find out.
http://pubads.g.doubleclick.net/gampad/clk?id=49501711&iu=/4140/ostg.clktrk
_______________________________________________
Unicon-group mailing list
Unicon-group@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/unicon-group
