Tcl Source Code

Check-in [4c6197ca80]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added tests for mcforgetpackage, mcpackagelocale and mcpackageconfig
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | msgcat_dyn_locale | tip-412
Files: files | file ages | folders
SHA1: 4c6197ca80269af157c002344de78acc58400160
User & Date: oehhar 2015-06-29 21:26:24.734
Context
2015-06-29
21:44
[TIP 412] msgcat dynamic locale change and package private locale (msgcat 1.6.0) check-in: 392ff6199d user: oehhar tags: trunk
21:26
Added tests for mcforgetpackage, mcpackagelocale and mcpackageconfig Closed-Leaf check-in: 4c6197ca80 user: oehhar tags: msgcat_dyn_locale, tip-412
2015-06-26
15:16
Tests for mcexists and mcloadedlocales check-in: 9806884e41 user: oehhar tags: msgcat_dyn_locale
Changes
Side-by-Side Diff Ignore Whitespace Patch
Changes to library/msgcat/msgcat.tcl.
︙
464
465
466
467
468
469
470

471
472


473
474
475
476
477
478
479

464
465
466
467
468
469
470
471


472
473
474
475
476
477
478
479
480








+
-
-
+
+








    }
    set ns [uplevel 1 {::namespace current}]
    
    switch -exact -- $subcommand {
	get { return [lindex [PackagePreferences $ns] 0] }
	preferences { return [PackagePreferences $ns] }
	loaded { return [PackageLocales $ns] }
	present { return [expr {$locale in [PackageLocales $ns]} ]}
	isset {	return [dict exists $PackageConfig loclist $ns] }
	set {	# set a package locale or add a package locale
	isset { return [dict exists $PackageConfig loclist $ns] }
	set { # set a package locale or add a package locale

	    # Copy the default locale if no package locale set so far
	    if {![dict exists $PackageConfig loclist $ns]} {
		dict set PackageConfig loclist $ns $Loclist
		dict set PackageConfig loadedlocales $ns $LoadedLocales
	    }
︙
663
664
665
666
667
668
669
670

671
672
673
674
675
676
677

664
665
666
667
668
669
670

671
672
673
674
675
676
677
678








-
+








		mcfolder { return [Load $ns [PackageLocales $ns]] }
		loadcmd { return [Load $ns [PackageLocales $ns] 1] }
	    }
	    return 0
	}
	default {
	    return -code error "unknown subcommand \"$subcommand\":\
		    must be get, isset, unset, or set"
		    must be get, isset, set, or unset"
	}
    }
    return
}

# msgcat::PackagePreferences --
#
︙
Changes to tests/msgcat.test.
︙
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

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








-
-
+
+









-
-
+
+








    # Even though foo_BAR_notexist does not exist,
    # foo_BAR, foo and the root should be loaded.
	test msgcat-5.4 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale foo_BAR_notexist
	} -cleanup {
	    mclocale $locale
	    ::msgcat::mcloadedlocales clear
	    ::msgcat::mcpackageconfig unset mcfolder 
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder 
	} -body {
	    mcload $msgdir
	} -result 3

	test msgcat-5.5 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale no_FI_notexist
	} -cleanup {
	    mclocale $locale
	    ::msgcat::mcloadedlocales clear
	    ::msgcat::mcpackageconfig unset mcfolder 
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder 
	} -body {
	    mcload $msgdir
	} -result 1

	test msgcat-5.6 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale foo
︙
503
504
505
506
507
508
509














510
511
512
513
514
515
516

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








