Changes to Doc/Extra/version.html.
Changes to Externals/Eagle/lib/Eagle1.0/init.eagle.
︙ | | |
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
-
-
+
+
|
#
# NOTE: Is the Eagle Package for Tcl (Garuda) available? This check
# is different in Eagle and Tcl.
#
if {[isEagle]} then {
return [expr {[llength [info commands tcl]] > 0 && [tcl ready] && \
[catch {tcl eval [tcl master] package present Garuda}] == 0 && \
[catch {tcl eval [tcl master] garuda packageid} packageId] == 0}]
[catch {tcl eval [tcl master] {package present Garuda}}] == 0 && \
[catch {tcl eval [tcl master] {garuda packageid}} packageId] == 0}]
} else {
return [expr {[catch {package present Garuda}] == 0 && \
[catch {garuda packageid} packageId] == 0}]
}
}
proc isTclThread { name } {
|
︙ | | |
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
|
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
|
-
-
-
-
+
+
+
+
|
return ""
}
proc readFile { fileName } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
set file_id [open $fileName RDONLY]
fconfigure $file_id -encoding binary -translation binary; # BINARY DATA
set result [read $file_id]
close $file_id
set channel [open $fileName RDONLY]
fconfigure $channel -encoding binary -translation binary; # BINARY DATA
set result [read $channel]
close $channel
return $result
}
proc readSharedFile { fileName } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
|
︙ | | |
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
|
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
|
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
-
+
+
-
-
+
+
|
lappend command 0 file -share readWrite
}
#
# NOTE: Open the file using the command constructed above, configure
# the channel for binary data, and output the data to it.
#
set file_id [eval $command]
fconfigure $file_id -encoding binary -translation binary; # BINARY DATA
set result [read $file_id]
close $file_id
set channel [eval $command]
fconfigure $channel -encoding binary -translation binary; # BINARY DATA
set result [read $channel]
close $channel
return $result
}
proc writeFile { fileName data } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
set file_id [open $fileName {WRONLY CREAT TRUNC}]
fconfigure $file_id -encoding binary -translation binary; # BINARY DATA
puts -nonewline $file_id $data
close $file_id
set channel [open $fileName {WRONLY CREAT TRUNC}]
fconfigure $channel -encoding binary -translation binary; # BINARY DATA
puts -nonewline $channel $data
close $channel
return ""
}
proc appendFile { fileName data } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
set file_id [open $fileName {WRONLY CREAT APPEND}]
fconfigure $file_id -encoding binary -translation binary; # BINARY DATA
puts -nonewline $file_id $data
close $file_id
set channel [open $fileName {WRONLY CREAT APPEND}]
fconfigure $channel -encoding binary -translation binary; # BINARY DATA
puts -nonewline $channel $data
close $channel
return ""
}
proc appendLogFile { fileName data } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
set file_id [open $fileName {WRONLY CREAT APPEND}]
fconfigure $file_id -encoding binary -translation \
set channel [open $fileName {WRONLY CREAT APPEND}]
fconfigure $channel -encoding binary -translation \
[expr {[isEagle] ? "protocol" : "auto"}]; # LOG DATA
puts -nonewline $file_id $data
close $file_id
puts -nonewline $channel $data
close $channel
return ""
}
proc appendSharedFile { fileName data } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
|
︙ | | |
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
|
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
|
-
-
-
-
+
+
+
+
|
lappend command 0 file -share readWrite
}
#
# NOTE: Open the file using the command constructed above, configure
# the channel for binary data, and output the data to it.
#
set file_id [eval $command]
fconfigure $file_id -encoding binary -translation binary; # BINARY DATA
puts -nonewline $file_id $data; flush $file_id
close $file_id
set channel [eval $command]
fconfigure $channel -encoding binary -translation binary; # BINARY DATA
puts -nonewline $channel $data; flush $channel
close $channel
return ""
}
proc appendSharedLogFile { fileName data } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
|
︙ | | |
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
|
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
|
-
-
+
+
-
-
+
+
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
|
lappend command 0 file -share readWrite
}
#
# NOTE: Open the file using the command constructed above, configure
# the channel for binary data, and output the data to it.
#
set file_id [eval $command]
fconfigure $file_id -encoding binary -translation \
set channel [eval $command]
fconfigure $channel -encoding binary -translation \
[expr {[isEagle] ? "protocol" : "auto"}]; # LOG DATA
puts -nonewline $file_id $data; flush $file_id
close $file_id
puts -nonewline $channel $data; flush $channel
close $channel
return ""
}
proc readAsciiFile { fileName } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
set file_id [open $fileName RDONLY]
fconfigure $file_id -encoding ascii -translation auto; # ASCII TEXT
set result [read $file_id]
close $file_id
set channel [open $fileName RDONLY]
fconfigure $channel -encoding ascii -translation auto; # ASCII TEXT
set result [read $channel]
close $channel
return $result
}
proc writeAsciiFile { fileName data } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
set file_id [open $fileName {WRONLY CREAT TRUNC}]
fconfigure $file_id -encoding ascii -translation auto; # ASCII TEXT
puts -nonewline $file_id $data
close $file_id
set channel [open $fileName {WRONLY CREAT TRUNC}]
fconfigure $channel -encoding ascii -translation auto; # ASCII TEXT
puts -nonewline $channel $data
close $channel
return ""
}
proc readUnicodeFile { fileName } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
set file_id [open $fileName RDONLY]
fconfigure $file_id -encoding unicode -translation auto; # UNICODE TEXT
set result [read $file_id]
close $file_id
set channel [open $fileName RDONLY]
fconfigure $channel -encoding unicode -translation auto; # UNICODE TEXT
set result [read $channel]
close $channel
return $result
}
proc writeUnicodeFile { fileName data } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
set file_id [open $fileName {WRONLY CREAT TRUNC}]
fconfigure $file_id -encoding unicode -translation auto; # UNICODE TEXT
puts -nonewline $file_id $data
close $file_id
set channel [open $fileName {WRONLY CREAT TRUNC}]
fconfigure $channel -encoding unicode -translation auto; # UNICODE TEXT
puts -nonewline $channel $data
close $channel
return ""
}
proc getDirResultPath { pattern path } {
#
# NOTE: This should work properly in both Tcl and Eagle.
# Is the result path itself already absolute?
|
︙ | | |
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
|
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
|
-
+
|
return "cannot fetch update, the URI is invalid"
}
}
proc runUpdateAndExit {} {
set directory [file dirname [info nameofexecutable]]
set command [list exec -- \
set command [list exec -shell -- \
[file join $directory Hippogriff.exe] -delay 2000]
eval $command &; exit -force
}
proc getUpdateData { uri } {
#
|
︙ | | |
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
|
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
|
-
+
-
+
+
+
+
|
#
# NOTE: This proc is used to check for new versions -OR- new update
# scripts for the runtime when a user executes the interactive
# "#check" command. To disable this functionality, simply
# redefine this procedure to do nothing.
#
proc checkForUpdate { {wantScripts false} } {
proc checkForUpdate { {wantScripts false} {quiet false} } {
#
# NOTE: This should work properly in Eagle only.
#
set updateUri [appendArgs [info engine Uri] [info engine UpdateFile]]
#
# NOTE: Fetch the master update data from the distribution site
# and normalize to Unix-style line-endings.
#
set updateData [string map [list \r\n \n] [getUpdateData $updateUri]]
#
# NOTE: Split the data into lines.
#
set lines [split $updateData \n]
#
# NOTE: Keep track of how many update scripts are processed.
#
set scriptCount 0
array set scriptCount {
invalid 0 fail 0 bad 0
ok 0 error 0
}
#
# NOTE: Check each line to find the build information...
#
foreach line $lines {
#
# NOTE: Remove excess whitespace.
|
︙ | | |
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
|
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
|
#
set patchLevel [lindex $fields 4]
if {[string length $patchLevel] == 0} then {
set patchLevel 0.0.0.0; # no patch level?
}
#
# NOTE: Grab the time-stamp field.
#
set timeStamp [lindex $fields 5]
if {[string length $timeStamp] == 0} then {
set timeStamp 0; #never?
}
#
# NOTE: Does it look like the number of seconds since the epoch
# or some kind of date/time string?
#
if {[string is integer -strict $timeStamp]} then {
set dateTime [clock format $timeStamp]
} else {
set dateTime [clock format [clock scan $timeStamp]]
}
#
# NOTE: Grab the patch level for the running engine.
#
set enginePatchLevel [info engine PatchLevel]
#
# NOTE: Grab the time-stamp for the running engine.
#
set engineTimeStamp [info engine TimeStamp]
if {[string length $engineTimeStamp] == 0} then {
set engineTimeStamp 0; #never?
}
#
# NOTE: Does it look like the number of seconds since the epoch
# or some kind of date/time string?
#
if {[string is integer -strict $engineTimeStamp]} then {
set engineDateTime [clock format $engineTimeStamp]
} else {
set engineDateTime [clock format [clock scan $engineTimeStamp]]
}
#
# NOTE: Compare the patch level from the line to the one we
# are currently using.
# NOTE: For build lines, compare the patch level from the line
# to the one we are currently using using a simple patch
# level comparison.
#
if {$checkBuild} then {
set compare [package vcompare $patchLevel $enginePatchLevel]
if {($checkBuild && $compare > 0) || \
($checkScript && $compare == 0)} then {
#
# NOTE: Grab the time-stamp field.
#
set compare [package vcompare $patchLevel $enginePatchLevel]
} else {
#
# NOTE: This is not a build line, no match.
#
set compare -1
}
#
# NOTE: For script lines, use regular expression matching.
#
set timeStamp [lindex $fields 5]
if {[string length $timeStamp] == 0} then {
set timeStamp 0; #never?
if {$checkScript} then {
#
# NOTE: Use [catch] here to prevent raising a script error
# due to a malformed patch level regular expression.
#
if {[catch {
regexp -nocase -- $patchLevel $enginePatchLevel
} match]} then {
#
# NOTE: The patch level from the script line was most
# likely not a valid regular expression.
#
set match false
}
} else {
#
# NOTE: This is not a script line, no match.
#
set match false
}
#
# NOTE: Are we interested in further processing this line?
#
if {($checkBuild && $compare > 0) ||
($checkScript && $match)} then {
#
# NOTE: Grab the base URI field (i.e. it may be a mirror
# site).
#
set baseUri [lindex $fields 6]
if {$checkBuild && [string length $baseUri] == 0} then {
set baseUri [info engine Uri]; # primary site.
}
#
# NOTE: Grab the notes field (which may be empty).
#
set notes [lindex $fields 10]
if {[string length $notes] > 0} then {
set notes [unescapeUpdateNotes $notes]
}
#
# NOTE: Does it look like the number of seconds since the
# epoch or some kind of date/time string?
#
if {[string is integer -strict $timeStamp]} then {
set dateTime [clock format $timeStamp]
} else {
set dateTime [clock format [clock scan $timeStamp]]
}
#
# NOTE: The engine patch level from the line is greater,
# we are out-of-date. Return the result of our
# checking now.
#
if {$checkBuild} then {
return [list [appendArgs "newer build " $patchLevel \
" is available as of " $dateTime] [list $baseUri \
return [list [appendArgs \
"latest build " $patchLevel ", dated " $dateTime \
", is newer than running build " $enginePatchLevel \
", dated " $engineDateTime] [list $baseUri \
$patchLevel] [list $notes]]
}
#
# NOTE: The script patch level from the line matches the
# current engine patch level exactly, this script
# should be evaluated if it can be authenticated.
|
︙ | | |
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
|
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
|
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
+
-
+
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
+
+
|
#
# NOTE: Next, verify the script has a valid base URI.
# For update scripts, this must be the location
# where the update script data can be downloaded.
#
if {[string length $baseUri] == 0} then {
if {!$quiet} then {
tqputs $channel [appendArgs \
"---- invalid baseUri value for update script line: " \
$line \"\n]
continue
tqputs $channel [appendArgs \
"---- invalid baseUri value for update script " \
"line: " $line \"\n]
}
incr scriptCount(invalid); continue
}
#
# NOTE: Next, grab the md5 field and see if it looks valid.
# Below, the value of this field will be compared to
# that of the actual MD5 hash of the downloaded script
# data.
#
set lineMd5 [lindex $fields 7]
if {[string length $lineMd5] == 0} then {
if {!$quiet} then {
tqputs $channel [appendArgs \
"---- invalid md5 value for update script line: " \
$line \"\n]
continue
tqputs $channel [appendArgs \
"---- invalid md5 value for update script " \
"line: " $line \"\n]
}
incr scriptCount(invalid); continue
}
#
# NOTE: Next, grab the sha1 field and see if it looks valid.
# Below, the value of this field will be compared to
# that of the actual SHA1 hash of the downloaded script
# data.
#
set lineSha1 [lindex $fields 8]
if {[string length $lineSha1] == 0} then {
if {!$quiet} then {
tqputs $channel [appendArgs \
"---- invalid sha1 value for update script line: " \
$line \"\n]
continue
tqputs $channel [appendArgs \
"---- invalid sha1 value for update script " \
"line: " $line \"\n]
}
incr scriptCount(invalid); continue
}
#
# NOTE: Next, grab the sha512 field and see if it looks
# valid. Below, the value of this field will be
# compared to that of the actual SHA512 hash of the
# downloaded script data.
#
set lineSha512 [lindex $fields 9]
if {[string length $lineSha512] == 0} then {
if {!$quiet} then {
tqputs $channel [appendArgs \
"---- invalid sha512 value for update script line: " \
$line \"\n]
continue
tqputs $channel [appendArgs \
"---- invalid sha512 value for update script " \
"line: " $line \"\n]
}
incr scriptCount(invalid); continue
}
#
# NOTE: Next, show the extra information associated with
# this update script, if any.
#
if {!$quiet} then {
tqputs $channel [appendArgs \
"---- fetching update script from \"" $baseUri "\" (" \
$dateTime ") with notes:\n"]
tqputs $channel [appendArgs \
"---- fetching update script from \"" $baseUri \
"\" (" $dateTime ") with notes:\n"]
set trimNotes [string trim $notes]
set trimNotes [string trim $notes]
tqputs $channel [appendArgs \
[expr {[string length $trimNotes] > 0 ? $trimNotes : \
"<none>"}] "\n---- end of update script notes\n"]
tqputs $channel [appendArgs \
[expr {[string length $trimNotes] > 0 ? $trimNotes : \
"<none>"}] "\n---- end of update script notes\n"]
}
#
# NOTE: Next, attempt to fetch the update script data.
#
set code [catch {getUpdateScriptData $baseUri} result]
if {$code == 0} then {
#
# NOTE: Success, set the script data from the result.
#
set scriptData $result
} else {
#
# NOTE: Failure, report the error message to the log.
#
if {!$quiet} then {
tqputs $channel [appendArgs \
"---- failed to fetch update script: " $result \n]
continue
tqputs $channel [appendArgs \
"---- failed to fetch update script: " $result \n]
}
incr scriptCount(fail); continue
}
#
# NOTE: Next, verify that the md5, sha1, and sha512
# hashes of the raw script data match what was
# specified in the md5, sha1, and sha512 fields.
#
set scriptMd5 [hash normal md5 $scriptData]
if {![string equal -nocase $lineMd5 $scriptMd5]} then {
if {!$quiet} then {
tqputs $channel [appendArgs \
"---- wrong md5 value \"" $scriptMd5 \
"\" for update script line: " $line \"\n]
continue
tqputs $channel [appendArgs \
"---- wrong md5 value \"" $scriptMd5 \
"\" for update script line: " $line \"\n]
}
incr scriptCount(bad); continue
}
set scriptSha1 [hash normal sha1 $scriptData]
if {![string equal -nocase $lineSha1 $scriptSha1]} then {
if {!$quiet} then {
tqputs $channel [appendArgs \
"---- wrong sha1 value \"" $scriptSha1 \
"\" for update script line: " $line \"\n]
continue
tqputs $channel [appendArgs \
"---- wrong sha1 value \"" $scriptSha1 \
"\" for update script line: " $line \"\n]
}
incr scriptCount(bad); continue
}
set scriptSha512 [hash normal sha512 $scriptData]
if {![string equal -nocase $lineSha512 $scriptSha512]} then {
if {!$quiet} then {
tqputs $channel [appendArgs \
"---- wrong sha512 value \"" $scriptSha512 \
"\" for update script line: " $line \"\n]
continue
tqputs $channel [appendArgs \
"---- wrong sha512 value \"" $scriptSha512 \
"\" for update script line: " $line \"\n]
}
incr scriptCount(bad); continue
}
#
# NOTE: Finally, everything looks good. Therefore, just
# evaluate the update script and print the result.
#
if {!$quiet} then {
tqputs $channel [appendArgs \
"---- evaluating update script from \"" $baseUri \
\"...\n]
tqputs $channel [appendArgs \
"---- evaluating update script from \"" $baseUri \
\"...\n]
}
#
# NOTE: Reset the variables that will be used to contain
# the result of the update script.
#
set code 0; set result ""
|
︙ | | |
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
|
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
|
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
-
-
+
+
+
+
-
+
+
+
+
+
-
+
-
+
+
-
+
|
# NOTE: Reset manual override of the script file name
# to be returned by [info script].
#
object invoke -flags +NonPublic Interpreter.GetActive \
PopScriptLocation true
}
#
# NOTE: Keep track of the number of update scripts that
# generate Ok and Error return codes.
#
if {$code == 0} then {
incr scriptCount(ok)
} else {
incr scriptCount(error)
}
if {!$quiet} then {
host result $code $result; incr scriptCount
tqputs $channel "\n---- end of update script results\n"
host result $code $result
tqputs $channel "\n---- end of update script results\n"
}
}
} elseif {$checkBuild && $compare < 0} then {
#
# NOTE: The patch level from the line is less, we are more
# up-to-date than the latest version?
#
return [list [appendArgs "running build " $enginePatchLevel \
" is newer than the latest build " $patchLevel]]
return [list [appendArgs \
"running build " $enginePatchLevel ", dated " \
$engineDateTime ", is newer than latest build " \
$patchLevel ", dated " $dateTime]]
} elseif {$checkBuild} then {
#
# NOTE: The patch levels are equal, we are up-to-date.
#
return [list "running build is the latest"]
return [list [appendArgs \
"running build " $enginePatchLevel ", dated " \
$engineDateTime ", is the latest build"]]
}
}
}
}
}
#
# NOTE: Figure out what the final result should be. If we get
# to this point when checking for a new build, something
# must have gone awry. Otherwise, report the number of
# update scripts that were successfully processed.
#
if {$wantScripts} then {
set scriptCount(total) [expr [join [array values scriptCount] +]]
if {$scriptCount > 0} then {
if {$scriptCount(total) > 0} then {
return [list [appendArgs \
"processed " $scriptCount " update scripts"]]
"processed " $scriptCount(total) " update scripts: " \
[array get scriptCount]]]
} else {
return [list "no update scripts were processed"]
}
} else {
return [list "cannot determine if running build is the latest"]
return [list "could not determine if running build is the latest"]
}
}
proc getReturnType { object member } {
if {[string length $object] == 0 || [string length $member] == 0} then {
return ""
}
|
︙ | | |
Changes to Externals/Eagle/lib/Eagle1.0/shell.eagle.
Changes to Externals/Eagle/lib/Eagle1.0/test.eagle.
︙ | | |
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
|
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
|
-
+
+
+
+
+
+
-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#
# NOTE: Now, attempt to flush the test log queue, if available.
#
tlog ""
}
proc getTclShellFileName {} {
proc getTclShellFileName { automatic } {
#
# NOTE: Start out with an empty list of candiate Tcl shells.
#
set shells [list]
#
# NOTE: Check the environment variables we know about that
# NOTE: Check all environment variables we know about that
# may contain the path where the Tcl shell is located.
#
foreach name [list Eagle_Tcl_Shell Tcl_Shell] {
set value [getEnvironmentVariable $name]
#
# TODO: Possibly add a check if the file actually exists
# here.
#
if {[string length $value] > 0} then {
#
# NOTE: *EXTERNAL* Return verbatim, no normalization.
# NOTE: *EXTERNAL* Use verbatim, no normalization.
#
if {$automatic} then {
#
# NOTE: In automatic mode, the environment variable
# value simply represents another candidate
# Tcl shell (i.e. it does not halt the search
# for other candidate Tcl shells).
#
lappend shells $value
} else {
#
# NOTE: In manual mode, the environment variable
# value represents an "override" and halts
# the search for other candidate Tcl shells.
#
return $value
}
}
#
# NOTE: None of the environment variables returned anything
# valid, return the fallback default.
return $value
}
}
}
#
# NOTE: The automatic Tcl shell detection is only available when
# running in Eagle.
#
if {[isEagle]} then {
#
# NOTE: Attempt to check for the "best" available dynamically
# loadable Tcl library and then attempt to use its
# "associated" Tcl shell. A very similar block of code
# is also used by the [checkForTclInstalls] procedure
# in the constraints package.
#
if {[catch {tcl select -architecture} tcl] == 0} then {
#
# NOTE: Did we find one? Attempt to grab the index of the
# version field from the returned dictionary value.
#
set dotVersion [getDictionaryValue $tcl version]
#
# NOTE: Verify that the version we found is valid and that
# it conforms to the pattern we expect.
#
if {[string length $dotVersion] > 0 && \
[regexp -- {^\d+\.\d+$} $dotVersion]} then {
#
# NOTE: Gather the list of candidate Tcl shells to check
# using the range of versions we are interested in,
# starting with the "best" available version and
# ending with the absolute minimum version supported
# by the Eagle core library. A very similar block
# of code is also used by the [checkForTclShell]
# procedure in the constraints package.
#
foreach version [lsort -real -decreasing [tcl \
versionrange -maximumversion $dotVersion]] {
lappend shells [appendArgs \
tclsh [string map [list . ""] $version]]
lappend shells [appendArgs tclsh $version]
}
}
}
#
# NOTE: Check each candidate Tcl shell and query its fully
# qualified path from it. If it cannot be executed,
# we know that candidate Tcl shell is not available.
#
foreach shell $shells {
if {[catch {
getTclExecutableForTclShell $shell
} executable] == 0 && $executable ne "error"} then {
#
# NOTE: It looks like this Tcl shell is available.
# Return the fully qualified path to it now.
#
return $executable
}
}
}
#
# NOTE: Return the fallback default.
#
return tclsh
}
proc getTemporaryPath {} {
#
# NOTE: Build the list of "temporary directory" override
|
︙ | | |
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
|
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
}
}
return $result
}
proc formatDecimal { value {places 4} {zeros false} } {
#
# NOTE: If the value is an empty string, do nothing and return an empty
# string.
#
if {[string length $value] == 0} then {
return ""
}
#
# NOTE: For now, use slightly different methods for formatting floating
# pointer numbers for native Tcl and Eagle.
#
if {[isEagle] && [llength [info commands object]] > 0} then {
#
# HACK: This works; however, in order to do this kind of thing cleanly,
# we really need the Tcl [format] command.
#
set result [object invoke String Format [appendArgs "{0:0." \
[string repeat [expr {$zeros ? "0" : "#"}] $places] "}"] \
[set object [object invoke -create Double Parse $value]]]
unset object; # dispose
} else {
#
# NOTE: See, nice and clean when done in Tcl?
#
set result [format [appendArgs %. $places f] $value]
#
# HACK: Since native Tcl does not appear to expose a method to only
# preserve non-zero trailing digits, we may need to manually
# remove extra trailing zeros.
#
if {!$zeros} then {
#
# NOTE: Remove all trailing zeros and the trailing decimal point,
# if necessary.
#
set result [string trimright [string trimright $result 0] .]
}
}
return $result
}
proc clearTestPercent { channel } {
if {[isEagle]} then {
|
︙ | | |
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
|
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
|
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
|
# test suite. Make sure these commands do not already exist
# prior to attempt to adding them.
#
if {[llength [info commands testConstraint]] == 0} then {
interp alias {} testConstraint {} haveOrAddConstraint
if {!$quiet} then {
tqputs [getTestChannelOrDefault] [appendArgs \
"---- added \"testConstraint\" alias\n"]
tqputs [getTestChannelOrDefault] \
"---- added \"testConstraint\" alias\n"
}
}
if {[llength [info commands ::tcltest::testConstraint]] == 0} then {
interp alias {} ::tcltest::testConstraint {} haveOrAddConstraint
if {!$quiet} then {
tqputs [getTestChannelOrDefault] [appendArgs \
"---- added \"::tcltest::testConstraint\" alias\n"]
tqputs [getTestChannelOrDefault] \
"---- added \"::tcltest::testConstraint\" alias\n"
}
}
#
# NOTE: This is needed by most tests in the Tcl test suite. Make
# sure this command does not already exist prior to adding it.
#
if {[llength [info commands ::tcltest::cleanupTests]] == 0} then {
proc ::tcltest::cleanupTests { args } {}
if {!$quiet} then {
tqputs [getTestChannelOrDefault] [appendArgs \
"---- added \"::tcltest::cleanupTests\" procedure\n"]
tqputs [getTestChannelOrDefault] \
"---- added \"::tcltest::cleanupTests\" procedure\n"
}
}
} else {
#
# NOTE: Remove the compatibility shim command aliases that we setup
# earlier.
#
if {[lsearch -exact [info commands] \
::tcltest::cleanupTests] != -1} then {
rename ::tcltest::cleanupTests ""
if {!$quiet} then {
tqputs $::test_channel [appendArgs \
"---- removed \"::tcltest::cleanupTests\" procedure\n"]
tqputs $::test_channel \
"---- removed \"::tcltest::cleanupTests\" procedure\n"
}
}
if {[lsearch -exact [interp aliases] \
::tcltest::testConstraint] != -1} then {
interp alias {} ::tcltest::testConstraint {} {}
if {!$quiet} then {
tqputs $::test_channel [appendArgs \
"---- removed \"::tcltest::testConstraint\" alias\n"]
tqputs $::test_channel \
"---- removed \"::tcltest::testConstraint\" alias\n"
}
}
if {[lsearch -exact [interp aliases] testConstraint] != -1} then {
interp alias {} testConstraint {} {}
if {!$quiet} then {
tqputs $::test_channel [appendArgs \
"---- removed \"testConstraint\" alias\n"]
tqputs $::test_channel \
"---- removed \"testConstraint\" alias\n"
}
}
}
}
proc tresult { code result } {
host result $code $result; tlog $result
|
︙ | | |
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
|
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
|
after flags =$flags
}
} finally {
interp bgerror {} $bgerror
}
}
proc testExecTclScript { script } {
proc testExecTclScript { script {shell ""} } {
try {
#
# NOTE: Get a temporary file name for the script we are going to
# use to query the machine type for the native Tcl shell.
#
set fileName [file tempname]
#
# NOTE: Since the native Tcl shell cannot simply evaluate a string
# supplied via the command line, write the script to be
# evaluated to the temporary file.
#
writeFile $fileName $script
#
# NOTE: Use the specified shell, if it is valid; otherwise, use
# the configured Tcl shell.
#
if {[string length $shell] == 0} then {
#
# NOTE: Before attempting to use the configured Tcl shell, make
# sure it has actually been set.
#
if {[info exists ::test_tclsh] && \
[string length $::test_tclsh] > 0} then {
set shell $::test_tclsh
} else {
#
# NOTE: We cannot execute the native Tcl shell because one
# has not been specified, nor configured.
#
return error
}
}
#
# NOTE: Evaluate the script using the native Tcl shell, trim the
# excess whitespace from the output, and return it to the
# caller.
#
if {[catch {string trim \
[testExec $::test_tclsh [list -success Success] \
[testExec $shell [list -success Success] \
[appendArgs \" $fileName \"]]} result] == 0} then {
#
# NOTE: Success, return the result to the caller.
#
return $result
} else {
#
|
︙ | | |
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
|
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
|
-
+
-
+
-
+
-
+
-
+
+
+
-
+
+
+
+
+
-
+
-
+
|
# type for the native Tcl shell.
#
catch {file delete $fileName}
}
}
}
proc getTclVersionForTclShell {} {
proc getTclVersionForTclShell { {shell ""} } {
return [testExecTclScript {
puts -nonewline stdout [info tclversion]
}]
} $shell]
}
proc getCommandsForTclShell {} {
proc getCommandsForTclShell { {shell ""} } {
return [testExecTclScript {
puts -nonewline stdout [info commands]
}]
} $shell]
}
proc getMachineForTclShell {} {
proc getMachineForTclShell { {shell ""} } {
return [testExecTclScript {
puts -nonewline stdout $tcl_platform(machine)
} $shell]
}
}]
proc getTclExecutableForTclShell { {shell ""} } {
return [testExecTclScript {
puts -nonewline stdout [info nameofexecutable]
} $shell]
}
proc getTkVersionForTclShell {} {
proc getTkVersionForTclShell { {shell ""} } {
return [testExecTclScript {
puts -nonewline stdout [package require Tk]; exit
}]
} $shell]
}
proc getGarudaDll {} {
#
# NOTE: Get the Garuda DLL of the same platform (i.e. machine type)
# as the native Tcl shell.
#
|
︙ | | |
Changes to Externals/Eagle/lib/Eagle1.0/vendor.eagle.
Changes to Externals/Eagle/lib/Test1.0/constraints.eagle.
︙ | | |
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
+
+
+
+
-
+
+
+
+
|
# a package. Make sure we can hash content before proceeding.
#
if {[isEagle] || [catch {package require sha1}] == 0} then {
tputs $channel yes\n
foreach fileName $fileNames {
if {[isEagle]} then {
#
# NOTE: Use the relatively new -filename option to the Eagle
# [hash] command.
#
set sha1 [hash normal sha1 [readFile $fileName]]
set sha1 [hash normal -filename sha1 $fileName]
} else {
#
# BUGBUG: Apparently, the ActiveState tcllib sha1 package may
# have a bug that produces the wrong values here. No
# attempt is made here to work around any such bug.
# For further information, please see:
#
# http://core.tcl.tk/tcllib/info/ad20454023
#
set sha1 [sha1::sha1 -hex -filename $fileName]
}
tputs $channel [appendArgs \
"---- file \"" $fileName "\"... sha1 (" $sha1 ")\n"]
}
|
︙ | | |
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
|
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
|
-
+
-
+
|
tputs $channel no\n
}
proc checkForFossil { channel } {
tputs $channel "---- checking for Fossil... "
if {[catch {set version [exec -- fossil version]}] == 0} then {
if {[catch {exec -- fossil version} version] == 0} then {
set version [string trim $version]
set pattern {^This is fossil version (.*) \[([0-9a-f]+)\]\
\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2} UTC$}
if {[regexp -- $pattern $version dummy version sourceId]} then {
#
# NOTE: Add a constraint to show that the Fossil executable
# itself is available.
#
addConstraint fossil_version
#
# NOTE: Append the version of Fossil currently in use.
#
append result version " " $version " \[" $sourceId \]
if {[catch {set remote [exec -- fossil remote]}] == 0} then {
if {[catch {exec -- fossil remote} remote] == 0} then {
set remote [string trim $remote]; set valid false
if {[isEagle]} then {
#
# NOTE: With Eagle, we can actually validate the URI.
#
if {[uri isvalid $remote]} then {
|
︙ | | |
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
|
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
addConstraint performance
tputs $channel yes\n
} else {
tputs $channel no\n
}
}
proc checkForBigLists { channel } {
tputs $channel "---- checking for big list testing... "
#
# NOTE: Are we allowed to do big list testing?
#
if {![info exists ::no(bigLists)]} then {
if {[isEagle]} then {
#
# MONO: Using the native utility library when running on Mono to
# join big lists seems to cause StackOverflowException to
# be thrown.
#
if {[info exists ::no(mono)] || ![isMono] || \
![haveConstraint nativeUtility]} then {
#
# NOTE: Yes, it appears that it is available.
#
addConstraint bigLists
tputs $channel yes\n
} else {
tputs $channel "no, broken on Mono with native utility\n"
}
} else {
addConstraint bigLists
tputs $channel yes\n
}
} else {
tputs $channel no\n
}
}
proc checkForStackIntensive { channel } {
tputs $channel "---- checking for stack intensive testing... "
#
# NOTE: Are we allowed to do stack intensive testing?
#
|
︙ | | |
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
|
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
|
+
-
+
|
"---- checking for network connectivity to host \"" $host "\"... "]
if {[isEagle]} then {
#
# NOTE: Running this check on the Mono 3.3.0 release build will lock
# up the process; therefore, attempt to skip it in that case.
#
if {[info exists ::no(mono)] || ![isMono] || \
if {![isMono] || ![haveConstraint mono33]} then {
![haveConstraint mono33]} then {
#
# BUGBUG: Tcl 8.4 does not like this expression (and Tcl tries to
# compile it even though it will only actually ever be
# evaluated in Eagle).
#
set expr {[llength [info commands uri]] > 0 && \
[catch {uri ping $host $timeout} response] == 0 && \
|
︙ | | |
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
|
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
|
-
-
+
+
|
############################ BEGIN Eagle ONLY #############################
###########################################################################
proc checkForSoftwareUpdateTrust { channel } {
tputs $channel "---- checking for software update trust... "
if {[llength [info commands uri]] > 0 && \
[catch {uri softwareupdates} result] == 0 && \
$result eq "software update certificate is trusted"} then {
[catch {uri softwareupdates} trust] == 0 && \
$trust eq "software update certificate is trusted"} then {
#
# NOTE: Yes, it appears that we trust our software updates.
# Since this setting is off by default, the user (or
# a script evaluated by the user) must have manually
# turned it on.
#
addConstraint softwareUpdate
|
︙ | | |
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
|
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
|
-
-
+
+
-
-
+
+
-
+
-
+
|
tputs $channel no\n
}
}
proc checkForHost { channel } {
tputs $channel "---- checking for host... "
if {[catch {host isopen} result] == 0} then {
if {$result} then {
if {[catch {host isopen} open] == 0} then {
if {$open} then {
addConstraint hostIsOpen
tputs $channel open\n
} else {
if {[catch {host redirected Input} result] == 0} then {
if {$result} then {
if {[catch {host redirected Input} redirected] == 0} then {
if {$redirected} then {
addConstraint hostInputRedirected
tputs $channel redirected\n
} else {
addConstraint hostIsClosed
tputs $channel closed\n
}
} else {
tlog $result; tputs $channel error\n]
tlog $redirected; tputs $channel error\n
}
}
} else {
tlog $result; tputs $channel error\n]
tlog $open; tputs $channel error\n
}
}
proc checkForHostType { channel } {
tputs $channel "---- checking for host type... "
if {[set code [catch {object invoke \
|
︙ | | |
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
|
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
|
-
+
|
proc checkForRuntime { channel } {
tputs $channel "---- checking for runtime... "
#
# NOTE: Are we running inside Mono (regardless of operating system)?
#
if {[isMono]} then {
if {![info exists ::no(mono)] && [isMono]} then {
#
# NOTE: Yes, it appears that we are running inside Mono.
#
addConstraint mono; # running on Mono.
tputs $channel [appendArgs [expr {[info exists \
::eagle_platform(runtime)] ? \
|
︙ | | |
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
|
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
|
-
+
|
#
# NOTE: Now create a version string for use in the constraint name
# (remove the periods).
#
set version [string map [list . ""] $dotVersion]
if {[isMono]} then {
if {![info exists ::no(mono)] && [isMono]} then {
#
# NOTE: If the runtime version was found, add a test constraint
# for it now.
#
if {[string length $version] > 0} then {
#
# NOTE: We are running on Mono. Keep track of the specific
|
︙ | | |
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
|
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
|
-
+
|
#
# NOTE: The culture information is present, use it and show it.
#
addConstraint [appendArgs culture. [string map [list - _] $culture]]
tputs $channel [appendArgs $culture \n]
} else {
tputs $channel [appendArgs unknown \n]
tputs $channel unknown\n
}
}
proc checkForThreadCulture { channel } {
tputs $channel "---- checking for thread culture... "
#
|
︙ | | |
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
|
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
|
-
+
|
# NOTE: The culture information is present, use it and show it.
#
addConstraint [appendArgs threadCulture. [string map [list - _] \
$culture]]
tputs $channel [appendArgs $culture \n]
} else {
tputs $channel [appendArgs unknown \n]
tputs $channel unknown\n
}
}
proc checkForQuiet { channel } {
tputs $channel "---- checking for quiet... "
if {[catch {object invoke Interpreter.GetActive Quiet} quiet] == 0 && \
|
︙ | | |
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
|
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
+
+
-
+
-
-
+
+
-
+
|
tputs $channel no\n
}
proc checkForTclReady { channel } {
tputs $channel "---- checking for Tcl readiness... "
if {[catch {tcl ready} result] == 0 && $result} then {
if {[catch {tcl ready} ready] == 0 && $ready} then {
#
# NOTE: Yes, native Tcl is loaded and ready.
#
addConstraint tclReady
#
# NOTE: Yes, native Tcl is ready -OR- available.
#
addConstraint tclReadyOrLibrary
#
# NOTE: Ok, attempt to determine the loaded Tcl version.
#
if {[catch {
tcl eval [tcl master] {info tclversion}
} version] == 0 && [regexp -- {^\d+\.\d+$} $version]} then {
addConstraint [appendArgs \
tclReady [string map [list . ""] $version]]
#
# NOTE: The Tcl library is ready; however, we need to add the
# appropriate test constraint to indicate that a specific
# version of Tcl is "either ready or available".
#
if {[haveConstraint tclLibrary86] && $version >= 8.6} then {
addConstraint tclReadyOrLibrary86
} elseif {[haveConstraint tclLibrary85] && $version >= 8.5} then {
addConstraint tclReadyOrLibrary85
} elseif {[haveConstraint tclLibrary84] && $version >= 8.4} then {
addConstraint tclReadyOrLibrary84
}
tputs $channel [appendArgs "yes (" $version ")\n"]
} else {
#
# NOTE: The Tcl library is ready; however, we have no idea what
# version it actually is; therefore, skip adding the test
# constraint to indicate that a specific version of Tcl
# is "either ready or available".
#
tputs $channel yes\n
tputs $channel yes\n
}
} else {
#
# NOTE: The Tcl library is not ready; however, we still need to add
# the appropriate test constraint to indicate that a specific
# version of Tcl is "either ready or available".
#
if {[haveConstraint tclLibrary86]} then {
addConstraint tclReadyOrLibrary86
} elseif {[haveConstraint tclLibrary85]} then {
addConstraint tclReadyOrLibrary85
} elseif {[haveConstraint tclLibrary84]} then {
addConstraint tclReadyOrLibrary84
}
tputs $channel no\n
}
}
proc checkForTclShell { channel } {
#
# HACK: If this returns "error" that normally indicates an error was
# caught during [exec] (i.e. the native Tcl shell could not be
# executed).
#
set prefix "---- checking for Tcl shell version... "
if {[catch {getTclVersionForTclShell} result] == 0 && \
$result ne "error"} then {
if {[catch {getTclVersionForTclShell} version] == 0 && \
$version ne "error"} then {
#
# NOTE: Yes, a native Tcl shell appears to be available.
#
addConstraint tclShell
#
# NOTE: Now, add the version specific test constraint.
#
addConstraint [appendArgs tclShell [string map [list . ""] $result]]
addConstraint [appendArgs \
tclShell [string map [list . ""] $version]]
tputs $channel [appendArgs $prefix "yes (" $result ")\n"]
tputs $channel [appendArgs $prefix "yes (" $version ")\n"]
} else {
tputs $channel [appendArgs $prefix no\n]
}
}
proc checkForTkPackage { channel } {
#
# HACK: We do not care about the Tk version returned from this
# procedure, we only care if it returns "error" because that
# would indicate an error was caught during [exec] (i.e. the
# native Tcl shell could not be executed).
#
set prefix "---- checking for Tk package version... "
if {[catch {getTkVersionForTclShell} result] == 0 && \
$result ne "error"} then {
if {[catch {getTkVersionForTclShell} version] == 0 && \
$version ne "error"} then {
#
# NOTE: Yes, a native Tk package appears to be available.
#
addConstraint tkPackage
tputs $channel [appendArgs $prefix "yes (" $result ")\n"]
tputs $channel [appendArgs $prefix "yes (" $version ")\n"]
} else {
tputs $channel [appendArgs $prefix no\n]
}
}
proc checkForPowerShell { channel } {
tputs $channel "---- checking for PowerShell... "
|
︙ | | |
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
|
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
|
+
|
if {[string length $version] > 0} then {
set nativeUtility [appendArgs \
$name . [join [lrange [split $version .] 0 1] .]]
} else {
set nativeUtility $name
}
addConstraint nativeUtility
addConstraint [appendArgs nativeUtility. $nativeUtility]
tputs $channel [appendArgs $::eagle_platform(nativeUtility) \
" " ( $nativeUtility ) \n]
} else {
tputs $channel unknown\n
}
|
︙ | | |
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
|
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
|
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
-
+
|
set release [object invoke Microsoft.Win32.Registry GetValue $key \
Release null]
if {[string is integer -strict $release] && $release >= 378389} then {
#
# NOTE: Yes, it appears that it is available.
#
addConstraint dotNet45OrHigher
#
# NOTE: If the "release" value is greater than or equal to 378758,
# then the .NET Framework 4.5.1 is installed.
#
if {$release >= 378758} then {
addConstraint dotNet451
addConstraint dotNet451OrHigher
set version 4.5.1
} else {
addConstraint dotNet45
addConstraint dotNet45
set version 4.5
}
#
# NOTE: Show the "release" value we found in the registry.
#
tputs $channel [appendArgs "yes (" $release ")\n"]
tputs $channel [appendArgs "yes (" $release ", " $version ")\n"]
#
# NOTE: We are done here, return now.
#
return
}
}
|
︙ | | |
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
|
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
|
-
+
|
set key [appendArgs HKEY_LOCAL_MACHINE\\ \
[getSoftwareRegistryKey true] {\Microsoft\VisualStudio}]
#
# NOTE: The versions of Visual Studio that we support.
#
set versions [list [list 8.0 2005] [list 9.0 2008] \
[list 10.0 2010] [list 11.0 2012]]
[list 10.0 2010] [list 11.0 2012] [list 12.0 2013]]
#
# NOTE: Check each version and keep track of the ones we find.
#
foreach version $versions {
#
# NOTE: Attempt to fetch the Visual Studio install directory
|
︙ | | |
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
|
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
|
-
+
|
checkForTclOptions checkForWindowsCommandProcessor checkForFossil \
checkForEagle checkForSymbols checkForLogFile checkForGaruda \
checkForShell checkForDebug checkForTk checkForVersion \
checkForCommand checkForTestExec checkForTestMachine \
checkForTestPlatform checkForTestConfiguration checkForTestSuffix \
checkForFile checkForPathFile checkForNativeCode checkForTip127 \
checkForTip194 checkForTip241 checkForTip285 checkForTip405 \
checkForTip426 checkForTiming checkForPerformance \
checkForTip426 checkForTiming checkForPerformance checkForBigLists \
checkForStackIntensive checkForInteractive checkForInteractiveCommand \
checkForUserInteraction checkForNetwork checkForCompileOption] false \
false
###########################################################################
############################## END Tcl ONLY ###############################
###########################################################################
|
︙ | | |
Changes to Externals/Eagle/lib/Test1.0/prologue.eagle.
︙ | | |
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
-
-
+
+
|
# or whatever project the Eagle binaries are being used by) using a
# Fossil binary in the PATH, if available.
#
if {![info exists root_path] && \
![info exists no(exec)] && ![info exists no(fossil)]} then {
set pattern {^local-root:\s+(.*?)\s+$}
if {[catch {set exec [exec -- fossil info]}] || \
[regexp -line -- $pattern $exec dummy directory] == 0} then {
if {[catch {exec -- fossil info} exec] || \
![regexp -line -- $pattern $exec dummy directory]} then {
#
# NOTE: We could not query local root directory of the source checkout
# from Fossil; therefore, attempt to make an educated guess. This
# value will probably be wrong for any project(s) other than Eagle.
# In that case, this value should be overridden by that project to
# reflect the actual local root directory of the source checkout
# for that project.
|
︙ | | |
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
|
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
# NOTE: Set the default test configuration (i.e. Debug or Release), if
# necessary.
#
if {![info exists test_configuration]} then {
set test_configuration [getPlatformInfo configuration Release]
}
#
# NOTE: Set the Tcl shell executable to use for those specialized tests that
# may require it, if necessary.
#
if {![info exists test_tclsh]} then {
#
# NOTE: When running in Eagle, more complex logic is required to determine
# the Tcl shell to use for the various tests that require it. Also,
# this same logic is used with Tcl when it is not running from an
# instance of the Tcl shell executable.
#
if {[isEagle] || ![string match tclsh* $bin_file]} then {
if {[info exists test_flags(-tclsh)] && \
[string length $test_flags(-tclsh)] > 0} then {
#
# NOTE: Use the Tcl shell specified via the command line.
#
set test_tclsh $test_flags(-tclsh)
} else {
#
# NOTE: Check for a Tcl shell specified via the environment.
#
set test_tclsh [getTclShellFileName]
}
} else {
set test_tclsh $bin_file
}
}
#
# NOTE: Has automatic log file naming been disabled?
#
if {![info exists no(logFileName)]} then {
#
# NOTE: Set the log to use for test output, if necessary.
#
if {![info exists test_log]} then {
set test_log [file join [getTemporaryPath] [appendArgs [file tail [info \
nameofexecutable]] [getTestLogId] .test. [pid] .log]]
}
}
#
# NOTE: Has native Tcl shell detection and use been disabled?
#
if {![info exists no(tclsh)]} then {
#
# NOTE: Set the Tcl shell executable to use for those specialized
# tests that may require it, if necessary.
#
if {![info exists test_tclsh]} then {
#
# NOTE: When running in Eagle, more complex logic is required to
# determine the Tcl shell to use for the various tests that
# require it. Also, this same logic is used with Tcl when it
# is not running from an instance of the Tcl shell executable.
#
if {[isEagle] || ![string match tclsh* $bin_file]} then {
if {[info exists test_flags(-tclsh)] && \
[string length $test_flags(-tclsh)] > 0} then {
#
# NOTE: Use the Tcl shell specified via the command line.
#
set test_tclsh $test_flags(-tclsh)
} else {
if {![info exists no(getTclShellFileName)]} then {
#
# NOTE: Attempt to automatically select a Tcl shell to use.
#
tputs $test_channel \
"==== WARNING: attempting automatic Tcl shell selection...\n"
set test_tclsh [getTclShellFileName true]
} else {
#
# NOTE: Skip detection and use the fallback default.
#
set test_tclsh tclsh
}
}
} else {
set test_tclsh $bin_file
}
}
}
#
# NOTE: When running in Eagle, check for any non-core plugins loaded into
# the interpreter and issue warnings if any are found. The warning
# may be used to explain subsequent test failures due to the extra
# plugins being loaded (i.e. there are some tests are sensitive to
# having "unexpected" plugins loaded).
|
︙ | | |
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
|
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
|
-
-
+
+
|
if {[string length $publicKeyToken] == 0} then {
#
# NOTE: The Eagle core library is not strong name signed. This is not an
# error, per se; however, it may cause some tests to fail and it
# should be reported to the user and noted in the test suite log
# file.
#
tputs $test_channel [appendArgs \
"==== WARNING: running without any strong name signature...\n"]
tputs $test_channel \
"==== WARNING: running without any strong name signature...\n"
} else {
#
# BUGBUG: Tcl 8.4 does not like this expression because it contains the
# "ni" operator (and Tcl tries to compile it even though it will
# only actually ever be evaluated in Eagle).
#
set expr {$publicKeyToken ni \
|
︙ | | |
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
|
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
|
-
-
+
+
+
|
tputs $test_channel [appendArgs "---- tests running in: \"" \
[pwd] \"\n]
tputs $test_channel [appendArgs "---- temporary files stored in: \"" \
[getTemporaryPath] \"\n]
tputs $test_channel [appendArgs "---- native Tcl shell: \"" \
$test_tclsh \"\n]
tputs $test_channel [appendArgs "---- native Tcl shell: " \
[expr {[info exists test_tclsh] && [string length $test_tclsh] > 0 ? \
[appendArgs \" $test_tclsh \"] : "<none>"}] \n]
tputs $test_channel [appendArgs "---- disabled options: " \
[formatList [lsort [array names no]] <none>] \n]
#
# NOTE: Initialize the Eagle test constraints.
#
|
︙ | | |
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
|
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
|
-
+
|
checkForRuntime $test_channel
}
#
# NOTE: Check the variant and/or version of the CLR that we are
# currently running on.
#
if {![info exists no(runtimeVersion)]} then {
if {![info exists no(checkForRuntimeVersion)]} then {
checkForRuntimeVersion $test_channel
}
#
# NOTE: Check the framework version (i.e. regardless of runtime) that
# we are currently running on.
#
|
︙ | | |
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
|
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
|
-
+
|
#
if {![info exists no(compileOptions)]} then {
#
# NOTE: Has dedicated test support been enabled (at compile-time)?
#
if {![info exists no(compileTest)]} then {
#
# NOTE: For test "tclLoad-1.16.1".
# NOTE: For tests "tclLoad-1.17.1" and "tclLoad-1.17.2".
#
checkForCompileOption $test_channel TEST
}
}
###########################################################################
########################### END Tcl Constraints ###########################
|
︙ | | |
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
|
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
|
-
+
+
+
+
+
|
checkForScriptLibrary $test_channel
}
if {![info exists no(tclOptions)]} then {
checkForTclOptions $test_channel
}
if {![info exists no(stackIntensive)]} then {
if {![info exists no(checkForBigLists)]} then {
checkForBigLists $test_channel
}
if {![info exists no(checkForStackIntensive)]} then {
checkForStackIntensive $test_channel
}
if {![info exists no(windowsCommandProcessor)]} then {
checkForWindowsCommandProcessor $test_channel cmd.exe
}
|
︙ | | |
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
|
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
|
-
+
|
if {![info exists no(tip426)]} then {
checkForTip426 $test_channel
}
#
# NOTE: Has performance testing been disabled?
#
if {![info exists no(performance)]} then {
if {![info exists no(checkForPerformance)]} then {
checkForPerformance $test_channel
}
#
# NOTE: Have any timing related constraints been disabled?
#
# BUGBUG: In Eagle, these checks for "precision" timing are not overly
|
︙ | | |
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
|
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
|
-
+
-
+
-
+
|
if {[isEagle]} then {
#
# NOTE: Get the source checkout and tags (i.e. of Eagle or whatever
# project the Eagle binaries are being used by) using a Fossil
# binary in the PATH, if available.
#
if {![info exists no(exec)] && ![info exists no(fossil)]} then {
if {[catch {set exec [exec -- fossil info]}] == 0} then {
if {[catch {exec -- fossil info} exec] == 0} then {
set pattern {^checkout:\s+(.*?)\s+$}
if {[regexp -line -- $pattern $exec dummy checkout] == 0} then {
if {![regexp -line -- $pattern $exec dummy checkout]} then {
#
# NOTE: We could not query the source checkout from Fossil.
#
set checkout <none>
}
set pattern {^tags:\s+(.*?)\s+$}
if {[regexp -line -- $pattern $exec dummy tags] == 0} then {
if {![regexp -line -- $pattern $exec dummy tags]} then {
#
# NOTE: We could not query the tags from Fossil.
#
set tags <none>
}
} else {
#
|
︙ | | |
Added Externals/MSVCPP/vcredist_x64_2013_RTM.exe.
Added Externals/MSVCPP/vcredist_x86_2013_RTM.exe.
Changes to SQLite.Designer/SQLite.Designer.2005.csproj.
Changes to SQLite.Designer/SQLite.Designer.2008.csproj.
Changes to SQLite.Designer/SQLite.Designer.2010.csproj.
Changes to SQLite.Designer/SQLite.Designer.2012.csproj.
Added SQLite.Designer/SQLite.Designer.2013.csproj.