361 lines
7.7 KiB
QBasic
361 lines
7.7 KiB
QBasic
' ============================================================
|
|
' Test program for user-defined types and random-access file I/O
|
|
' ============================================================
|
|
|
|
PRINT "==== User-Defined Type Tests ===="
|
|
|
|
' ---- Test 1: Basic TYPE definition and field access ----
|
|
PRINT ""
|
|
PRINT "---- Test 1: Basic TYPE and field access ----"
|
|
|
|
TYPE PersonRecord
|
|
firstName AS STRING * 20
|
|
lastName AS STRING * 30
|
|
age AS INTEGER
|
|
salary AS DOUBLE
|
|
END TYPE
|
|
|
|
DIM person AS PersonRecord
|
|
person.firstName = "John"
|
|
person.lastName = "Doe"
|
|
person.age = 30
|
|
person.salary = 55000.50
|
|
|
|
PRINT "Name: "; person.firstName; " "; person.lastName
|
|
PRINT "Age: "; person.age
|
|
PRINT "Salary: "; person.salary
|
|
|
|
' ---- Test 2: Multiple TYPE definitions ----
|
|
PRINT ""
|
|
PRINT "---- Test 2: Multiple TYPE definitions ----"
|
|
|
|
TYPE Point2D
|
|
x AS DOUBLE
|
|
y AS DOUBLE
|
|
END TYPE
|
|
|
|
TYPE Rectangle
|
|
width AS DOUBLE
|
|
height AS DOUBLE
|
|
END TYPE
|
|
|
|
DIM pt AS Point2D
|
|
pt.x = 3.0
|
|
pt.y = 4.0
|
|
PRINT "Point: ("; pt.x; ", "; pt.y; ")"
|
|
|
|
DIM rect AS Rectangle
|
|
rect.width = 10.5
|
|
rect.height = 20.3
|
|
PRINT "Rect: "; rect.width; " x "; rect.height
|
|
|
|
' ---- Test 3: UDT with integer fields ----
|
|
PRINT ""
|
|
PRINT "---- Test 3: UDT integer fields ----"
|
|
|
|
TYPE Color
|
|
r AS INTEGER
|
|
g AS INTEGER
|
|
b AS INTEGER
|
|
END TYPE
|
|
|
|
DIM c AS Color
|
|
c.r = 255
|
|
c.g = 128
|
|
c.b = 64
|
|
PRINT "Color: ("; c.r; ", "; c.g; ", "; c.b; ")"
|
|
|
|
' ---- Test 4: Array of UDTs ----
|
|
PRINT ""
|
|
PRINT "---- Test 4: Array of UDTs ----"
|
|
|
|
DIM points(3) AS Point2D
|
|
DIM i AS INTEGER
|
|
|
|
FOR i = 0 TO 3
|
|
points(i).x = i * 1.5
|
|
points(i).y = i * 2.5
|
|
NEXT i
|
|
|
|
FOR i = 0 TO 3
|
|
PRINT "points("; i; "): ("; points(i).x; ", "; points(i).y; ")"
|
|
NEXT i
|
|
|
|
' ---- Test 5: UDT field expressions ----
|
|
PRINT ""
|
|
PRINT "---- Test 5: UDT field expressions ----"
|
|
|
|
DIM p1 AS Point2D
|
|
DIM p2 AS Point2D
|
|
p1.x = 1.0
|
|
p1.y = 2.0
|
|
p2.x = 4.0
|
|
p2.y = 6.0
|
|
|
|
DIM dist AS DOUBLE
|
|
dist = SQR((p2.x - p1.x) * (p2.x - p1.x) + (p2.y - p1.y) * (p2.y - p1.y))
|
|
PRINT "Distance: "; dist
|
|
|
|
' ---- Test 6: SIZEOF ----
|
|
PRINT ""
|
|
PRINT "---- Test 6: SIZEOF ----"
|
|
|
|
DIM szPerson AS LONG
|
|
szPerson = SIZEOF(PersonRecord)
|
|
PRINT "SIZEOF(PersonRecord) = "; szPerson
|
|
|
|
DIM szPoint AS LONG
|
|
szPoint = SIZEOF(Point2D)
|
|
PRINT "SIZEOF(Point2D) = "; szPoint
|
|
|
|
DIM szColor AS LONG
|
|
szColor = SIZEOF(Color)
|
|
PRINT "SIZEOF(Color) = "; szColor
|
|
|
|
' ---- Test 7: Random-access file I/O ----
|
|
PRINT ""
|
|
PRINT "---- Test 7: Random-access file I/O ----"
|
|
|
|
TYPE Item
|
|
name AS STRING * 16
|
|
price AS DOUBLE
|
|
qty AS INTEGER
|
|
END TYPE
|
|
|
|
DIM item1 AS Item
|
|
DIM item2 AS Item
|
|
DIM item3 AS Item
|
|
|
|
item1.name = "Widget"
|
|
item1.price = 9.99
|
|
item1.qty = 100
|
|
|
|
item2.name = "Gadget"
|
|
item2.price = 24.95
|
|
item2.qty = 50
|
|
|
|
item3.name = "Doohickey"
|
|
item3.price = 4.50
|
|
item3.qty = 200
|
|
|
|
' Write records
|
|
OPEN "/tmp/test_items.dat" FOR RANDOM AS #1 LEN = SIZEOF(Item)
|
|
PUT #1, 1, item1
|
|
PUT #1, 2, item2
|
|
PUT #1, 3, item3
|
|
CLOSE #1
|
|
|
|
' Read records back in different order
|
|
DIM loaded AS Item
|
|
OPEN "/tmp/test_items.dat" FOR RANDOM AS #1 LEN = SIZEOF(Item)
|
|
|
|
GET #1, 2, loaded
|
|
PRINT "Record 2: "; loaded.name; " $"; loaded.price; " qty="; loaded.qty
|
|
|
|
GET #1, 1, loaded
|
|
PRINT "Record 1: "; loaded.name; " $"; loaded.price; " qty="; loaded.qty
|
|
|
|
GET #1, 3, loaded
|
|
PRINT "Record 3: "; loaded.name; " $"; loaded.price; " qty="; loaded.qty
|
|
|
|
CLOSE #1
|
|
|
|
' ---- Test 8: Overwrite and re-read record ----
|
|
PRINT ""
|
|
PRINT "---- Test 8: Overwrite and re-read ----"
|
|
|
|
DIM updated AS Item
|
|
updated.name = "NewWidget"
|
|
updated.price = 19.99
|
|
updated.qty = 75
|
|
|
|
OPEN "/tmp/test_items.dat" FOR RANDOM AS #1 LEN = SIZEOF(Item)
|
|
PUT #1, 1, updated
|
|
GET #1, 1, loaded
|
|
PRINT "Updated record 1: "; loaded.name; " $"; loaded.price; " qty="; loaded.qty
|
|
|
|
' Verify record 3 is unchanged
|
|
GET #1, 3, loaded
|
|
PRINT "Record 3 unchanged: "; loaded.name; " $"; loaded.price; " qty="; loaded.qty
|
|
CLOSE #1
|
|
|
|
' ---- Test 9: UDT with mixed field types ----
|
|
PRINT ""
|
|
PRINT "---- Test 9: Mixed field types ----"
|
|
|
|
TYPE MixedRecord
|
|
label AS STRING * 10
|
|
byteVal AS BYTE
|
|
intVal AS INTEGER
|
|
longVal AS LONG
|
|
floatVal AS FLOAT
|
|
dblVal AS DOUBLE
|
|
END TYPE
|
|
|
|
DIM m AS MixedRecord
|
|
m.label = "TestMixed"
|
|
m.byteVal = 42
|
|
m.intVal = -1000
|
|
m.longVal = 100000
|
|
m.floatVal = 3.14
|
|
m.dblVal = 2.71828
|
|
|
|
PRINT "Label: "; m.label
|
|
PRINT "Byte: "; m.byteVal
|
|
PRINT "Int: "; m.intVal
|
|
PRINT "Long: "; m.longVal
|
|
PRINT "Double: "; m.dblVal
|
|
|
|
' ---- Test 10: Nested UDTs ----
|
|
PRINT ""
|
|
PRINT "---- Test 10: Nested UDTs ----"
|
|
|
|
TYPE Vec2
|
|
x AS DOUBLE
|
|
y AS DOUBLE
|
|
END TYPE
|
|
|
|
TYPE Circle
|
|
center AS Vec2
|
|
radius AS DOUBLE
|
|
END TYPE
|
|
|
|
DIM circ AS Circle
|
|
circ.center.x = 10.0
|
|
circ.center.y = 20.0
|
|
circ.radius = 5.5
|
|
PRINT "Circle center: ("; circ.center.x; ", "; circ.center.y; ")"
|
|
PRINT "Circle radius: "; circ.radius
|
|
|
|
' ---- Test 11: Nested UDT read in expressions ----
|
|
PRINT ""
|
|
PRINT "---- Test 11: Nested UDT expressions ----"
|
|
|
|
DIM circ2 AS Circle
|
|
circ2.center.x = 30.0
|
|
circ2.center.y = 40.0
|
|
circ2.radius = 2.0
|
|
|
|
DIM dx AS DOUBLE
|
|
DIM dy AS DOUBLE
|
|
dx = circ2.center.x - circ.center.x
|
|
dy = circ2.center.y - circ.center.y
|
|
PRINT "dx = "; dx
|
|
PRINT "dy = "; dy
|
|
|
|
' ---- Test 12: UDT whole-struct copy ----
|
|
PRINT ""
|
|
PRINT "---- Test 12: UDT copy ----"
|
|
|
|
DIM orig AS Vec2
|
|
orig.x = 42.0
|
|
orig.y = 99.0
|
|
|
|
DIM copy AS Vec2
|
|
copy = orig
|
|
PRINT "copy.x = "; copy.x
|
|
PRINT "copy.y = "; copy.y
|
|
|
|
' Modify original, verify copy is independent
|
|
orig.x = 0.0
|
|
PRINT "After modify orig, copy.x = "; copy.x
|
|
|
|
' ---- Test 13: Nested UDT sub-struct copy ----
|
|
PRINT ""
|
|
PRINT "---- Test 13: Nested UDT sub-struct copy ----"
|
|
|
|
DIM savedCenter AS Vec2
|
|
savedCenter = circ.center
|
|
PRINT "savedCenter: ("; savedCenter.x; ", "; savedCenter.y; ")"
|
|
|
|
' Assign sub-struct to nested field
|
|
DIM circ3 AS Circle
|
|
DIM newCenter AS Vec2
|
|
newCenter.x = 77.0
|
|
newCenter.y = 88.0
|
|
circ3.center = newCenter
|
|
circ3.radius = 3.0
|
|
PRINT "circ3 center: ("; circ3.center.x; ", "; circ3.center.y; ")"
|
|
PRINT "circ3 radius: "; circ3.radius
|
|
|
|
' ---- Test 14: Array of UDTs with nested types ----
|
|
PRINT ""
|
|
PRINT "---- Test 14: Array of nested UDTs ----"
|
|
|
|
DIM circles(2) AS Circle
|
|
circles(0).center.x = 1.0
|
|
circles(0).center.y = 2.0
|
|
circles(0).radius = 10.0
|
|
circles(1).center.x = 3.0
|
|
circles(1).center.y = 4.0
|
|
circles(1).radius = 20.0
|
|
circles(2).center.x = 5.0
|
|
circles(2).center.y = 6.0
|
|
circles(2).radius = 30.0
|
|
|
|
DIM ci AS INTEGER
|
|
FOR ci = 0 TO 2
|
|
PRINT "circles("; ci; "): ("; circles(ci).center.x; ", "; circles(ci).center.y; ") r="; circles(ci).radius
|
|
NEXT ci
|
|
|
|
' ---- Test 15: Copy between array elements ----
|
|
PRINT ""
|
|
PRINT "---- Test 15: Array element copy ----"
|
|
|
|
circles(0) = circles(2)
|
|
PRINT "After copy, circles(0).center.x = "; circles(0).center.x
|
|
PRINT "After copy, circles(0).radius = "; circles(0).radius
|
|
|
|
' ---- Test 16: Three-level nesting ----
|
|
PRINT ""
|
|
PRINT "---- Test 16: Three-level nesting ----"
|
|
|
|
TYPE LineSegment
|
|
start AS Vec2
|
|
finish AS Vec2
|
|
END TYPE
|
|
|
|
TYPE Shape
|
|
outline AS LineSegment
|
|
label AS STRING * 16
|
|
END TYPE
|
|
|
|
DIM shape AS Shape
|
|
shape.outline.start.x = 1.0
|
|
shape.outline.start.y = 2.0
|
|
shape.outline.finish.x = 10.0
|
|
shape.outline.finish.y = 20.0
|
|
shape.label = "MyLine"
|
|
|
|
PRINT "Shape: "; shape.label
|
|
PRINT " from ("; shape.outline.start.x; ", "; shape.outline.start.y; ")"
|
|
PRINT " to ("; shape.outline.finish.x; ", "; shape.outline.finish.y; ")"
|
|
|
|
' ---- Test 17: Nested UDT file I/O ----
|
|
PRINT ""
|
|
PRINT "---- Test 17: Nested UDT file I/O ----"
|
|
|
|
DIM c1 AS Circle
|
|
DIM c2 AS Circle
|
|
c1.center.x = 111.0
|
|
c1.center.y = 222.0
|
|
c1.radius = 333.0
|
|
c2.center.x = 444.0
|
|
c2.center.y = 555.0
|
|
c2.radius = 666.0
|
|
|
|
OPEN "/tmp/test_circles.dat" FOR RANDOM AS #1 LEN = SIZEOF(Circle)
|
|
PUT #1, 1, c1
|
|
PUT #1, 2, c2
|
|
CLOSE #1
|
|
|
|
DIM ld AS Circle
|
|
OPEN "/tmp/test_circles.dat" FOR RANDOM AS #1 LEN = SIZEOF(Circle)
|
|
GET #1, 2, ld
|
|
PRINT "Loaded circle 2: ("; ld.center.x; ", "; ld.center.y; ") r="; ld.radius
|
|
GET #1, 1, ld
|
|
PRINT "Loaded circle 1: ("; ld.center.x; ", "; ld.center.y; ") r="; ld.radius
|
|
CLOSE #1
|
|
|
|
PRINT ""
|
|
PRINT "==== ALL UDT TESTS COMPLETE ===="
|