+
+
+
+
+
+
+
+
+
+
+
+
+
+








	} -cleanup {
	    mclocale $locale
	    rename ::msgcat::mcunknown {}
	    rename SavedMcunknown ::msgcat::mcunknown
	} -body {
	    mc def
	} -result unknown:no_fi_notexist:def

	test msgcat-5.11 {mcpackageconfig mcfolder} -setup {
	    variable locale [mclocale]
	    mclocale ""
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder
	} -cleanup {
	    mclocale $locale
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder 
	} -body {
	    mclocale foo
	    mcpackageconfig set mcfolder $msgdir
	} -result 2

    foreach loc $locales {
	if { $loc eq {} } {
	    set msg ROOT
        } else {
	    set msg [string tolower $loc]
	}
︙
733
734
735
736
737
738
739
740
741

742
743

744
745

746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763











































































































































































































































































































764
765
766
767
768

747
748
749
750
751
752
753


754


755


756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773

774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077








-
-
+
-
-
+
-
-
+

















-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






	    variable locale [mclocale]
	    mclocale {}
	    mcloadedlocales clear
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo_bar
	    set resultlist [mcloadedlocales loaded]
	    # The result is position independent so check length and existence
	    # The result is position independent so sort
	    list [llength $resultlist] [expr {"" in $resultlist}]\
		    [expr {"foo" in $resultlist}]\
	    set resultlist [lsort [mcloadedlocales loaded]]
		    [expr {"foo_bar" in $resultlist}]
	} -result {3 1 1 1}
	} -result {{} foo foo_bar}
    
	test msgcat-10.4 {mcloadedlocales clear} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale {}
	    mcloadedlocales clear
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo
	    mcset foo k1 v1
	    set res [mcexists k1]
	    mclocale ""
	    mcloadedlocales clear
	    mclocale foo
	    lappend res [mcexists k1]
	} -result {1 0}
    

    # Tests msgcat-11.*: [mcforgetpackage]

	test msgcat-11.1 {mcforgetpackage translation} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo
	    mcset foo k1 v1
	    set res [mcexists k1]
	    mcforgetpackage
	    lappend res [mcexists k1]
	} -result {1 0}

	test msgcat-11.2 {mcforgetpackage locale} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo
	    mcpackagelocale set bar
	    set res [mcpackagelocale get]
	    mcforgetpackage
	    lappend res [mcpackagelocale get]
	} -result {bar foo}

	test msgcat-11.3 {mcforgetpackage options} -body {
	    mcpackageconfig set loadcmd ""
	    set res [mcpackageconfig isset loadcmd]
	    mcforgetpackage
	    lappend res [mcpackageconfig isset loadcmd]
	} -result {1 0}

    # Tests msgcat-12.*: [mcpackagelocale]

	test msgcat-12.1 {mcpackagelocale no subcommand} -body {
	    mcpackagelocale
	} -returnCodes 1\
	-result {wrong # args: should be "mcpackagelocale subcommand ?locale?"}

	test msgcat-12.2 {mclpackagelocale wrong subcommand} -body {
	    mcpackagelocale junk
	} -returnCodes 1\
	-result {unknown subcommand "junk": must be clear, get, isset, loaded, present, set, or unset}

	test msgcat-12.3 {mcpackagelocale set} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    mcpackagelocale set bar
	    list [mcpackagelocale get] [mclocale]
	} -result {bar foo}

	test msgcat-12.4 {mcpackagelocale get} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    set res [mcpackagelocale get]
	    mcpackagelocale set bar
	    lappend res [mcpackagelocale get]
	} -result {foo bar}

	test msgcat-12.5 {mcpackagelocale preferences} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    set res [list [mcpackagelocale preferences]]
	    mcpackagelocale set bar
	    lappend res [mcpackagelocale preferences]
	} -result {{foo {}} {bar {}}}

	test msgcat-12.6 {mcpackagelocale loaded} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale ""
	    mcloadedlocales clear
	    mclocale foo
	    # The result is position independent so sort
	    set res [list [lsort [mcpackagelocale loaded]]]
	    mcpackagelocale set bar
	    lappend res [lsort [mcpackagelocale loaded]]
	} -result {{{} foo} {{} bar foo}}

	test msgcat-12.7 {mcpackagelocale isset} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    set res [mcpackagelocale isset]
	    mcpackagelocale set bar
	    lappend res [mcpackagelocale isset]
	} -result {0 1}

	test msgcat-12.8 {mcpackagelocale unset} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mcpackagelocale set bar
	    set res [mcpackagelocale isset]
	    mcpackagelocale unset
	    lappend res [mcpackagelocale isset]
	} -result {1 0}

	test msgcat-12.9 {mcpackagelocale present} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale ""
	    mcloadedlocales clear
	    mclocale foo
	    set res [mcpackagelocale present foo]
	    lappend res [mcpackagelocale present bar]
	    mcpackagelocale set bar
	    lappend res [mcpackagelocale present foo]\
		    [mcpackagelocale present bar]
	} -result {1 0 1 1}

	test msgcat-12.10 {mcpackagelocale clear} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale ""
	    mcloadedlocales clear
	    mclocale foo
	    mcpackagelocale set bar
	    mcpackagelocale clear
	    list [mcpackagelocale present foo] [mcpackagelocale present bar]
	} -result {0 1}

    # Tests msgcat-13.*: [mcpackageconfig subcmds]

	test msgcat-13.1 {mcpackageconfig no subcommand} -body {
	    mcpackageconfig
	} -returnCodes 1\
	-result {wrong # args: should be "mcpackageconfig subcommand option ?value?"}

	test msgcat-13.2 {mclpackageconfig wrong subcommand} -body {
	    mcpackageconfig junk mcfolder
	} -returnCodes 1\
	-result {unknown subcommand "junk": must be get, isset, set, or unset}

	test msgcat-13.3 {mclpackageconfig wrong option} -body {
	    mcpackageconfig get junk
	} -returnCodes 1\
	-result {bad option "junk": must be mcfolder, loadcmd, changecmd, or unknowncmd}

	test msgcat-13.4 {mcpackageconfig get} -setup {
	    mcforgetpackage
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set loadcmd ""
	    mcpackageconfig get loadcmd
	} -result {}

	test msgcat-13.5 {mcpackageconfig (is/un)set} -setup {
	    mcforgetpackage
	} -cleanup {
	    mcforgetpackage
	} -body {
	    set res [mcpackageconfig isset loadcmd]
	    lappend res [mcpackageconfig set loadcmd ""]
	    lappend res [mcpackageconfig isset loadcmd]
	    mcpackageconfig unset loadcmd
	    lappend res [mcpackageconfig isset loadcmd]
	} -result {0 0 1 0}

    # option mcfolder is already tested with 5.11
    
    # Tests msgcat-14.*: callbacks: loadcmd, changecmd, unknowncmd
    
    # This routine is used as bgerror and by direct callback invocation
    proc callbackproc args {
	variable resultvariable
	set resultvariable $args
    }
    proc callbackfailproc args {
	return -code error fail
    }
    set bgerrorsaved [interp bgerror {}]
    interp bgerror {} [namespace code callbackproc]
    
	test msgcat-14.1 {invokation loadcmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set loadcmd [namespace code callbackproc]
	    mclocale foo_bar
	    lsort $resultvariable
	} -result {foo foo_bar}

	test msgcat-14.2 {invokation failed in loadcmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set loadcmd [namespace code callbackfailproc]
	    mclocale foo_bar
	    # let the bgerror run
	    after 100 set [namespace current]::resultvariable timeout
	    vwait [namespace current]::resultvariable
	    lassign $resultvariable err errdict
	    list $err [dict get $errdict -code]
	} -result {fail 1}

	test msgcat-14.3 {invokation changecmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set changecmd [namespace code callbackproc]
	    mclocale foo_bar
	    set resultvariable
	} -result {foo_bar foo {}}

	test msgcat-14.4 {invokation unknowncmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set unknowncmd [namespace code callbackproc]
	    mclocale foo_bar
	    mc k1 p1
	    set resultvariable
	} -result {foo_bar k1 p1}

	test msgcat-14.5 {disable global unknowncmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	    rename ::msgcat::mcunknown SavedMcunknown
	    proc ::msgcat::mcunknown {dom s} {
		return unknown:$dom:$s
	    }
	} -cleanup {
	    mcforgetpackage
	    rename ::msgcat::mcunknown {}
	    rename SavedMcunknown ::msgcat::mcunknown
	} -body {
	    mcpackageconfig set unknowncmd ""
	    mclocale foo_bar
	    mc k1%s p1
	} -result {k1p1}

	test msgcat-14.6 {unknowncmd failing} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set unknowncmd [namespace code callbackfailproc]
	    mclocale foo_bar
	    mc k1
	} -returnCodes 1\
	-result {fail}

    interp bgerror {} $bgerrorsaved

    cleanupTests
}
namespace delete ::msgcat::test
return
This page was generated in about 0.018s by Fossil 2.27 [a6d506ecc4] 2025-07-09 13:52:53