commit dc833039179ee11dae9aeb15b7d75e7435f7f1c9 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Mon Dec 12 23:16:42 2016 -0800 * test/src/regex-resources/PTESTS: Convert to UTF-8. diff --git a/test/src/regex-resources/PTESTS b/test/src/regex-resources/PTESTS index 02b357c..68acc31 100644 --- a/test/src/regex-resources/PTESTS +++ b/test/src/regex-resources/PTESTS @@ -1,341 +1,341 @@ # 2.8.2 Regular Expression General Requirement -2¦4¦bb*¦abbbc¦ -2¦2¦bb*¦ababbbc¦ -7¦9¦A#*::¦A:A#:qA::qA#::qA##::q¦ -1¦5¦A#*::¦A##::A#::qA::qA#:q¦ +2¦4¦bb*¦abbbc¦ +2¦2¦bb*¦ababbbc¦ +7¦9¦A#*::¦A:A#:qA::qA#::qA##::q¦ +1¦5¦A#*::¦A##::A#::qA::qA#:q¦ # 2.8.3.1.2 BRE Special Characters # GA108 -2¦2¦\.¦a.c¦ -2¦2¦\[¦a[c¦ -2¦2¦\\¦a\c¦ -2¦2¦\*¦a*c¦ -2¦2¦\^¦a^c¦ -2¦2¦\$¦a$c¦ -7¦11¦X\*Y\*8¦Y*8X*8X*Y*8¦ +2¦2¦\.¦a.c¦ +2¦2¦\[¦a[c¦ +2¦2¦\\¦a\c¦ +2¦2¦\*¦a*c¦ +2¦2¦\^¦a^c¦ +2¦2¦\$¦a$c¦ +7¦11¦X\*Y\*8¦Y*8X*8X*Y*8¦ # GA109 -2¦2¦[.]¦a.c¦ -2¦2¦[[]¦a[c¦ --1¦-1¦[[]¦ac¦ -2¦2¦[\]¦a\c¦ -1¦1¦[\a]¦abc¦ -2¦2¦[\.]¦a\.c¦ -2¦2¦[\.]¦a.\c¦ -2¦2¦[*]¦a*c¦ -2¦2¦[$]¦a$c¦ -2¦2¦[X*Y8]¦7*8YX¦ +2¦2¦[.]¦a.c¦ +2¦2¦[[]¦a[c¦ +-1¦-1¦[[]¦ac¦ +2¦2¦[\]¦a\c¦ +1¦1¦[\a]¦abc¦ +2¦2¦[\.]¦a\.c¦ +2¦2¦[\.]¦a.\c¦ +2¦2¦[*]¦a*c¦ +2¦2¦[$]¦a$c¦ +2¦2¦[X*Y8]¦7*8YX¦ # GA110 -2¦2¦*¦a*c¦ -3¦4¦*a¦*b*a*c¦ -1¦5¦**9=¦***9=9¦ +2¦2¦*¦a*c¦ +3¦4¦*a¦*b*a*c¦ +1¦5¦**9=¦***9=9¦ # GA111 -1¦1¦^*¦*bc¦ --1¦-1¦^*¦a*c¦ --1¦-1¦^*¦^*ab¦ -1¦5¦^**9=¦***9=¦ --1¦-1¦^*5<*9¦5<9*5<*9¦ +1¦1¦^*¦*bc¦ +-1¦-1¦^*¦a*c¦ +-1¦-1¦^*¦^*ab¦ +1¦5¦^**9=¦***9=¦ +-1¦-1¦^*5<*9¦5<9*5<*9¦ # GA112 -2¦3¦\(*b\)¦a*b¦ --1¦-1¦\(*b\)¦ac¦ -1¦6¦A\(**9\)=¦A***9=79¦ +2¦3¦\(*b\)¦a*b¦ +-1¦-1¦\(*b\)¦ac¦ +1¦6¦A\(**9\)=¦A***9=79¦ # GA113(1) -1¦3¦\(^*ab\)¦*ab¦ --1¦-1¦\(^*ab\)¦^*ab¦ --1¦-1¦\(^*b\)¦a*b¦ --1¦-1¦\(^*b\)¦^*b¦ +1¦3¦\(^*ab\)¦*ab¦ +-1¦-1¦\(^*ab\)¦^*ab¦ +-1¦-1¦\(^*b\)¦a*b¦ +-1¦-1¦\(^*b\)¦^*b¦ ### GA113(2) GNU regex implements GA113(1) -##-1¦-1¦\(^*ab\)¦*ab¦ -##-1¦-1¦\(^*ab\)¦^*ab¦ -##1¦1¦\(^*b\)¦b¦ -##1¦3¦\(^*b\)¦^^b¦ +##-1¦-1¦\(^*ab\)¦*ab¦ +##-1¦-1¦\(^*ab\)¦^*ab¦ +##1¦1¦\(^*b\)¦b¦ +##1¦3¦\(^*b\)¦^^b¦ # GA114 -1¦3¦a^b¦a^b¦ -1¦3¦a\^b¦a^b¦ -1¦1¦^^¦^bc¦ -2¦2¦\^¦a^c¦ -1¦1¦[c^b]¦^abc¦ -1¦1¦[\^ab]¦^ab¦ -2¦2¦[\^ab]¦c\d¦ --1¦-1¦[^^]¦^¦ -1¦3¦\(a^b\)¦a^b¦ -1¦3¦\(a\^b\)¦a^b¦ -2¦2¦\(\^\)¦a^b¦ +1¦3¦a^b¦a^b¦ +1¦3¦a\^b¦a^b¦ +1¦1¦^^¦^bc¦ +2¦2¦\^¦a^c¦ +1¦1¦[c^b]¦^abc¦ +1¦1¦[\^ab]¦^ab¦ +2¦2¦[\^ab]¦c\d¦ +-1¦-1¦[^^]¦^¦ +1¦3¦\(a^b\)¦a^b¦ +1¦3¦\(a\^b\)¦a^b¦ +2¦2¦\(\^\)¦a^b¦ # GA115 -3¦3¦$$¦ab$¦ --1¦-1¦$$¦$ab¦ -2¦3¦$c¦a$c¦ -2¦2¦[$]¦a$c¦ -1¦2¦\$a¦$a¦ -3¦3¦\$$¦ab$¦ -2¦6¦A\([34]$[34]\)B¦XA4$3BY¦ +3¦3¦$$¦ab$¦ +-1¦-1¦$$¦$ab¦ +2¦3¦$c¦a$c¦ +2¦2¦[$]¦a$c¦ +1¦2¦\$a¦$a¦ +3¦3¦\$$¦ab$¦ +2¦6¦A\([34]$[34]\)B¦XA4$3BY¦ # 2.8.3.1.3 Periods in BREs # GA116 -1¦1¦.¦abc¦ --1¦-1¦.ab¦abc¦ -1¦3¦ab.¦abc¦ -1¦3¦a.b¦a,b¦ --1¦-1¦.......¦PqRs6¦ -1¦7¦.......¦PqRs6T8¦ +1¦1¦.¦abc¦ +-1¦-1¦.ab¦abc¦ +1¦3¦ab.¦abc¦ +1¦3¦a.b¦a,b¦ +-1¦-1¦.......¦PqRs6¦ +1¦7¦.......¦PqRs6T8¦ # 2.8.3.2 RE Bracket Expression # GA118 -2¦2¦[abc]¦xbyz¦ --1¦-1¦[abc]¦xyz¦ -2¦2¦[abc]¦xbay¦ +2¦2¦[abc]¦xbyz¦ +-1¦-1¦[abc]¦xyz¦ +2¦2¦[abc]¦xbay¦ # GA119 -2¦2¦[^a]¦abc¦ -4¦4¦[^]cd]¦cd]ef¦ -2¦2¦[^abc]¦axyz¦ --1¦-1¦[^abc]¦abc¦ -3¦3¦[^[.a.]b]¦abc¦ -3¦3¦[^[=a=]b]¦abc¦ -2¦2¦[^-ac]¦abcde-¦ -2¦2¦[^ac-]¦abcde-¦ -3¦3¦[^a-b]¦abcde¦ -3¦3¦[^a-bd-e]¦dec¦ -2¦2¦[^---]¦-ab¦ -16¦16¦[^a-zA-Z0-9]¦pqrstVWXYZ23579#¦ +2¦2¦[^a]¦abc¦ +4¦4¦[^]cd]¦cd]ef¦ +2¦2¦[^abc]¦axyz¦ +-1¦-1¦[^abc]¦abc¦ +3¦3¦[^[.a.]b]¦abc¦ +3¦3¦[^[=a=]b]¦abc¦ +2¦2¦[^-ac]¦abcde-¦ +2¦2¦[^ac-]¦abcde-¦ +3¦3¦[^a-b]¦abcde¦ +3¦3¦[^a-bd-e]¦dec¦ +2¦2¦[^---]¦-ab¦ +16¦16¦[^a-zA-Z0-9]¦pqrstVWXYZ23579#¦ # GA120(1) -3¦3¦[]a]¦cd]ef¦ -1¦1¦[]-a]¦a_b¦ -3¦3¦[][.-.]-0]¦ab0-]¦ -1¦1¦[]^a-z]¦string¦ +3¦3¦[]a]¦cd]ef¦ +1¦1¦[]-a]¦a_b¦ +3¦3¦[][.-.]-0]¦ab0-]¦ +1¦1¦[]^a-z]¦string¦ # GA120(2) -4¦4¦[^]cd]¦cd]ef¦ -0¦0¦[^]]*¦]]]]]]]]X¦ -0¦0¦[^]]*¦]]]]]]]]¦ -9¦9¦[^]]\{1,\}¦]]]]]]]]X¦ --1¦-1¦[^]]\{1,\}¦]]]]]]]]¦ +4¦4¦[^]cd]¦cd]ef¦ +0¦0¦[^]]*¦]]]]]]]]X¦ +0¦0¦[^]]*¦]]]]]]]]¦ +9¦9¦[^]]\{1,\}¦]]]]]]]]X¦ +-1¦-1¦[^]]\{1,\}¦]]]]]]]]¦ # GA120(3) -3¦3¦[c[.].]d]¦ab]cd¦ -2¦8¦[a-z]*[[.].]][A-Z]*¦Abcd]DEFg¦ +3¦3¦[c[.].]d]¦ab]cd¦ +2¦8¦[a-z]*[[.].]][A-Z]*¦Abcd]DEFg¦ # GA121 -2¦2¦[[.a.]b]¦Abc¦ -1¦1¦[[.a.]b]¦aBc¦ --1¦-1¦[[.a.]b]¦ABc¦ -3¦3¦[^[.a.]b]¦abc¦ -3¦3¦[][.-.]-0]¦ab0-]¦ -3¦3¦[A-[.].]c]¦ab]!¦ +2¦2¦[[.a.]b]¦Abc¦ +1¦1¦[[.a.]b]¦aBc¦ +-1¦-1¦[[.a.]b]¦ABc¦ +3¦3¦[^[.a.]b]¦abc¦ +3¦3¦[][.-.]-0]¦ab0-]¦ +3¦3¦[A-[.].]c]¦ab]!¦ # GA122 --2¦-2¦[[.ch.]]¦abc¦ --2¦-2¦[[.ab.][.CD.][.EF.]]¦yZabCDEFQ9¦ +-2¦-2¦[[.ch.]]¦abc¦ +-2¦-2¦[[.ab.][.CD.][.EF.]]¦yZabCDEFQ9¦ # GA125 -2¦2¦[[=a=]b]¦Abc¦ -1¦1¦[[=a=]b]¦aBc¦ --1¦-1¦[[=a=]b]¦ABc¦ -3¦3¦[^[=a=]b]¦abc¦ +2¦2¦[[=a=]b]¦Abc¦ +1¦1¦[[=a=]b]¦aBc¦ +-1¦-1¦[[=a=]b]¦ABc¦ +3¦3¦[^[=a=]b]¦abc¦ # GA126 #W the expected result for [[:alnum:]]* is 2-7 which is wrong -0¦0¦[[:alnum:]]*¦ aB28gH¦ -2¦7¦[[:alnum:]][[:alnum:]]*¦ aB28gH¦ +0¦0¦[[:alnum:]]*¦ aB28gH¦ +2¦7¦[[:alnum:]][[:alnum:]]*¦ aB28gH¦ #W the expected result for [^[:alnum:]]* is 2-5 which is wrong -0¦0¦[^[:alnum:]]*¦2 ,a¦ -2¦5¦[^[:alnum:]][^[:alnum:]]*¦2 ,a¦ +0¦0¦[^[:alnum:]]*¦2 ,a¦ +2¦5¦[^[:alnum:]][^[:alnum:]]*¦2 ,a¦ #W the expected result for [[:alpha:]]* is 2-5 which is wrong -0¦0¦[[:alpha:]]*¦ aBgH2¦ -2¦5¦[[:alpha:]][[:alpha:]]*¦ aBgH2¦ -1¦6¦[^[:alpha:]]*¦2 8,a¦ -1¦2¦[[:blank:]]*¦ ¦ -1¦8¦[^[:blank:]]*¦aB28gH, ¦ -1¦2¦[[:cntrl:]]*¦  ¦ -1¦8¦[^[:cntrl:]]*¦aB2 8gh,¦ +0¦0¦[[:alpha:]]*¦ aBgH2¦ +2¦5¦[[:alpha:]][[:alpha:]]*¦ aBgH2¦ +1¦6¦[^[:alpha:]]*¦2 8,a¦ +1¦2¦[[:blank:]]*¦ ¦ +1¦8¦[^[:blank:]]*¦aB28gH, ¦ +1¦2¦[[:cntrl:]]*¦  ¦ +1¦8¦[^[:cntrl:]]*¦aB2 8gh,¦ #W the expected result for [[:digit:]]* is 2-3 which is wrong -0¦0¦[[:digit:]]*¦a28¦ -2¦3¦[[:digit:]][[:digit:]]*¦a28¦ -1¦8¦[^[:digit:]]*¦aB gH,¦ -1¦7¦[[:graph:]]*¦aB28gH, ¦ -1¦3¦[^[:graph:]]*¦ ,¦ -1¦2¦[[:lower:]]*¦agB¦ -1¦8¦[^[:lower:]]*¦B2 8H,a¦ -1¦8¦[[:print:]]*¦aB2 8gH, ¦ -1¦2¦[^[:print:]]*¦  ¦ +0¦0¦[[:digit:]]*¦a28¦ +2¦3¦[[:digit:]][[:digit:]]*¦a28¦ +1¦8¦[^[:digit:]]*¦aB gH,¦ +1¦7¦[[:graph:]]*¦aB28gH, ¦ +1¦3¦[^[:graph:]]*¦ ,¦ +1¦2¦[[:lower:]]*¦agB¦ +1¦8¦[^[:lower:]]*¦B2 8H,a¦ +1¦8¦[[:print:]]*¦aB2 8gH, ¦ +1¦2¦[^[:print:]]*¦  ¦ #W the expected result for [[:punct:]]* is 2-2 which is wrong -0¦0¦[[:punct:]]*¦a,2¦ -2¦3¦[[:punct:]][[:punct:]]*¦a,,2¦ -1¦9¦[^[:punct:]]*¦aB2 8gH¦ -1¦3¦[[:space:]]*¦ ¦ +0¦0¦[[:punct:]]*¦a,2¦ +2¦3¦[[:punct:]][[:punct:]]*¦a,,2¦ +1¦9¦[^[:punct:]]*¦aB2 8gH¦ +1¦3¦[[:space:]]*¦ ¦ #W the expected result for [^[:space:]]* is 2-9 which is wrong -0¦0¦[^[:space:]]*¦ aB28gH, ¦ -2¦9¦[^[:space:]][^[:space:]]*¦ aB28gH, ¦ +0¦0¦[^[:space:]]*¦ aB28gH, ¦ +2¦9¦[^[:space:]][^[:space:]]*¦ aB28gH, ¦ #W the expected result for [[:upper:]]* is 2-3 which is wrong -0¦0¦[[:upper:]]*¦aBH2¦ -2¦3¦[[:upper:]][[:upper:]]*¦aBH2¦ -1¦8¦[^[:upper:]]*¦a2 8g,B¦ +0¦0¦[[:upper:]]*¦aBH2¦ +2¦3¦[[:upper:]][[:upper:]]*¦aBH2¦ +1¦8¦[^[:upper:]]*¦a2 8g,B¦ #W the expected result for [[:xdigit:]]* is 2-5 which is wrong -0¦0¦[[:xdigit:]]*¦gaB28h¦ -2¦5¦[[:xdigit:]][[:xdigit:]]*¦gaB28h¦ +0¦0¦[[:xdigit:]]*¦gaB28h¦ +2¦5¦[[:xdigit:]][[:xdigit:]]*¦gaB28h¦ #W the expected result for [^[:xdigit:]]* is 2-7 which is wrong -2¦7¦[^[:xdigit:]][^[:xdigit:]]*¦a gH,2¦ +2¦7¦[^[:xdigit:]][^[:xdigit:]]*¦a gH,2¦ # GA127 --2¦-2¦[b-a]¦abc¦ -1¦1¦[a-c]¦bbccde¦ -2¦2¦[a-b]¦-bc¦ -3¦3¦[a-z0-9]¦AB0¦ -3¦3¦[^a-b]¦abcde¦ -3¦3¦[^a-bd-e]¦dec¦ -1¦1¦[]-a]¦a_b¦ -2¦2¦[+--]¦a,b¦ -2¦2¦[--/]¦a.b¦ -2¦2¦[^---]¦-ab¦ -3¦3¦[][.-.]-0]¦ab0-]¦ -3¦3¦[A-[.].]c]¦ab]!¦ -2¦6¦bc[d-w]xy¦abchxyz¦ +-2¦-2¦[b-a]¦abc¦ +1¦1¦[a-c]¦bbccde¦ +2¦2¦[a-b]¦-bc¦ +3¦3¦[a-z0-9]¦AB0¦ +3¦3¦[^a-b]¦abcde¦ +3¦3¦[^a-bd-e]¦dec¦ +1¦1¦[]-a]¦a_b¦ +2¦2¦[+--]¦a,b¦ +2¦2¦[--/]¦a.b¦ +2¦2¦[^---]¦-ab¦ +3¦3¦[][.-.]-0]¦ab0-]¦ +3¦3¦[A-[.].]c]¦ab]!¦ +2¦6¦bc[d-w]xy¦abchxyz¦ # GA129 -1¦1¦[a-cd-f]¦dbccde¦ --1¦-1¦[a-ce-f]¦dBCCdE¦ -2¦4¦b[n-zA-M]Y¦absY9Z¦ -2¦4¦b[n-zA-M]Y¦abGY9Z¦ +1¦1¦[a-cd-f]¦dbccde¦ +-1¦-1¦[a-ce-f]¦dBCCdE¦ +2¦4¦b[n-zA-M]Y¦absY9Z¦ +2¦4¦b[n-zA-M]Y¦abGY9Z¦ # GA130 -3¦3¦[-xy]¦ac-¦ -2¦4¦c[-xy]D¦ac-D+¦ -2¦2¦[--/]¦a.b¦ -2¦4¦c[--/]D¦ac.D+b¦ -2¦2¦[^-ac]¦abcde-¦ -1¦3¦a[^-ac]c¦abcde-¦ -3¦3¦[xy-]¦zc-¦ -2¦4¦c[xy-]7¦zc-786¦ -2¦2¦[^ac-]¦abcde-¦ -2¦4¦a[^ac-]c¦5abcde-¦ -2¦2¦[+--]¦a,b¦ -2¦4¦a[+--]B¦Xa,By¦ -2¦2¦[^---]¦-ab¦ -4¦6¦X[^---]Y¦X-YXaYXbY¦ +3¦3¦[-xy]¦ac-¦ +2¦4¦c[-xy]D¦ac-D+¦ +2¦2¦[--/]¦a.b¦ +2¦4¦c[--/]D¦ac.D+b¦ +2¦2¦[^-ac]¦abcde-¦ +1¦3¦a[^-ac]c¦abcde-¦ +3¦3¦[xy-]¦zc-¦ +2¦4¦c[xy-]7¦zc-786¦ +2¦2¦[^ac-]¦abcde-¦ +2¦4¦a[^ac-]c¦5abcde-¦ +2¦2¦[+--]¦a,b¦ +2¦4¦a[+--]B¦Xa,By¦ +2¦2¦[^---]¦-ab¦ +4¦6¦X[^---]Y¦X-YXaYXbY¦ # 2.8.3.3 BREs Matching Multiple Characters # GA131 -3¦4¦cd¦abcdeabcde¦ -1¦2¦ag*b¦abcde¦ --1¦-1¦[a-c][e-f]¦abcdef¦ -3¦4¦[a-c][e-f]¦acbedf¦ -4¦8¦abc*XYZ¦890abXYZ#*¦ -4¦9¦abc*XYZ¦890abcXYZ#*¦ -4¦15¦abc*XYZ¦890abcccccccXYZ#*¦ --1¦-1¦abc*XYZ¦890abc*XYZ#*¦ +3¦4¦cd¦abcdeabcde¦ +1¦2¦ag*b¦abcde¦ +-1¦-1¦[a-c][e-f]¦abcdef¦ +3¦4¦[a-c][e-f]¦acbedf¦ +4¦8¦abc*XYZ¦890abXYZ#*¦ +4¦9¦abc*XYZ¦890abcXYZ#*¦ +4¦15¦abc*XYZ¦890abcccccccXYZ#*¦ +-1¦-1¦abc*XYZ¦890abc*XYZ#*¦ # GA132 -2¦4¦\(*bc\)¦a*bc¦ -1¦2¦\(ab\)¦abcde¦ -1¦10¦\(a\(b\(c\(d\(e\(f\(g\)h\(i\(j\)\)\)\)\)\)\)\)¦abcdefghijk¦ -3¦8¦43\(2\(6\)*0\)AB¦654320ABCD¦ -3¦9¦43\(2\(7\)*0\)AB¦6543270ABCD¦ -3¦12¦43\(2\(7\)*0\)AB¦6543277770ABCD¦ +2¦4¦\(*bc\)¦a*bc¦ +1¦2¦\(ab\)¦abcde¦ +1¦10¦\(a\(b\(c\(d\(e\(f\(g\)h\(i\(j\)\)\)\)\)\)\)\)¦abcdefghijk¦ +3¦8¦43\(2\(6\)*0\)AB¦654320ABCD¦ +3¦9¦43\(2\(7\)*0\)AB¦6543270ABCD¦ +3¦12¦43\(2\(7\)*0\)AB¦6543277770ABCD¦ # GA133 -1¦10¦\(a\(b\(c\(d\(e\(f\(g\)h\(i\(j\)\)\)\)\)\)\)\)¦abcdefghijk¦ --1¦-1¦\(a\(b\(c\(d\(e\(f\(g\)h\(i\(k\)\)\)\)\)\)\)\)¦abcdefghijk¦ +1¦10¦\(a\(b\(c\(d\(e\(f\(g\)h\(i\(j\)\)\)\)\)\)\)\)¦abcdefghijk¦ +-1¦-1¦\(a\(b\(c\(d\(e\(f\(g\)h\(i\(k\)\)\)\)\)\)\)\)¦abcdefghijk¦ # GA134 -2¦4¦\(bb*\)¦abbbc¦ -2¦2¦\(bb*\)¦ababbbc¦ -1¦6¦a\(.*b\)¦ababbbc¦ -1¦2¦a\(b*\)¦ababbbc¦ -1¦20¦a\(.*b\)c¦axcaxbbbcsxbbbbbbbbc¦ +2¦4¦\(bb*\)¦abbbc¦ +2¦2¦\(bb*\)¦ababbbc¦ +1¦6¦a\(.*b\)¦ababbbc¦ +1¦2¦a\(b*\)¦ababbbc¦ +1¦20¦a\(.*b\)c¦axcaxbbbcsxbbbbbbbbc¦ # GA135 -1¦7¦\(a\(b\(c\(d\(e\)\)\)\)\)\4¦abcdededede¦ +1¦7¦\(a\(b\(c\(d\(e\)\)\)\)\)\4¦abcdededede¦ #W POSIX does not really specify whether a\(b\)*c\1 matches acb. #W back references are supposed to expand to the last match, but what #W if there never was a match as in this case? --1¦-1¦a\(b\)*c\1¦acb¦ -1¦11¦\(a\(b\(c\(d\(e\(f\(g\)h\(i\(j\)\)\)\)\)\)\)\)\9¦abcdefghijjk¦ +-1¦-1¦a\(b\)*c\1¦acb¦ +1¦11¦\(a\(b\(c\(d\(e\(f\(g\)h\(i\(j\)\)\)\)\)\)\)\)\9¦abcdefghijjk¦ # GA136 #W These two tests have the same problem as the test in GA135. No match #W of a subexpression, why should the back reference be usable? #W 1 2 a\(b\)*c\1 acb -#W 4 7 a\(b\(c\(d\(f\)*\)\)\)\4¦xYzabcdePQRST --1¦-1¦a\(b\)*c\1¦acb¦ --1¦-1¦a\(b\(c\(d\(f\)*\)\)\)\4¦xYzabcdePQRST¦ +#W 4 7 a\(b\(c\(d\(f\)*\)\)\)\4¦xYzabcdePQRST +-1¦-1¦a\(b\)*c\1¦acb¦ +-1¦-1¦a\(b\(c\(d\(f\)*\)\)\)\4¦xYzabcdePQRST¦ # GA137 --2¦-2¦\(a\(b\)\)\3¦foo¦ --2¦-2¦\(a\(b\)\)\(a\(b\)\)\5¦foo¦ +-2¦-2¦\(a\(b\)\)\3¦foo¦ +-2¦-2¦\(a\(b\)\)\(a\(b\)\)\5¦foo¦ # GA138 -1¦2¦ag*b¦abcde¦ -1¦10¦a.*b¦abababvbabc¦ -2¦5¦b*c¦abbbcdeabbbbbbcde¦ -2¦5¦bbb*c¦abbbcdeabbbbbbcde¦ -1¦5¦a\(b\)*c\1¦abbcbbb¦ --1¦-1¦a\(b\)*c\1¦abbdbd¦ -0¦0¦\([a-c]*\)\1¦abcacdef¦ -1¦6¦\([a-c]*\)\1¦abcabcabcd¦ -1¦2¦a^*b¦ab¦ -1¦5¦a^*b¦a^^^b¦ +1¦2¦ag*b¦abcde¦ +1¦10¦a.*b¦abababvbabc¦ +2¦5¦b*c¦abbbcdeabbbbbbcde¦ +2¦5¦bbb*c¦abbbcdeabbbbbbcde¦ +1¦5¦a\(b\)*c\1¦abbcbbb¦ +-1¦-1¦a\(b\)*c\1¦abbdbd¦ +0¦0¦\([a-c]*\)\1¦abcacdef¦ +1¦6¦\([a-c]*\)\1¦abcabcabcd¦ +1¦2¦a^*b¦ab¦ +1¦5¦a^*b¦a^^^b¦ # GA139 -1¦2¦a\{2\}¦aaaa¦ -1¦7¦\([a-c]*\)\{0,\}¦aabcaab¦ -1¦2¦\(a\)\1\{1,2\}¦aabc¦ -1¦3¦\(a\)\1\{1,2\}¦aaaabc¦ +1¦2¦a\{2\}¦aaaa¦ +1¦7¦\([a-c]*\)\{0,\}¦aabcaab¦ +1¦2¦\(a\)\1\{1,2\}¦aabc¦ +1¦3¦\(a\)\1\{1,2\}¦aaaabc¦ #W the expression \(\(a\)\1\)\{1,2\} is ill-formed, using \2 -1¦4¦\(\(a\)\2\)\{1,2\}¦aaaabc¦ +1¦4¦\(\(a\)\2\)\{1,2\}¦aaaabc¦ # GA140 -1¦2¦a\{2\}¦aaaa¦ --1¦-1¦a\{2\}¦abcd¦ -0¦0¦a\{0\}¦aaaa¦ -1¦64¦a\{64\}¦aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa¦ +1¦2¦a\{2\}¦aaaa¦ +-1¦-1¦a\{2\}¦abcd¦ +0¦0¦a\{0\}¦aaaa¦ +1¦64¦a\{64\}¦aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa¦ # GA141 -1¦7¦\([a-c]*\)\{0,\}¦aabcaab¦ +1¦7¦\([a-c]*\)\{0,\}¦aabcaab¦ #W the expected result for \([a-c]*\)\{2,\} is failure which isn't correct -1¦3¦\([a-c]*\)\{2,\}¦abcdefg¦ -1¦3¦\([a-c]*\)\{1,\}¦abcdefg¦ --1¦-1¦a\{64,\}¦aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa¦ +1¦3¦\([a-c]*\)\{2,\}¦abcdefg¦ +1¦3¦\([a-c]*\)\{1,\}¦abcdefg¦ +-1¦-1¦a\{64,\}¦aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa¦ # GA142 -1¦3¦a\{2,3\}¦aaaa¦ --1¦-1¦a\{2,3\}¦abcd¦ -0¦0¦\([a-c]*\)\{0,0\}¦foo¦ -1¦63¦a\{1,63\}¦aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa¦ +1¦3¦a\{2,3\}¦aaaa¦ +-1¦-1¦a\{2,3\}¦abcd¦ +0¦0¦\([a-c]*\)\{0,0\}¦foo¦ +1¦63¦a\{1,63\}¦aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa¦ # 2.8.3.4 BRE Precedence # GA143 #W There are numerous bugs in the original version. -2¦19¦\^\[[[.].]]\\(\\1\\)\*\\{1,2\\}\$¦a^[]\(\1\)*\{1,2\}$b¦ -1¦6¦[[=*=]][[=\=]][[=]=]][[===]][[...]][[:punct:]]¦*\]=.;¦ -1¦6¦[$\(*\)^]*¦$\()*^¦ -1¦1¦[\1]¦1¦ -1¦1¦[\{1,2\}]¦{¦ +2¦19¦\^\[[[.].]]\\(\\1\\)\*\\{1,2\\}\$¦a^[]\(\1\)*\{1,2\}$b¦ +1¦6¦[[=*=]][[=\=]][[=]=]][[===]][[...]][[:punct:]]¦*\]=.;¦ +1¦6¦[$\(*\)^]*¦$\()*^¦ +1¦1¦[\1]¦1¦ +1¦1¦[\{1,2\}]¦{¦ #W the expected result for \(*\)*\1* is 2-2 which isn't correct -0¦0¦\(*\)*\1*¦a*b*11¦ -2¦3¦\(*\)*\1*b¦a*b*11¦ +0¦0¦\(*\)*\1*¦a*b*11¦ +2¦3¦\(*\)*\1*b¦a*b*11¦ #W the expected result for \(a\(b\{1,2\}\)\{1,2\}\) is 1-5 which isn't correct -1¦3¦\(a\(b\{1,2\}\)\{1,2\}\)¦abbab¦ -1¦5¦\(a\(b\{1,2\}\)\)\{1,2\}¦abbab¦ -1¦1¦^\(^\(^a$\)$\)$¦a¦ -1¦2¦\(a\)\1$¦aa¦ -1¦3¦ab*¦abb¦ -1¦4¦ab\{2,4\}¦abbbc¦ +1¦3¦\(a\(b\{1,2\}\)\{1,2\}\)¦abbab¦ +1¦5¦\(a\(b\{1,2\}\)\)\{1,2\}¦abbab¦ +1¦1¦^\(^\(^a$\)$\)$¦a¦ +1¦2¦\(a\)\1$¦aa¦ +1¦3¦ab*¦abb¦ +1¦4¦ab\{2,4\}¦abbbc¦ # 2.8.3.5 BRE Expression Anchoring # GA144 -1¦1¦^a¦abc¦ --1¦-1¦^b¦abc¦ --1¦-1¦^[a-zA-Z]¦99Nine¦ -1¦4¦^[a-zA-Z]*¦Nine99¦ +1¦1¦^a¦abc¦ +-1¦-1¦^b¦abc¦ +-1¦-1¦^[a-zA-Z]¦99Nine¦ +1¦4¦^[a-zA-Z]*¦Nine99¦ # GA145(1) -1¦2¦\(^a\)\1¦aabc¦ --1¦-1¦\(^a\)\1¦^a^abc¦ -1¦2¦\(^^a\)¦^a¦ -1¦1¦\(^^\)¦^^¦ -1¦3¦\(^abc\)¦abcdef¦ --1¦-1¦\(^def\)¦abcdef¦ +1¦2¦\(^a\)\1¦aabc¦ +-1¦-1¦\(^a\)\1¦^a^abc¦ +1¦2¦\(^^a\)¦^a¦ +1¦1¦\(^^\)¦^^¦ +1¦3¦\(^abc\)¦abcdef¦ +-1¦-1¦\(^def\)¦abcdef¦ ### GA145(2) GNU regex implements GA145(1) -##-1¦-1¦\(^a\)\1¦aabc¦ -##1¦4¦\(^a\)\1¦^a^abc¦ -##-1¦-1¦\(^^a\)¦^a¦ -##1¦2¦\(^^\)¦^^¦ +##-1¦-1¦\(^a\)\1¦aabc¦ +##1¦4¦\(^a\)\1¦^a^abc¦ +##-1¦-1¦\(^^a\)¦^a¦ +##1¦2¦\(^^\)¦^^¦ # GA146 -3¦3¦a$¦cba¦ --1¦-1¦a$¦abc¦ -5¦7¦[a-z]*$¦99ZZxyz¦ +3¦3¦a$¦cba¦ +-1¦-1¦a$¦abc¦ +5¦7¦[a-z]*$¦99ZZxyz¦ #W the expected result for [a-z]*$ is failure which isn't correct -10¦9¦[a-z]*$¦99ZZxyz99¦ -3¦3¦$$¦ab$¦ --1¦-1¦$$¦$ab¦ -3¦3¦\$$¦ab$¦ +10¦9¦[a-z]*$¦99ZZxyz99¦ +3¦3¦$$¦ab$¦ +-1¦-1¦$$¦$ab¦ +3¦3¦\$$¦ab$¦ # GA147(1) --1¦-1¦\(a$\)\1¦bcaa¦ --1¦-1¦\(a$\)\1¦ba$¦ --1¦-1¦\(ab$\)¦ab$¦ -1¦2¦\(ab$\)¦ab¦ -4¦6¦\(def$\)¦abcdef¦ --1¦-1¦\(abc$\)¦abcdef¦ +-1¦-1¦\(a$\)\1¦bcaa¦ +-1¦-1¦\(a$\)\1¦ba$¦ +-1¦-1¦\(ab$\)¦ab$¦ +1¦2¦\(ab$\)¦ab¦ +4¦6¦\(def$\)¦abcdef¦ +-1¦-1¦\(abc$\)¦abcdef¦ ### GA147(2) GNU regex implements GA147(1) -##-1¦-1¦\(a$\)\1¦bcaa¦ -##2¦5¦\(a$\)\1¦ba$a$¦ -##-1¦-1¦\(ab$\)¦ab¦ -##1¦3¦\(ab$\)¦ab$¦ +##-1¦-1¦\(a$\)\1¦bcaa¦ +##2¦5¦\(a$\)\1¦ba$a$¦ +##-1¦-1¦\(ab$\)¦ab¦ +##1¦3¦\(ab$\)¦ab$¦ # GA148 -0¦0¦^$¦¦ -1¦3¦^abc$¦abc¦ --1¦-1¦^xyz$¦^xyz^¦ --1¦-1¦^234$¦^234$¦ -1¦9¦^[a-zA-Z0-9]*$¦2aA3bB9zZ¦ --1¦-1¦^[a-z0-9]*$¦2aA3b#B9zZ¦ +0¦0¦^$¦¦ +1¦3¦^abc$¦abc¦ +-1¦-1¦^xyz$¦^xyz^¦ +-1¦-1¦^234$¦^234$¦ +1¦9¦^[a-zA-Z0-9]*$¦2aA3bB9zZ¦ +-1¦-1¦^[a-z0-9]*$¦2aA3b#B9zZ¦ commit c78f872a5667abacb3531edd9aad969af31a3e1f Author: Noam Postavsky Date: Mon Dec 12 21:21:14 2016 -0500 Clarify thread-signal semantics * doc/lispref/threads.texi (Basic Thread Functions): Explain that the thread will be signaled as soon as possible. diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi index 7ecfb19..de1c27b 100644 --- a/doc/lispref/threads.texi +++ b/doc/lispref/threads.texi @@ -82,9 +82,11 @@ immediately. @defun thread-signal thread error-symbol data Like @code{signal} (@pxref{Signaling Errors}), but the signal is delivered in the thread @var{thread}. If @var{thread} is the current -thread, then this just calls @code{signal} immediately. -@code{thread-signal} will cause a thread to exit a call to -@code{mutex-lock}, @code{condition-wait}, or @code{thread-join}. +thread, then this just calls @code{signal} immediately. Otherwise, +@var{thread} will receive the signal as soon as it becomes current. +If @var{thread} was blocked by a call to @code{mutex-lock}, +@code{condition-wait}, or @code{thread-join}; @code{thread-signal} +will unblock it. @end defun @defun thread-yield commit f66174a1b7f8e87e699ecf629563244782291148 Author: Noam Postavsky Date: Sun Dec 11 13:08:15 2016 -0500 Clean up var watcher disabling on thread switching * src/data.c (Fset_default): Move code into new C level function, `set_default_internal'. (set_default_internal): New function, like `Fset_default' but also takes additional bindflag parameter. (set_internal): Only call `notify_variable_watchers' if bindflag is not SET_INTERNAL_THREAD_SWITCH. * src/eval.c (do_specbind, do_one_unbind): Add bindflag parameter, passed on to set_internal and set_default_internal. Adjust callers. (rebind_for_thread_switch, unbind_for_thread_switch): Pass SET_INTERNAL_THREAD_SWITCH to do_specbind, do_one_unbind instead of temporarily adjusting symbol's trapped_write field. diff --git a/src/data.c b/src/data.c index 52cfe4a..6dd346b 100644 --- a/src/data.c +++ b/src/data.c @@ -1299,11 +1299,13 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, return; case SYMBOL_TRAPPED_WRITE: - notify_variable_watchers (symbol, voide? Qnil : newval, - (bindflag == SET_INTERNAL_BIND? Qlet : - bindflag == SET_INTERNAL_UNBIND? Qunlet : - voide? Qmakunbound : Qset), - where); + /* Setting due to thread-switching doesn't count. */ + if (bindflag != SET_INTERNAL_THREAD_SWITCH) + notify_variable_watchers (symbol, voide? Qnil : newval, + (bindflag == SET_INTERNAL_BIND? Qlet : + bindflag == SET_INTERNAL_UNBIND? Qunlet : + voide? Qmakunbound : Qset), + where); /* FALLTHROUGH! */ case SYMBOL_UNTRAPPED_WRITE: break; @@ -1414,7 +1416,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, int offset = XBUFFER_OBJFWD (innercontents)->offset; int idx = PER_BUFFER_IDX (offset); if (idx > 0 - && !bindflag + && bindflag == SET_INTERNAL_SET && !let_shadows_buffer_binding_p (sym)) SET_PER_BUFFER_VALUE_P (buf, idx, 1); } @@ -1634,11 +1636,9 @@ local bindings in certain buffers. */) xsignal1 (Qvoid_variable, symbol); } -DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0, - doc: /* Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated. -The default value is seen in buffers that do not have their own values -for this variable. */) - (Lisp_Object symbol, Lisp_Object value) +void +set_default_internal (Lisp_Object symbol, Lisp_Object value, + enum Set_Internal_Bind bindflag) { struct Lisp_Symbol *sym; @@ -1652,11 +1652,13 @@ for this variable. */) xsignal1 (Qsetting_constant, symbol); else /* Allow setting keywords to their own value. */ - return value; + return; case SYMBOL_TRAPPED_WRITE: /* Don't notify here if we're going to call Fset anyway. */ - if (sym->redirect != SYMBOL_PLAINVAL) + if (sym->redirect != SYMBOL_PLAINVAL + /* Setting due to thread switching doesn't count. */ + && bindflag != SET_INTERNAL_THREAD_SWITCH) notify_variable_watchers (symbol, value, Qset_default, Qnil); /* FALLTHROUGH! */ case SYMBOL_UNTRAPPED_WRITE: @@ -1669,7 +1671,7 @@ for this variable. */) switch (sym->redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; - case SYMBOL_PLAINVAL: return Fset (symbol, value); + case SYMBOL_PLAINVAL: set_internal (symbol, value, Qnil, bindflag); return; case SYMBOL_LOCALIZED: { struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); @@ -1680,7 +1682,7 @@ for this variable. */) /* If the default binding is now loaded, set the REALVALUE slot too. */ if (blv->fwd && EQ (blv->defcell, blv->valcell)) store_symval_forwarding (blv->fwd, value, NULL); - return value; + return; } case SYMBOL_FORWARDED: { @@ -1706,15 +1708,25 @@ for this variable. */) if (!PER_BUFFER_VALUE_P (b, idx)) set_per_buffer_value (b, offset, value); } - return value; } else - return Fset (symbol, value); + set_internal (symbol, value, Qnil, bindflag); + return; } default: emacs_abort (); } } +DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0, + doc: /* Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated. +The default value is seen in buffers that do not have their own values +for this variable. */) + (Lisp_Object symbol, Lisp_Object value) +{ + set_default_internal (symbol, value, SET_INTERNAL_SET); + return value; +} + DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0, doc: /* Set the default value of variable VAR to VALUE. VAR, the variable name, is literal (not evaluated); diff --git a/src/eval.c b/src/eval.c index 7852ef7..0b257e2 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3197,7 +3197,7 @@ let_shadows_global_binding_p (Lisp_Object symbol) static void do_specbind (struct Lisp_Symbol *sym, union specbinding *bind, - Lisp_Object value) + Lisp_Object value, enum Set_Internal_Bind bindflag) { switch (sym->redirect) { @@ -3205,19 +3205,19 @@ do_specbind (struct Lisp_Symbol *sym, union specbinding *bind, if (!sym->trapped_write) SET_SYMBOL_VAL (sym, value); else - set_internal (specpdl_symbol (bind), value, Qnil, SET_INTERNAL_BIND); + set_internal (specpdl_symbol (bind), value, Qnil, bindflag); break; case SYMBOL_FORWARDED: if (BUFFER_OBJFWDP (SYMBOL_FWD (sym)) && specpdl_kind (bind) == SPECPDL_LET_DEFAULT) { - Fset_default (specpdl_symbol (bind), value); + set_default_internal (specpdl_symbol (bind), value, bindflag); return; } /* FALLTHROUGH */ case SYMBOL_LOCALIZED: - set_internal (specpdl_symbol (bind), value, Qnil, SET_INTERNAL_BIND); + set_internal (specpdl_symbol (bind), value, Qnil, bindflag); break; default: @@ -3258,7 +3258,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.old_value = SYMBOL_VAL (sym); specpdl_ptr->let.saved_value = Qnil; grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value); + do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); break; case SYMBOL_LOCALIZED: if (SYMBOL_BLV (sym)->frame_local) @@ -3291,7 +3291,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) { specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value); + do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); return; } } @@ -3299,7 +3299,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.kind = SPECPDL_LET; grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value); + do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); break; } default: emacs_abort (); @@ -3354,23 +3354,16 @@ rebind_for_thread_switch (void) { Lisp_Object value = specpdl_saved_value (bind); Lisp_Object sym = specpdl_symbol (bind); - bool was_trapped = - SYMBOLP (sym) - && XSYMBOL (sym)->trapped_write == SYMBOL_TRAPPED_WRITE; - /* FIXME: This is not clean, and if do_specbind signals an - error, the symbol will be left untrapped. */ - if (was_trapped) - XSYMBOL (sym)->trapped_write = SYMBOL_UNTRAPPED_WRITE; bind->let.saved_value = Qnil; - do_specbind (XSYMBOL (sym), bind, value); - if (was_trapped) - XSYMBOL (sym)->trapped_write = SYMBOL_TRAPPED_WRITE; + do_specbind (XSYMBOL (sym), bind, value, + SET_INTERNAL_THREAD_SWITCH); } } } static void -do_one_unbind (union specbinding *this_binding, bool unwinding) +do_one_unbind (union specbinding *this_binding, bool unwinding, + enum Set_Internal_Bind bindflag) { eassert (unwinding || this_binding->kind >= SPECPDL_LET); switch (this_binding->kind) @@ -3399,7 +3392,7 @@ do_one_unbind (union specbinding *this_binding, bool unwinding) SET_SYMBOL_VAL (XSYMBOL (sym), specpdl_old_value (this_binding)); else set_internal (sym, specpdl_old_value (this_binding), - Qnil, SET_INTERNAL_UNBIND); + Qnil, bindflag); break; } else @@ -3409,8 +3402,9 @@ do_one_unbind (union specbinding *this_binding, bool unwinding) } } case SPECPDL_LET_DEFAULT: - Fset_default (specpdl_symbol (this_binding), - specpdl_old_value (this_binding)); + set_default_internal (specpdl_symbol (this_binding), + specpdl_old_value (this_binding), + bindflag); break; case SPECPDL_LET_LOCAL: { @@ -3422,7 +3416,7 @@ do_one_unbind (union specbinding *this_binding, bool unwinding) /* If this was a local binding, reset the value in the appropriate buffer, but only if that buffer's binding still exists. */ if (!NILP (Flocal_variable_p (symbol, where))) - set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND); + set_internal (symbol, old_value, where, bindflag); } break; } @@ -3496,7 +3490,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value) union specbinding this_binding; this_binding = *--specpdl_ptr; - do_one_unbind (&this_binding, true); + do_one_unbind (&this_binding, true, SET_INTERNAL_UNBIND); } if (NILP (Vquit_flag) && !NILP (quitf)) @@ -3515,17 +3509,8 @@ unbind_for_thread_switch (struct thread_state *thr) if ((--bind)->kind >= SPECPDL_LET) { Lisp_Object sym = specpdl_symbol (bind); - bool was_trapped = - SYMBOLP (sym) - && XSYMBOL (sym)->trapped_write == SYMBOL_TRAPPED_WRITE; bind->let.saved_value = find_symbol_value (sym); - /* FIXME: This is not clean, and if do_one_unbind signals an - error, the symbol will be left untrapped. */ - if (was_trapped) - XSYMBOL (sym)->trapped_write = SYMBOL_UNTRAPPED_WRITE; - do_one_unbind (bind, false); - if (was_trapped) - XSYMBOL (sym)->trapped_write = SYMBOL_TRAPPED_WRITE; + do_one_unbind (bind, false, SET_INTERNAL_THREAD_SWITCH); } } } diff --git a/src/lisp.h b/src/lisp.h index 252707c..5b77dc8 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3493,10 +3493,14 @@ extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); enum Set_Internal_Bind { SET_INTERNAL_SET, SET_INTERNAL_BIND, - SET_INTERNAL_UNBIND + SET_INTERNAL_UNBIND, + SET_INTERNAL_THREAD_SWITCH }; extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, enum Set_Internal_Bind); +extern void set_default_internal (Lisp_Object, Lisp_Object, + enum Set_Internal_Bind bindflag); + extern void syms_of_data (void); extern void swap_in_global_binding (struct Lisp_Symbol *); commit 8db7b65d66f01e90a05cc9f11c67667233d84ca0 Author: Glenn Morris Date: Mon Dec 12 20:03:20 2016 -0500 Minor fix for define-derived-mode * lisp/emacs-lisp/derived.el (define-derived-mode): Do not let eg eval-defun reset the values of syntax or abbrev tables, since they might have been defined externally. (Bug#16160) diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 0f7691a..3117027 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -217,16 +217,17 @@ No problems result if this variable is not bound. ,(if declare-syntax `(progn (unless (boundp ',syntax) - (put ',syntax 'definition-name ',child)) - (defvar ,syntax (make-syntax-table)) + (put ',syntax 'definition-name ',child) + (defvar ,syntax (make-syntax-table))) (unless (get ',syntax 'variable-documentation) (put ',syntax 'variable-documentation (purecopy ,(format "Syntax table for `%s'." child)))))) ,(if declare-abbrev `(progn - (put ',abbrev 'definition-name ',child) - (defvar ,abbrev - (progn (define-abbrev-table ',abbrev nil) ,abbrev)) + (unless (boundp ',abbrev) + (put ',abbrev 'definition-name ',child) + (defvar ,abbrev + (progn (define-abbrev-table ',abbrev nil) ,abbrev))) (unless (get ',abbrev 'variable-documentation) (put ',abbrev 'variable-documentation (purecopy ,(format "Abbrev table for `%s'." child)))))) commit 3e651e3c6b241eaeab70e63c267366e9678b6b52 Author: Paul Eggert Date: Mon Dec 12 14:54:30 2016 -0800 * build-aux/git-hooks/pre-commit: Add whitespace comment. diff --git a/build-aux/git-hooks/pre-commit b/build-aux/git-hooks/pre-commit index 5a51244..3709784 100755 --- a/build-aux/git-hooks/pre-commit +++ b/build-aux/git-hooks/pre-commit @@ -45,4 +45,12 @@ for new_name in `$git_diff HEAD`; do esac done +# The '--check' option of git diff-index makes Git complain if changes +# introduce whitespace errors. This can be a pain when editing test +# files that deliberately contain lines with trailing whitespace. +# To work around the problem you can run a command like 'git config +# core.whitespace -trailing-space'. It may be better to revamp the +# tests so that trailing spaces are generated on the fly rather than +# being committed as source. + exec git diff-index --check --cached HEAD -- commit 27cada035a79b633e856a437dd0e037acc1d61c6 Author: Clément Pit--Claudel Date: Mon Dec 5 00:52:14 2016 -0500 Move backtrace to ELisp using a new mapbacktrace primitive * src/eval.c (get_backtrace_starting_at, backtrace_frame_apply) (Fmapbacktrace, Fbacktrace_frame_internal): New functions. (get_backtrace_frame, Fbacktrace_debug): Use `get_backtrace_starting_at'. * lisp/subr.el (backtrace--print-frame): New function. (backtrace): Reimplement using `backtrace--print-frame' and `mapbacktrace'. (backtrace-frame): Reimplement using `backtrace-frame--internal'. * lisp/emacs-lisp/debug.el (debugger-setup-buffer): Pass a base to `mapbacktrace' instead of searching for "(debug" in the output of `backtrace'. * test/lisp/subr-tests.el (subr-test-backtrace-simple-tests) (subr-test-backtrace-integration-test): New tests. * doc/lispref/debugging.texi (Internals of Debugger): Document `mapbacktrace' and missing argument BASE of `backtrace-frame'. diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index c80b0f9..8fb663d 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -727,7 +727,7 @@ invocation. This variable is obsolete and will be removed in future versions. @end defvar -@defun backtrace-frame frame-number +@defun backtrace-frame frame-number &optional base The function @code{backtrace-frame} is intended for use in Lisp debuggers. It returns information about what computation is happening in the stack frame @var{frame-number} levels down. @@ -744,10 +744,31 @@ In the return value, @var{function} is whatever was supplied as the case of a macro call. If the function has a @code{&rest} argument, that is represented as the tail of the list @var{arg-values}. +If @var{base} is specified, @var{frame-number} counts relative to +the topmost frame whose @var{function} is @var{base}. + If @var{frame-number} is out of range, @code{backtrace-frame} returns @code{nil}. @end defun +@defun mapbacktrace function &optional base +The function @code{mapbacktrace} calls @var{function} once for each +frame in the backtrace, starting at the first frame whose function is +@var{base} (or from the top if @var{base} is omitted or @code{nil}). + +@var{function} is called with four arguments: @var{evald}, @var{func}, +@var{args}, and @var{flags}. + +If a frame has not evaluated its arguments yet or is a special form, +@var{evald} is @code{nil} and @var{args} is a list of forms. + +If a frame has evaluated its arguments and called its function +already, @var{evald} is @code{t} and @var{args} is a list of values. +@var{flags} is a plist of properties of the current frame: currently, +the only supported property is @code{:debug-on-exit}, which is +@code{t} if the stack frame's @code{debug-on-exit} flag is set. +@end defun + @include edebug.texi @node Syntax Errors diff --git a/etc/NEWS b/etc/NEWS index 44de338..fdd901f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -74,6 +74,10 @@ for '--daemon'. * Changes in Emacs 26.1 +++ +** The new function 'mapbacktrace' applies a function to all frames of +the current stack trace. + ++++ ** Emacs now provides a limited form of concurrency with Lisp threads. Concurrency in Emacs Lisp is "mostly cooperative", meaning that Emacs will only switch execution between threads at well-defined diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 5430b72..5a4b097 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -274,15 +274,14 @@ That buffer should be current already." (let ((standard-output (current-buffer)) (print-escape-newlines t) (print-level 8) - (print-length 50)) - (backtrace)) + (print-length 50)) + ;; FIXME the debugger could pass a custom callback to mapbacktrace + ;; instead of manipulating printed results. + (mapbacktrace #'backtrace--print-frame 'debug)) (goto-char (point-min)) (delete-region (point) (progn - (search-forward (if debugger-stack-frame-as-list - "\n (debug " - "\n debug(")) - (forward-line (if (eq (car args) 'debug) + (forward-line (if (eq (car args) 'debug) ;; Remove debug--implement-debug-on-entry ;; and the advice's `apply' frame. 3 diff --git a/lisp/subr.el b/lisp/subr.el index 952453a..99b1429 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4334,6 +4334,51 @@ The properties used on SYMBOL are `composefunc', `sendfunc', (put symbol 'sendfunc sendfunc) (put symbol 'abortfunc (or abortfunc 'kill-buffer)) (put symbol 'hookvar (or hookvar 'mail-send-hook))) + + +(defun backtrace--print-frame (evald func args flags) + "Print a trace of a single stack frame to `standard-output'. +EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'." + (princ (if (plist-get flags :debug-on-exit) "* " " ")) + (cond + ((and evald (not debugger-stack-frame-as-list)) + (prin1 func) + (if args (prin1 args) (princ "()"))) + (t + (prin1 (cons func args)))) + (princ "\n")) + +(defun backtrace () + "Print a trace of Lisp function calls currently active. +Output stream used is value of `standard-output'." + (let ((print-level (or print-level 8))) + (mapbacktrace #'backtrace--print-frame 'backtrace))) + +(defun backtrace-frames (&optional base) + "Collect all frames of current backtrace into a list. +If non-nil, BASE should be a function, and frames before its +nearest activation frames are discarded." + (let ((frames nil)) + (mapbacktrace (lambda (&rest frame) (push frame frames)) + (or base 'backtrace-frames)) + (nreverse frames))) + +(defun backtrace-frame (nframes &optional base) + "Return the function and arguments NFRAMES up from current execution point. +If non-nil, BASE should be a function, and NFRAMES counts from its +nearest activation frame. +If the frame has not evaluated the arguments yet (or is a special form), +the value is (nil FUNCTION ARG-FORMS...). +If the frame has evaluated its arguments and called its function already, +the value is (t FUNCTION ARG-VALUES...). +A &rest arg is represented as the tail of the list ARG-VALUES. +FUNCTION is whatever was supplied as car of evaluated list, +or a lambda expression for macro calls. +If NFRAMES is more than the number of frames, the value is nil." + (backtrace-frame--internal + (lambda (evald func args _) `(,evald ,func ,@args)) + nframes (or base 'backtrace-frame))) + (defvar called-interactively-p-functions nil "Special hook called to skip special frames in `called-interactively-p'. diff --git a/src/eval.c b/src/eval.c index f1e0ae7..7852ef7 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3541,87 +3541,29 @@ context where binding is lexical by default. */) } -DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, - doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG. -The debugger is entered when that frame exits, if the flag is non-nil. */) - (Lisp_Object level, Lisp_Object flag) -{ - union specbinding *pdl = backtrace_top (); - register EMACS_INT i; - - CHECK_NUMBER (level); - - for (i = 0; backtrace_p (pdl) && i < XINT (level); i++) - pdl = backtrace_next (pdl); - - if (backtrace_p (pdl)) - set_backtrace_debug_on_exit (pdl, !NILP (flag)); - - return flag; -} - -DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "", - doc: /* Print a trace of Lisp function calls currently active. -Output stream used is value of `standard-output'. */) - (void) +static union specbinding * +get_backtrace_starting_at (Lisp_Object base) { union specbinding *pdl = backtrace_top (); - Lisp_Object tem; - Lisp_Object old_print_level = Vprint_level; - if (NILP (Vprint_level)) - XSETFASTINT (Vprint_level, 8); - - while (backtrace_p (pdl)) - { - write_string (backtrace_debug_on_exit (pdl) ? "* " : " "); - if (backtrace_nargs (pdl) == UNEVALLED) - { - Fprin1 (Fcons (backtrace_function (pdl), *backtrace_args (pdl)), - Qnil); - write_string ("\n"); - } - else - { - tem = backtrace_function (pdl); - if (debugger_stack_frame_as_list) - write_string ("("); - Fprin1 (tem, Qnil); /* This can QUIT. */ - if (!debugger_stack_frame_as_list) - write_string ("("); - { - ptrdiff_t i; - for (i = 0; i < backtrace_nargs (pdl); i++) - { - if (i || debugger_stack_frame_as_list) - write_string(" "); - Fprin1 (backtrace_args (pdl)[i], Qnil); - } - } - write_string (")\n"); - } - pdl = backtrace_next (pdl); + if (!NILP (base)) + { /* Skip up to `base'. */ + base = Findirect_function (base, Qt); + while (backtrace_p (pdl) + && !EQ (base, Findirect_function (backtrace_function (pdl), Qt))) + pdl = backtrace_next (pdl); } - Vprint_level = old_print_level; - return Qnil; + return pdl; } static union specbinding * get_backtrace_frame (Lisp_Object nframes, Lisp_Object base) { - union specbinding *pdl = backtrace_top (); register EMACS_INT i; CHECK_NATNUM (nframes); - - if (!NILP (base)) - { /* Skip up to `base'. */ - base = Findirect_function (base, Qt); - while (backtrace_p (pdl) - && !EQ (base, Findirect_function (backtrace_function (pdl), Qt))) - pdl = backtrace_next (pdl); - } + union specbinding *pdl = get_backtrace_starting_at (base); /* Find the frame requested. */ for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--) @@ -3630,33 +3572,71 @@ get_backtrace_frame (Lisp_Object nframes, Lisp_Object base) return pdl; } -DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 2, NULL, - doc: /* Return the function and arguments NFRAMES up from current execution point. -If that frame has not evaluated the arguments yet (or is a special form), -the value is (nil FUNCTION ARG-FORMS...). -If that frame has evaluated its arguments and called its function already, -the value is (t FUNCTION ARG-VALUES...). -A &rest arg is represented as the tail of the list ARG-VALUES. -FUNCTION is whatever was supplied as car of evaluated list, -or a lambda expression for macro calls. -If NFRAMES is more than the number of frames, the value is nil. -If BASE is non-nil, it should be a function and NFRAMES counts from its -nearest activation frame. */) - (Lisp_Object nframes, Lisp_Object base) +static Lisp_Object +backtrace_frame_apply (Lisp_Object function, union specbinding *pdl) { - union specbinding *pdl = get_backtrace_frame (nframes, base); - if (!backtrace_p (pdl)) return Qnil; + + Lisp_Object flags = Qnil; + if (backtrace_debug_on_exit (pdl)) + flags = Fcons (QCdebug_on_exit, Fcons (Qt, Qnil)); + if (backtrace_nargs (pdl) == UNEVALLED) - return Fcons (Qnil, - Fcons (backtrace_function (pdl), *backtrace_args (pdl))); + return call4 (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags); else { Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl)); + return call4 (function, Qt, backtrace_function (pdl), tem, flags); + } +} - return Fcons (Qt, Fcons (backtrace_function (pdl), tem)); +DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, + doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG. +The debugger is entered when that frame exits, if the flag is non-nil. */) + (Lisp_Object level, Lisp_Object flag) +{ + CHECK_NUMBER (level); + union specbinding *pdl = get_backtrace_frame(level, Qnil); + + if (backtrace_p (pdl)) + set_backtrace_debug_on_exit (pdl, !NILP (flag)); + + return flag; +} + +DEFUN ("mapbacktrace", Fmapbacktrace, Smapbacktrace, 1, 2, 0, + doc: /* Call FUNCTION for each frame in backtrace. +If BASE is non-nil, it should be a function and iteration will start +from its nearest activation frame. +FUNCTION is called with 4 arguments: EVALD, FUNC, ARGS, and FLAGS. If +a frame has not evaluated its arguments yet or is a special form, +EVALD is nil and ARGS is a list of forms. If a frame has evaluated +its arguments and called its function already, EVALD is t and ARGS is +a list of values. +FLAGS is a plist of properties of the current frame: currently, the +only supported property is :debug-on-exit. `mapbacktrace' always +returns nil. */) + (Lisp_Object function, Lisp_Object base) +{ + union specbinding *pdl = get_backtrace_starting_at (base); + + while (backtrace_p (pdl)) + { + backtrace_frame_apply (function, pdl); + pdl = backtrace_next (pdl); } + + return Qnil; +} + +DEFUN ("backtrace-frame--internal", Fbacktrace_frame_internal, + Sbacktrace_frame_internal, 3, 3, NULL, + doc: /* Call FUNCTION on stack frame NFRAMES away from BASE. +Return the result of FUNCTION, or nil if no matching frame could be found. */) + (Lisp_Object function, Lisp_Object nframes, Lisp_Object base) +{ + return backtrace_frame_apply (function, get_backtrace_frame (nframes, base)); } /* For backtrace-eval, we want to temporarily unwind the last few elements of @@ -4114,8 +4094,9 @@ alist of active lexical bindings. */); defsubr (&Srun_hook_wrapped); defsubr (&Sfetch_bytecode); defsubr (&Sbacktrace_debug); - defsubr (&Sbacktrace); - defsubr (&Sbacktrace_frame); + DEFSYM (QCdebug_on_exit, ":debug-on-exit"); + defsubr (&Smapbacktrace); + defsubr (&Sbacktrace_frame_internal); defsubr (&Sbacktrace_eval); defsubr (&Sbacktrace__locals); defsubr (&Sspecial_variable_p); diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index ce21290..82a70ca 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -224,5 +224,52 @@ (error-message-string (should-error (version-to-list "beta22_8alpha3"))) "Invalid version syntax: `beta22_8alpha3' (must start with a number)")))) +(defun subr-test--backtrace-frames-with-backtrace-frame (base) + "Reference implementation of `backtrace-frames'." + (let ((idx 0) + (frame nil) + (frames nil)) + (while (setq frame (backtrace-frame idx base)) + (push frame frames) + (setq idx (1+ idx))) + (nreverse frames))) + +(defun subr-test--frames-2 (base) + (let ((_dummy nil)) + (progn ;; Add a few frames to top of stack + (unwind-protect + (cons (mapcar (pcase-lambda (`(,evald ,func ,args ,_)) + `(,evald ,func ,@args)) + (backtrace-frames base)) + (subr-test--backtrace-frames-with-backtrace-frame base)))))) + +(defun subr-test--frames-1 (base) + (subr-test--frames-2 base)) + +(ert-deftest subr-test-backtrace-simple-tests () + "Test backtrace-related functions (simple tests). +This exercises `backtrace-frame', and indirectly `mapbacktrace'." + ;; `mapbacktrace' returns nil + (should (equal (mapbacktrace #'ignore) nil)) + ;; Unbound BASE is silently ignored + (let ((unbound (make-symbol "ub"))) + (should (equal (backtrace-frame 0 unbound) nil)) + (should (equal (mapbacktrace #'error unbound) nil))) + ;; First frame is backtrace-related function + (should (equal (backtrace-frame 0) '(t backtrace-frame 0))) + (should (equal (catch 'ret + (mapbacktrace (lambda (&rest args) (throw 'ret args)))) + '(t mapbacktrace ((lambda (&rest args) (throw 'ret args))) nil))) + ;; Past-end NFRAMES is silently ignored + (should (equal (backtrace-frame most-positive-fixnum) nil))) + +(ert-deftest subr-test-backtrace-integration-test () + "Test backtrace-related functions (integration test). +This exercises `backtrace-frame', `backtrace-frames', and +indirectly `mapbacktrace'." + ;; Compare two implementations of backtrace-frames + (let ((frame-lists (subr-test--frames-1 'subr-test--frames-2))) + (should (equal (car frame-lists) (cdr frame-lists))))) + (provide 'subr-tests) ;;; subr-tests.el ends here commit a41ded87b318ce3cbeb0ba3624bcb83ae3b8a437 Author: Paul Eggert Date: Mon Dec 12 14:27:35 2016 -0800 Use C99 syntax for font drivers Problem reported by Daniel Colascione in: http://lists.gnu.org/archive/html/emacs-devel/2016-12/msg00515.html * src/ftcrfont.c (ftcrfont_driver): * src/ftfont.c (ftfont_driver): * src/ftxfont.c (ftxfont_driver): * src/macfont.m (macfont_driver): * src/nsfont.m (nsfont_driver): * src/xfont.c (xfont_driver): * src/xftfont.c (xftfont_driver): Use C99 syntax, not the old GNU C syntax. diff --git a/src/ftcrfont.c b/src/ftcrfont.c index f62b40f..67b43b6 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -280,30 +280,30 @@ ftcrfont_draw (struct glyph_string *s, struct font_driver const ftcrfont_driver = { - type: LISPSYM_INITIALLY (Qftcr), - get_cache: ftfont_get_cache, - list: ftcrfont_list, - match: ftcrfont_match, - list_family: ftfont_list_family, - open: ftcrfont_open, - close: ftcrfont_close, - has_char: ftfont_has_char, - encode_char: ftfont_encode_char, - text_extents: ftcrfont_text_extents, - draw: ftcrfont_draw, - get_bitmap: ftfont_get_bitmap, - anchor_point: ftfont_anchor_point, + .type = LISPSYM_INITIALLY (Qftcr), + .get_cache = ftfont_get_cache, + .list = ftcrfont_list, + .match = ftcrfont_match, + .list_family = ftfont_list_family, + .open = ftcrfont_open, + .close = ftcrfont_close, + .has_char = ftfont_has_char, + .encode_char = ftfont_encode_char, + .text_extents = ftcrfont_text_extents, + .draw = ftcrfont_draw, + .get_bitmap = ftfont_get_bitmap, + .anchor_point = ftfont_anchor_point, #ifdef HAVE_LIBOTF - otf_capability: ftfont_otf_capability, + .otf_capability = ftfont_otf_capability, #endif #if defined HAVE_M17N_FLT && defined HAVE_LIBOTF - shape: ftfont_shape, + .shape = ftfont_shape, #endif #ifdef HAVE_OTF_GET_VARIATION_GLYPHS - get_variation_glyphs: ftfont_variation_glyphs, + .get_variation_glyphs = ftfont_variation_glyphs, #endif - filter_properties: ftfont_filter_properties, - combining_capability: ftfont_combining_capability, + .filter_properties = ftfont_filter_properties, + .combining_capability = ftfont_combining_capability, }; void diff --git a/src/ftfont.c b/src/ftfont.c index 768b524..bcc10c4 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -2697,29 +2697,29 @@ ftfont_combining_capability (struct font *font) static struct font_driver const ftfont_driver = { /* We can't draw a text without device dependent functions. */ - type: LISPSYM_INITIALLY (Qfreetype), - get_cache: ftfont_get_cache, - list: ftfont_list, - match: ftfont_match, - list_family: ftfont_list_family, - open: ftfont_open, - close: ftfont_close, - has_char: ftfont_has_char, - encode_char: ftfont_encode_char, - text_extents: ftfont_text_extents, - get_bitmap: ftfont_get_bitmap, - anchor_point: ftfont_anchor_point, + .type = LISPSYM_INITIALLY (Qfreetype), + .get_cache = ftfont_get_cache, + .list = ftfont_list, + .match = ftfont_match, + .list_family = ftfont_list_family, + .open = ftfont_open, + .close = ftfont_close, + .has_char = ftfont_has_char, + .encode_char = ftfont_encode_char, + .text_extents = ftfont_text_extents, + .get_bitmap = ftfont_get_bitmap, + .anchor_point = ftfont_anchor_point, #ifdef HAVE_LIBOTF - otf_capability: ftfont_otf_capability, + .otf_capability = ftfont_otf_capability, #endif #if defined HAVE_M17N_FLT && defined HAVE_LIBOTF - shape: ftfont_shape, + .shape = ftfont_shape, #endif #ifdef HAVE_OTF_GET_VARIATION_GLYPHS - get_variation_glyphs: ftfont_variation_glyphs, + .get_variation_glyphs = ftfont_variation_glyphs, #endif - filter_properties: ftfont_filter_properties, - combining_capability: ftfont_combining_capability, + .filter_properties = ftfont_filter_properties, + .combining_capability = ftfont_combining_capability, }; void diff --git a/src/ftxfont.c b/src/ftxfont.c index d8792ac..d1632e3 100644 --- a/src/ftxfont.c +++ b/src/ftxfont.c @@ -342,31 +342,31 @@ ftxfont_end_for_frame (struct frame *f) struct font_driver const ftxfont_driver = { /* We can't draw a text without device dependent functions. */ - type: LISPSYM_INITIALLY (Qftx), - get_cache: ftfont_get_cache, - list: ftxfont_list, - match: ftxfont_match, - list_family: ftfont_list_family, - open: ftxfont_open, - close: ftxfont_close, - has_char: ftfont_has_char, - encode_char: ftfont_encode_char, - text_extents: ftfont_text_extents, - draw: ftxfont_draw, - get_bitmap: ftfont_get_bitmap, - anchor_point: ftfont_anchor_point, + .type = LISPSYM_INITIALLY (Qftx), + .get_cache = ftfont_get_cache, + .list = ftxfont_list, + .match = ftxfont_match, + .list_family = ftfont_list_family, + .open = ftxfont_open, + .close = ftxfont_close, + .has_char = ftfont_has_char, + .encode_char = ftfont_encode_char, + .text_extents = ftfont_text_extents, + .draw = ftxfont_draw, + .get_bitmap = ftfont_get_bitmap, + .anchor_point = ftfont_anchor_point, #ifdef HAVE_LIBOTF - otf_capability: ftfont_otf_capability, + .otf_capability = ftfont_otf_capability, #endif - end_for_frame: ftxfont_end_for_frame, + .end_for_frame = ftxfont_end_for_frame, #if defined HAVE_M17N_FLT && defined HAVE_LIBOTF - shape: ftfont_shape, + .shape = ftfont_shape, #endif #ifdef HAVE_OTF_GET_VARIATION_GLYPHS - get_variation_glyphs: ftfont_variation_glyphs, + .get_variation_glyphs = ftfont_variation_glyphs, #endif - filter_properties: ftfont_filter_properties, - combining_capability: ftfont_combining_capability, + .filter_properties = ftfont_filter_properties, + .combining_capability = ftfont_combining_capability, }; void diff --git a/src/macfont.m b/src/macfont.m index b2f3dff..855b3fe 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -1663,21 +1663,21 @@ static int macfont_variation_glyphs (struct font *, int c, static struct font_driver const macfont_driver = { - type: LISPSYM_INITIALLY (Qmac_ct), - get_cache: macfont_get_cache, - list: macfont_list, - match: macfont_match, - list_family: macfont_list_family, - free_entity: macfont_free_entity, - open: macfont_open, - close: macfont_close, - has_char: macfont_has_char, - encode_char: macfont_encode_char, - text_extents: macfont_text_extents, - draw: macfont_draw, - shape: macfont_shape, - get_variation_glyphs: macfont_variation_glyphs, - filter_properties: macfont_filter_properties, + .type = LISPSYM_INITIALLY (Qmac_ct), + .get_cache = macfont_get_cache, + .list = macfont_list, + .match = macfont_match, + .list_family = macfont_list_family, + .free_entity = macfont_free_entity, + .open = macfont_open, + .close = macfont_close, + .has_char = macfont_has_char, + .encode_char = macfont_encode_char, + .text_extents = macfont_text_extents, + .draw = macfont_draw, + .shape = macfont_shape, + .get_variation_glyphs = macfont_variation_glyphs, + .filter_properties = macfont_filter_properties, }; static Lisp_Object diff --git a/src/nsfont.m b/src/nsfont.m index d14c362..757b217 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -1485,18 +1485,18 @@ - (void)setIntAttribute: (NSInteger)attributeTag value: (NSInteger)val struct font_driver const nsfont_driver = { - type: LISPSYM_INITIALLY (Qns), - case_sensitive: true, - get_cache: nsfont_get_cache, - list: nsfont_list, - match: nsfont_match, - list_family: nsfont_list_family, - open: nsfont_open, - close: nsfont_close, - has_char: nsfont_has_char, - encode_char: nsfont_encode_char, - text_extents: nsfont_text_extents, - draw: nsfont_draw, + .type = LISPSYM_INITIALLY (Qns), + .case_sensitive = true, + .get_cache = nsfont_get_cache, + .list = nsfont_list, + .match = nsfont_match, + .list_family = nsfont_list_family, + .open = nsfont_open, + .close = nsfont_close, + .has_char = nsfont_has_char, + .encode_char = nsfont_encode_char, + .text_extents = nsfont_text_extents, + .draw = nsfont_draw, }; void diff --git a/src/xfont.c b/src/xfont.c index 5999f67..09ca628 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -1079,19 +1079,19 @@ xfont_check (struct frame *f, struct font *font) struct font_driver const xfont_driver = { - type: LISPSYM_INITIALLY (Qx), - get_cache: xfont_get_cache, - list: xfont_list, - match: xfont_match, - list_family: xfont_list_family, - open: xfont_open, - close: xfont_close, - prepare_face: xfont_prepare_face, - has_char: xfont_has_char, - encode_char: xfont_encode_char, - text_extents: xfont_text_extents, - draw: xfont_draw, - check: xfont_check, + .type = LISPSYM_INITIALLY (Qx), + .get_cache = xfont_get_cache, + .list = xfont_list, + .match = xfont_match, + .list_family = xfont_list_family, + .open = xfont_open, + .close = xfont_close, + .prepare_face = xfont_prepare_face, + .has_char = xfont_has_char, + .encode_char = xfont_encode_char, + .text_extents = xfont_text_extents, + .draw = xfont_draw, + .check = xfont_check, }; void diff --git a/src/xftfont.c b/src/xftfont.c index 74f5ec6..7f0e3c6 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -752,35 +752,35 @@ xftfont_cached_font_ok (struct frame *f, Lisp_Object font_object, struct font_driver const xftfont_driver = { /* We can't draw a text without device dependent functions. */ - type: LISPSYM_INITIALLY (Qxft), - get_cache: xfont_get_cache, - list: xftfont_list, - match: xftfont_match, - list_family: ftfont_list_family, - open: xftfont_open, - close: xftfont_close, - prepare_face: xftfont_prepare_face, - done_face: xftfont_done_face, - has_char: xftfont_has_char, - encode_char: xftfont_encode_char, - text_extents: xftfont_text_extents, - draw: xftfont_draw, - get_bitmap: ftfont_get_bitmap, - anchor_point: ftfont_anchor_point, + .type = LISPSYM_INITIALLY (Qxft), + .get_cache = xfont_get_cache, + .list = xftfont_list, + .match = xftfont_match, + .list_family = ftfont_list_family, + .open = xftfont_open, + .close = xftfont_close, + .prepare_face = xftfont_prepare_face, + .done_face = xftfont_done_face, + .has_char = xftfont_has_char, + .encode_char = xftfont_encode_char, + .text_extents = xftfont_text_extents, + .draw = xftfont_draw, + .get_bitmap = ftfont_get_bitmap, + .anchor_point = ftfont_anchor_point, #ifdef HAVE_LIBOTF - otf_capability: ftfont_otf_capability, + .otf_capability = ftfont_otf_capability, #endif - end_for_frame: xftfont_end_for_frame, + .end_for_frame = xftfont_end_for_frame, #if defined HAVE_M17N_FLT && defined HAVE_LIBOTF - shape: xftfont_shape, + .shape = xftfont_shape, #endif #ifdef HAVE_OTF_GET_VARIATION_GLYPHS - get_variation_glyphs: ftfont_variation_glyphs, + .get_variation_glyphs = ftfont_variation_glyphs, #endif - filter_properties: ftfont_filter_properties, - cached_font_ok: xftfont_cached_font_ok, - combining_capability: ftfont_combining_capability, - drop_xrender_surfaces: xftfont_drop_xrender_surfaces, + .filter_properties = ftfont_filter_properties, + .cached_font_ok = xftfont_cached_font_ok, + .combining_capability = ftfont_combining_capability, + .drop_xrender_surfaces = xftfont_drop_xrender_surfaces, }; void commit 3c655230d2517d091d6af9835031cbc5d665dccb Author: Glenn Morris Date: Mon Dec 12 17:17:34 2016 -0500 Obsolete gs.el * lisp/gs.el: Move to lisp/obsolete. (Bug#1524) * doc/lispref/display.texi (Image Formats): Remove postscript. (PostScript Images): Remove section. * doc/lispref/elisp.texi: Update menu. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 851baa3..945a701 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -4779,7 +4779,6 @@ displayed (@pxref{Display Feature Testing}). * Image Descriptors:: How to specify an image for use in @code{:display}. * XBM Images:: Special features for XBM format. * XPM Images:: Special features for XPM format. -* PostScript Images:: Special features for PostScript format. * ImageMagick Images:: Special features available through ImageMagick. * SVG Images:: Creating and manipulating SVG images. * Other Image Types:: Various other formats are supported. @@ -4804,12 +4803,12 @@ to modify the set of known names for these dynamic libraries. Supported image formats (and the required support libraries) include PBM and XBM (which do not depend on support libraries and are always available), XPM (@code{libXpm}), GIF (@code{libgif} or -@code{libungif}), PostScript (@code{gs}), JPEG (@code{libjpeg}), TIFF +@code{libungif}), JPEG (@code{libjpeg}), TIFF (@code{libtiff}), PNG (@code{libpng}), and SVG (@code{librsvg}). Each of these image formats is associated with an @dfn{image type symbol}. The symbols for the above formats are, respectively, -@code{pbm}, @code{xbm}, @code{xpm}, @code{gif}, @code{postscript}, +@code{pbm}, @code{xbm}, @code{xpm}, @code{gif}, @code{jpeg}, @code{tiff}, @code{png}, and @code{svg}. Furthermore, if you build Emacs with ImageMagick @@ -5122,33 +5121,6 @@ the name of a color as it appears in the image file, and @var{color} specifies the actual color to use for displaying that name. @end table -@node PostScript Images -@subsection PostScript Images -@cindex postscript images - - To use PostScript for an image, specify image type @code{postscript}. -This works only if you have Ghostscript installed. You must always use -these three properties: - -@table @code -@item :pt-width @var{width} -The value, @var{width}, specifies the width of the image measured in -points (1/72 inch). @var{width} must be an integer. - -@item :pt-height @var{height} -The value, @var{height}, specifies the height of the image in points -(1/72 inch). @var{height} must be an integer. - -@item :bounding-box @var{box} -The value, @var{box}, must be a list or vector of four integers, which -specifying the bounding box of the PostScript image, analogous to the -@samp{BoundingBox} comment found in PostScript files. - -@example -%%BoundingBox: 22 171 567 738 -@end example -@end table - @node ImageMagick Images @subsection ImageMagick Images @cindex ImageMagick images diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 4a53a0c..494e8fc 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1472,7 +1472,6 @@ Images * Image Descriptors:: How to specify an image for use in @code{:display}. * XBM Images:: Special features for XBM format. * XPM Images:: Special features for XPM format. -* PostScript Images:: Special features for PostScript format. * ImageMagick Images:: Special features available through ImageMagick. * Other Image Types:: Various other formats are supported. * Defining Images:: Convenient ways to define an image for later use. diff --git a/lisp/gs.el b/lisp/obsolete/gs.el similarity index 97% rename from lisp/gs.el rename to lisp/obsolete/gs.el index 7ab3d8b..c4cdceb 100644 --- a/lisp/gs.el +++ b/lisp/obsolete/gs.el @@ -4,6 +4,7 @@ ;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal +;; Obsolete-since: 26.1 ;; This file is part of GNU Emacs. @@ -22,7 +23,9 @@ ;;; Commentary: -;; This code is experimental. Don't use it. +;; This code is experimental. Don't use it. Try imagemagick images instead. +;; When this file is removed from Emacs, associated code in image.c +;; can be removed too (HAVE_GHOSTSCRIPT). ;;; Code: commit ffb1302123610699424d79b96352a9ad16d2b048 Author: Glenn Morris Date: Mon Dec 12 15:21:48 2016 -0500 Un-revert recent Ffset change * src/data.c (Ffset): Reinstate the check for "nil". diff --git a/src/data.c b/src/data.c index 09d94f5..52cfe4a 100644 --- a/src/data.c +++ b/src/data.c @@ -733,6 +733,9 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, { register Lisp_Object function; CHECK_SYMBOL (symbol); + /* Perhaps not quite the right error signal, but seems good enough. */ + if (NILP (symbol)) + xsignal1 (Qsetting_constant, symbol); function = XSYMBOL (symbol)->function; commit 61f8c2386c29fe44d7ebf6fa816f140a2d918110 Author: Glenn Morris Date: Mon Dec 12 15:20:39 2016 -0500 Minor advice.el fix * lisp/emacs-lisp/advice.el (ad-preactivate-advice): Avoid setting the function definition of nil. This was happening during bootstrap of org-compat.el, apparently due to eager macro expansion of code behind a (featurep 'xemacs) test. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index c0da59c..b621ac5 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2830,7 +2830,7 @@ advised definition from scratch." (ad-get-cache-id function)))) (ad-set-advice-info function old-advice-info) (advice-remove function advicefunname) - (fset advicefunname old-advice) + (if advicefunname (fset advicefunname old-advice)) (if old-advice (advice-add function :around advicefunname))))) commit 940df47741c5e7be1c1c84d7371da492018f0d8a Author: Eli Zaretskii Date: Mon Dec 12 19:56:03 2016 +0200 Make etags-tests work in out-of-tree builds * test/lisp/progmodes/etags-tests.el (etags-bug-158) (etags-bug-23164): Make them work in an out-of-tree build. Reported by Ken Brown . diff --git a/test/lisp/progmodes/etags-tests.el b/test/lisp/progmodes/etags-tests.el index a715bba..a992a17 100644 --- a/test/lisp/progmodes/etags-tests.el +++ b/test/lisp/progmodes/etags-tests.el @@ -37,7 +37,9 @@ xref-buf) (set-buffer buf-with-global-tags) (setq default-directory (expand-file-name ".")) - (visit-tags-table "./manual/etags/ETAGS.good_1") + (visit-tags-table + (expand-file-name "manual/etags/ETAGS.good_1" + (getenv "EMACS_TEST_DIRECTORY"))) ;; Check that tags in ETAGS.good_1 are recognized. (setq xref-buf (xref-find-definitions "LL_Task_Procedure_Access/t")) (should (bufferp xref-buf)) @@ -52,7 +54,10 @@ (set-buffer buf-with-local-tags) (setq default-directory (expand-file-name ".")) (let (his-masters-voice) - (visit-tags-table "./manual/etags/ETAGS.good_3" t)) + (visit-tags-table + (expand-file-name "manual/etags/ETAGS.good_3" + (getenv "EMACS_TEST_DIRECTORY")) + t)) ;; Check that tags in ETAGS.good_1 are recognized. (setq xref-buf (xref-find-definitions "LL_Task_Procedure_Access/t")) (should (bufferp xref-buf)) @@ -78,6 +83,9 @@ "Test that setting a local value of tags table doesn't signal errors." (set-buffer (get-buffer-create "*foobar*")) (fundamental-mode) - (visit-tags-table "./manual/etags/ETAGS.good_3" t) + (visit-tags-table + (expand-file-name "manual/etags/ETAGS.good_3" + (getenv "EMACS_TEST_DIRECTORY")) + t) (should (equal (should-error (xref-find-definitions "foobar123")) '(user-error "No definitions found for: foobar123")))) commit 825f4dd42f0f656bcb4536546b33fe8e54756468 Author: Eli Zaretskii Date: Mon Dec 12 19:08:21 2016 +0200 Avoid crashing if a new thread is signaled right away * src/thread.c (post_acquire_global_lock): Don't raise the pending signal if the thread's handlers were not yet set up, as that will cause Emacs to exit with a fatal error. This can happen if a thread is signaled as soon as make-thread returns, before the new thread had an opportunity to acquire the global lock, set up the handlers, and call the thread function. * test/src/thread-tests.el (thread-signal-early): New test. diff --git a/src/thread.c b/src/thread.c index 6e9ca2e..e8cb430 100644 --- a/src/thread.c +++ b/src/thread.c @@ -77,7 +77,12 @@ post_acquire_global_lock (struct thread_state *self) set_buffer_internal_2 (current_buffer); } - if (!NILP (current_thread->error_symbol)) + /* We could have been signaled while waiting to grab the global lock + for the first time since this thread was created, in which case + we didn't yet have the opportunity to set up the handlers. Delay + raising the signal in that case (it will be actually raised when + the thread comes here after acquiring the lock the next time). */ + if (!NILP (current_thread->error_symbol) && handlerlist) { Lisp_Object sym = current_thread->error_symbol; Lisp_Object data = current_thread->error_data; @@ -622,16 +627,15 @@ run_thread (void *state) acquire_global_lock (self); - { /* Put a dummy catcher at top-level so that handlerlist is never NULL. - This is important since handlerlist->nextfree holds the freelist - which would otherwise leak every time we unwind back to top-level. */ - handlerlist_sentinel = xzalloc (sizeof (struct handler)); - handlerlist = handlerlist_sentinel->nextfree = handlerlist_sentinel; - struct handler *c = push_handler (Qunbound, CATCHER); - eassert (c == handlerlist_sentinel); - handlerlist_sentinel->nextfree = NULL; - handlerlist_sentinel->next = NULL; - } + /* Put a dummy catcher at top-level so that handlerlist is never NULL. + This is important since handlerlist->nextfree holds the freelist + which would otherwise leak every time we unwind back to top-level. */ + handlerlist_sentinel = xzalloc (sizeof (struct handler)); + handlerlist = handlerlist_sentinel->nextfree = handlerlist_sentinel; + struct handler *c = push_handler (Qunbound, CATCHER); + eassert (c == handlerlist_sentinel); + handlerlist_sentinel->nextfree = NULL; + handlerlist_sentinel->next = NULL; /* It might be nice to do something with errors here. */ internal_condition_case (invoke_thread_function, Qt, do_nothing); diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 7261cda..26c0b72 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -235,4 +235,13 @@ (sit-for 1) (should (= (point) 21)))) +(ert-deftest thread-signal-early () + "Test signaling a thread as soon as it is started by the OS." + (let ((thread + (make-thread #'(lambda () + (while t (thread-yield)))))) + (thread-signal thread 'error nil) + (sit-for 1) + (should-not (thread-alive-p thread)))) + ;;; threads.el ends here commit a416e1d6c111527205f3583c8d201bf95af6fa20 Author: Eli Zaretskii Date: Mon Dec 12 18:03:40 2016 +0200 Fix point motion in cloned buffers * src/thread.c (post_acquire_global_lock): Call set_buffer_internal_2 instead of tricking set_buffer_internal_1 into resetting the current buffer even if it didn't change. This avoids bug#25165, caused by failing to record the modified values of point and mark, because current_buffer was set to NULL. Also, don't bother re-setting the buffer if there was no thread switch, as that just wastes cycles. * src/buffer.c (set_buffer_internal_2): New function, with most of the body of set_buffer_internal_1, but without the test for B being identical to the current buffer. (set_buffer_internal_1): Call set_buffer_internal_2 if B is not identical to the current buffer. * src/buffer.h (set_buffer_internal_2): Add prototype. * test/src/thread-tests.el (thread-sticky-point): New test. diff --git a/src/buffer.c b/src/buffer.c index cea1ddb..babfba3 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -2033,9 +2033,6 @@ DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0, void set_buffer_internal_1 (register struct buffer *b) { - register struct buffer *old_buf; - register Lisp_Object tail; - #ifdef USE_MMAP_FOR_BUFFERS if (b->text->beg == NULL) enlarge_buffer_text (b, 0); @@ -2044,6 +2041,17 @@ set_buffer_internal_1 (register struct buffer *b) if (current_buffer == b) return; + set_buffer_internal_2 (b); +} + +/* Like set_buffer_internal_1, but doesn't check whether B is already + the current buffer. Called upon switch of the current thread, see + post_acquire_global_lock. */ +void set_buffer_internal_2 (register struct buffer *b) +{ + register struct buffer *old_buf; + register Lisp_Object tail; + BUFFER_CHECK_INDIRECTION (b); old_buf = current_buffer; diff --git a/src/buffer.h b/src/buffer.h index 21ad5e3..854b5b5 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -1082,6 +1082,7 @@ extern void recenter_overlay_lists (struct buffer *, ptrdiff_t); extern ptrdiff_t overlay_strings (ptrdiff_t, struct window *, unsigned char **); extern void validate_region (Lisp_Object *, Lisp_Object *); extern void set_buffer_internal_1 (struct buffer *); +extern void set_buffer_internal_2 (struct buffer *); extern void set_buffer_temp (struct buffer *); extern Lisp_Object buffer_local_value (Lisp_Object, Lisp_Object); extern void record_buffer (Lisp_Object); diff --git a/src/thread.c b/src/thread.c index 3e61723..6e9ca2e 100644 --- a/src/thread.c +++ b/src/thread.c @@ -55,7 +55,6 @@ release_global_lock (void) static void post_acquire_global_lock (struct thread_state *self) { - Lisp_Object buffer; struct thread_state *prev_thread = current_thread; /* Do this early on, so that code below could signal errors (e.g., @@ -71,12 +70,12 @@ post_acquire_global_lock (struct thread_state *self) if (prev_thread != NULL) unbind_for_thread_switch (prev_thread); rebind_for_thread_switch (); - } - /* We need special handling to re-set the buffer. */ - XSETBUFFER (buffer, self->m_current_buffer); - self->m_current_buffer = 0; - set_buffer_internal (XBUFFER (buffer)); + /* Set the new thread's current buffer. This needs to be done + even if it is the same buffer as that of the previous thread, + because of thread-local bindings. */ + set_buffer_internal_2 (current_buffer); + } if (!NILP (current_thread->error_symbol)) { diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 4e7b052..7261cda 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -221,8 +221,18 @@ :group 'widget-faces)) (ert-deftest thread-errors () - "Test what happens when a thread signals an error." + "Test what happens when a thread signals an error." (should (threadp (make-thread #'call-error "call-error"))) (should (threadp (make-thread #'thread-custom "thread-custom")))) +(ert-deftest thread-sticky-point () + "Test bug #25165 with point movement in cloned buffer." + (with-temp-buffer + (insert "Lorem ipsum dolor sit amet, consectetur adipiscing elit.") + (goto-char (point-min)) + (clone-indirect-buffer nil nil) + (forward-char 20) + (sit-for 1) + (should (= (point) 21)))) + ;;; threads.el ends here commit 00d4ba2794243763b818c013669e36c1d2c7de62 Author: Michael Albinus Date: Mon Dec 12 11:12:34 2016 +0100 Further improvements in Tramp's file name unquoting * lisp/net/tramp-adb.el (tramp-adb-handle-file-local-copy) (tramp-adb-handle-write-region): Unquote localname. (tramp-adb-handle-copy-file): Implement direct copy on remote device. (tramp-adb-handle-rename-file): Quote arguments, add "-f" to force. * lisp/net/tramp.el (tramp-file-name-unquote-localname): New defun. (tramp-handle-file-name-case-insensitive-p): * lisp/net/tramp-gvfs.el (tramp-gvfs-get-file-attributes) (tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec) (tramp-gvfs-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-make-copy-program-file-name): * lisp/net/tramp-smb.el (tramp-smb-get-share) (tramp-smb-get-localname): Use it. * test/lisp/net/tramp-tests.el (tramp--test-docker-p): New defun. (tramp--test-special-characters, tramp-test34-utf8) (tramp-test34-utf8-with-stat, tramp-test34-utf8-with-perl) (tramp-test34-utf8-with-ls): Use it. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index f03f50b..a4218c2 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -523,6 +523,9 @@ Emacs dired can't find files." (defun tramp-adb-handle-delete-directory (directory &optional recursive) "Like `delete-directory' for Tramp files." (setq directory (expand-file-name directory)) + (with-parsed-tramp-file-name (file-truename directory) nil + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-directory-property v localname)) (with-parsed-tramp-file-name directory nil (tramp-flush-file-property v (file-name-directory localname)) (tramp-flush-directory-property v localname) @@ -578,7 +581,8 @@ Emacs dired can't find files." (with-tramp-progress-reporter v 3 (format "Fetching %s to tmp file %s" filename tmpfile) ;; "adb pull ..." does not always return an error code. - (when (or (tramp-adb-execute-adb-command v "pull" localname tmpfile) + (when (or (tramp-adb-execute-adb-command + v "pull" (tramp-compat-file-name-unquote localname) tmpfile) (not (file-exists-p tmpfile))) (ignore-errors (delete-file tmpfile)) (tramp-error @@ -638,7 +642,8 @@ But handle the case, if the \"test\" command is not available." v 3 (format-message "Moving tmp file `%s' to `%s'" tmpfile filename) (unwind-protect - (when (tramp-adb-execute-adb-command v "push" tmpfile localname) + (when (tramp-adb-execute-adb-command + v "push" tmpfile (tramp-compat-file-name-unquote localname)) (tramp-error v 'file-error "Cannot write: `%s'" filename)) (delete-file tmpfile))) @@ -681,38 +686,65 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (if (file-directory-p filename) (tramp-file-name-handler 'copy-directory filename newname keep-date t) - (with-tramp-progress-reporter - (tramp-dissect-file-name - (if (tramp-tramp-file-p filename) filename newname)) - 0 (format "Copying %s to %s" filename newname) - - (let ((tmpfile (file-local-copy filename))) - - (if tmpfile - ;; Remote filename. - (condition-case err - (rename-file tmpfile newname ok-if-already-exists) - ((error quit) - (delete-file tmpfile) - (signal (car err) (cdr err)))) - - ;; Remote newname. - (when (file-directory-p newname) - (setq newname - (expand-file-name (file-name-nondirectory filename) newname))) - - (with-parsed-tramp-file-name newname nil - (when (and (not ok-if-already-exists) - (file-exists-p newname)) - (tramp-error v 'file-already-exists newname)) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname) - (when (tramp-adb-execute-adb-command v "push" filename localname) - (tramp-error - v 'file-error "Cannot copy `%s' `%s'" filename newname)))))) + + (let ((t1 (tramp-tramp-file-p filename)) + (t2 (tramp-tramp-file-p newname))) + (with-parsed-tramp-file-name (if t1 filename newname) nil + (with-tramp-progress-reporter + v 0 (format "Copying %s to %s" filename newname) + + (if (and t1 t2 (tramp-equal-remote filename newname)) + (let ((l1 (file-remote-p filename 'localname)) + (l2 (file-remote-p newname 'localname))) + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + ;; We must also flush the cache of the directory, + ;; because `file-attributes' reads the values from + ;; there. + (tramp-flush-file-property v (file-name-directory l2)) + (tramp-flush-file-property v l2) + ;; Short track. + (tramp-adb-barf-unless-okay + v (format + "cp -f %s %s" + (tramp-shell-quote-argument l1) + (tramp-shell-quote-argument l2)) + "Error copying %s to %s" filename newname)) + + (let ((tmpfile (file-local-copy filename))) + + (if tmpfile + ;; Remote filename. + (condition-case err + (rename-file tmpfile newname ok-if-already-exists) + ((error quit) + (delete-file tmpfile) + (signal (car err) (cdr err)))) + + ;; Remote newname. + (when (file-directory-p newname) + (setq newname + (expand-file-name + (file-name-nondirectory filename) newname))) + + (with-parsed-tramp-file-name newname nil + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + + ;; We must also flush the cache of the directory, + ;; because `file-attributes' reads the values from + ;; there. + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + (when (tramp-adb-execute-adb-command + v "push" + (tramp-compat-file-name-unquote filename) + (tramp-compat-file-name-unquote localname)) + (tramp-error + v 'file-error + "Cannot copy `%s' `%s'" filename newname))))))))) ;; KEEP-DATE handling. (when keep-date @@ -749,7 +781,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-flush-file-property v l2) ;; Short track. (tramp-adb-barf-unless-okay - v (format "mv %s %s" l1 l2) + v (format + "mv -f %s %s" + (tramp-shell-quote-argument l1) + (tramp-shell-quote-argument l2)) "Error renaming %s to %s" filename newname)) ;; Rename by copy. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 46f2523..37aba59 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -901,6 +901,7 @@ file names." "Return GVFS attributes association list of FILENAME." (setq filename (directory-file-name (expand-file-name filename))) (with-parsed-tramp-file-name filename nil + (setq localname (tramp-compat-file-name-unquote localname)) (if (or (and (string-match "^\\(afp\\|smb\\)$" method) (string-match "^/?\\([^/]+\\)$" localname)) @@ -1511,7 +1512,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (string-equal user (or (tramp-file-name-user vec) "")) (string-equal host (tramp-file-name-host vec)) (string-match (concat "^" (regexp-quote prefix)) - (tramp-file-name-localname vec))) + (tramp-file-name-unquote-localname vec))) ;; Set prefix, mountpoint and location. (unless (string-equal prefix "/") (tramp-set-file-property vec "/" "prefix" prefix)) @@ -1535,7 +1536,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (domain (tramp-file-name-domain vec)) (host (tramp-file-name-real-host vec)) (port (tramp-file-name-port vec)) - (localname (tramp-file-name-localname vec)) + (localname (tramp-file-name-unquote-localname vec)) (share (when (string-match "^/?\\([^/]+\\)" localname) (match-string 1 localname))) (ssl (if (string-match "^davs" method) "true" "false")) @@ -1645,7 +1646,7 @@ connection if a previous connection has died for some reason." (let* ((method (tramp-file-name-method vec)) (user (tramp-file-name-user vec)) (host (tramp-file-name-host vec)) - (localname (tramp-file-name-localname vec)) + (localname (tramp-file-name-unquote-localname vec)) (object-path (tramp-gvfs-object-path (tramp-make-tramp-file-name method user host "")))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 52746f6..419dccb 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2227,14 +2227,8 @@ the uid and gid from FILENAME." v 'file-error "Unknown operation `%s', must be `copy' or `rename'" op)))) - (localname1 - (if t1 - (file-remote-p filename 'localname) - filename)) - (localname2 - (if t2 - (file-remote-p newname 'localname) - newname)) + (localname1 (if t1 (file-remote-p filename 'localname) filename)) + (localname2 (if t2 (file-remote-p newname 'localname) newname)) (prefix (file-remote-p (if t1 filename newname))) cmd-result) @@ -2324,11 +2318,9 @@ the uid and gid from FILENAME." (t2 (if (eq op 'copy) (copy-file - localname1 tmpfile t - keep-date preserve-uid-gid) + localname1 tmpfile t keep-date preserve-uid-gid) (tramp-run-real-handler - 'rename-file - (list localname1 tmpfile t))) + 'rename-file (list localname1 tmpfile t))) ;; We must change the ownership as local user. ;; Since this does not work reliable, we also ;; give read permissions. @@ -5166,8 +5158,8 @@ Return ATTR." (let ((method (tramp-file-name-method vec)) (user (tramp-file-name-user vec)) (host (tramp-file-name-real-host vec)) - (localname (tramp-compat-file-name-unquote - (directory-file-name (tramp-file-name-localname vec))))) + (localname + (directory-file-name (tramp-file-name-unquote-localname vec)))) (when (string-match tramp-ipv6-regexp host) (setq host (format "[%s]" host))) (unless (string-match "ftp$" method) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 7d0dc66..70b72d8 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1525,8 +1525,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (defun tramp-smb-get-share (vec) "Returns the share name of LOCALNAME." (save-match-data - (let ((localname - (tramp-compat-file-name-unquote (tramp-file-name-localname vec)))) + (let ((localname (tramp-file-name-unquote-localname vec))) (when (string-match "^/?\\([^/]+\\)/" localname) (match-string 1 localname))))) @@ -1534,8 +1533,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." "Returns the file name of LOCALNAME. If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (save-match-data - (let ((localname - (tramp-compat-file-name-unquote (tramp-file-name-localname vec)))) + (let ((localname (tramp-file-name-unquote-localname vec))) (setq localname (if (string-match "^/?[^/]+\\(/.*\\)" localname) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 100be3a..7987029 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1146,6 +1146,11 @@ entry does not exist, return nil." (string-to-number (match-string 2 host))) (tramp-get-method-parameter vec 'tramp-default-port))))) +;; The localname can be quoted with "/:". Extract this. +(defun tramp-file-name-unquote-localname (vec) + "Return unquoted localname component of VEC." + (tramp-compat-file-name-unquote (tramp-file-name-localname vec))) + ;;;###tramp-autoload (defun tramp-tramp-file-p (name) "Return t if NAME is a string with Tramp file name syntax." @@ -2910,7 +2915,9 @@ User is always nil." (with-tramp-connection-property v "case-insensitive" ;; The idea is to compare a file with lower case letters ;; with the same file with upper case letters. - (let ((candidate (directory-file-name filename)) + (let ((candidate + (tramp-compat-file-name-unquote + (directory-file-name filename))) tmpfile) ;; Check, whether we find an existing file with lower case ;; letters. This avoids us to create a temporary file. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 2d17fa0..e80af42 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2102,6 +2102,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." This requires restrictions of file name syntax." (tramp-adb-file-name-p tramp-test-temporary-file-directory)) +(defun tramp--test-docker-p () + "Check, whether the docker method is used. +This does not support some special file names." + (string-equal + "docker" (file-remote-p tramp-test-temporary-file-directory 'method))) + (defun tramp--test-ftp-p () "Check, whether an FTP-like method is used. This does not support globbing characters in file names (yet)." @@ -2293,7 +2299,9 @@ Several special characters do not work properly there." (tramp--test-check-files (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) "foo bar baz" - (if (or (tramp--test-adb-p) (eq system-type 'cygwin)) + (if (or (tramp--test-adb-p) + (tramp--test-docker-p) + (eq system-type 'cygwin)) " foo bar baz " " foo\tbar baz\t")) "$foo$bar$$baz$" @@ -2404,6 +2412,7 @@ Use the `ls' command." (ert-deftest tramp-test34-utf8 () "Check UTF8 encoding in file names and file contents." (skip-unless (tramp--test-enabled)) + (skip-unless (not (tramp--test-docker-p))) (skip-unless (not (tramp--test-rsync-p))) (tramp--test-utf8)) @@ -2413,6 +2422,7 @@ Use the `ls' command." Use the `stat' command." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) + (skip-unless (not (tramp--test-docker-p))) (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p)))) (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (skip-unless (tramp-get-remote-stat v))) @@ -2429,6 +2439,7 @@ Use the `stat' command." Use the `perl' command." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) + (skip-unless (not (tramp--test-docker-p))) (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p)))) (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (skip-unless (tramp-get-remote-perl v))) @@ -2448,6 +2459,7 @@ Use the `perl' command." Use the `ls' command." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) + (skip-unless (not (tramp--test-docker-p))) (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p)))) (let ((tramp-connection-properties